| … | |
… | |
| 12 | readFile |
12 | readFile |
| 13 | formatDateTime |
13 | formatDateTime |
| 14 | parseDateTime |
14 | parseDateTime |
| 15 | dbDecode |
15 | dbDecode |
| 16 | dbEncode |
16 | dbEncode |
|
|
17 | decodeAnswers |
|
|
18 | encodeAnswers |
| 17 | ref2string |
19 | ref2string |
| 18 | hash2string |
20 | hash2string |
| 19 | array2string |
21 | array2string |
| 20 | ); |
22 | ); |
| 21 | |
23 | |
| … | |
… | |
| 50 | sub parseDateTime($) { |
52 | sub parseDateTime($) { |
| 51 | my $string = shift; |
53 | my $string = shift; |
| 52 | return str2time $string; |
54 | return str2time $string; |
| 53 | } |
55 | } |
| 54 | |
56 | |
|
|
57 | # ----- |
|
|
58 | |
| 55 | sub dbDecode($) { |
59 | sub dbDecode($) { |
| 56 | my $string = shift; |
60 | my $string = shift; |
| 57 | return unless defined $string and $string; |
61 | return unless defined $string and $string; |
| 58 | my %hash = $string =~ /(.*?)(?<!\\)=(.*?)(?:(?<!\\)&|$)/g; |
62 | my %hash = $string =~ /(.*?)(?<!\\)=(.*?)(?:(?<!\\)&|$)/g; |
| 59 | $hash{$_} =~ s/\\(&|=)/$1/g foreach (keys %hash); # unescape & and = |
63 | $hash{$_} =~ s/\\(&|=)/$1/g foreach keys %hash; # unescape & and = |
| 60 | return %hash; |
64 | return %hash; |
| 61 | } |
65 | } |
| 62 | |
66 | |
| 63 | sub dbEncode(@) { |
67 | sub dbEncode(@) { |
| 64 | my %hash = @_; |
68 | my %hash = @_; |
| … | |
… | |
| 67 | $hash{$_} = "" unless defined $hash{$_}; # promote undef to "" |
71 | $hash{$_} = "" unless defined $hash{$_}; # promote undef to "" |
| 68 | $hash{$_} =~ s/(=|&)/\\$1/g; # escape & and = |
72 | $hash{$_} =~ s/(=|&)/\\$1/g; # escape & and = |
| 69 | $string .= "$_=$hash{$_}&"; |
73 | $string .= "$_=$hash{$_}&"; |
| 70 | } |
74 | } |
| 71 | chop $string; # remove final '&' from string for old code :p |
75 | chop $string; # remove final '&' from string for old code :p |
|
|
76 | return $string; |
|
|
77 | } |
|
|
78 | |
|
|
79 | sub decodeAnswers($) { |
|
|
80 | my $string = shift; |
|
|
81 | return unless defined $string and $string; |
|
|
82 | my @array = split m/##/, $string; |
|
|
83 | $array[$_] =~ s/\\#\\/#/g foreach 0 .. $#array; |
|
|
84 | return @array; # it's actually a hash ;) |
|
|
85 | } |
|
|
86 | |
|
|
87 | sub encodeAnswers(\%\@) { |
|
|
88 | my %hash = %{ shift() }; |
|
|
89 | my @order = @{ shift() }; |
|
|
90 | my $string; |
|
|
91 | foreach my $name (@order) { |
|
|
92 | my $value = defined $hash{$name} ? $hash{$name} : ""; |
|
|
93 | $name =~ s/#/\\#\\/g; # this is a WEIRD way to escape things |
|
|
94 | $value =~ s/#/\\#\\/g; # and it's not my fault! |
|
|
95 | $string .= "$name##$value##"; # this is also not my fault |
|
|
96 | } |
|
|
97 | $string =~ s/##$//; # remove last pair of hashs |
| 72 | return $string; |
98 | return $string; |
| 73 | } |
99 | } |
| 74 | |
100 | |
| 75 | # ----- |
101 | # ----- |
| 76 | |
102 | |
| … | |
… | |
| 94 | $result .= "<td>" . ref2string($hash{$_}, $dontExpand) . "</td>"; |
120 | $result .= "<td>" . ref2string($hash{$_}, $dontExpand) . "</td>"; |
| 95 | $result .= "</tr>"; |
121 | $result .= "</tr>"; |
| 96 | } |
122 | } |
| 97 | } elsif ($baseType eq "ARRAY") { |
123 | } elsif ($baseType eq "ARRAY") { |
| 98 | my @array = @$ref; |
124 | my @array = @$ref; |
|
|
125 | # special case for Problem, Set, and User objects, which are defined |
|
|
126 | # using lists and contain a @FIELDS package variable: |
|
|
127 | no strict 'refs'; |
|
|
128 | my @FIELDS = eval { @{$refType."::FIELDS"} }; |
|
|
129 | use strict 'refs'; |
|
|
130 | undef @FIELDS unless scalar @FIELDS == scalar @array and not $@; |
| 99 | foreach (0 .. $#array) { |
131 | foreach (0 .. $#array) { |
| 100 | $result .= '<tr valign="top">'; |
132 | $result .= '<tr valign="top">'; |
| 101 | $result .= "<td>$_</td>"; |
133 | $result .= "<td>$_</td>"; |
|
|
134 | $result .= "<td>".$FIELDS[$_]."</td>" if @FIELDS; |
| 102 | $result .= "<td>" . ref2string($array[$_], $dontExpand) . "</td>"; |
135 | $result .= "<td>" . ref2string($array[$_], $dontExpand) . "</td>"; |
| 103 | $result .= "</tr>"; |
136 | $result .= "</tr>"; |
| 104 | } |
137 | } |
| 105 | } elsif ($baseType eq "SCALAR") { |
138 | } elsif ($baseType eq "SCALAR") { |
| 106 | my $scalar = $$ref; |
139 | my $scalar = $$ref; |
Parent Directory
| 
Revision Log
| 
Patch