';
if ($baseType eq "HASH") {
my %hash = %$ref;
foreach (sort keys %hash) {
$result .= '
';
$result .= "
$_
";
$result .= "
" . ref2string($hash{$_}, $dontExpand) . "
";
$result .= "
";
}
} elsif ($baseType eq "ARRAY") {
my @array = @$ref;
# special case for Problem, Set, and User objects, which are defined
# using lists and contain a @FIELDS package variable:
no strict 'refs';
my @FIELDS = eval { @{$refType."::FIELDS"} };
use strict 'refs';
undef @FIELDS unless scalar @FIELDS == scalar @array and not $@;
foreach (0 .. $#array) {
$result .= '
";
} else {
# perhaps a coderef? in any case, i don't feel like dealing with it!
$result .= '
';
$result .= "
$ref
";
$result .= "
";
}
$result .= "
"
} else {
$result .= defined $ref ? $ref : 'undef';
}
}
our $BASE64_ENCODED = 'base64_encoded:';
# use constant BASE64_ENCODED = 'base64_encoded;
# was not evaluated in the matching and substitution
# statements
sub decodeAnswers($) {
my $string = shift;
return unless defined $string and $string;
if ($string =~/^$BASE64_ENCODED/o) {
$string =~ s/^$BASE64_ENCODED//o;
$string = decode_base64($string);
}
my @array = split m/##/, $string;
$array[$_] =~ s/\\#\\/#/g foreach 0 .. $#array;
push @array, "" if @array%2;
return @array; # it's actually a hash ;)
}
sub encodeAnswers(\%\@) {
my %hash = %{ shift() };
my @order = @{ shift() };
my $string = "";
foreach my $name (@order) {
my $value = defined $hash{$name} ? $hash{$name} : "";
$name =~ s/#/\\#\\/g; # this is a WEIRD way to escape things
$value =~ s/#/\\#\\/g; # and it's not my fault!
if ($value =~ m/\\$/) {
# if the value ends with a backslash, string2hash will
# interpret that as a normal escape sequence (not part
# of the weird pound escape sequence) if the next
# character is &. So we have to protect against this.
# will adding a spcae at the end of the last answer
# hurt anything? i don't think so...
$value .= " ";
}
$string .= "$name##$value##"; # this is also not my fault
}
$string =~ s/##$//; # remove last pair of hashs
$string = $BASE64_ENCODED.encode_base64($string, "");
# Empty string in second argument prevents end-of-line characters from being used.
# This is nice for examining database contents manually since it prevents newlines
# from being introduced into database records.
return $string;
}
sub max(@) {
my $soFar;
foreach my $item (@_) {
$soFar = $item unless defined $soFar;
if ($item > $soFar) {
$soFar = $item;
}
}
return defined $soFar ? $soFar : 0;
}
sub pretty_print_rh($) {
my $rh = shift;
foreach my $key (sort keys %{$rh}) {
warn " $key => ",$rh->{$key},"\n";
}
}
sub cryptPassword($) {
my ($clearPassword) = @_;
my $salt = join("", ('.','/','0'..'9','A'..'Z','a'..'z')[rand 64, rand 64]);
my $cryptPassword = crypt($clearPassword, $salt);
return $cryptPassword;
}
# from the Perl Cookbook, first edition, page 25:
sub dequote($) {
local $_ = shift;
my ($white, $leader); # common whitespace and common leading string
if (/^\s*(?:([^\w\s]+)(\s*).*\n)(?:\s*\1\2?.*\n)+$/) {
($white, $leader) = ($2, quotemeta($1));
} else {
($white, $leader) = (/^(\s+)/, '');
}
s/^\s*?$leader(?:$white)?//gm;
return $_;
}
sub undefstr($@) {
map { defined $_ ? $_ : $_[0] } @_[1..$#_];
}
# shuffle an array in place
# Perl Cookbook, Recipe 4.17. Randomizing an Array
sub fisher_yates_shuffle {
my $array = shift;
my $i;
for ($i = @$array; --$i; ) {
my $j = int rand ($i+1);
next if $i == $j;
@$array[$i,$j] = @$array[$j,$i];
}
}
################################################################################
# Sorting
################################################################################
# p. 101, Camel, 3rd ed.
# The <=> and cmp operators return -1 if the left operand is less than the
# right operand, 0 if they are equal, and +1 if the left operand is greater
# than the right operand.
sub sortByName($@) {
my ($field, @items) = @_;
return sort {
my @aParts = split m/(?<=\D)(?=\d)|(?<=\d)(?=\D)/, defined $field ? $a->$field : $a;
my @bParts = split m/(?<=\D)(?=\d)|(?<=\d)(?=\D)/, defined $field ? $b->$field : $b;
while (@aParts and @bParts) {
my $aPart = shift @aParts;
my $bPart = shift @bParts;
my $aNumeric = $aPart =~ m/^\d*$/;
my $bNumeric = $bPart =~ m/^\d*$/;
# numbers should come before words
return -1 if $aNumeric and not $bNumeric;
return +1 if not $aNumeric and $bNumeric;
# both have the same type
if ($aNumeric and $bNumeric) {
next if $aPart == $bPart; # check next pair
return $aPart <=> $bPart; # compare numerically
} else {
next if $aPart eq $bPart; # check next pair
return $aPart cmp $bPart; # compare lexicographically
}
}
return +1 if @aParts; # a has more sections, should go second
return -1 if @bParts; # a had fewer sections, should go first
} @items;
}
1;