[system] / branches / gage_dev / webwork2 / lib / WeBWorK / Utils.pm Repository:
ViewVC logotype

Diff of /branches/gage_dev/webwork2/lib/WeBWorK/Utils.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 440 Revision 1111
1################################################################################ 1################################################################################
2# WeBWorK mod_perl (c) 1995-2002 WeBWorK Team, Univeristy of Rochester 2# WeBWorK mod_perl (c) 2000-2002 WeBWorK Project
3# $Id$ 3# $Id$
4################################################################################ 4################################################################################
5 5
6package WeBWorK::Utils; 6package WeBWorK::Utils;
7use base qw(Exporter);
8
9=head1 NAME
10
11WeBWorK::Utils - useful utilities used by other WeBWorK modules.
12
13=cut
7 14
8use strict; 15use strict;
9use warnings; 16use warnings;
10use base qw(Exporter);
11use Date::Format; 17use Date::Format;
12use Date::Parse; 18use Date::Parse;
19use DB; # DeBug, not DataBase
13 20
14our @EXPORT = (); 21our @EXPORT = ();
15our @EXPORT_OK = qw( 22our @EXPORT_OK = qw(
16 runtime_use 23 runtime_use
24 backtrace
17 readFile 25 readFile
18 formatDateTime 26 formatDateTime
19 parseDateTime 27 parseDateTime
28 writeLog
29 writeTimingLogEntry
30 list2hash
31 max
32 readDirectory
20 dbDecode 33 dbDecode
21 dbEncode 34 dbEncode
22 decodeAnswers 35 decodeAnswers
23 encodeAnswers 36 encodeAnswers
24 ref2string 37 ref2string
25 hash2string 38 sortByName
26 array2string
27); 39);
28 40
29sub runtime_use($) { 41sub runtime_use($) {
30 return unless @_; 42 return unless @_;
31 eval "package Main; require $_[0]; import $_[0]"; 43 eval "package Main; require $_[0]; import $_[0]";
32 die $@ if $@; 44 die $@ if $@;
33} 45}
34 46
47sub backtrace {
48 my ($style) = @_;
49 $style = "warn" unless $style;
50 my @bt = DB->backtrace;
51 shift @bt; # Remove "backtrace" from the backtrace;
52 if ($style eq "die") {
53 die join "\n", @bt;
54 } elsif ($style eq "warn") {
55 warn join "\n", @bt;
56 } elsif ($style eq "print") {
57 print join "\n", @bt;
58 } elsif ($style eq "return") {
59 return @bt;
60 }
61}
62
35sub readFile($) { 63sub readFile($) {
36 my $fileName = shift; 64 my $fileName = shift;
65 local *INPUTFILE;
37 open INPUTFILE, "<", $fileName 66 open INPUTFILE, "<", $fileName
38 or die "Failed to read $fileName: $!"; 67 or die "Failed to read $fileName: $!";
39 local $/ = undef; 68 local $/ = undef;
40 my $result = <INPUTFILE>; 69 my $result = <INPUTFILE>;
41 close INPUTFILE; 70 close INPUTFILE;
42 return $result; 71 return $result;
43} 72}
44 73
74sub readDirectory($) {
75 my ($dirname) = @_;
76
77 opendir my $dirhandle, $dirname or die "couldn't open directory $dirname: $!";
78 my @contents = readdir $dirhandle;
79 closedir $dirhandle;
80 return @contents;
81}
82
45sub formatDateTime($) { 83sub formatDateTime($) {
46 my $dateTime = shift; 84 my $dateTime = shift;
47 # "standard" WeBWorK date/time format: 85 # "standard" WeBWorK date/time format (for set definition files):
48 # %m month number, starting with 01 86 # %m month number, starting with 01
49 # %d numeric day of the month, with leading zeros (eg 01..31) 87 # %d numeric day of the month, with leading zeros (eg 01..31)
50 # %y year (2 digits) 88 # %y year (2 digits)
51 # %I hour, 12 hour clock, leading 0's) 89 # %I hour, 12 hour clock, leading 0's)
52 # %M minute, leading 0's 90 # %M minute, leading 0's
53 # %P am or pm (Yes %p and %P are backwards :) 91 # %P am or pm (Yes %p and %P are backwards :)
54 return time2str "%m/%d/%y %I:%M%P", $dateTime; 92 return time2str("%m/%d/%y %I:%M%P", $dateTime);
55} 93}
56 94
57sub parseDateTime($) { 95sub parseDateTime($) {
58 my $string = shift; 96 my $string = shift;
59 return str2time $string; 97 return str2time($string);
60} 98}
61 99
62# ----- 100sub writeLog($$@) {
63 101 my ($ce, $facility, @message) = @_;
64sub dbDecode($) { 102 unless ($ce->{webworkFiles}->{logs}->{$facility}) {
65 my $string = shift; 103 warn "There is no log file for the $facility facility defined.\n";
66 return unless defined $string and $string; 104 return;
67 my %hash = $string =~ /(.*?)(?<!\\)=(.*?)(?:(?<!\\)&|$)/g; 105 }
68 $hash{$_} =~ s/\\(&|=)/$1/g foreach keys %hash; # unescape & and = 106 my $logFile = $ce->{webworkFiles}->{logs}->{$facility};
69 return %hash; 107 local *LOG;
108 if (open LOG, ">>", $logFile) {
109 print LOG "[", time2str("%a %b %d %H:%M:%S %Y", time), "] @message\n";
110 close LOG;
111 } else {
112 warn "failed to open $logFile for writing: $!";
113 }
70} 114}
71 115
72sub dbEncode(@) { 116# $ce - a WeBWork::CourseEnvironment object
73 my %hash = @_; 117# $function - fully qualified function name
74 my $string; 118# $details - any information, do not use the characters '[' or ']'
75 foreach (keys %hash) { 119# $beginEnd - the string "begin", "intermediate", or "end"
76 $hash{$_} = "" unless defined $hash{$_}; # promote undef to "" 120# use the intermediate step begun or completed for INTERMEDIATE
77 $hash{$_} =~ s/(=|&)/\\$1/g; # escape & and = 121# use an empty string for $details when calling for END
78 $string .= "$_=$hash{$_}&"; 122sub writeTimingLogEntry($$$$) {
123 my ($ce, $function, $details, $beginEnd) = @_;
124 return unless defined $ce->{webworkFiles}->{logs}->{timing};
125 $beginEnd = ($beginEnd eq "begin") ? ">" : ($beginEnd eq "end") ? "<" : "-";
126 writeLog($ce, "timing", "$$ ".time." $beginEnd $function [$details]");
127}
128
129sub list2hash {
130 map {$_ => "0"} @_;
131}
132
133sub max {
134 my $soFar;
135 foreach my $item (@_) {
136 $soFar = $item unless defined $soFar;
137 if ($item > $soFar) {
138 $soFar = $item;
79 } 139 }
80 chop $string; # remove final '&' from string for old code :p 140 }
81 return $string; 141 return defined $soFar ? $soFar : 0;
82} 142}
83 143
84sub decodeAnswers($) { 144sub decodeAnswers($) {
85 my $string = shift; 145 my $string = shift;
86 return unless defined $string and $string; 146 return unless defined $string and $string;
87 my @array = split m/##/, $string; 147 my @array = split m/##/, $string;
88 $array[$_] =~ s/\\#\\/#/g foreach 0 .. $#array; 148 $array[$_] =~ s/\\#\\/#/g foreach 0 .. $#array;
149 push @array, "" if @array%2;
89 return @array; # it's actually a hash ;) 150 return @array; # it's actually a hash ;)
90} 151}
91 152
92sub encodeAnswers(\%\@) { 153sub encodeAnswers(\%\@) {
93 my %hash = %{ shift() }; 154 my %hash = %{ shift() };
… …
95 my $string; 156 my $string;
96 foreach my $name (@order) { 157 foreach my $name (@order) {
97 my $value = defined $hash{$name} ? $hash{$name} : ""; 158 my $value = defined $hash{$name} ? $hash{$name} : "";
98 $name =~ s/#/\\#\\/g; # this is a WEIRD way to escape things 159 $name =~ s/#/\\#\\/g; # this is a WEIRD way to escape things
99 $value =~ s/#/\\#\\/g; # and it's not my fault! 160 $value =~ s/#/\\#\\/g; # and it's not my fault!
161 if ($value =~ m/\\$/) {
162 # if the value ends with a backslash, string2hash will
163 # interpret that as a normal escape sequence (not part
164 # of the weird pound escape sequence) if the next
165 # character is &. So we have to protect against this.
166 # will adding a spcae at the end of the last answer
167 # hurt anything? i don't think so...
168 $value .= " ";
169 }
100 $string .= "$name##$value##"; # this is also not my fault 170 $string .= "$name##$value##"; # this is also not my fault
101 } 171 }
102 $string =~ s/##$//; # remove last pair of hashs 172 $string =~ s/##$//; # remove last pair of hashs
103 return $string; 173 return $string;
104} 174}
105
106# -----
107 175
108sub ref2string($;$); 176sub ref2string($;$);
109sub ref2string($;$) { 177sub ref2string($;$) {
110 my $ref = shift; 178 my $ref = shift;
111 my $dontExpand = shift || {}; 179 my $dontExpand = shift || {};
… …
157 } 225 }
158} 226}
159 227
160sub refBaseType($) { 228sub refBaseType($) {
161 my $ref = shift; 229 my $ref = shift;
162 local $SIG{__DIE__} = 'IGNORE'; 230 $ref =~ m/(\w+)\(/; # this might not be robust...
163 return "HASH" if eval { $_ = %$ref; 1 };
164 return "ARRAY" if eval { $_ = @$ref; 1 };
165 return "SCALAR" if eval { $_ = $$ref; 1 };
166 return 0; 231 return $1;
167} 232}
168 233
169# ----- 234# p. 101, Camel, 3rd ed.
235# The <=> and cmp operators return -1 if the left operand is less than the
236# right operand, 0 if they are equal, and +1 if the left operand is greater
237# than the right operand.
170 238
171#sub hash2string($;$$) { 239sub sortByName {
172# my $hr = shift; 240 my ($field, @items) = @_;
173# my $table = shift || 0; 241 return sort {
174# my $indent = shift || 0; 242 my @aParts = split m/(?<=\D)(?=\d)|(?<=\d)(?=\D)/, $a->$field;
175# my $result = $table ? '<table border="1">' : ""; 243 my @bParts = split m/(?<=\D)(?=\d)|(?<=\d)(?=\D)/, $b->$field;
176# foreach my $key (keys %$hr) { 244 while (@aParts and @bParts) {
177# my $value = $hr->{$key}; 245 my $aPart = shift @aParts;
178# $result .= $table 246 my $bPart = shift @bParts;
179# ? "<tr><td>$key</td>" 247 my $aNumeric = $aPart =~ m/^\d*$/;
180# : "\t"x$indent . "{$key} ="; 248 my $bNumeric = $bPart =~ m/^\d*$/;
181# if (ref $value eq 'HASH') { 249
182# $result .= $table ? "<td>" : "\n"; 250 # numbers should come before words
183# $result .= hash2string($value, $table, $indent+1); 251 return -1 if $aNumeric and not $bNumeric;
184# $result .= $table ? "</td>" : ""; 252 return +1 if not $aNumeric and $bNumeric;
185# } elsif (ref $value eq 'ARRAY') { 253
186# $result .= $table ? "<td>" : "\n"; 254 # both have the same type
187# $result .= array2string($value, $table, $indent+1); 255 if ($aNumeric and $bNumeric) {
188# $result .= $table ? "</td>" : ""; 256 next if $aPart == $bPart; # check next pair
189# } elsif (defined $value) { 257 return $aPart <=> $bPart; # compare numerically
190# $result .= $table
191# ? "<td>$value</td>"
192# : " $value\n";
193# } else { 258 } else {
194# $result .= $table ? "" : "\n"; 259 next if $aPart eq $bPart; # check next pair
260 return $aPart cmp $bPart; # compare lexicographically
261 }
195# } 262 }
196# $result .= $table ? "</tr>" : ""; 263 return +1 if @aParts; # a has more sections, should go second
197# } 264 return -1 if @bParts; # a had fewer sections, should go first
198# $result .= "</table>"; 265 } @items;
199# return $result; 266}
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 267
2471; 2681;
Legend:
Removed from v.440  
changed lines
  Added in v.1111
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9