| … | |
… | |
| 33 | use File::Spec; |
33 | use File::Spec; |
| 34 | use Time::Zone; |
34 | use Time::Zone; |
| 35 | use MIME::Base64; |
35 | use MIME::Base64; |
| 36 | use Errno; |
36 | use Errno; |
| 37 | use File::Path qw(rmtree); |
37 | use File::Path qw(rmtree); |
|
|
38 | use Storable; |
| 38 | use Carp; |
39 | use Carp; |
| 39 | |
40 | |
| 40 | use constant MKDIR_ATTEMPTS => 10; |
41 | use constant MKDIR_ATTEMPTS => 10; |
| 41 | |
42 | |
| 42 | # "standard" WeBWorK date/time format (for set definition files): |
43 | # "standard" WeBWorK date/time format (for set definition files): |
| … | |
… | |
| 810 | } |
811 | } |
| 811 | our $BASE64_ENCODED = 'base64_encoded:'; |
812 | our $BASE64_ENCODED = 'base64_encoded:'; |
| 812 | # use constant BASE64_ENCODED = 'base64_encoded; |
813 | # use constant BASE64_ENCODED = 'base64_encoded; |
| 813 | # was not evaluated in the matching and substitution |
814 | # was not evaluated in the matching and substitution |
| 814 | # statements |
815 | # statements |
|
|
816 | # sub decodeAnswers($) { |
|
|
817 | # my $string = shift; |
|
|
818 | # return unless defined $string and $string; |
|
|
819 | # |
|
|
820 | # if ($string =~/^$BASE64_ENCODED/o) { |
|
|
821 | # $string =~ s/^$BASE64_ENCODED//o; |
|
|
822 | # $string = decode_base64($string); |
|
|
823 | # } |
|
|
824 | # |
|
|
825 | # my @array = split m/##/, $string; |
|
|
826 | # $array[$_] =~ s/\\#\\/#/g foreach 0 .. $#array; |
|
|
827 | # push @array, "" if @array%2; |
|
|
828 | # return @array; # it's actually a hash ;) |
|
|
829 | # } |
|
|
830 | |
| 815 | sub decodeAnswers($) { |
831 | sub decodeAnswers($) { |
| 816 | my $string = shift; |
832 | my $serialized = shift; |
| 817 | return unless defined $string and $string; |
833 | return unless defined $serialized and $serialized; |
| 818 | |
834 | my $array_ref = eval{ Storable::thaw($serialized) }; |
| 819 | if ($string =~/^$BASE64_ENCODED/o) { |
835 | if ($@) { |
| 820 | $string =~ s/^$BASE64_ENCODED//o; |
836 | warn "problem fetching answers -- possibly left over from base64 days. $@"; |
| 821 | $string = decode_base64($string); |
837 | return (); |
|
|
838 | } else { |
|
|
839 | return @{$array_ref}; |
| 822 | } |
840 | } |
| 823 | |
|
|
| 824 | my @array = split m/##/, $string; |
|
|
| 825 | $array[$_] =~ s/\\#\\/#/g foreach 0 .. $#array; |
|
|
| 826 | push @array, "" if @array%2; |
|
|
| 827 | return @array; # it's actually a hash ;) |
|
|
| 828 | } |
841 | } |
| 829 | |
842 | |
| 830 | sub encodeAnswers(\%\@) { |
843 | sub encodeAnswers(\%\@) { |
|
|
844 | my %hash = %{shift()}; |
|
|
845 | my @order = @{shift()}; |
|
|
846 | my @ordered_hash = (); |
|
|
847 | foreach my $key (@order) { |
|
|
848 | push @ordered_hash, $key, $hash{$key}; |
|
|
849 | } |
|
|
850 | return Storable::freeze( \@ordered_hash); |
|
|
851 | |
|
|
852 | } |
|
|
853 | |
|
|
854 | # sub encodeAnswers(\%\@) { |
| 831 | my %hash = %{ shift() }; |
855 | # my %hash = %{ shift() }; |
| 832 | my @order = @{ shift() }; |
856 | # my @order = @{ shift() }; |
| 833 | my $string = ""; |
857 | # my $string = ""; |
| 834 | foreach my $name (@order) { |
858 | # foreach my $name (@order) { |
| 835 | my $value = defined $hash{$name} ? $hash{$name} : ""; |
859 | # my $value = defined $hash{$name} ? $hash{$name} : ""; |
| 836 | $name =~ s/#/\\#\\/g; # this is a WEIRD way to escape things |
860 | # $name =~ s/#/\\#\\/g; # this is a WEIRD way to escape things |
| 837 | $value =~ s/#/\\#\\/g; # and it's not my fault! |
861 | # $value =~ s/#/\\#\\/g; # and it's not my fault! |
| 838 | if ($value =~ m/\\$/) { |
862 | # if ($value =~ m/\\$/) { |
| 839 | # if the value ends with a backslash, string2hash will |
863 | # # if the value ends with a backslash, string2hash will |
| 840 | # interpret that as a normal escape sequence (not part |
864 | # # interpret that as a normal escape sequence (not part |
| 841 | # of the weird pound escape sequence) if the next |
865 | # # of the weird pound escape sequence) if the next |
| 842 | # character is &. So we have to protect against this. |
866 | # # character is &. So we have to protect against this. |
| 843 | # will adding a spcae at the end of the last answer |
867 | # # will adding a spcae at the end of the last answer |
| 844 | # hurt anything? i don't think so... |
868 | # # hurt anything? i don't think so... |
| 845 | $value .= " "; |
869 | # $value .= " "; |
| 846 | } |
870 | # } |
| 847 | $string .= "$name##$value##"; # this is also not my fault |
871 | # $string .= "$name##$value##"; # this is also not my fault |
| 848 | } |
872 | # } |
| 849 | $string =~ s/##$//; # remove last pair of hashs |
873 | # $string =~ s/##$//; # remove last pair of hashs |
| 850 | |
874 | # |
| 851 | $string = $BASE64_ENCODED.encode_base64($string, ""); |
875 | # $string = $BASE64_ENCODED.encode_base64($string, ""); |
| 852 | # Empty string in second argument prevents end-of-line characters from being used. |
876 | # # Empty string in second argument prevents end-of-line characters from being used. |
| 853 | # This is nice for examining database contents manually since it prevents newlines |
877 | # # This is nice for examining database contents manually since it prevents newlines |
| 854 | # from being introduced into database records. |
878 | # # from being introduced into database records. |
| 855 | |
879 | # |
| 856 | return $string; |
880 | # return $string; |
| 857 | } |
881 | # } |
| 858 | |
882 | |
| 859 | sub max(@) { |
883 | sub max(@) { |
| 860 | my $soFar; |
884 | my $soFar; |
| 861 | foreach my $item (@_) { |
885 | foreach my $item (@_) { |
| 862 | $soFar = $item unless defined $soFar; |
886 | $soFar = $item unless defined $soFar; |
Parent Directory
| 
Revision Log
| 
Patch