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