| … | |
… | |
| 33 | dbDecode |
33 | dbDecode |
| 34 | dbEncode |
34 | dbEncode |
| 35 | decodeAnswers |
35 | decodeAnswers |
| 36 | encodeAnswers |
36 | encodeAnswers |
| 37 | ref2string |
37 | ref2string |
| 38 | dequoteHere |
38 | sortByName |
| 39 | wrapText |
|
|
| 40 | ); |
39 | ); |
| 41 | |
40 | |
| 42 | sub runtime_use($) { |
41 | sub runtime_use($) { |
| 43 | return unless @_; |
42 | return unless @_; |
| 44 | eval "package Main; require $_[0]; import $_[0]"; |
43 | eval "package Main; require $_[0]; import $_[0]"; |
| … | |
… | |
| 139 | $soFar = $item; |
138 | $soFar = $item; |
| 140 | } |
139 | } |
| 141 | } |
140 | } |
| 142 | return defined $soFar ? $soFar : 0; |
141 | return defined $soFar ? $soFar : 0; |
| 143 | } |
142 | } |
| 144 | |
|
|
| 145 | # ----- |
|
|
| 146 | |
|
|
| 147 | #sub dbDecode($) { |
|
|
| 148 | # my $string = shift; |
|
|
| 149 | # return unless defined $string and $string; |
|
|
| 150 | # my %hash = $string =~ /(.*?)(?<!\\)=(.*?)(?:(?<!\\)&|$)/g; |
|
|
| 151 | # $hash{$_} =~ s/\\(&|=)/$1/g foreach keys %hash; # unescape & and = |
|
|
| 152 | # return %hash; |
|
|
| 153 | #} |
|
|
| 154 | # |
|
|
| 155 | #sub dbEncode(@) { |
|
|
| 156 | # my %hash = @_; |
|
|
| 157 | # my $string; |
|
|
| 158 | # foreach (keys %hash) { |
|
|
| 159 | # $hash{$_} = "" unless defined $hash{$_}; # promote undef to "" |
|
|
| 160 | # $hash{$_} =~ s/(=|&)/\\$1/g; # escape & and = |
|
|
| 161 | # $string .= "$_=$hash{$_}&"; |
|
|
| 162 | # } |
|
|
| 163 | # chop $string; # remove final '&' from string for old code :p |
|
|
| 164 | # return $string; |
|
|
| 165 | #} |
|
|
| 166 | # moved to lib/WeBWorK/DB/Utils.pm |
|
|
| 167 | |
143 | |
| 168 | sub decodeAnswers($) { |
144 | sub decodeAnswers($) { |
| 169 | my $string = shift; |
145 | my $string = shift; |
| 170 | return unless defined $string and $string; |
146 | return unless defined $string and $string; |
| 171 | my @array = split m/##/, $string; |
147 | my @array = split m/##/, $string; |
| … | |
… | |
| 194 | $string .= "$name##$value##"; # this is also not my fault |
170 | $string .= "$name##$value##"; # this is also not my fault |
| 195 | } |
171 | } |
| 196 | $string =~ s/##$//; # remove last pair of hashs |
172 | $string =~ s/##$//; # remove last pair of hashs |
| 197 | return $string; |
173 | return $string; |
| 198 | } |
174 | } |
| 199 | |
|
|
| 200 | # ----- |
|
|
| 201 | |
175 | |
| 202 | sub ref2string($;$); |
176 | sub ref2string($;$); |
| 203 | sub ref2string($;$) { |
177 | sub ref2string($;$) { |
| 204 | my $ref = shift; |
178 | my $ref = shift; |
| 205 | my $dontExpand = shift || {}; |
179 | my $dontExpand = shift || {}; |
| … | |
… | |
| 255 | my $ref = shift; |
229 | my $ref = shift; |
| 256 | $ref =~ m/(\w+)\(/; # this might not be robust... |
230 | $ref =~ m/(\w+)\(/; # this might not be robust... |
| 257 | return $1; |
231 | return $1; |
| 258 | } |
232 | } |
| 259 | |
233 | |
|
|
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. |
|
|
238 | |
|
|
239 | sub sortByName { |
|
|
240 | my ($field, @items) = @_; |
|
|
241 | return sort { |
|
|
242 | my @aParts = split m/(?<=\D)(?=\d)|(?<=\d)(?=\D)/, $a->$field; |
|
|
243 | my @bParts = split m/(?<=\D)(?=\d)|(?<=\d)(?=\D)/, $b->$field; |
|
|
244 | while (@aParts and @bParts) { |
|
|
245 | my $aPart = shift @aParts; |
|
|
246 | my $bPart = shift @bParts; |
|
|
247 | my $aNumeric = $aPart =~ m/^\d*$/; |
|
|
248 | my $bNumeric = $bPart =~ m/^\d*$/; |
|
|
249 | |
|
|
250 | # numbers should come before words |
|
|
251 | return -1 if $aNumeric and not $bNumeric; |
|
|
252 | return +1 if not $aNumeric and $bNumeric; |
|
|
253 | |
|
|
254 | # both have the same type |
|
|
255 | if ($aNumeric and $bNumeric) { |
|
|
256 | next if $aPart == $bPart; # check next pair |
|
|
257 | return $aPart <=> $bPart; # compare numerically |
|
|
258 | } else { |
|
|
259 | next if $aPart eq $bPart; # check next pair |
|
|
260 | return $aPart cmp $bPart; # compare lexicographically |
|
|
261 | } |
|
|
262 | } |
|
|
263 | return +1 if @aParts; # a has more sections, should go second |
|
|
264 | return -1 if @bParts; # a had fewer sections, should go first |
|
|
265 | } @items; |
|
|
266 | } |
|
|
267 | |
| 260 | 1; |
268 | 1; |
Parent Directory
| 
Revision Log
| 
Patch