Parent Directory
| 
Revision Log
cleanup? -sam
1 ################################################################################ 2 # WeBWorK mod_perl (c) 1995-2002 WeBWorK Team, Univeristy of Rochester 3 # $Id$ 4 ################################################################################ 5 6 package WeBWorK::Utils; 7 8 use strict; 9 use warnings; 10 use base qw(Exporter); 11 use Date::Format; 12 use Date::Parse; 13 14 our @EXPORT = (); 15 our @EXPORT_OK = qw( 16 runtime_use 17 readFile 18 formatDateTime 19 parseDateTime 20 dbDecode 21 dbEncode 22 decodeAnswers 23 encodeAnswers 24 ref2string 25 hash2string 26 array2string 27 ); 28 29 sub runtime_use($) { 30 return unless @_; 31 eval "package Main; require $_[0]; import $_[0]"; 32 die $@ if $@; 33 } 34 35 sub readFile($) { 36 my $fileName = shift; 37 open INPUTFILE, "<", $fileName 38 or die "Failed to read $fileName: $!"; 39 local $/ = undef; 40 my $result = <INPUTFILE>; 41 close INPUTFILE; 42 return $result; 43 } 44 45 sub formatDateTime($) { 46 my $dateTime = shift; 47 # "standard" WeBWorK date/time format: 48 # %m month number, starting with 01 49 # %d numeric day of the month, with leading zeros (eg 01..31) 50 # %y year (2 digits) 51 # %I hour, 12 hour clock, leading 0's) 52 # %M minute, leading 0's 53 # %P am or pm (Yes %p and %P are backwards :) 54 return time2str "%m/%d/%y %I:%M%P", $dateTime; 55 } 56 57 sub parseDateTime($) { 58 my $string = shift; 59 return str2time $string; 60 } 61 62 # ----- 63 64 sub dbDecode($) { 65 my $string = shift; 66 return unless defined $string and $string; 67 my %hash = $string =~ /(.*?)(?<!\\)=(.*?)(?:(?<!\\)&|$)/g; 68 $hash{$_} =~ s/\\(&|=)/$1/g foreach keys %hash; # unescape & and = 69 return %hash; 70 } 71 72 sub dbEncode(@) { 73 my %hash = @_; 74 my $string; 75 foreach (keys %hash) { 76 $hash{$_} = "" unless defined $hash{$_}; # promote undef to "" 77 $hash{$_} =~ s/(=|&)/\\$1/g; # escape & and = 78 $string .= "$_=$hash{$_}&"; 79 } 80 chop $string; # remove final '&' from string for old code :p 81 return $string; 82 } 83 84 sub decodeAnswers($) { 85 my $string = shift; 86 return unless defined $string and $string; 87 my @array = split m/##/, $string; 88 $array[$_] =~ s/\\#\\/#/g foreach 0 .. $#array; 89 return @array; # it's actually a hash ;) 90 } 91 92 sub encodeAnswers(\%\@) { 93 my %hash = %{ shift() }; 94 my @order = @{ shift() }; 95 my $string; 96 foreach my $name (@order) { 97 my $value = defined $hash{$name} ? $hash{$name} : ""; 98 $name =~ s/#/\\#\\/g; # this is a WEIRD way to escape things 99 $value =~ s/#/\\#\\/g; # and it's not my fault! 100 $string .= "$name##$value##"; # this is also not my fault 101 } 102 $string =~ s/##$//; # remove last pair of hashs 103 return $string; 104 } 105 106 # ----- 107 108 sub ref2string($;$); 109 sub ref2string($;$) { 110 my $ref = shift; 111 my $dontExpand = shift || {}; 112 my $refType = ref $ref; 113 my $result; 114 if ($refType and not $dontExpand->{$refType}) { 115 my $baseType = refBaseType($ref); 116 $result .= '<font size="1" color="grey">' . $refType; 117 $result .= " ($baseType)" if $baseType and $refType ne $baseType; 118 $result .= ":</font><br>"; 119 $result .= '<table border="1" cellpadding="2">'; 120 if ($baseType eq "HASH") { 121 my %hash = %$ref; 122 foreach (sort keys %hash) { 123 $result .= '<tr valign="top">'; 124 $result .= "<td>$_</td>"; 125 $result .= "<td>" . ref2string($hash{$_}, $dontExpand) . "</td>"; 126 $result .= "</tr>"; 127 } 128 } elsif ($baseType eq "ARRAY") { 129 my @array = @$ref; 130 # special case for Problem, Set, and User objects, which are defined 131 # using lists and contain a @FIELDS package variable: 132 no strict 'refs'; 133 my @FIELDS = eval { @{$refType."::FIELDS"} }; 134 use strict 'refs'; 135 undef @FIELDS unless scalar @FIELDS == scalar @array and not $@; 136 foreach (0 .. $#array) { 137 $result .= '<tr valign="top">'; 138 $result .= "<td>$_</td>"; 139 $result .= "<td>".$FIELDS[$_]."</td>" if @FIELDS; 140 $result .= "<td>" . ref2string($array[$_], $dontExpand) . "</td>"; 141 $result .= "</tr>"; 142 } 143 } elsif ($baseType eq "SCALAR") { 144 my $scalar = $$ref; 145 $result .= '<tr valign="top">'; 146 $result .= "<td>$scalar</td>"; 147 $result .= "</tr>"; 148 } else { 149 # perhaps a coderef? in any case, i don't feel like dealing with it! 150 $result .= '<tr valign="top">'; 151 $result .= "<td>$ref</td>"; 152 $result .= "</tr>"; 153 } 154 $result .= "</table>" 155 } else { 156 $result .= defined $ref ? $ref : '<font color="red">undef</font>'; 157 } 158 } 159 160 sub refBaseType($) { 161 my $ref = shift; 162 local $SIG{__DIE__} = 'IGNORE'; 163 return "HASH" if eval { $_ = %$ref; 1 }; 164 return "ARRAY" if eval { $_ = @$ref; 1 }; 165 return "SCALAR" if eval { $_ = $$ref; 1 }; 166 return 0; 167 } 168 169 # ----- 170 171 #sub hash2string($;$$) { 172 # my $hr = shift; 173 # my $table = shift || 0; 174 # my $indent = shift || 0; 175 # my $result = $table ? '<table border="1">' : ""; 176 # foreach my $key (keys %$hr) { 177 # my $value = $hr->{$key}; 178 # $result .= $table 179 # ? "<tr><td>$key</td>" 180 # : "\t"x$indent . "{$key} ="; 181 # if (ref $value eq 'HASH') { 182 # $result .= $table ? "<td>" : "\n"; 183 # $result .= hash2string($value, $table, $indent+1); 184 # $result .= $table ? "</td>" : ""; 185 # } elsif (ref $value eq 'ARRAY') { 186 # $result .= $table ? "<td>" : "\n"; 187 # $result .= array2string($value, $table, $indent+1); 188 # $result .= $table ? "</td>" : ""; 189 # } elsif (defined $value) { 190 # $result .= $table 191 # ? "<td>$value</td>" 192 # : " $value\n"; 193 # } else { 194 # $result .= $table ? "" : "\n"; 195 # } 196 # $result .= $table ? "</tr>" : ""; 197 # } 198 # $result .= "</table>"; 199 # return $result; 200 #} 201 # 202 #sub array2string($;$$) { 203 # my $ar = shift; 204 # my $table = shift || 0; 205 # my $indent = shift || 0; 206 # my $result = $table ? '<table border="1">' : ""; 207 # foreach my $index (0 .. @$ar-1) { 208 # my $value = $ar->[$index]; 209 # $result .= $table 210 # ? "<tr><td>$index</td>" 211 # : "\t"x$indent . "[$index] ="; 212 # if (ref $value eq 'HASH') { 213 # $result .= $table ? "<td>" : "\n"; 214 # $result .= hash2string($value, $table, $indent+1); 215 # $result .= $table ? "</td>" : ""; 216 # } elsif (ref $value eq 'ARRAY') { 217 # $result .= $table ? "<td>" : "\n"; 218 # $result .= array2string($value, $table, $indent+1); 219 # $result .= $table ? "</td>" : ""; 220 # } elsif (defined $value) { 221 # $result .= $table 222 # ? "<td>$value</td>" 223 # : " $value\n"; 224 # } else { 225 # $result .= $table ? "" : "\n"; 226 # } 227 # $result .= $table ? "</tr>" : ""; 228 # } 229 # $result .= "</table>"; 230 # return $result; 231 #} 232 # 233 #sub isHashRef($) { 234 # my $ref = shift; 235 # local $SIG{__DIE__} = 'IGNORE'; 236 # $_ = eval{ %$ref }; 237 # return not defined $@; 238 #} 239 # 240 #sub isArrayRef($) { 241 # my $ref = shift; 242 # local $SIG{__DIE__} = 'IGNORE'; 243 # $_ = eval{ @$ref }; 244 # return not defined $@; 245 #} 246 247 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |