Parent Directory
| 
Revision Log
Fix max in Util.pm did some UI refactoring. -Dennis
1 ################################################################################ 2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project 3 # $Id$ 4 ################################################################################ 5 6 package WeBWorK::Utils; 7 use base qw(Exporter); 8 9 =head1 NAME 10 11 WeBWorK::Utils - useful utilities used by other WeBWorK modules. 12 13 =cut 14 15 use strict; 16 use warnings; 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 list2hash 29 max 30 readDirectory 31 dbDecode 32 dbEncode 33 decodeAnswers 34 encodeAnswers 35 ref2string 36 dequoteHere 37 wrapText 38 ); 39 40 sub runtime_use($) { 41 return unless @_; 42 eval "package Main; require $_[0]; import $_[0]"; 43 die $@ if $@; 44 } 45 46 sub readFile($) { 47 my $fileName = shift; 48 local *INPUTFILE; 49 open INPUTFILE, "<", $fileName 50 or die "Failed to read $fileName: $!"; 51 local $/ = undef; 52 my $result = <INPUTFILE>; 53 close INPUTFILE; 54 return $result; 55 } 56 57 sub readDirectory($) { 58 my ($dirname) = @_; 59 60 opendir my $dirhandle, $dirname or die "couldn't open directory $dirname: $!"; 61 my @contents = readdir $dirhandle; 62 closedir $dirhandle; 63 return @contents; 64 } 65 66 sub formatDateTime($) { 67 my $dateTime = shift; 68 # "standard" WeBWorK date/time format (for set definition files): 69 # %m month number, starting with 01 70 # %d numeric day of the month, with leading zeros (eg 01..31) 71 # %y year (2 digits) 72 # %I hour, 12 hour clock, leading 0's) 73 # %M minute, leading 0's 74 # %P am or pm (Yes %p and %P are backwards :) 75 return time2str("%m/%d/%y %I:%M%P", $dateTime); 76 } 77 78 sub parseDateTime($) { 79 my $string = shift; 80 return str2time($string); 81 } 82 83 sub writeLog($$@) { 84 my ($ce, $facility, @message) = @_; 85 unless ($ce->{webworkFiles}->{logs}->{$facility}) { 86 warn "There is no log file for the $facility facility defined.\n"; 87 return; 88 } 89 my $logFile = $ce->{webworkFiles}->{logs}->{$facility}; 90 local *LOG; 91 if (open LOG, ">>", $logFile) { 92 print LOG "[", time2str("%a %b %d %H:%M:%S %Y", time), "] @message\n"; 93 close LOG; 94 } else { 95 warn "failed to open $logFile for writing: $!"; 96 } 97 } 98 99 # $ce - a WeBWork::CourseEnvironment object 100 # $function - fully qualified function name 101 # $details - any information, do not use the characters '[' or ']' 102 # $beginEnd - the string "begin", "intermediate", or "end" 103 # use the intermediate step begun or completed for INTERMEDIATE 104 # use an empty string for $details when calling for END 105 sub writeTimingLogEntry($$$$) { 106 my ($ce, $function, $details, $beginEnd) = @_; 107 return unless defined $ce->{webworkFiles}->{logs}->{timing}; 108 $beginEnd = ($beginEnd eq "begin") ? ">" : ($beginEnd eq "end") ? "<" : "-"; 109 writeLog($ce, "timing", "$$ ".time." $beginEnd $function [$details]"); 110 } 111 112 sub list2hash { 113 map {$_ => "0"} @_; 114 } 115 116 sub max { 117 my $soFar; 118 foreach my $item (@_) { 119 $soFar = $item unless defined $soFar; 120 if ($item > $soFar) { 121 $soFar = $item; 122 } 123 } 124 return defined $soFar ? $soFar : 0; 125 } 126 127 # ----- 128 129 sub dbDecode($) { 130 my $string = shift; 131 return unless defined $string and $string; 132 my %hash = $string =~ /(.*?)(?<!\\)=(.*?)(?:(?<!\\)&|$)/g; 133 $hash{$_} =~ s/\\(&|=)/$1/g foreach keys %hash; # unescape & and = 134 return %hash; 135 } 136 137 sub dbEncode(@) { 138 my %hash = @_; 139 my $string; 140 foreach (keys %hash) { 141 $hash{$_} = "" unless defined $hash{$_}; # promote undef to "" 142 $hash{$_} =~ s/(=|&)/\\$1/g; # escape & and = 143 $string .= "$_=$hash{$_}&"; 144 } 145 chop $string; # remove final '&' from string for old code :p 146 return $string; 147 } 148 149 sub decodeAnswers($) { 150 my $string = shift; 151 return unless defined $string and $string; 152 my @array = split m/##/, $string; 153 $array[$_] =~ s/\\#\\/#/g foreach 0 .. $#array; 154 push @array, "" if @array%2; 155 return @array; # it's actually a hash ;) 156 } 157 158 sub encodeAnswers(\%\@) { 159 my %hash = %{ shift() }; 160 my @order = @{ shift() }; 161 my $string; 162 foreach my $name (@order) { 163 my $value = defined $hash{$name} ? $hash{$name} : ""; 164 $name =~ s/#/\\#\\/g; # this is a WEIRD way to escape things 165 $value =~ s/#/\\#\\/g; # and it's not my fault! 166 $string .= "$name##$value##"; # this is also not my fault 167 } 168 $string =~ s/##$//; # remove last pair of hashs 169 return $string; 170 } 171 172 # ----- 173 174 sub ref2string($;$); 175 sub ref2string($;$) { 176 my $ref = shift; 177 my $dontExpand = shift || {}; 178 my $refType = ref $ref; 179 my $result; 180 if ($refType and not $dontExpand->{$refType}) { 181 my $baseType = refBaseType($ref); 182 $result .= '<font size="1" color="grey">' . $refType; 183 $result .= " ($baseType)" if $baseType and $refType ne $baseType; 184 $result .= ":</font><br>"; 185 $result .= '<table border="1" cellpadding="2">'; 186 if ($baseType eq "HASH") { 187 my %hash = %$ref; 188 foreach (sort keys %hash) { 189 $result .= '<tr valign="top">'; 190 $result .= "<td>$_</td>"; 191 $result .= "<td>" . ref2string($hash{$_}, $dontExpand) . "</td>"; 192 $result .= "</tr>"; 193 } 194 } elsif ($baseType eq "ARRAY") { 195 my @array = @$ref; 196 # special case for Problem, Set, and User objects, which are defined 197 # using lists and contain a @FIELDS package variable: 198 no strict 'refs'; 199 my @FIELDS = eval { @{$refType."::FIELDS"} }; 200 use strict 'refs'; 201 undef @FIELDS unless scalar @FIELDS == scalar @array and not $@; 202 foreach (0 .. $#array) { 203 $result .= '<tr valign="top">'; 204 $result .= "<td>$_</td>"; 205 $result .= "<td>".$FIELDS[$_]."</td>" if @FIELDS; 206 $result .= "<td>" . ref2string($array[$_], $dontExpand) . "</td>"; 207 $result .= "</tr>"; 208 } 209 } elsif ($baseType eq "SCALAR") { 210 my $scalar = $$ref; 211 $result .= '<tr valign="top">'; 212 $result .= "<td>$scalar</td>"; 213 $result .= "</tr>"; 214 } else { 215 # perhaps a coderef? in any case, i don't feel like dealing with it! 216 $result .= '<tr valign="top">'; 217 $result .= "<td>$ref</td>"; 218 $result .= "</tr>"; 219 } 220 $result .= "</table>" 221 } else { 222 $result .= defined $ref ? $ref : '<font color="red">undef</font>'; 223 } 224 } 225 226 sub refBaseType($) { 227 my $ref = shift; 228 local $SIG{__DIE__} = 'IGNORE'; 229 return "HASH" if eval { $_ = %$ref; 1 }; 230 return "ARRAY" if eval { $_ = @$ref; 1 }; 231 return "SCALAR" if eval { $_ = $$ref; 1 }; 232 return 0; 233 } 234 235 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |