| … | |
… | |
| 12 | |
12 | |
| 13 | =cut |
13 | =cut |
| 14 | |
14 | |
| 15 | use strict; |
15 | use strict; |
| 16 | use warnings; |
16 | use warnings; |
|
|
17 | use Apache::DB; |
| 17 | use Date::Format; |
18 | use Date::Format; |
| 18 | use Date::Parse; |
19 | use Date::Parse; |
| 19 | use DB; # DeBug, not DataBase |
20 | use Errno; |
|
|
21 | |
|
|
22 | use constant MKDIR_ATTEMPTS => 10; |
| 20 | |
23 | |
| 21 | our @EXPORT = (); |
24 | our @EXPORT = (); |
| 22 | our @EXPORT_OK = qw( |
25 | our @EXPORT_OK = qw( |
| 23 | runtime_use |
26 | runtime_use |
| 24 | backtrace |
27 | backtrace |
| … | |
… | |
| 34 | dbEncode |
37 | dbEncode |
| 35 | decodeAnswers |
38 | decodeAnswers |
| 36 | encodeAnswers |
39 | encodeAnswers |
| 37 | ref2string |
40 | ref2string |
| 38 | sortByName |
41 | sortByName |
|
|
42 | makeTempDirectory |
|
|
43 | pretty_print_rh |
| 39 | ); |
44 | ); |
| 40 | |
45 | |
| 41 | sub runtime_use($) { |
46 | sub runtime_use($) { |
| 42 | return unless @_; |
47 | return unless @_; |
| 43 | eval "package Main; require $_[0]; import $_[0]"; |
48 | eval "package Main; require $_[0]; import $_[0]"; |
| … | |
… | |
| 263 | return +1 if @aParts; # a has more sections, should go second |
268 | return +1 if @aParts; # a has more sections, should go second |
| 264 | return -1 if @bParts; # a had fewer sections, should go first |
269 | return -1 if @bParts; # a had fewer sections, should go first |
| 265 | } @items; |
270 | } @items; |
| 266 | } |
271 | } |
| 267 | |
272 | |
|
|
273 | sub makeTempDirectory($$) { |
|
|
274 | my ($parent, $basename) = @_; |
|
|
275 | # Loop until we're able to create a directory, or it fails for some |
|
|
276 | # reason other than there already being something there. |
|
|
277 | my $triesRemaining = MKDIR_ATTEMPTS; |
|
|
278 | my ($fullPath, $success); |
|
|
279 | do { |
|
|
280 | my $suffix = join "", map { ('A'..'Z','a'..'z','0'..'9')[int rand 62] } 1 .. 8; |
|
|
281 | $fullPath = "$parent/$basename.$suffix"; |
|
|
282 | $success = mkdir $fullPath; |
|
|
283 | } until ($success or not $!{EEXIST}); |
|
|
284 | die "Failed to create directory $fullPath: $!" |
|
|
285 | unless $success; |
|
|
286 | return $fullPath; |
|
|
287 | } |
|
|
288 | |
| 268 | sub pretty_print_rh { |
289 | sub pretty_print_rh { |
| 269 | my $rh = shift; |
290 | my $rh = shift; |
| 270 | foreach my $key (sort keys %{$rh}) { |
291 | foreach my $key (sort keys %{$rh}) { |
| 271 | warn " $key => ",$rh->{$key},"\n"; |
292 | warn " $key => ",$rh->{$key},"\n"; |
| 272 | } |
293 | } |
| 273 | } |
294 | } |
|
|
295 | |
| 274 | 1; |
296 | 1; |