View of /trunk/webwork2/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 WWSafe;
   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 {  # list the problem libraries that are available.
   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 for ",$rh->{library_name}," is $dirPath";
  114   my @outListLib;
  115   my %libDirectoryList;
  116   my $wanted = sub {
  117     unless ($File::Find::dir =~/.svn/ ) {
  118       my $name = $File::Find::name;
  119       if ($name =~/\S/ ) {
  120         $name =~ s|^$dirPath/*||;  # cut the first directory
  121         push(@outListLib, "$name") if $name =~/\.pg/;
  122 
  123       }
  124     }
  125   };
  126   my $wanted_directory = sub {
  127     unless ($File::Find::dir =~/.svn/ ) {
  128       my $dir = $File::Find::dir;
  129       if ($dir =~/\S/ ) {
  130         $dir =~ s|^$dirPath/*||;  # cut the first directory
  131         $libDirectoryList{$dir}++;
  132       }
  133     }
  134   };
  135 
  136   my $command = $rh->{command};
  137   warn "the command being executed is ' $command '";
  138   $command = 'all' unless defined($command);
  139       $command eq 'all' &&    do {
  140                     find({wanted=>$wanted,follow_fast=>1 }, $dirPath);
  141                     @outListLib = sort @outListLib;
  142                     $out->{ra_out} = \@outListLib;
  143                     $out->{text} = encode_base64( join("\n", @outListLib) );
  144                     return($out);
  145       };
  146       $command eq 'dirOnly' &&   do {
  147                     find({wanted=>$wanted_directory,follow_fast=>1 }, $dirPath);
  148                     @outListLib = sort keys %libDirectoryList;
  149                     $out->{ra_out} = \@outListLib;
  150                     $out->{text} = encode_base64( join("\n", @outListLib) );
  151                     return($out);
  152       };
  153 
  154       $command eq 'files' && do {  @outListLib=();
  155                      my $separator = ($dirPath =~m|/$|) ?'' : '/';
  156                      my $dirPath2 = $dirPath . $separator . $rh->{dirPath};
  157                      if ( -e $dirPath2) {
  158                        find($wanted, $dirPath2);
  159                        @outListLib = sort @outListLib;
  160                        $out ->{text} = encode_base64( join("\n", @outListLib ) );
  161                        $out->{ra_out} = \@outListLib;
  162                      } else {
  163                        $out->{error} = "Can't open directory  $dirPath2";
  164                      }
  165                      return($out);
  166 
  167       };
  168       # else
  169       $out->{error}="Unrecognized command $command";
  170       return( $out );
  171 }
  172 
  173 
  174 sub pretty_print_rh {
  175   my $rh = shift;
  176   my $out = "";
  177   my $type = ref($rh);
  178   if ( ref($rh) =~/HASH/ ) {
  179     foreach my $key (sort keys %{$rh})  {
  180       $out .= "  $key => " . pretty_print_rh( $rh->{$key} ) . "\n";
  181     }
  182   } elsif ( ref($rh) =~ /SCALAR/ ) {
  183     $out = "scalar reference ". ${$rh};
  184   } elsif ( ref($rh) =~/Base64/ ) {
  185     $out .= "base64 reference " .$$rh;
  186   } else {
  187     $out =  $rh;
  188   }
  189   if (defined($type) ) {
  190     $out .= "type = $type \n";
  191   }
  192   return $out;
  193 }
  194 
  195 
  196 1;