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