View of /branches/rel-2-4-patches/webwork2/lib/WeBWorK/DB/Record.pm

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: webwork2/lib/WeBWorK/DB/Record.pm,v 1.12.4.1.2.1 2008/06/24 15:21:54 gage Exp $
    5 #
    6 # This program is free software; you can redistribute it and/or modify it under
    7 # the terms of either: (a) the GNU General Public License as published by the
    8 # Free Software Foundation; either version 2, or (at your option) any later
    9 # version, or (b) the "Artistic License" which comes with this package.
   10 #
   11 # This program is distributed in the hope that it will be useful, but WITHOUT
   12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   13 # FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
   14 # Artistic License for more details.
   15 ################################################################################
   16 
   17 package WeBWorK::DB::Record;
   18 
   19 =head1 NAME
   20 
   21 WeBWorK::DB::Record - common functionality for Record classes.
   22 
   23 =cut
   24 
   25 use strict;
   26 use warnings;
   27 use Carp;
   28 
   29 =head1 CONSTRUCTOR
   30 
   31 =over
   32 
   33 =item new($Prototype)
   34 
   35 Create a new record object, set initial values from the record object
   36 $Prototype, which must be a subclass of WeBWorK::DB::Record.
   37 
   38 =item new(%fields)
   39 
   40 Create a new record object, set initial values from the hash %fields, which
   41 must contain keys equal to the field names of the record class.
   42 
   43 =cut
   44 
   45 sub new {
   46   my $invocant = shift;
   47   my $self = bless {}, ref($invocant) || $invocant;
   48 
   49   if (@_) {
   50     if (UNIVERSAL::isa($_[0], __PACKAGE__)) {
   51       $self->init_from_object($_[0]);
   52     } elsif (ref $_[0] eq "HASH") {
   53       $self->init_from_hashref($_[0]);
   54     } elsif (ref $_[0] eq "ARRAY") {
   55       $self->init_from_arrayref($_[0]);
   56     } else {
   57       $self->init_from_hashref({@_});
   58     }
   59   }
   60 
   61   return $self;
   62 }
   63 
   64 # this will have to be changed if we actually implement any custom accessors/mutators
   65 sub init_from_object { shift->init_from_hashref(shift) }
   66 
   67 sub init_from_hashref {
   68   my ($self, $prototype) = @_;
   69   @$self{$self->FIELDS} = @$prototype{$self->FIELDS};
   70 }
   71 
   72 sub init_from_arrayref {
   73   my ($self, $prototype) = @_;
   74   @$self{$self->FIELDS} = @$prototype;
   75 }
   76 
   77 =back
   78 
   79 =head1 BASE METHODS
   80 
   81 =over
   82 
   83 =item idsToString
   84 
   85 Returns a string representation of the object's keyfields.
   86 
   87 =cut
   88 
   89 sub idsToString {
   90   my $self = shift;
   91   return join " ", map { "$_=" . (defined $self->$_ ? "'".$self->$_."'" : "undef") } $self->KEYFIELDS;
   92 }
   93 
   94 =item idsToString
   95 
   96 Returns a string representation of the object's fields.
   97 
   98 =cut
   99 
  100 sub toString {
  101   my $self = shift;
  102   return join " ", map { "$_=" . (defined $self->$_ ? "'".$self->$_."'" : "undef") } $self->FIELDS;
  103 }
  104 
  105 =item toHash
  106 
  107 Returns a hash representation of the object's fields. If interpreted as a list,
  108 the fields will be in order.
  109 
  110 =cut
  111 
  112 sub toHash {
  113   my $self = shift;
  114   return map { $_ => $self->$_ } $self->FIELDS;
  115 }
  116 
  117 =item toArray
  118 
  119 Returns an array representation of the object's fields.
  120 
  121 =cut
  122 
  123 sub toArray {
  124   my $self = shift;
  125   return map { $self->$_ } $self->FIELDS;
  126 }
  127 
  128 =back
  129 
  130 =cut
  131 
  132 sub _fields {
  133   my $invocant = shift;
  134   my $class = ref $invocant || $invocant;
  135   my @field_data = @_;
  136 
  137   my %field_data = @field_data;
  138   my @field_order = @field_data[ grep {$_%2==0} 0..$#field_data ];
  139   my @keyfields = grep { $field_data{$_}{key} } @field_order;
  140   my @nonkeyfields = grep { not $field_data{$_}{key} } @field_order;
  141   my @sql_types = map { $field_data{$_}{type} } @field_order;
  142 
  143   no strict 'refs';
  144 
  145   # class methods that return field info
  146   *{$class."::FIELD_DATA"} = sub { return \%field_data };
  147   *{$class."::FIELDS"} = sub { return @field_order };
  148   *{$class."::KEYFIELDS"} = sub { return @keyfields };
  149   *{$class."::NONKEYFIELDS"} = sub { return @nonkeyfields };
  150   *{$class."::SQL_TYPES"} = sub { return @sql_types };
  151 
  152   # accessor functions
  153   foreach my $field (@field_order) {
  154     # always define a "base" accessor
  155     # custom public accessors can use this to actually do the getting and setting
  156     *{$class."::_base_$field"} = sub {
  157       my $self = shift;
  158       $self->{$field} = shift if @_;
  159       return $self->{$field};
  160     };
  161     # if there isn't a public accessor in the subclass, alias it to the base accessor
  162     next if exists ${$class."::"}{$field};
  163     *{$class."::$field"} = *{$class."::_base_$field"};
  164   }
  165 }
  166 
  167 sub _initial_records {
  168   my $invocant = shift;
  169   my $class = ref $invocant || $invocant;
  170   my @initializers = @_;
  171 
  172   no strict 'refs';
  173   *{$class."::INITIAL_RECORDS"} = sub { return @initializers };
  174 }
  175 
  176 1;
  177