[system] / trunk / webwork-modperl / lib / WeBWorK / Utils.pm Repository:
ViewVC logotype

Diff of /trunk/webwork-modperl/lib/WeBWorK/Utils.pm

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

Revision 423 Revision 424
… …
5use warnings; 5use warnings;
6use Date::Format; 6use Date::Format;
7use Date::Parse; 7use Date::Parse;
8 8
9our @EXPORT = (); 9our @EXPORT = ();
10our @EXPORT_OK = qw(runtime_use readFile formatDate hash2string array2string); 10our @EXPORT_OK = qw(
11 runtime_use
12 readFile
13 formatDateTime
14 parseDateTime
15 ref2string
16 hash2string
17 array2string
18);
11 19
12sub runtime_use($) { 20sub runtime_use($) {
13 return unless @_; 21 return unless @_;
14 eval "require $_[0]; import $_[0]"; 22 eval "package Main; require $_[0]; import $_[0]";
15 die $@ if $@; 23 die $@ if $@;
16} 24}
17 25
18sub readFile($) { 26sub readFile($) {
19 my $fileName = shift; 27 my $fileName = shift;
… …
36 # %P am or pm (Yes %p and %P are backwards :) 44 # %P am or pm (Yes %p and %P are backwards :)
37 return time2str "%m/%d/%y %I:%M%P", $dateTime; 45 return time2str "%m/%d/%y %I:%M%P", $dateTime;
38} 46}
39 47
40sub parseDateTime($) { 48sub parseDateTime($) {
41 $string = shift; 49 my $string = shift;
42 return str2time $string; 50 return str2time $string;
43} 51}
44 52
45sub hash2string { 53# -----
54
55sub ref2string($;$);
56sub ref2string($;$) {
46 my $hr = shift; 57 my $ref = shift;
47 my $indent = shift || 0; 58 my $dontExpand = shift || {};
59 my $refType = ref $ref;
48 my $result; 60 my $result;
61 if ($refType and not $dontExpand->{$refType}) {
62 my $baseType = refBaseType($ref);
63 $result .= '<font size="1" color="grey">' . $refType;
64 $result .= " ($baseType)" if $refType ne $baseType;
65 $result .= ":</font><br>";
66 $result .= '<table border="1" cellpadding="2">';
67 if ($baseType eq "HASH") {
68 my %hash = %$ref;
49 foreach (keys %$hr) { 69 foreach (sort keys %hash) {
50 $result .= "\t"x$indent . "{$_} ="; 70 $result .= '<tr valign="top">';
51 if (ref $hr->{$_} eq 'HASH') { 71 $result .= "<td>$_</td>";
72 $result .= "<td>" . ref2string($hash{$_}, $dontExpand) . "</td>";
73 $result .= "</tr>";
74 }
75 } elsif ($baseType eq "ARRAY") {
76 my @array = @$ref;
77 foreach (0 .. $#array) {
78 $result .= '<tr valign="top">';
79 $result .= "<td>$_</td>";
80 $result .= "<td>" . ref2string($array[$_], $dontExpand) . "</td>";
81 $result .= "</tr>";
82 }
83 } elsif ($baseType eq "SCALAR") {
84 my $scalar = $$ref;
85 $result .= '<tr valign="top">';
86 $result .= "<td>$scalar</td>";
52 $result .= "\n"; 87 $result .= "</tr>";
53 $result .= hash2string($hr->{$_}, $indent+1);
54 } elsif (ref $hr->{$_} eq 'ARRAY') {
55 $result .= "\n";
56 $result .= array2string($hr->{$_}, $indent+1);
57 } else { 88 } else {
58 $result .= " " . $hr->{$_} . "\n"; 89 # perhaps a coderef? in any case, i don't feel like dealing with it!
90 $result .= '<tr valign="top">';
91 $result .= "<td>$ref</td>";
92 $result .= "</tr>";
59 } 93 }
94 $result .= "</table>"
95 } else {
96 $result .= defined $ref ? $ref : '<font color="red">undef</font>';
60 } 97 }
61 return $result;
62} 98}
63 99
64sub array2string { 100sub refBaseType($) {
65 my $ar = shift; 101 my $ref = shift;
66 my $indent = shift || 0; 102 local $SIG{__DIE__} = 'IGNORE';
67 my $result; 103 return "CODE" if eval { $_ = \&$ref; 1 };
68 foreach (0 .. @$ar-1) { 104 return "HASH" if eval { $_ = %$ref; 1 };
69 $result .= "\t"x$indent . "[$_] ="; 105 return "ARRAY" if eval { $_ = @$ref; 1 };
70 if (ref $ar->[$_] eq 'HASH') { 106 return "SCALAR" if eval { $_ = $$ref; 1 };
71 $result .= "\n"; 107 return 0;
72 $result .= hash2string($ar->[$_], $indent+1);
73 } elsif (ref $ar->[$_] eq 'ARRAY') {
74 $result .= "\n";
75 $result .= array2string($ar->[$_], $indent+1);
76 } else {
77 $result .= " " . $ar->[$_] . "\n";
78 }
79 }
80 return $result;
81} 108}
82 109
83=pod 110# -----
84sub pretty_print_rh {
85 my $r_input = shift;
86 my $out = '';
87 if ( not ref($r_input) ) {
88 $out = $r_input; # not a reference
89 } elsif (is_hash_ref($r_input)) {
90 local($^W) = 0;
91 $out .= "<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">";
92 foreach my $key (sort keys %$r_input ) {
93 $out .= "<tr><TD> $key</TD><TD>=&gt;</td><td>&nbsp;".pretty_print_rh($r_input->{$key}) . "</td></tr>";
94 }
95 $out .="</table>";
96 } elsif (is_array_ref($r_input) ) {
97 my @array = @$r_input;
98 $out .= "( " ;
99 while (@array) {
100 $out .= pretty_print_rh(shift @array) . " , ";
101 }
102 $out .= " )";
103 } elsif (ref($r_input) eq 'CODE') {
104 $out = "$r_input";
105 } else {
106 $out = $r_input;
107 }
108 $out;
109}
110 111
111sub is_hash_ref { 112#sub hash2string($;$$) {
112 my $in =shift; 113# my $hr = shift;
113 my $save_SIG_die_trap = $SIG{__DIE__}; 114# my $table = shift || 0;
114 $SIG{__DIE__} = sub {CORE::die(@_) }; 115# my $indent = shift || 0;
115 my $out = eval{ %{ $in } }; 116# my $result = $table ? '<table border="1">' : "";
116 $out = ($@ eq '') ? 1 : 0; 117# foreach my $key (keys %$hr) {
117 $@=''; 118# my $value = $hr->{$key};
118 $SIG{__DIE__} = $save_SIG_die_trap; 119# $result .= $table
119 $out; 120# ? "<tr><td>$key</td>"
120} 121# : "\t"x$indent . "{$key} =";
121sub is_array_ref { 122# if (ref $value eq 'HASH') {
123# $result .= $table ? "<td>" : "\n";
124# $result .= hash2string($value, $table, $indent+1);
125# $result .= $table ? "</td>" : "";
126# } elsif (ref $value eq 'ARRAY') {
127# $result .= $table ? "<td>" : "\n";
128# $result .= array2string($value, $table, $indent+1);
129# $result .= $table ? "</td>" : "";
130# } elsif (defined $value) {
131# $result .= $table
132# ? "<td>$value</td>"
133# : " $value\n";
134# } else {
135# $result .= $table ? "" : "\n";
136# }
137# $result .= $table ? "</tr>" : "";
138# }
139# $result .= "</table>";
140# return $result;
141#}
142#
143#sub array2string($;$$) {
122 my $in =shift; 144# my $ar = shift;
123 my $save_SIG_die_trap = $SIG{__DIE__}; 145# my $table = shift || 0;
124 $SIG{__DIE__} = sub {CORE::die(@_) }; 146# my $indent = shift || 0;
125 my $out = eval{ @{ $in } }; 147# my $result = $table ? '<table border="1">' : "";
126 $out = ($@ eq '') ? 1 : 0; 148# foreach my $index (0 .. @$ar-1) {
127 $@=''; 149# my $value = $ar->[$index];
128 $SIG{__DIE__} = $save_SIG_die_trap; 150# $result .= $table
129 $out; 151# ? "<tr><td>$index</td>"
130} 152# : "\t"x$indent . "[$index] =";
131=cut 153# if (ref $value eq 'HASH') {
154# $result .= $table ? "<td>" : "\n";
155# $result .= hash2string($value, $table, $indent+1);
156# $result .= $table ? "</td>" : "";
157# } elsif (ref $value eq 'ARRAY') {
158# $result .= $table ? "<td>" : "\n";
159# $result .= array2string($value, $table, $indent+1);
160# $result .= $table ? "</td>" : "";
161# } elsif (defined $value) {
162# $result .= $table
163# ? "<td>$value</td>"
164# : " $value\n";
165# } else {
166# $result .= $table ? "" : "\n";
167# }
168# $result .= $table ? "</tr>" : "";
169# }
170# $result .= "</table>";
171# return $result;
172#}
173#
174#sub isHashRef($) {
175# my $ref = shift;
176# local $SIG{__DIE__} = 'IGNORE';
177# $_ = eval{ %$ref };
178# return not defined $@;
179#}
180#
181#sub isArrayRef($) {
182# my $ref = shift;
183# local $SIG{__DIE__} = 'IGNORE';
184# $_ = eval{ @$ref };
185# return not defined $@;
186#}
132 187
1331; 1881;
Legend:
Removed from v.423  
changed lines
  Added in v.424
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9