View of /trunk/webwork-modperl/lib/WebworkWebservice/LibraryActions.pm

    1 #!/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 use Apache;
   22 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 warn "LibraryActions is ready";
   40 
   41 ##############################################
   42 #   Obtain basic information about local libraries
   43 ##############################################
   44  my %prob_libs  = %{$ce->{courseFiles}->{problibs} };
   45 
   46  warn pretty_print_rh(\%prob_libs);
   47  # 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     warn "library directory path is $dirPath";
  114   my @outListLib;
  115   my $wanted = sub {
  116     my $name = $File::Find::name;
  117     my @out=();
  118     if ($name =~/\S/ ) {
  119       $name =~ s|^$dirPath/*||o;  # cut the first directory
  120             # $name =~ s|^\w*\/||;     # cut the set name
  121       push(@outListLib, "$name") if $name =~/\.pg/;
  122 
  123     }
  124   };
  125 
  126   my $command = $rh->{command};
  127   $command = 'all' unless defined($command);
  128       $command eq 'all' &&    do {print "$dirPath\n\n";
  129                     find($wanted, $dirPath);
  130                     @outListLib = sort @outListLib;
  131                     $out->{ra_out} = \@outListLib;
  132                     $out->{text} = join("\n", @outListLib);
  133                     return($out);
  134       };
  135       $command eq 'setsOnly' &&   do {
  136                       if ( opendir(DIR, $dirPath) ) {
  137                           my @fileList=();
  138                         while (defined(my $file = readdir(DIR))) {
  139                           push(@fileList,$file) if -d "$dirPath/$file";
  140 
  141                         }
  142                         $out->{text} = join("\n",sort @fileList);
  143                         closedir(DIR);
  144                       } else {
  145                         $out->{error}= "Can't open directory $dirPath";
  146                       }
  147                       return($out);
  148       };
  149 
  150       $command eq 'listSet' && do {@outListLib=();
  151                      my $dirPath2 = $dirPath . $rh->{set};
  152 
  153                      if ( -e $dirPath2) {
  154                        find($wanted, $dirPath2);
  155                        $out ->{text} = join("\n", sort @outListLib );
  156                      } else {
  157                        $out->{error} = "Can't open directory $dirPath2";
  158                      }
  159                      return($out);
  160 
  161       };
  162       # else
  163       $out->{error}="Unrecognized command $command";
  164       $out;
  165 }
  166 
  167 
  168 sub pretty_print_rh {
  169   my $rh = shift;
  170   my $out = "";
  171   my $type = ref($rh);
  172   if ( ref($rh) =~/HASH/ ) {
  173     foreach my $key (sort keys %{$rh})  {
  174       $out .= "  $key => " . pretty_print_rh( $rh->{$key} ) . "\n";
  175     }
  176   } elsif ( ref($rh) =~ /SCALAR/ ) {
  177     $out = "scalar reference ". ${$rh};
  178   } elsif ( ref($rh) =~/Base64/ ) {
  179     $out .= "base64 reference " .$$rh;
  180   } else {
  181     $out =  $rh;
  182   }
  183   if (defined($type) ) {
  184     $out .= "type = $type \n";
  185   }
  186   return $out;
  187 }
  188 
  189 
  190 1;