/usr/share/perl5/Class/DBI/FromForm.pm is in libclass-dbi-fromform-perl 0.04-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 | package Class::DBI::FromForm;
use strict;
use vars qw/$VERSION @EXPORT/;
use base 'Exporter';
$VERSION = 0.04;
@EXPORT = qw/update_from_form create_from_form/;
=head1 NAME
Class::DBI::FromForm - Update Class::DBI data using Data::FormValidator or HTML Widget
=head1 SYNOPSIS
package Film;
use Class::DBI::FromForm;
use base 'Class::DBI';
my $results = Data::FormValidator->check( ... );
my $film = Film->retrieve('Fahrenheit 911');
$film->update_from_form($results);
my $new_film = Film->create_from_form($results);
=head1 DESCRIPTION
Create and update L<Class::DBI> objects from L<Data::FormValidator> or L<HTML::Widget>.
=head2 METHODS
=head3 create_from_form
Create a new object.
=cut
sub create_from_form {
my $class = shift;
die "create_from_form can only be called as a class method" if ref $class;
__PACKAGE__->_run_create( $class, @_ );
}
=head3 update_from_form
Update object.
=cut
sub update_from_form {
my $self = shift;
die "update_from_form cannot be called as a class method" unless ref $self;
__PACKAGE__->_run_update( $self, @_ );
}
sub _run_create {
my ( $me, $class, $results ) = @_;
my $them = bless {}, $class;
my $cols = {};
foreach my $col ( $them->columns('All') ) {
if($results->isa('HTML::Widget::Result')) {
$cols->{$col} = $results->param($col);
} else {
$cols->{$col} = $results->valid($col);
}
}
return $class->create($cols);
}
sub _run_update {
my ( $me, $them, $results ) = @_;
my @cols = ( $results->isa('HTML::Widget::Result') ?
$results->valid :
keys %{ $results->valid } );
foreach my $col ( @cols ) {
if ( $them->can($col) ) {
next if $col eq $them->primary_column;
if($results->isa('HTML::Widget::Result')) {
$them->$col( $results->param($col));
} else {
$them->$col( $results->valid($col));
}
}
}
$them->update;
return 1;
}
=head1 fill_widget <widget>
This only applies to L<HTML::Widget>>.
Fills the form from a CDBI object.
=cut
sub fill_widget {
my ($me ,$widget)=@_;
foreach my $element ( @{ $widget->{_elements} } ) {
my $name=$element->name;
next unless $name && $me->can($name);
$element->value($me->$name);
}
}
=head1 SEE ALSO
L<Class::DBI>, L<Class::DBI::FromCGI>, L<Data::FormValidator>
=head1 AUTHOR
Sebastian Riedel, C<sri@oook.de>
=head1 LICENSE
This library is free software . You can redistribute it and/or modify it under
the same terms as perl itself.
=cut
1;
|