Parent Directory
| 
Revision Log
- created macros/IO.pl, which is loaded with no opmask by PG.pm. It is a copy of WeBWorK::PG::IO.pm, with some changes to make it work as a macro package. The translator no longer shares IO.pm's functions with the safe compartment. This is a BAD THING, and should be reconsidered when the Translator is revised. - Changed many (but not all) checks for HTML or HTML_tth modes to match /^HTML/ in the macros. - changed &header to &head in Problem.pm - Added problem environment variables for gif2eps and png2eps and modified &dangerousMacros::alias to use them - fixed MOST of the harmless warnings in the system. there's still the "Use of uninitialized value in null operation" warning in template(), tho. Still to come: - make images in PDFs work - fix TTH mode character encodings on mac (maybe) - have logout button invalidate key - Pretty die messages (from outside of the translator) - Feedback - need nice modular way of sending email - Options - email address and password
1 ################################################################################ 2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project 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 writeLog 27 writeTimingLogEntry 28 dbDecode 29 dbEncode 30 decodeAnswers 31 encodeAnswers 32 ref2string 33 ); 34 35 sub runtime_use($) { 36 return unless @_; 37 eval "package Main; require $_[0]; import $_[0]"; 38 die $@ if $@; 39 } 40 41 sub readFile($) { 42 my $fileName = shift; 43 local *INPUTFILE; 44 open INPUTFILE, "<", $fileName 45 or die "Failed to read $fileName: $!"; 46 local $/ = undef; 47 my $result = <INPUTFILE>; 48 close INPUTFILE; 49 return $result; 50 } 51 52 sub formatDateTime($) { 53 my $dateTime = shift; 54 # "standard" WeBWorK date/time format (for set definition files): 55 # %m month number, starting with 01 56 # %d numeric day of the month, with leading zeros (eg 01..31) 57 # %y year (2 digits) 58 # %I hour, 12 hour clock, leading 0's) 59 # %M minute, leading 0's 60 # %P am or pm (Yes %p and %P are backwards :) 61 return time2str("%m/%d/%y %I:%M%P", $dateTime); 62 } 63 64 sub parseDateTime($) { 65 my $string = shift; 66 return str2time $string; 67 } 68 69 sub writeLog($$@) { 70 my ($ce, $facility, @message) = @_; 71 unless ($ce->{webworkFiles}->{logs}->{$facility}) { 72 warn "There is no log file for the $facility facility defined.\n"; 73 return; 74 } 75 my $logFile = $ce->{webworkFiles}->{logs}->{$facility}; 76 local *LOG; 77 if (open LOG, ">>", $logFile) { 78 print LOG "[", time2str("%a %b %d %H:%M:%S %Y", time), "] @message\n"; 79 close LOG; 80 } else { 81 warn "failed to open $logFile for writing: $!"; 82 } 83 } 84 85 sub writeTimingLogEntry($$$$) { 86 my ($ce, $function, $details, $beginEnd) = @_; 87 return unless defined $ce->{webworkFiles}->{logs}->{timing}; 88 $beginEnd = ($beginEnd eq "begin") ? ">" : "<"; 89 writeLog($ce, "timing", "$$ ".time." $beginEnd $function [$details]"); 90 } 91 92 # ----- 93 94 sub dbDecode($) { 95 my $string = shift; 96 return unless defined $string and $string; 97 my %hash = $string =~ /(.*?)(?<!\\)=(.*?)(?:(?<!\\)&|$)/g; 98 $hash{$_} =~ s/\\(&|=)/$1/g foreach keys %hash; # unescape & and = 99 return %hash; 100 } 101 102 sub dbEncode(@) { 103 my %hash = @_; 104 my $string; 105 foreach (keys %hash) { 106 $hash{$_} = "" unless defined $hash{$_}; # promote undef to "" 107 $hash{$_} =~ s/(=|&)/\\$1/g; # escape & and = 108 $string .= "$_=$hash{$_}&"; 109 } 110 chop $string; # remove final '&' from string for old code :p 111 return $string; 112 } 113 114 sub decodeAnswers($) { 115 my $string = shift; 116 return unless defined $string and $string; 117 my @array = split m/##/, $string; 118 $array[$_] =~ s/\\#\\/#/g foreach 0 .. $#array; 119 push @array, "" if @array%2; 120 return @array; # it's actually a hash ;) 121 } 122 123 sub encodeAnswers(\%\@) { 124 my %hash = %{ shift() }; 125 my @order = @{ shift() }; 126 my $string; 127 foreach my $name (@order) { 128 my $value = defined $hash{$name} ? $hash{$name} : ""; 129 $name =~ s/#/\\#\\/g; # this is a WEIRD way to escape things 130 $value =~ s/#/\\#\\/g; # and it's not my fault! 131 $string .= "$name##$value##"; # this is also not my fault 132 } 133 $string =~ s/##$//; # remove last pair of hashs 134 return $string; 135 } 136 137 # ----- 138 139 sub ref2string($;$); 140 sub ref2string($;$) { 141 my $ref = shift; 142 my $dontExpand = shift || {}; 143 my $refType = ref $ref; 144 my $result; 145 if ($refType and not $dontExpand->{$refType}) { 146 my $baseType = refBaseType($ref); 147 $result .= '<font size="1" color="grey">' . $refType; 148 $result .= " ($baseType)" if $baseType and $refType ne $baseType; 149 $result .= ":</font><br>"; 150 $result .= '<table border="1" cellpadding="2">'; 151 if ($baseType eq "HASH") { 152 my %hash = %$ref; 153 foreach (sort keys %hash) { 154 $result .= '<tr valign="top">'; 155 $result .= "<td>$_</td>"; 156 $result .= "<td>" . ref2string($hash{$_}, $dontExpand) . "</td>"; 157 $result .= "</tr>"; 158 } 159 } elsif ($baseType eq "ARRAY") { 160 my @array = @$ref; 161 # special case for Problem, Set, and User objects, which are defined 162 # using lists and contain a @FIELDS package variable: 163 no strict 'refs'; 164 my @FIELDS = eval { @{$refType."::FIELDS"} }; 165 use strict 'refs'; 166 undef @FIELDS unless scalar @FIELDS == scalar @array and not $@; 167 foreach (0 .. $#array) { 168 $result .= '<tr valign="top">'; 169 $result .= "<td>$_</td>"; 170 $result .= "<td>".$FIELDS[$_]."</td>" if @FIELDS; 171 $result .= "<td>" . ref2string($array[$_], $dontExpand) . "</td>"; 172 $result .= "</tr>"; 173 } 174 } elsif ($baseType eq "SCALAR") { 175 my $scalar = $$ref; 176 $result .= '<tr valign="top">'; 177 $result .= "<td>$scalar</td>"; 178 $result .= "</tr>"; 179 } else { 180 # perhaps a coderef? in any case, i don't feel like dealing with it! 181 $result .= '<tr valign="top">'; 182 $result .= "<td>$ref</td>"; 183 $result .= "</tr>"; 184 } 185 $result .= "</table>" 186 } else { 187 $result .= defined $ref ? $ref : '<font color="red">undef</font>'; 188 } 189 } 190 191 sub refBaseType($) { 192 my $ref = shift; 193 local $SIG{__DIE__} = 'IGNORE'; 194 return "HASH" if eval { $_ = %$ref; 1 }; 195 return "ARRAY" if eval { $_ = @$ref; 1 }; 196 return "SCALAR" if eval { $_ = $$ref; 1 }; 197 return 0; 198 } 199 200 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |