View of /trunk/webwork2/lib/WeBWorK/DBv3/NormalizerMixin.pm

    1 # This mixin is modeled after Tatsuhiko Miyagawa's Class::Trigger mixin. It is
    2 # simpler and less reusable.
    3 
    4 package WeBWorK::DBv3::NormalizerMixin;
    5 
    6 use strict;
    7 use warnings;
    8 use Class::Data::Inheritable;
    9 use Carp ();
   10 
   11 sub import {
   12   my ($invocant) = @_;
   13   my $pkg = caller(0);
   14 
   15   # XXX 5.005_03 isa() is broken with MI
   16   unless ($pkg->can('mk_classdata')) {
   17     no strict 'refs';
   18     push @{"$pkg\::ISA"}, 'Class::Data::Inheritable';
   19   }
   20 
   21   $pkg->mk_classdata('__normalizers');
   22 
   23   # export mixin methods
   24   no strict 'refs';
   25   my @methods = qw(add_normalizer call_normalizer);
   26   *{"$pkg\::$_"} = \&{$_} for @methods;
   27 }
   28 
   29 sub add_normalizer {
   30   my ($invocant, @new) = @_;
   31 
   32   my $normalizers = __fetch_normalizers($invocant) || {};
   33   my %normalizers = __deep_dereference($normalizers);
   34 
   35   while (my ($column, $code) = splice @new, 0, 2) {
   36     __validate_field($invocant, $column);
   37     Carp::croak('add_normalizer() needs coderef') unless ref($code) eq 'CODE';
   38     push @{$normalizers{$column}}, $code;
   39   }
   40 
   41   __store_normalizers($invocant, \%normalizers);
   42 }
   43 
   44 sub call_normalizer {
   45   my ($invocant, $column_values, $column) = @_;
   46 
   47   my $normalizers = __fetch_normalizers($invocant) || return;
   48   if (exists $normalizers->{$column}) {
   49     foreach my $code (@{$normalizers->{$column}}) {
   50       #warn "call_normalizer: old value of column '$column': '", $column_values->{$column}, "'.\n";
   51       $column_values->{$column} = $code->($column_values->{$column});
   52       #warn "call_normalizer: new value of column '$column': '", $column_values->{$column}, "'.\n";
   53     }
   54   } else {
   55     __validate_field($invocant, $column);
   56   }
   57 }
   58 
   59 ################################################################################
   60 
   61 sub __validate_field {
   62   my ($invocant, $column) = @_;
   63   Carp::croak("$column is not valid field for " . (ref($invocant) || $invocant))
   64     unless $invocant->find_column($column) ? 1 : "";
   65 }
   66 
   67 sub __fetch_normalizers {
   68   my ($invocant) = @_;
   69 
   70   if (ref $invocant) {
   71     # called with an instance, use the instance's normalizers
   72     return $invocant->{__normalizers};
   73   } else {
   74     # called with a class, use the class's normalizers
   75     return $invocant->__normalizers;
   76   }
   77 }
   78 
   79 sub __store_normalizers {
   80   my ($invocant, $normalizers) = @_;
   81 
   82   if (ref $invocant) {
   83     # called with an instance, use the instance's normalizers
   84     $invocant->{__normalizers} = $normalizers;
   85   } else {
   86     # called with a class, use the class's normalizers
   87     $invocant->__normalizers($normalizers);
   88   }
   89 }
   90 
   91 # straight from Class::Trigger -- two-level copy of hash-of-arrays.
   92 sub __deep_dereference {
   93   my $hashref = shift;
   94   my %copy;
   95   while (my($key, $arrayref) = each %$hashref) {
   96     $copy{$key} = [ @$arrayref ];
   97   }
   98   return %copy;
   99 }
  100 
  101 ################################################################################
  102 
  103 1;