root/trunk/DB/Table/Row/Row.pm @ 1

Revision 1, 28.4 KB (checked in by bradley, 5 years ago)

Initial import
Line 
1
2package DB::Table::Row;
3
4use Carp qw(cluck confess);
5use Data::Dumper;
6use strict;
7
8# TODO: use Exception;
9
10=pod
11=head1 NAME
12
13DB::Table::Row - provide an interface to a row within a DB::Table object.
14
15=head1 SYNOPSIS
16
17    use DB::Table::Row;
18    my $row = DB::Table::Row->construct($dbh, $table, $hashRef);
19    $row->insert() || check_for_errors();
20
21    my $userId = $row->userId();
22    my $userId = $row->getValue('userId');
23    $row->username('newUserName');
24    $row->setValue('username', 'newUserName');
25    $row->update() || check_for_errors();
26
27    my $row = DB::Table::Row->getByPKey($dbh, $table, $userId);
28    $row->delete();
29
30=head1 DESCRIPTION
31
32DB::Table::Row provides an interface to a row in a given database table. It does its best
33to prevent the need for writing any custom SQL and also understands foreign-key relationships
34and implements constraints on databases which understand the CASE ... END clause.
35
36This module gets its understanding of the table structure that the row is from by being passed
37an instance of a DB::Table object (or a sub-class there-of).
38
39=head1 METHODS
40
41=cut
42
43# /* construct */ {{{
44=pod
45
46=head2 Class Methods
47
48=over 4
49
50=item my $row = DB::Table::Row->construct($dbh, $table, $hashRef);
51
52This method is used to construct a row object with the structure defined
53by $table, with values defined in $hashRef. This method does not actually
54insert the row into the given table (See the L<insert()> method), but rather
55just constructs in in-memory representation of the row.
56
57=cut
58sub construct
59{
60    # create a new database object
61
62    my $ref   = shift;
63    my $class = ref($ref) || $ref;
64
65    my $dbh   = shift;
66    my $table = shift || confess("Usage: $class->new(\$dbh, \$table, \$obj)");
67    my $obj   = shift || {};
68
69    $obj->{'_dbh'}   = $dbh;
70    $obj->{'_table'} = $table;
71
72    # WARNING: This assumes that the first primary key field is the one with the serial column.
73    # In most cases it is, but this wont work if it isnt.
74    $obj->{($table->primaryKeys())[0]} = undef;
75
76    delete($obj->{'_deleted'});
77    delete($obj->{'_modified'});
78    delete($obj->{'_validationError'});
79    delete($obj->{'_validation'});
80
81    return bless ($obj, $class);
82}
83# /* construct */ }}}
84
85# /* getByPKey */ {{{
86=pod
87
88=item my @rows = DB::Table::Row->getByPKey($dbh, $table, @keys);
89
90This method is used to fetch one or more rows using primary keys.
91
92If used in scalar context (my $row = DB::Table::Row->getByPKey())
93then only the first row is actually returned, while in array context
94all rows are returned.
95
96If no primary keys are specified, then all rows in the table are returned
97(use with caution on very large tables).
98
99You may, however, select a subset of the expected rows by supplying a hash-ref
100as the first key, with 'pageLength' being the number of rows you'd like, and
101'pageOffset' being the row to start counting from. For example:
102
103  my @rows = DB::Table::Row->getByPKey($dbh, $table, {pageOffset => 100,
104                                                      pageLength => 10}
105                                       [, @id_list]);
106Will only select rows 100 - 110 from the database. You may still supply
107an ID list if you choose, in which case you will get back a subset of
108rows with the IDs you specify.
109
110Rows are always returned in ncrementing primary key order, ie row[n]'s primary key
111will always be smaller than row[n + 1]'s primary key.
112
113=cut
114# get the specified object, or a list of them, or all of them
115sub getByPKey
116{
117    my $ref   = shift;
118    my $class = ref($ref) || $ref;
119
120    my $dbh   = shift || confess("Usage: $class->getByPKey(\$dbh, \$table [, \@IDs ]);");
121    my $table = shift || confess("Usage: $class->getByPKey(\$dbh, \$table [, \@IDs ]);");
122
123    my @obj_ids = @_;
124    my $pageOptions = {pageLength => 'ALL',
125                       pageOffset => 0};
126    if (ref($obj_ids[0]) eq 'HASH')
127    {
128        $pageOptions = shift @obj_ids;
129    }
130
131    my @rows; # Store fetched rows...
132
133    my $get_obj_sql;
134    my $numExpectedObjs = scalar(@obj_ids);
135    if ($numExpectedObjs > 0)
136    {
137        $get_obj_sql = sprintf("SELECT %s, %s FROM %s WHERE %s ORDER BY %s LIMIT %s OFFSET %s",
138                              join(', ', $table->primaryKeys),
139                              join(', ', $table->fields()),
140                              $table->name(),
141                              join(' AND ', map { "$_ = ?" } $table->primaryKeys()),
142                              join(', ', $table->primaryKeys()),
143                              $pageOptions->{'pageLength'},
144                              $pageOptions->{'pageOffset'});
145    }
146    else
147    {
148        $get_obj_sql = sprintf("SELECT %s, %s FROM %s ORDER BY %s LIMIT %s OFFSET %s",
149                              join(', ', $table->primaryKeys()),
150                              join(', ', $table->fields()),
151                              $table->name(),
152                              join(', ', $table->primaryKeys()),
153                              $pageOptions->{'pageLength'},
154                              $pageOptions->{'pageOffset'});
155    }
156    my $get_obj_sth = $dbh->prepare_cached($get_obj_sql, {pg_prepare_now => 1}, 3) or
157      confess (sprintf("Could not prepare_cached(%s): Error Code %d (%s)", $get_obj_sql, $dbh->err, $dbh->errstr));
158
159    do
160    {
161        my $id = shift @obj_ids;
162        my $success;
163        if (defined ($id))
164        {
165            $success = $get_obj_sth->execute(ref($id) eq 'ARRAY' ? @{$id} : $id);
166        }
167        else
168        {
169            $success = $get_obj_sth->execute();
170        }
171
172        unless ($success)
173        {
174            # TODO: Raise an exception.
175            cluck (sprintf("Could not execute(%s)\n(%s)\n Error Code %d (%s)",
176                          $get_obj_sql,
177                          (ref($id) eq 'ARRAY' ? @{$id} : $id),
178                          $dbh->err,
179                          $dbh->errstr));
180            return undef;
181        }
182        my %row = (_dbh   => $dbh,
183                   _table => $table);
184        $get_obj_sth->bind_columns(map { \$row{$_} } $table->primaryKeys, $table->fields());
185        while ($get_obj_sth->fetch)
186        {
187            my (%newRow) = (%row);
188            push @rows, bless (\%newRow, $class);
189        }
190        $get_obj_sth->finish;
191    }
192    while (@obj_ids);
193
194    return wantarray ? @rows : $rows[0];
195}
196# /* getByPKey */ }}}
197
198# /* getByFKey */ {{{
199=pod
200
201=item my @rows = DB::Table::Row->getByFKey($dbh, $table, $fKeyName, @FKeys);
202
203This method is used to get all rows from the specified $table object, where
204$fKeyName is in the list of FKeys. This method can be used to select
205rows where a non-primary-key field is equal to a value supplied in the list
206of @FKeys. For example, if you want to get all rows who's 'owner_id' field
207is equal to 5, you might say:
208
209  my $row = DB::Table::Row->getByFKey($dbh, $table, 'owner_id', 5);
210
211=cut
212sub getByFKey
213{
214    my $ref   = shift;
215    my $class = ref($ref) || $ref;
216
217    my $dbh      = shift || confess("Usage: $class->getByFKey(\$dbh, \$table, \$fKeyName, \@FKeys ]);");
218    my $table    = shift || confess("Usage: $class->getByFKey(\$dbh, \$table, \$fKeyName, \@FKeys ]);");
219    my $fKeyName = shift || confess("Usage: $class->getByFKey(\$dbh, \$table, \$fKeyName, \@FKeys ]);");
220    my @fKeyIds  = @_;
221
222    my @rows; # Store fetched rows...
223
224    my $get_obj_sql;
225    my $numExpectedObjs = scalar(@fKeyIds);
226    if ($numExpectedObjs > 0)
227    {
228        $get_obj_sql = sprintf("SELECT %s, %s FROM %s WHERE %s ORDER BY %s",
229                              join(', ', $table->primaryKeys()),
230                              join(', ', $table->fields()),
231                              $table->name(),
232                              "$fKeyName = ?",
233                              join(', ', $table->primaryKeys()));
234    }
235    else
236    {
237        confess("Usage: $class->getByFKey(\$dbh, \$table, \$fKeyName, \@FKeys]);");
238    }
239    my $get_obj_sth = $dbh->prepare_cached($get_obj_sql, {pg_prepare_now => 1}, 3) or
240      confess (sprintf("Could not prepare_cached(%s): Error Code %d (%s)", $get_obj_sql, $dbh->err, $dbh->errstr));
241
242    do
243    {
244        my $id = shift @fKeyIds;
245        my $success;
246        if (defined ($id))
247        {
248            $success = $get_obj_sth->execute($id);
249        }
250
251        unless ($success)
252        {
253            # TODO: Raise an exception.
254            cluck (sprintf("Could not execute(%s)\n(%s)\n Error Code %d (%s)",
255                          $get_obj_sql,
256                          (ref($id) eq 'ARRAY' ? @{$id} : $id),
257                          $dbh->err,
258                          $dbh->errstr));
259            return undef;
260        }
261        my %row = (_dbh   => $dbh,
262                   _table => $table);
263        $get_obj_sth->bind_columns(map { \$row{$_} } $table->primaryKeys(), $table->fields());
264        while ($get_obj_sth->fetch)
265        {
266            my (%newRow) = (%row);
267            push @rows, bless (\%newRow, $class);
268        }
269        $get_obj_sth->finish;
270    }
271    while (@fKeyIds);
272
273    return wantarray ? @rows : $rows[0];
274}
275# /* getByFKey */ }}}
276
277# /* searchByString */ {{{
278=pod
279
280=item my @rows = DB::Table::Row->searchByString($dbh, $table, $searchString);
281
282This method allows a free-text search to be performed on the database. All
283non-primary-key fields are cast to a string and then search using the LIKE clause.
284Searching is not case-sensitive either.
285
286TODO: There is not yet a way to limit which fields are searched, and foreign key's are
287not "de-referenced".
288
289=back
290
291=cut
292sub searchByString
293{
294    my $ref = shift;
295    my $class = ref($ref) || $ref;
296
297    my $dbh    = shift || confess("Usage: $class->searchByString(\$dbh, \$table, \$string);");
298    my $table  = shift || confess("Usage: $class->searchByString(\$dbh, \$table, \$string);");
299    my $string = shift || confess("Usage: $class->searchByString(\$dbh, \$table, \$string);");
300
301    my $search_obj_sql = sprintf("SELECT %s, %s FROM %s WHERE %s ORDER BY %s",
302                              join(', ', $table->primaryKeys()),
303                              join(', ', $table->fields()),
304                              $table->name(),
305                              join(' OR ', map { "LOWER($_\::text) LIKE ?" } $table->fields()),
306                              join(', ', $table->primaryKeys()));
307    my $search_obj_sth = $dbh->prepare_cached($search_obj_sql, {pg_prepare_now => 1}, 3) or
308      confess (sprintf("Could not prepare_cached(%s): Error Code %d (%s)", $search_obj_sql, $dbh->err, $dbh->errstr));
309
310    my $sucess = $search_obj_sth->execute(map { lc("\%$string\%") } $table->fields());
311    unless ($sucess)
312    {
313        # TODO: Raise an exception.
314        cluck (sprintf("Could not execute(%s)\n(%s)\n Error Code %d (%s)",
315                      $search_obj_sql,
316                      (map { lc("\%$string\%") } $table->fields()),
317                      $dbh->err,
318                      $dbh->errstr));
319        return undef;
320    }
321
322    my %row = ( _dbh   => $dbh,
323                _table => $table);
324    $search_obj_sth->bind_columns(map { \$row{$_} } $table->primaryKeys(), $table->fields());
325
326    my @rows;
327    while ($search_obj_sth->fetch)
328    {
329        my (%newRow) = (%row);
330        push @rows, bless (\%newRow, $class);
331    }
332    $search_obj_sth->finish;
333
334    return wantarray ? @rows : $rows[0];
335}
336# /* searchByString */ }}}
337
338# /* _valueMap */ {{{
339sub _valueMap
340{
341    my $self = shift;
342
343    my $fName = shift;
344    my $value = shift;
345
346    if (!$value)
347    {
348        return undef;
349    }
350    return $value;
351}
352# /* _valueMap */ }}}
353
354# /* insert */ {{{
355=pod
356
357=head2 Object Methods
358
359=over 4
360
361=item $row->insert();
362
363Once constructed, the row can be inserted into the database. If the row cannot be inserted
364into the database, then undef is returned (You should then check L<validationError()>, and
365then use L<getValidationError()> on each field to see the reason why the row could not be
366inserted.
367
368=cut
369sub insert
370{
371    my $self = shift;
372
373    unless ($self->validate())
374    {
375        # TODO: Raise an exception.
376        return undef;
377    }
378
379    my $new_sql = sprintf("INSERT INTO %s ( %s ) VALUES ( %s )", $self->{'_table'}->name(),
380                                                                 join (', ', $self->{'_table'}->fields()),
381                                                                 join (', ', map { '?' } $self->{'_table'}->fields()));
382
383    my $new_obj_sth = $self->{'_dbh'}->prepare_cached($new_sql, {pg_prepare_now => 1}, 3) or
384      confess (sprintf("Could not prepare_cached(%s): Error Code %d (%s)", $new_sql, $self->{'_dbh'}->err, $self->{'_dbh'}->errstr));
385
386    my @values = map { $self->_valueMap($_, $self->{$_}) } $self->{'_table'}->fields();
387
388    if ($self->{'_dbh'}->can('pg_savepoint') && $self->{'_dbh'}->{private_dbdpg}{version} >= 80000)
389    {
390        $self->{'_dbh'}->pg_savepoint("pre_insert"); # Create a save-point in the transaction
391    }
392    $new_obj_sth->execute(@values) or
393    do {
394        if ($self->_catchDupeKeyError())
395        {
396            if ($self->{'_dbh'}->can('pg_rollback_to') && $self->{'_dbh'}->{private_dbdpg}{version} >= 80000)
397            {
398                $self->{'_dbh'}->pg_rollback_to("pre_insert"); # Go back to before the failed execute()
399            }
400            return undef;
401        }
402        # TODO: Raise an exception.
403        confess (sprintf("Could not execute(%s)\n(%s)\n Error Code %d (%s)",
404                      $new_sql,
405                      join(',', @values),
406                      $self->{'_dbh'}->err,
407                      $self->{'_dbh'}->errstr));
408    };
409    if ($self->{'_dbh'}->can('pg_release') && $self->{'_dbh'}->{private_dbdpg}{version} >= 80000)
410    {
411        $self->{'_dbh'}->pg_release("pre_insert");
412    }
413
414    # WARNING: This assumes that the first primary key field is the one with the serial column.
415    # In most cases it is, but this wont work if it isnt.
416
417    my $seqName = sprintf("%s_%s_seq", $self->{'_table'}->name(), ($self->{'_table'}->primaryKeys())[0]);
418    my $lastIdSql = "SELECT CURRVAL(?)";
419    my $lastIdSth = $self->{'_dbh'}->prepare_cached($lastIdSql, {pg_prepare_now => 1}, 3)
420      or confess (sprintf("Could not prepare_cached(%s): Error Code %d (%s)", $lastIdSql, $self->{'_dbh'}->err, $self->{'_dbh'}->errstr));
421
422    $lastIdSth->execute($seqName);
423    my $newId = $lastIdSth->fetchall_arrayref()->[0]->[0];
424
425    $self->{($self->{'_table'}->primaryKeys())[0]} = $newId;
426    return $newId;
427}
428# /* insert */ }}}
429
430# /* update */ {{{
431=pod
432
433=item $row->update();
434
435If any changes are made to the values of a row, then when the row gets DESTORY'd,
436the changes will automatically be saved back to the database. However, you may wish
437explicitly call update() for two reasons: You may want the changes saved to the datbase
438before the row object goes out of scope, and (more importantly) you should check the
439return value of the call to update() to catch any invalid values.
440
441If the row could not be updated in the database, then undef is returned (You should then
442check L<validationError()>, and then use L<getValidationError()> on each field to see
443the reason why the row could not be inserted.
444
445=cut
446sub update
447{
448    my $self = shift;
449
450    unless ($self->validate())
451    {
452        # TODO: Raise an exception.
453        return undef;
454    }
455
456    my $update_sql = sprintf("UPDATE %s SET %s WHERE %s",
457                             $self->{'_table'}->name(),
458                             join(', ',     map { "$_ = ?" } $self->{'_table'}->fields()),
459                             join(' AND ', map { "$_ = ?" } $self->{'_table'}->primaryKeys()));
460
461    my $update_sth = $self->{'_dbh'}->prepare_cached($update_sql, {pg_prepare_now => 1}, 3) or
462      confess (sprintf("Could not prepare_cached(%s): Error Code %d (%s)", $update_sql, $self->{'_dbh'}->err, $self->{'_dbh'}->errstr));
463
464    my @values = map { $self->_valueMap($_, $self->{$_}) } $self->{'_table'}->fields(), $self->{'_table'}->primaryKeys();
465    if ($self->{'_dbh'}->can('pg_savepoint') && $self->{'_dbh'}->{private_dbdpg}{version} >= 80000)
466    {
467        $self->{'_dbh'}->pg_savepoint("pre_update"); # Create a save-point in the transaction
468    }
469    $update_sth->execute(@values) or
470    do
471    {
472        if ($self->_catchDupeKeyError())
473        {
474            if ($self->{'_dbh'}->can('pg_rollback_to') && $self->{'_dbh'}->{private_dbdpg}{version} >= 80000)
475            {
476                $self->{'_dbh'}->pg_rollback_to("pre_update"); # Go back to before the failed execute()
477            }
478            return undef;
479        }
480        # TODO: Raise an exception.
481        confess (sprintf("Could not execute(%s)\n(%s)\n Error Code %d (%s)",
482                          $update_sql,
483                          join(', ', @values),
484                          $self->{'_dbh'}->err,
485                          $self->{'_dbh'}->errstr));
486    };
487    if ($self->{'_dbh'}->can('pg_release') && $self->{'_dbh'}->{private_dbdpg}{version} >= 80000)
488    {
489        $self->{'_dbh'}->pg_release("pre_update");
490    }
491    delete($self->{'_modified'});
492    return 1;
493}
494# /* update */ }}}
495
496# /* delete */ {{{
497=pod
498
499=item $row->delete();
500
501This method deletes the row from the database, and marks it as deleted so that
502futher access to the object can be made. You can still use a deleted object
503to L<construct()> a new one though.
504
505=cut
506sub delete
507{
508    my $self  = shift;
509
510    if ($self->{'_deleted'})
511    {
512        cluck("Attempt to delete an object twice");
513        return undef;
514    }
515
516    my $delete_sql = sprintf("DELETE FROM %s WHERE %s",
517                             $self->{'_table'}->name(),
518                             join(' AND ', map { "$_ = ?" } $self->{'_table'}->primaryKeys()));
519    my $delete_sth = $self->{'_dbh'}->prepare_cached($delete_sql, {pg_prepare_now => 1}, 3) or
520      confess (sprintf("Could not prepare_cached(%s): Error Code %d (%s)", $delete_sql, $self->{'_dbh'}->err, $self->{'_dbh'}->errstr));
521
522    $delete_sth->execute(map {$self->{$_}} $self->{'_table'}->primaryKeys()) or
523    do {
524            # TODO: Raise an exception.
525            cluck (sprintf("Could not execute(%s)\n(%s)\n Error Code %d (%s)",
526                          $delete_sql,
527                          join (', ', map {$self->{$_}} $self->{'_table'}->primaryKeys()),
528                          $self->{'_dbh'}->err,
529                          $self->{'_dbh'}->errstr));
530            return undef;
531    };
532
533    delete($self->{'_modified'}); # Prevent update attempts
534    $self->{'_deleted'}  = 1;     # Prevent further object access
535
536    return 1;
537}
538# /* delete */ }}}
539
540# /* _catchDupeKeyError */ {{{
541sub _catchDupeKeyError
542{
543    my $self = shift;
544    my $errorString = $self->{'_dbh'}->errstr;
545
546    my $tableName = $self->{'_table'}->name();
547    # TODO: This error string is postresql specific. Perhaps I should create a DB::Table::Row::Pg module instead?
548    # For now, people can just overload this method.
549    if ($errorString =~ /^ERROR:\s+duplicate key violates unique constraint "$tableName\_(.+?)\_key"$/)
550    {
551        my $dupeField = $1;
552        my $tableIsVowel = ''; my $fieldIsVowel = '';
553        $tableIsVowel = 'n' if (lc($self->{'_table'}->desc()->[0]) =~ /^[aeiou]/);
554        $fieldIsVowel = 'n' if (lc($self->{'_table'}->field($dupeField)->{'desc'}) =~ /^[aeiou]/);
555
556        my $fieldDesc = $self->{'_table'}->{'field'}->{$dupeField}->{'desc'};
557        $self->{'_validation'}->{$dupeField} = sprintf("There is already a%s %s with a%s %s of '%s'. %s must be unique",
558                                                       $tableIsVowel, lc($self->{'_table'}->desc()->[0]),
559                                                       $fieldIsVowel, lc($fieldDesc),
560                                                       $self->$dupeField, ucfirst(lc($fieldDesc)));
561        $self->{'_validationError'} = 1;
562        return 1;
563    }
564    return undef;
565}
566# /* _catchDupeKeyError }}}
567
568# /* getFKey */ {{{
569=pod
570
571=item my $foreignRow = $row->getFKey($foreignKeyField);
572
573Where $foreignKeyField in $row references a row in another table,
574this method can be used to fetch the referenced row.
575
576=cut
577sub getFKey
578{
579    my $self = shift;
580
581    my $fkeyName  = shift;
582    my $fkey      = $self->{'_table'}->field($fkeyName)->{'fkey'} || do { cluck("Cannot get fkey"); return undef };
583
584    my $fTable = $self->getFTable($fkeyName);
585    return $fTable->getRowByPKey($self->$fkeyName());
586}
587# /* getFKey */ }}}
588
589# /* getFTable */ {{{
590=pod
591
592=item my $foreignTable = $row->getFTable($foreignKeyField);
593
594Where $foreignKeyField in $row references a row in another table,
595this method can be used to return the referenced table object.
596
597=cut
598sub getFTable
599{
600    my $self = shift;
601
602    my $fieldName = shift;
603
604    my $className = sprintf("DB::Table::%s", ucfirst(lc($self->{'_table'}->field($fieldName)->{'fkey'}->{'table'})));
605    if ($className->can('open'))
606    {
607        return $className->open($self->{'_dbh'});
608    }
609    return DB::Table->open($self->{'_dbh'}, $self->{'_table'}->field($fieldName)->{'fkey'}->{'table'});
610}
611# /* getFTable */ }}}
612
613# /* getValue */ {{{
614=pod
615
616=item my $value = $row->getValue($fieldName);
617
618This method is used to get the value of the field/column specified by $fieldName.
619
620fieldName's are also autoloaded, so you can also say:
621
622    my $value = $row->$fieldName();
623
624=cut
625sub getValue
626{
627    my $self = shift;
628
629    my $fieldName = shift;
630
631    if (exists($self->{'_deleted'}))
632    {
633        confess("Cannot access a deleted object");
634    }
635
636    unless ($self->{'_table'}->field($fieldName) or exists ($self->{$fieldName}))
637    {
638        confess("Field $fieldName does not exist in table/object - possible typo???");
639    }
640
641    unless(exists($self->{'_table'}->field($fieldName)->{'read'}))
642    {
643        confess("You cannot read field $fieldName")
644    }
645    return $self->{$fieldName};
646}
647# /* getValue */ }}}
648
649# /* setValue */ {{{
650=pod
651
652=item my $oldValue = $row->setValue($fieldName, $newValue);
653
654This method is used to set a new value for the field specified by $fieldName.
655
656The old value is returned.
657
658fieldName's are also autoloaded, so you can also say:
659
660    my $oldValue = $row->$fieldName($newValue);
661
662=cut
663sub setValue
664{
665    my $self = shift;
666
667    my $fieldName = shift;
668    my $newValue  = shift;
669
670    if (exists($self->{'_deleted'}))
671    {
672        confess("Cannot access a deleted object");
673    }
674
675    unless ($self->{'_table'}->field($fieldName) or exists ($self->{$fieldName}))
676    {
677        confess("Field $fieldName does not exist in table/object - possible typo???");
678    }
679
680    unless(exists($self->{'_table'}->field($fieldName)->{'write'}))
681    {
682        confess("You cannot update field $fieldName")
683    }
684
685    my $oldValue = $self->{$fieldName};
686    $self->{$fieldName} = $newValue;
687    $self->{'_modified'} = 1;
688    return $oldValue;
689}
690# /* setValue */ }}}
691
692# /* AUTOLOAD */ {{{
693# The accessor methods to this object are auto-loaded...
694sub AUTOLOAD
695{
696    my $self = shift;
697    my $name = our $AUTOLOAD;
698
699    # make sure we were called in an object-oriented manor
700    # (class-methods are not auto-loaded)
701    confess("$self is not an object ($name)") unless (ref($self));
702
703    my $table = $self->{'_table'};
704
705    my ($field) = ($name =~ /::([a-zA-Z0-9_]+)$/);
706
707    if (@_)
708    {
709        return $self->setValue($field, @_);
710    }
711    return $self->getValue($field);
712}
713# /* AUTOLOAD */ }}}
714
715# /* DESTROY */ {{{
716sub DESTROY
717{
718    # If we have been modified, write the changes back to the DB.
719    my $self = shift;
720
721    if (exists ($self->{'_modified'}) && !exists($self->{'_deleted'}))
722    {
723        unless ($self->update())
724        {
725            confess("Row destroyed but could not be updated. You should call to update() explicitly to catch any validation errors");
726        }
727    }
728}
729# /* DESTROY */ }}}
730
731# /* validationError */ {{{
732=pod
733
734=item my $didError = $row->validationError();
735
736This method returns true if an insert() or update() failed
737because of a validation error (false otherwise).
738
739If this method returns true, you should iterate through each
740field and call L<getValidationError()> to see which field failed
741validation, and why.
742
743=cut
744sub validationError
745{
746    my $self = shift;
747
748    return $self->{'_validationError'};
749}
750# /* validationError */ }}}
751
752# /* getValidationError */ {{{
753=pod
754
755=item my $errorMsg = $row->getValidationError($fieldName);
756
757If an L<insert()> or L<update()> failed because of a validation error (check
758with L<validationError> then you should iterate through each field and call
759getValidationError to get the error message associated with each field. Fields
760without an error message passed validation, hence undef is returned.
761
762=cut
763sub getValidationError
764{
765    my $self = shift;
766
767    my $fieldName = shift || return undef;
768
769    return $self->{'_validation'}->{$fieldName};
770}
771# /* getValidationError */ }}}
772
773# /* validate */ {{{
774=pod
775
776=item my $didValidate = $row->validate();
777
778Validation is automatically performed when ever needed (before the row is
779inserted or updated in the database) and as such you probably wont need to
780call this explicitly, however, it is here in case you do.
781
782If all values are considered legal, then true is returned, undef otherwise.
783
784The exception is that validation is performed in such a way that the database
785never has to read/write any rows in the database, and as such duplicate key
786checking is not performed here. Instead, if validation passes, the record will
787be then be inserted/updated and if this fails because of a duplicate key then
788this is trapped and undef is then returned by the insert/update method (After
789setting the various validation-related error flags).
790
791=back
792
793=cut
794sub validate
795{
796    my $self = shift;
797
798    our $textFields = {'character varying' => 1,
799                       'character'         => 1};
800                       # We dont include 'text' here because it is not length-limited.
801
802    my @constraints;
803    my $isValid = 1;
804    foreach my $fieldName ($self->{'_table'}->fields)
805    {
806        my $field = $self->{'_table'}->field($fieldName);
807
808        if ($textFields->{$field->{'type'}})
809        {
810            if (length($self->$fieldName) > $field->{'length'})
811            {
812                $self->{'_validation'}->{$fieldName} = "Value is too long (must be <= " . $field->{'length'} . ")";
813                $isValid = 0;
814            }
815        }
816
817        my $regex = $field->{'validate'}->{'regex'};
818        eval {
819            unless ($self->$fieldName =~ /$regex/)
820            {
821                $self->{'_validation'}->{$fieldName} = $field->{'validate'}->{'error'} || "regular expression $regex failed";
822                $isValid = 0;
823            }
824        };
825        if ($@)
826        {
827             confess("Failed to compile regular expression for $fieldName: $@");
828        }
829        if (!$field->{'nullable'} && !$self->$fieldName)
830        {
831            $self->{'_validation'}->{$fieldName} = $field->{'desc'} . " must not be empty";
832            $isValid = 0;
833        }
834        if ($field->{'constraint'})
835        {
836            push @constraints, $field;
837        }
838    }
839    unless ($isValid)
840    {
841        $self->{'_validationError'} = 1;
842        return undef;
843    }
844    my $fieldMap = join('|', $self->{'_table'}->fields());
845    my @checks;
846    CONSTRAINT:
847    foreach my $c (@constraints)
848    {
849        my $text = $c->{'constraint'};
850        my @refs = ($text =~ /\b($fieldMap)\b/g);
851        foreach my $ref (@refs)
852        {
853            next CONSTRAINT unless ($self->$ref);
854            my $type = $self->{'_table'}->field($ref)->{'type'};
855            my $value = $self->{'_dbh'}->quote($self->$ref);
856            my $cast = "$value\:\:$type";
857            $text =~ s/\b$ref\b/$cast/ge;
858        }
859        my $check = sprintf("CASE WHEN %s THEN 1 ELSE 0 END AS %s", $text, $c->{'name'});
860        push @checks, $check;
861    }
862
863    # If there are no constraints, then return true
864    unless (scalar(@checks) >= 1)
865    {
866        return 1;
867    }
868
869    my $validateSql = sprintf("SELECT %s", join (', ', @checks));
870    my $validateSth = $self->{'_dbh'}->prepare($validateSql) or
871          confess (sprintf("Could not prepare(%s): Error Code %d (%s)", $validateSql, $self->{'_dbh'}->err, $self->{'_dbh'}->errstr));
872    $validateSth->execute() or
873    do {
874        # TODO: Raise an exception.
875        cluck (sprintf("Could not execute(%s)\nError Code %d (%s)",
876                      $validateSql,
877                      $self->{'_dbh'}->err,
878                      $self->{'_dbh'}->errstr));
879        return undef;
880    };
881    my $valid = $validateSth->fetchrow_hashref();
882    foreach my $field (keys %{$valid})
883    {
884        unless ($valid->{$field})
885        {
886            $self->{'_validation'}->{$field} = sprintf("constraint %s failed", $self->{'_table'}->field($field)->{'constraint'});
887            $self->{'_validationError'} = 1;
888            $isValid = undef;
889        }
890    }
891    delete($self->{'_validationError'}) if ($isValid);
892    return $isValid;
893}
894# /* validate */ }}}
895
896=pod
897
898=head1 AUTHOR
899
900Bradley Kite <bradley-cpan@kitefamily.co.uk>
901
902If you wish to email me, then please remove the '-cpan' part
903of my email address as anything addressed to 'bradley-cpan'
904is assumed to be spam and is not read.
905
906=head1 SEE ALSO
907
908L<DB::Table>, L<DBI>, L<perl>
909
910=cut
911
9121;
913
Note: See TracBrowser for help on using the browser.