SL/DB/Object.pm

   1 package SL::DB::Object;
   2
   3 use strict;
   4
   5 use Readonly;
   6 use Rose::DB::Object;
   7 use List::MoreUtils qw(any);
   8
   9 use SL::DB;
  10 use SL::DB::Helper::Attr;
  11 use SL::DB::Helper::Metadata;
  12 use SL::DB::Helper::Manager;
  13
  14 use base qw(Rose::DB::Object);
  15
  16 sub new {
  17   my $class = shift;
  18   my $self  = $class->SUPER::new();
  19
  20   $self->_assign_attributes(@_) if $self;
  21
  22   return $self;
  23 }
  24
  25 sub init_db {
  26   my $class_or_self = shift;
  27   my $class         = ref($class_or_self) || $class_or_self;
  28   my $type          = $class =~ m/::Auth/ ? 'LXOFFICE_AUTH' : 'LXOFFICE';
  29
  30   return SL::DB::create(undef, $type);
  31 }
  32
  33 sub meta_class {
  34   return 'SL::DB::Helper::Metadata';
  35 }
  36
  37 sub _get_manager_class {
  38   my $class_or_self = shift;
  39   my $class         = ref($class_or_self) || $class_or_self;
  40
  41   return $class->meta->convention_manager->auto_manager_class_name($class);
  42 }
  43
  44 Readonly my %text_column_types => (text => 1, char => 1, varchar => 1);
  45
  46 sub assign_attributes {
  47   my $self       = shift;
  48   my %attributes = @_;
  49
  50   my $pk         = ref($self)->meta->primary_key;
  51   delete @attributes{$pk->column_names} if $pk;
  52
  53   return $self->_assign_attributes(%attributes);
  54 }
  55
  56 sub _assign_attributes {
  57   my $self       = shift;
  58   my %attributes = @_;
  59
  60   my %types      = map { $_->name => $_->type } ref($self)->meta->columns;
  61
  62   while (my ($attribute, $value) = each %attributes) {
  63     my $type = lc($types{$attribute} || 'text');
  64     $value   = $type eq 'boolean'                ? ($value ? 't' : 'f')
  65              : $text_column_types{$type}         ? $value
  66              : defined($value) && ($value eq '') ? undef
  67              :                                     $value;
  68     $self->$attribute($value);
  69   }
  70
  71   return $self;
  72 }
  73
  74 sub update_attributes {
  75   my $self = shift;
  76
  77   $self->assign_attributes(@_)->save;
  78
  79   return $self;
  80 }
  81
  82 1;
  83
  84 __END__
  85
  86 =pod
  87
  88 =head1 NAME
  89
  90 SL::DB::Object: Base class for all of our model classes
  91
  92 =head1 DESCRIPTION
  93
  94 This is the base class from which all other model classes are
  95 derived. It contains functionality and settings required for all model
  96 classes.
  97
  98 Several functions (e.g. C<make_manager_class>, C<init_db>) in this
  99 class are used for setting up the classes / base classes used for all
 100 model instances. They overwrite the functions from
 101 L<Rose::DB::Object>.
 102
 103 =head1 FUNCTIONS
 104
 105 =over 4
 106
 107 =item assign_attributes %attributes
 108
 109 =item _assign_attributes %attributes
 110
 111 Assigns all elements from C<%attributes> to the columns by calling
 112 their setter functions. The difference between the two functions is
 113 that C<assign_attributes> protects primary key columns while
 114 C<_assign_attributes> doesn't.
 115
 116 Both functions handle values that are empty strings by replacing them
 117 with C<undef> for non-text columns. This allows the calling functions
 118 to use data from HTML forms as the input for C<assign_attributes>
 119 without having to remove empty strings themselves (think of
 120 e.g. select boxes with an empty option which should be turned into
 121 C<NULL> in the database).
 122
 123 =item update_attributes %attributes
 124
 125 Assigns the attributes from C<%attributes> by calling the
 126 C<assign_attributes> function and saves the object afterwards. Returns
 127 the object itself.
 128
 129 =item _get_manager_class
 130
 131 Returns the manager package for the object or class that it is called
 132 on. Can be used from methods in this package for getting the actual
 133 object's manager.
 134
 135 =back
 136
 137 =head1 AUTHOR
 138
 139 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 140
 141 =cut