View of /trunk/webwork2/lib/WeBWorK/Utils.pm

    1 ################################################################################
    2 # WeBWorK mod_perl (c) 1995-2002 WeBWorK Team, Univeristy of Rochester
    3 # $Id$
    4 ################################################################################
    5 
    6 package WeBWorK::Utils;
    7 
    8 =head1 NAME
    9 
   10 WeBWorK::Utils - useful utilities used by other WeBWorK modules.
   11 
   12 =cut
   13 
   14 use strict;
   15 use warnings;
   16 use base qw(Exporter);
   17 use Date::Format;
   18 use Date::Parse;
   19 
   20 our @EXPORT    = ();
   21 our @EXPORT_OK = qw(
   22   runtime_use
   23   readFile
   24   formatDateTime
   25   parseDateTime
   26   dbDecode
   27   dbEncode
   28   decodeAnswers
   29   encodeAnswers
   30   ref2string
   31 );
   32 
   33 sub runtime_use($) {
   34   return unless @_;
   35   eval "package Main; require $_[0]; import $_[0]";
   36   die $@ if $@;
   37 }
   38 
   39 sub readFile($) {
   40   my $fileName = shift;
   41   open INPUTFILE, "<", $fileName
   42     or die "Failed to read $fileName: $!";
   43   local $/ = undef;
   44   my $result = <INPUTFILE>;
   45   close INPUTFILE;
   46   return $result;
   47 }
   48 
   49 sub formatDateTime($) {
   50   my $dateTime = shift;
   51   # "standard" WeBWorK date/time format:
   52   # %m  month number, starting with 01
   53   # %d  numeric day of the month, with leading zeros (eg 01..31)
   54   # %y  year (2 digits)
   55   # %I  hour, 12 hour clock, leading 0's)
   56   # %M  minute, leading 0's
   57   # %P  am or pm (Yes %p and %P are backwards :)
   58   return time2str "%m/%d/%y %I:%M%P", $dateTime;
   59 }
   60 
   61 sub parseDateTime($) {
   62   my $string = shift;
   63   return str2time $string;
   64 }
   65 
   66 # -----
   67 
   68 sub dbDecode($) {
   69   my $string = shift;
   70   return unless defined $string and $string;
   71   my %hash = $string =~ /(.*?)(?<!\\)=(.*?)(?:(?<!\\)&|$)/g;
   72   $hash{$_} =~ s/\\(&|=)/$1/g foreach keys %hash; # unescape & and =
   73   return %hash;
   74 }
   75 
   76 sub dbEncode(@) {
   77   my %hash = @_;
   78   my $string;
   79   foreach (keys %hash) {
   80     $hash{$_} = "" unless defined $hash{$_}; # promote undef to ""
   81     $hash{$_} =~ s/(=|&)/\\$1/g; # escape & and =
   82     $string .= "$_=$hash{$_}&";
   83   }
   84   chop $string; # remove final '&' from string for old code :p
   85   return $string;
   86 }
   87 
   88 sub decodeAnswers($) {
   89   my $string = shift;
   90   return unless defined $string and $string;
   91   my @array = split m/##/, $string;
   92   $array[$_] =~ s/\\#\\/#/g foreach 0 .. $#array;
   93   push @array, "" if @array%2;
   94   return @array; # it's actually a hash ;)
   95 }
   96 
   97 sub encodeAnswers(\%\@) {
   98   my %hash = %{ shift() };
   99   my @order = @{ shift() };
  100   my $string;
  101   foreach my $name (@order) {
  102     my $value = defined $hash{$name} ? $hash{$name} : "";
  103     $name  =~ s/#/\\#\\/g; # this is a WEIRD way to escape things
  104     $value =~ s/#/\\#\\/g; # and it's not my fault!
  105     $string .= "$name##$value##"; # this is also not my fault
  106   }
  107   $string =~ s/##$//; # remove last pair of hashs
  108   return $string;
  109 }
  110 
  111 # -----
  112 
  113 sub ref2string($;$);
  114 sub ref2string($;$) {
  115   my $ref = shift;
  116   my $dontExpand = shift || {};
  117   my $refType = ref $ref;
  118   my $result;
  119   if ($refType and not $dontExpand->{$refType}) {
  120     my $baseType = refBaseType($ref);
  121     $result .= '<font size="1" color="grey">' . $refType;
  122     $result .= " ($baseType)" if $baseType and $refType ne $baseType;
  123     $result .= ":</font><br>";
  124     $result .= '<table border="1" cellpadding="2">';
  125     if ($baseType eq "HASH") {
  126       my %hash = %$ref;
  127       foreach (sort keys %hash) {
  128         $result .= '<tr valign="top">';
  129         $result .= "<td>$_</td>";
  130         $result .= "<td>" . ref2string($hash{$_}, $dontExpand) . "</td>";
  131         $result .= "</tr>";
  132       }
  133     } elsif ($baseType eq "ARRAY") {
  134       my @array = @$ref;
  135       # special case for Problem, Set, and User objects, which are defined
  136       # using lists and contain a @FIELDS package variable:
  137       no strict 'refs';
  138       my @FIELDS = eval { @{$refType."::FIELDS"} };
  139       use strict 'refs';
  140       undef @FIELDS unless scalar @FIELDS == scalar @array and not $@;
  141       foreach (0 .. $#array) {
  142         $result .= '<tr valign="top">';
  143         $result .= "<td>$_</td>";
  144         $result .= "<td>".$FIELDS[$_]."</td>" if @FIELDS;
  145         $result .= "<td>" . ref2string($array[$_], $dontExpand) . "</td>";
  146         $result .= "</tr>";
  147       }
  148     } elsif ($baseType eq "SCALAR") {
  149       my $scalar = $$ref;
  150       $result .= '<tr valign="top">';
  151       $result .= "<td>$scalar</td>";
  152       $result .= "</tr>";
  153     } else {
  154       # perhaps a coderef? in any case, i don't feel like dealing with it!
  155       $result .= '<tr valign="top">';
  156       $result .= "<td>$ref</td>";
  157       $result .= "</tr>";
  158     }
  159     $result .= "</table>"
  160   } else {
  161     $result .= defined $ref ? $ref : '<font color="red">undef</font>';
  162   }
  163 }
  164 
  165 sub refBaseType($) {
  166   my $ref = shift;
  167   local $SIG{__DIE__} = 'IGNORE';
  168   return "HASH"   if eval { $_ = %$ref; 1 };
  169   return "ARRAY"  if eval { $_ = @$ref; 1 };
  170   return "SCALAR" if eval { $_ = $$ref; 1 };
  171   return 0;
  172 }
  173 
  174 1;