Parent Directory
| 
Revision Log
Revision 6230 - (view) (download) (as text)
| 1 : | gage | 3065 | #!/usr/local/bin/perl -w |
| 2 : | |||
| 3 : | # Copyright (C) 2002 Michael Gage | ||
| 4 : | |||
| 5 : | ############################################################################### | ||
| 6 : | # Web service which fetches WeBWorK problems from a library. | ||
| 7 : | ############################################################################### | ||
| 8 : | |||
| 9 : | |||
| 10 : | #use lib '/home/gage/webwork/pg/lib'; | ||
| 11 : | #use lib '/home/gage/webwork/webwork-modperl/lib'; | ||
| 12 : | |||
| 13 : | package WebworkWebservice::LibraryActions; | ||
| 14 : | use WebworkWebservice; | ||
| 15 : | use base qw(WebworkWebservice); | ||
| 16 : | |||
| 17 : | use strict; | ||
| 18 : | use sigtrap; | ||
| 19 : | use Carp; | ||
| 20 : | use Safe; | ||
| 21 : | gage | 6230 | #use Apache; |
| 22 : | gage | 3065 | use WeBWorK::Utils; |
| 23 : | use WeBWorK::CourseEnvironment; | ||
| 24 : | use WeBWorK::PG::Translator; | ||
| 25 : | use WeBWorK::PG::IO; | ||
| 26 : | use Benchmark; | ||
| 27 : | use MIME::Base64 qw( encode_base64 decode_base64); | ||
| 28 : | |||
| 29 : | ############################################## | ||
| 30 : | # Obtain basic information about directories, course name and host | ||
| 31 : | ############################################## | ||
| 32 : | our $WW_DIRECTORY = $WebworkWebservice::WW_DIRECTORY; | ||
| 33 : | our $PG_DIRECTORY = $WebworkWebservice::PG_DIRECTORY; | ||
| 34 : | our $COURSENAME = $WebworkWebservice::COURSENAME; | ||
| 35 : | our $HOST_NAME = $WebworkWebservice::HOST_NAME; | ||
| 36 : | our $PASSWORD = $WebworkWebservice::PASSWORD; | ||
| 37 : | our $ce = WeBWorK::CourseEnvironment->new($WW_DIRECTORY, "", "", $COURSENAME); | ||
| 38 : | #warn "library ce \n ", WebworkWebservice::pretty_print_rh($ce); | ||
| 39 : | gage | 3073 | #warn "LibraryActions is ready"; |
| 40 : | gage | 3065 | |
| 41 : | ############################################## | ||
| 42 : | # Obtain basic information about local libraries | ||
| 43 : | ############################################## | ||
| 44 : | my %prob_libs = %{$ce->{courseFiles}->{problibs} }; | ||
| 45 : | |||
| 46 : | gage | 3073 | #warn pretty_print_rh(\%prob_libs); |
| 47 : | gage | 3065 | # replace library names with full paths |
| 48 : | |||
| 49 : | my $templateDir = $ce->{courseDirs}->{templates}; | ||
| 50 : | # warn "template Directory is $templateDir"; | ||
| 51 : | foreach my $key (keys %prob_libs) { | ||
| 52 : | $prob_libs{$key} = "$templateDir/$key"; | ||
| 53 : | } | ||
| 54 : | #warn "prob libraries", WebworkWebservice::pretty_print_rh(\%prob_libs); | ||
| 55 : | |||
| 56 : | sub listLibraries { | ||
| 57 : | my $rh = shift; | ||
| 58 : | return [sort keys %prob_libs]; | ||
| 59 : | } | ||
| 60 : | |||
| 61 : | use File::stat; | ||
| 62 : | sub readFile { | ||
| 63 : | my $rh = shift; | ||
| 64 : | local($|)=1; | ||
| 65 : | my $out = {}; | ||
| 66 : | my $filePath = $rh->{filePath}; | ||
| 67 : | unless ($rh->{pw} eq $PASSWORD ) { | ||
| 68 : | $out->{error} =404; | ||
| 69 : | return($out); | ||
| 70 : | } | ||
| 71 : | if ( defined($prob_libs{$rh->{library_name}} ) ) { | ||
| 72 : | $filePath = $prob_libs{$rh->{library_name}} .'/'. $filePath; | ||
| 73 : | } else { | ||
| 74 : | $out->{error} = "Could not find library:".$rh->{library_name}.":"; | ||
| 75 : | return($out); | ||
| 76 : | } | ||
| 77 : | |||
| 78 : | if (-r $filePath) { | ||
| 79 : | open IN, "<$filePath"; | ||
| 80 : | local($/)=undef; | ||
| 81 : | my $text = <IN>; | ||
| 82 : | $out->{text}= encode_base64($text); | ||
| 83 : | my $sb=stat($filePath); | ||
| 84 : | $out->{size}=$sb->size; | ||
| 85 : | $out->{path}=$filePath; | ||
| 86 : | $out->{permissions}=$sb->mode&07777; | ||
| 87 : | $out->{modTime}=scalar localtime $sb->mtime; | ||
| 88 : | close(IN); | ||
| 89 : | } else { | ||
| 90 : | $out->{error} = "Could not read file at |$filePath|"; | ||
| 91 : | } | ||
| 92 : | return($out); | ||
| 93 : | } | ||
| 94 : | |||
| 95 : | |||
| 96 : | |||
| 97 : | use File::Find; | ||
| 98 : | sub listLib { | ||
| 99 : | my $rh = shift; | ||
| 100 : | my $out = {}; | ||
| 101 : | my $dirPath; | ||
| 102 : | unless ($rh->{pw} eq $PASSWORD ) { | ||
| 103 : | $out->{error}=" 404 $PASSWORD and ".$rh->{pw}; | ||
| 104 : | return($out); | ||
| 105 : | } | ||
| 106 : | |||
| 107 : | if ( defined($prob_libs{$rh->{library_name}} ) ) { | ||
| 108 : | $dirPath = $prob_libs{$rh->{library_name}} ; | ||
| 109 : | } else { | ||
| 110 : | $out->{error} = "Could not find library:".$rh->{library_name}.":"; | ||
| 111 : | return($out); | ||
| 112 : | } | ||
| 113 : | gage | 6230 | warn "library directory path is $dirPath"; |
| 114 : | gage | 3065 | my @outListLib; |
| 115 : | my $wanted = sub { | ||
| 116 : | my $name = $File::Find::name; | ||
| 117 : | my @out=(); | ||
| 118 : | if ($name =~/\S/ ) { | ||
| 119 : | gage | 3243 | $name =~ s|^$dirPath/*||; # cut the first directory |
| 120 : | gage | 3065 | push(@outListLib, "$name") if $name =~/\.pg/; |
| 121 : | |||
| 122 : | } | ||
| 123 : | }; | ||
| 124 : | |||
| 125 : | my $command = $rh->{command}; | ||
| 126 : | $command = 'all' unless defined($command); | ||
| 127 : | gage | 3222 | $command eq 'all' && do { |
| 128 : | gage | 6230 | find({wanted=>$wanted,follow_fast=>1 }, $dirPath); |
| 129 : | gage | 3065 | @outListLib = sort @outListLib; |
| 130 : | $out->{ra_out} = \@outListLib; | ||
| 131 : | $out->{text} = join("\n", @outListLib); | ||
| 132 : | return($out); | ||
| 133 : | }; | ||
| 134 : | $command eq 'setsOnly' && do { | ||
| 135 : | if ( opendir(DIR, $dirPath) ) { | ||
| 136 : | my @fileList=(); | ||
| 137 : | while (defined(my $file = readdir(DIR))) { | ||
| 138 : | push(@fileList,$file) if -d "$dirPath/$file"; | ||
| 139 : | |||
| 140 : | } | ||
| 141 : | gage | 3222 | @fileList = sort @fileList; |
| 142 : | $out->{text} = join("\n",@fileList); | ||
| 143 : | $out->{ra_out} = \@fileList; | ||
| 144 : | gage | 3065 | closedir(DIR); |
| 145 : | } else { | ||
| 146 : | $out->{error}= "Can't open directory $dirPath"; | ||
| 147 : | } | ||
| 148 : | return($out); | ||
| 149 : | }; | ||
| 150 : | |||
| 151 : | $command eq 'listSet' && do {@outListLib=(); | ||
| 152 : | gage | 3073 | my $separator = ($dirPath =~m|/$|) ?'' : '/'; |
| 153 : | my $dirPath2 = $dirPath . $separator . $rh->{set}; | ||
| 154 : | gage | 3065 | |
| 155 : | if ( -e $dirPath2) { | ||
| 156 : | find($wanted, $dirPath2); | ||
| 157 : | gage | 3222 | @outListLib = sort @outListLib; |
| 158 : | $out ->{text} = join("\n", @outListLib ); | ||
| 159 : | $out->{ra_out} = \@outListLib; | ||
| 160 : | gage | 3065 | } else { |
| 161 : | gage | 3073 | $out->{error} = "Can't open directory $dirPath2"; |
| 162 : | gage | 3065 | } |
| 163 : | return($out); | ||
| 164 : | |||
| 165 : | }; | ||
| 166 : | # else | ||
| 167 : | $out->{error}="Unrecognized command $command"; | ||
| 168 : | $out; | ||
| 169 : | } | ||
| 170 : | |||
| 171 : | |||
| 172 : | sub pretty_print_rh { | ||
| 173 : | my $rh = shift; | ||
| 174 : | my $out = ""; | ||
| 175 : | my $type = ref($rh); | ||
| 176 : | if ( ref($rh) =~/HASH/ ) { | ||
| 177 : | foreach my $key (sort keys %{$rh}) { | ||
| 178 : | $out .= " $key => " . pretty_print_rh( $rh->{$key} ) . "\n"; | ||
| 179 : | } | ||
| 180 : | } elsif ( ref($rh) =~ /SCALAR/ ) { | ||
| 181 : | $out = "scalar reference ". ${$rh}; | ||
| 182 : | } elsif ( ref($rh) =~/Base64/ ) { | ||
| 183 : | $out .= "base64 reference " .$$rh; | ||
| 184 : | } else { | ||
| 185 : | $out = $rh; | ||
| 186 : | } | ||
| 187 : | if (defined($type) ) { | ||
| 188 : | $out .= "type = $type \n"; | ||
| 189 : | } | ||
| 190 : | return $out; | ||
| 191 : | } | ||
| 192 : | |||
| 193 : | |||
| 194 : | 1; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |