Parent Directory
| 
Revision Log
added some docs to Utils -sam
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 # $ce - a WeBWork::CourseEnvironment object 86 # $function - fully qualified function name 87 # $details - any information, do not use the characters '[' or ']' 88 # $beginEnd - the string "begin" or "end" 89 # use an empty string for $details when calling for END 90 sub writeTimingLogEntry($$$$) { 91 my ($ce, $function, $details, $beginEnd) = @_; 92 return unless defined $ce->{webworkFiles}->{logs}->{timing}; 93 $beginEnd = ($beginEnd eq "begin") ? ">" : "<"; 94 writeLog($ce, "timing", "$$ ".time." $beginEnd $function [$details]"); 95 } 96 97 # ----- 98 99 sub dbDecode($) { 100 my $string = shift; 101 return unless defined $string and $string; 102 my %hash = $string =~ /(.*?)(?<!\\)=(.*?)(?:(?<!\\)&|$)/g; 103 $hash{$_} =~ s/\\(&|=)/$1/g foreach keys %hash; # unescape & and = 104 return %hash; 105 } 106 107 sub dbEncode(@) { 108 my %hash = @_; 109 my $string; 110 foreach (keys %hash) { 111 $hash{$_} = "" unless defined $hash{$_}; # promote undef to "" 112 $hash{$_} =~ s/(=|&)/\\$1/g; # escape & and = 113 $string .= "$_=$hash{$_}&"; 114 } 115 chop $string; # remove final '&' from string for old code :p 116 return $string; 117 } 118 119 sub decodeAnswers($) { 120 my $string = shift; 121 return unless defined $string and $string; 122 my @array = split m/##/, $string; 123 $array[$_] =~ s/\\#\\/#/g foreach 0 .. $#array; 124 push @array, "" if @array%2; 125 return @array; # it's actually a hash ;) 126 } 127 128 sub encodeAnswers(\%\@) { 129 my %hash = %{ shift() }; 130 my @order = @{ shift() }; 131 my $string; 132 foreach my $name (@order) { 133 my $value = defined $hash{$name} ? $hash{$name} : ""; 134 $name =~ s/#/\\#\\/g; # this is a WEIRD way to escape things 135 $value =~ s/#/\\#\\/g; # and it's not my fault! 136 $string .= "$name##$value##"; # this is also not my fault 137 } 138 $string =~ s/##$//; # remove last pair of hashs 139 return $string; 140 } 141 142 # ----- 143 144 sub ref2string($;$); 145 sub ref2string($;$) { 146 my $ref = shift; 147 my $dontExpand = shift || {}; 148 my $refType = ref $ref; 149 my $result; 150 if ($refType and not $dontExpand->{$refType}) { 151 my $baseType = refBaseType($ref); 152 $result .= '<font size="1" color="grey">' . $refType; 153 $result .= " ($baseType)" if $baseType and $refType ne $baseType; 154 $result .= ":</font><br>"; 155 $result .= '<table border="1" cellpadding="2">'; 156 if ($baseType eq "HASH") { 157 my %hash = %$ref; 158 foreach (sort keys %hash) { 159 $result .= '<tr valign="top">'; 160 $result .= "<td>$_</td>"; 161 $result .= "<td>" . ref2string($hash{$_}, $dontExpand) . "</td>"; 162 $result .= "</tr>"; 163 } 164 } elsif ($baseType eq "ARRAY") { 165 my @array = @$ref; 166 # special case for Problem, Set, and User objects, which are defined 167 # using lists and contain a @FIELDS package variable: 168 no strict 'refs'; 169 my @FIELDS = eval { @{$refType."::FIELDS"} }; 170 use strict 'refs'; 171 undef @FIELDS unless scalar @FIELDS == scalar @array and not $@; 172 foreach (0 .. $#array) { 173 $result .= '<tr valign="top">'; 174 $result .= "<td>$_</td>"; 175 $result .= "<td>".$FIELDS[$_]."</td>" if @FIELDS; 176 $result .= "<td>" . ref2string($array[$_], $dontExpand) . "</td>"; 177 $result .= "</tr>"; 178 } 179 } elsif ($baseType eq "SCALAR") { 180 my $scalar = $$ref; 181 $result .= '<tr valign="top">'; 182 $result .= "<td>$scalar</td>"; 183 $result .= "</tr>"; 184 } else { 185 # perhaps a coderef? in any case, i don't feel like dealing with it! 186 $result .= '<tr valign="top">'; 187 $result .= "<td>$ref</td>"; 188 $result .= "</tr>"; 189 } 190 $result .= "</table>" 191 } else { 192 $result .= defined $ref ? $ref : '<font color="red">undef</font>'; 193 } 194 } 195 196 sub refBaseType($) { 197 my $ref = shift; 198 local $SIG{__DIE__} = 'IGNORE'; 199 return "HASH" if eval { $_ = %$ref; 1 }; 200 return "ARRAY" if eval { $_ = @$ref; 1 }; 201 return "SCALAR" if eval { $_ = $$ref; 1 }; 202 return 0; 203 } 204 205 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |