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