View of /trunk/pg/lib/WeBWorK/PG/IO.pm

    1 ################################################################################
    2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project
    3 # $Id$
    4 ################################################################################
    5 
    6 package WeBWorK::PG::IO;
    7 use base qw(Exporter);
    8 
    9 =head1 NAME
   10 
   11 WeBWorK::PG::IO - Private functions used by WeBWorK::PG::Translator for file IO.
   12 
   13 =cut
   14 
   15 use strict;
   16 use warnings;
   17 
   18 BEGIN {
   19   our @EXPORT = qw(
   20     includePGtext
   21     read_whole_problem_file
   22     read_whole_file
   23     convertPath
   24     getDirDelim
   25     fileFromPath
   26     directoryFromPath
   27     createFile
   28     createDirectory
   29   );
   30 
   31   our %SHARE = map { $_ => __PACKAGE__ } @EXPORT;
   32 
   33   if (defined $main::VERSION) {
   34     my $mod;
   35     for ($main::VERSION) {
   36       /^1\./          and $mod = "WeBWorK::PG::IO::WW1";
   37       /^2\./          and $mod = "WeBWorK::PG::IO::WW2";
   38       /^Daemon\s*2\./ and $mod = "WeBWorK::PG::IO::Daemon2";
   39     }
   40 
   41     eval "package Main; require $mod; import $mod"; # this is runtime_use
   42     die $@ if $@;
   43   } else {
   44     warn "\$main::VERSION not defined -- not loading version-specific IO functions";
   45   }
   46 }
   47 
   48 =head1 SYNOPSIS
   49 
   50  BEGIN { $main::VERSION = "2.0" }
   51  use WeBWorK::PG::IO;
   52  my %functions_to_share = %WeBWorK::PG::IO::SHARE;
   53 
   54 =head1 DESCRIPTION
   55 
   56 This module defines several functions to be shared with a safe compartment by
   57 the PG translator. It also loads a version-specific module (if found) based on
   58 the value of the C<$main::VERSION> variable.
   59 
   60 This module also maintains a hash C<%WeBWorK::PG::IO::SHARE>. The keys of this
   61 hash are the names of functions, and the values are the name of the package that
   62 contains the function.
   63 
   64 =head1 FUNCTIONS
   65 
   66 =over
   67 
   68 =item includePGtext($string_ref, $envir_ref)
   69 
   70 Calls C<createPGtext> recursively with the $safeCompartment variable set to 0 so
   71 that the rendering continues in the current safe compartment.  The output is the
   72 same as the output from createPGtext. This is used in processing some of the
   73 sample CAPA files.
   74 
   75 =cut
   76 
   77 sub includePGtext  {
   78   my $evalString = shift;
   79   if (ref($evalString) eq 'SCALAR') {
   80     $evalString = $$evalString;
   81   }
   82   $evalString =~ s/\nBEGIN_TEXT/TEXT\(EV3\(<<'END_TEXT'\)\);/g;
   83   $evalString =~ s/\\/\\\\/g; # \ can't be used for escapes because of TeX conflict
   84   $evalString =~ s/~~/\\/g;   # use ~~ as escape instead, use # for comments
   85   no strict;
   86   eval("package main; $evalString") ;
   87   my $errors = $@;
   88   die eval(q! "ERROR in included file:\n$main::envir{probFileName}\n $errors\n"!) if $errors;
   89   use strict;
   90   return "";
   91 }
   92 
   93 =item read_whole_problem_file($filePath)
   94 
   95 Don't use for huge files. The file name will have .pg appended to it if it
   96 doesn't already end in .pg.  Files may become double spaced.?  Check the join
   97 below. This is used in importing additional .pg files as is done in the sample
   98 problems translated from CAPA. Returns a reference to a string containing the
   99 contents of the file.
  100 
  101 =cut
  102 
  103 sub read_whole_problem_file {
  104   my $filePath = shift;
  105   $filePath =~s/^\s*//; # get rid of initial spaces
  106   $filePath =~s/\s*$//; # get rid of final spaces
  107   $filePath = "$filePath.pg" unless $filePath =~ /\.pg$/;
  108   read_whole_file($filePath);
  109 }
  110 
  111 sub read_whole_file {
  112   my $filePath = shift;
  113   local (*INPUT);
  114   open(INPUT, "<$filePath") || die "$0: readWholeProblemFile subroutine: <BR>Can't read file $filePath";
  115   local($/)=undef;
  116   my $string = <INPUT>;  # can't append spaces because this causes trouble with <<'EOF'   \nEOF construction
  117   close(INPUT);
  118   \$string;
  119 }
  120 
  121 =item convertPath($path)
  122 
  123 Currently a no-op. Returns $path unmodified.
  124 
  125 =cut
  126 
  127 sub convertPath {
  128     return wantarray ? @_ : shift;
  129 }
  130 
  131 sub getDirDelim {
  132   return ("/");
  133 }
  134 
  135 =item fileFromPath($path)
  136 
  137 Uses C<&getDirDelim> to determine the path delimiter.  Returns the last segment
  138 of the path (i.e. the text after the last delimiter).
  139 
  140 =cut
  141 
  142 sub fileFromPath {
  143   my $path = shift;
  144   my $delim = &getDirDelim();
  145   $path = convertPath($path);
  146   $path =~ m|([^$delim]+)$|;
  147   $1;
  148 }
  149 
  150 =item directoryFromPath($path)
  151 
  152 Uses C<&getDirDelim> to determine the path delimiter.  Returns the initial
  153 segments of the of the path (i.e. the text up to the last delimiter).
  154 
  155 =cut
  156 
  157 sub directoryFromPath {
  158   my $path = shift;
  159   my $delim = &getDirDelim();
  160   $path = convertPath($path);
  161   $path =~ s|[^$delim]*$||;
  162   $path;
  163 }
  164 
  165 =item createFile($fileName, $permission, $numgid)
  166 
  167 Creates a file with the given name, permission bits, and group ID.
  168 
  169 =cut
  170 
  171 sub createFile {
  172   my ($fileName, $permission, $numgid) = @_;
  173   open(TEMPCREATEFILE, ">$fileName")
  174     or die "Can't open $fileName: $!";
  175   my @stat = stat TEMPCREATEFILE;
  176   close(TEMPCREATEFILE);
  177 
  178   # if the owner of the file is running this script (e.g. when the file is
  179   # first created) set the permissions and group correctly
  180   if ($< == $stat[4]) {
  181     my $tmp = chmod($permission, $fileName)
  182       or warn "Can't do chmod($permission, $fileName): $!";
  183     chown(-1, $numgid, $fileName)
  184       or warn "Can't do chown($numgid, $fileName): $!";
  185   }
  186 }
  187 
  188 =item createDirectory($dirName, $permission, $numgid)
  189 
  190 Creates a directory with the given name, permission bits, and group ID.
  191 
  192 =cut
  193 
  194 sub createDirectory {
  195   my ($dirName, $permission, $numgid) = @_;
  196   $permission = (defined($permission)) ? $permission : '0770';
  197   # FIXME -- find out where the permission is supposed to be defined.
  198   #warn "dirName is $dirName and permission is $permission";
  199   mkdir($dirName, $permission)
  200     or warn "Can't do mkdir($dirName, $permission): $!";
  201   chmod($permission, $dirName)
  202     or warn "Can't do chmod($permission, $dirName): $!";
  203   unless ($numgid == -1) {
  204     chown(-1,$numgid,$dirName)
  205       or warn "Can't do chown(-1,$numgid,$dirName): $!";
  206   }
  207 }
  208 
  209 =back
  210 
  211 =cut
  212 
  213 1;