View of /trunk/webwork2/lib/WeBWorK/DB/Utils.pm

    1 ################################################################################
    2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project
    3 # $Id$
    4 ################################################################################
    5 
    6 package WeBWorK::DB::Utils;
    7 use base qw(Exporter);
    8 
    9 =head1 NAME
   10 
   11 WeBWorK::DB::Utils - useful utilities for the database modules.
   12 
   13 =cut
   14 
   15 use strict;
   16 use warnings;
   17 use Data::Dumper;
   18 
   19 our @EXPORT    = ();
   20 our @EXPORT_OK = qw(
   21   record2hash
   22   hash2record
   23   hash2string
   24   string2hash
   25   findDefaults
   26 );
   27 
   28 ################################################################################
   29 # WWDBv2 record <-> WWDBv1 hash
   30 #  not in the Record classes, since they are for legacy support
   31 ################################################################################
   32 
   33 # RECORDHASH defines the correspondance between WWDBv1 hash keys and WWDBv2
   34 # record fields.
   35 
   36 use constant RECORDHASH => {
   37   "WeBWorK::DB::Record::User" => [
   38     ['stfn', "first_name"   ],
   39     ['stln', "last_name"    ],
   40     ['stea', "email_address"],
   41     ['stid', "student_id"   ],
   42     ['stst', "status"       ],
   43     ['clsn', "section"      ],
   44     ['clrc', "recitation"   ],
   45     ['comt', "comment"      ],
   46   ],
   47   "WeBWorK::DB::Record::UserSet" => [
   48     ['stlg', "user_id"       ],
   49     ['stnm', "set_id"        ],
   50     ['shfn', "set_header"    ],
   51     ['phfn', "problem_header"],
   52     ['opdt', "open_date"     ],
   53     ['dudt', "due_date"      ],
   54     ['andt', "answer_date"   ],
   55   ],
   56   # a hash destined to be converted into a UserProblem must be converted
   57   # so that the hash keys, rather than containing the problem number,
   58   # contain the character '#'. Also, a new hash key '#' must be added
   59   # which contains the problem number.
   60   "WeBWorK::DB::Record::UserProblem" => [
   61     ['stlg',  "user_id"      ],
   62     ['stnm',  "set_id"       ],
   63     ['#',     "problem_id"   ],
   64     ['pfn#',  "source_file"  ],
   65     ['pva#',  "value"        ],
   66     ['pmia#', "max_attempts" ],
   67     ['pse#',  "problem_seed" ],
   68     ['pst#',  "status"       ],
   69     ['pat#',  "attempted"    ],
   70     ['pan#',  "last_answer"  ],
   71     ['pca#',  "num_correct"  ],
   72     ['pia#',  "num_incorrect"],
   73   ],
   74   # *** add tables for the rest of the record types
   75 };
   76 
   77 sub record2hash($) {
   78   my ($record) = @_;
   79   my $map = RECORDHASH->{ref $record};
   80   die ref $record, ": unknown record type" unless defined $map;
   81   my %hash;
   82   for (my $i = 0; $i < @$map; $i++) {
   83     my ($v1, $v2) = @{$map->[$i]};
   84     $hash{$v1} = $record->$v2;
   85   }
   86   return %hash;
   87 }
   88 
   89 sub hash2record($@) {
   90   my ($type, %hash) = @_;
   91   my $map = RECORDHASH->{$type};
   92   die $type, ": unknown record type" unless defined $map;
   93   my $record = $type->new();
   94   for (my $i = 0; $i < @$map; $i++) {
   95     my ($v1, $v2) = @{$map->[$i]};
   96     $record->$v2($hash{$v1});
   97   }
   98   return $record;
   99 }
  100 
  101 ################################################################################
  102 # WWDBv1 hash <-> WWDBv1 string
  103 ################################################################################
  104 
  105 sub hash2string(@) {
  106   my %hash = @_;
  107   my $string;
  108   return "" unless keys %hash;
  109   foreach (keys %hash) {
  110     $hash{$_} = "" unless defined $hash{$_}; # promote undef to ""
  111     $hash{$_} =~ s/(=|&)/\\$1/g; # escape & and =
  112     $string .= "$_=$hash{$_}&";
  113   }
  114   chop $string; # remove final '&' from string for old code :p
  115   return $string;
  116 }
  117 
  118 sub string2hash($) {
  119   my $string = shift;
  120   return unless defined $string and $string;
  121   my %hash = $string =~ /(.*?)(?<!\\)=(.*?)(?:(?<!\\)&|$)/g;
  122   $hash{$_} =~ s/\\(&|=)/$1/g foreach keys %hash; # unescape & and =
  123   return %hash;
  124 }
  125 
  126 ################################################################################
  127 # default generation
  128 ################################################################################
  129 
  130 sub findDefaults($@) {
  131   my ($globalClass, @Records) = @_;
  132 
  133   my %fields = map { $_ => {} } $globalClass->FIELDS();
  134   #delete $fields{$_} foreach $globalClass->KEYFIELDS();
  135 
  136   foreach my $Record (@Records) {
  137     foreach my $field (keys %fields) {
  138       my $value = $Record->$field();
  139       if ($value eq "UNDEFINED") {
  140         die "Uh oh... value eq \"UNDEFINED\"\n";
  141       }
  142       unless (defined $value) {
  143         $value = "UNDEFINED";
  144       }
  145       $fields{$field}{$value}++;
  146     }
  147   }
  148 
  149   #warn "Frequencies: ", Dumper(\%fields);
  150 
  151   my $Defaults = $globalClass->new();
  152   foreach my $field (keys %fields) {
  153     my $maxFreq = 0;
  154     my $maxValue;
  155     foreach my $value (keys %{$fields{$field}}) {
  156       my $freq = $fields{$field}{$value};
  157       if ($freq > $maxFreq) {
  158         $maxFreq = $freq;
  159         $maxValue = $value;
  160       }
  161     }
  162     undef $maxValue if $maxValue eq "UNDEFINED";
  163     $Defaults->$field($maxValue);
  164   }
  165 
  166   warn "Consensus defaults: ", Dumper($Defaults);
  167 
  168   return $Defaults;
  169 }
  170 
  171 1;