# # DESCRIPTION # PerlORM - Object relational mapper (ORM) for Perl. PerlORM is Perl # library that implements object-relational mapping. Its features are # much similar to those of Java's Hibernate library, but interface is # much different and easier to use. # # AUTHOR # Alexey V. Akimov # # COPYRIGHT # Copyright (C) 2005-2006 Alexey V. Akimov # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA # use English; use Cwd 'abs_path'; use ORM::Meta::ORM::History; ## ## CONSTRUCTORS ## ## use: $hist = $history_class->new ## ( ## obj => ORM, ## changed => { $prop1_name => [ $old_value, $new_value ], ... }, ## error => ORM::Error, ## ); ## ## use: $hist = $history_class->new ## ( ## obj => ORM, ## created => 1, ## error => ORM::Error, ## ); ## ## use: $hist = $history_class->new ## ( ## obj => ORM, ## deleted => 1, ## error => ORM::Error, ## ); ## sub new { my $class = shift; my %arg = @_; my %prop = defined $arg{prop} ? %{$arg{prop}} : (); my $error = ORM::Error->new; my @record; # Define common properties delete $arg{prop}; $prop{obj_class} = ref $arg{obj}; $prop{obj_id} = $arg{obj}->id; $prop{date} = time; if( $::ENV{REQUEST_URI} ) { $prop{editor} = "WWW: " . $::ENV{REMOTE_USER} . '@' . $::ENV{SERVER_NAME} . ':' . $::ENV{SERVER_PORT} . $::ENV{REQUEST_URI} . ", RemoteIP: " . $::ENV{REMOTE_ADDR}; } else { my $exec; $exec = abs_path( $0 ) unless( $OSNAME eq 'MSWin32' ); $prop{editor} = "Exec[$PID]: $exec, UID: ${UID}:".(int $GID).", EUID: ${EUID}:".(int $EGID); } # Define operation related properties and create objects if( $arg{created} ) { $prop{slaved_by} = undef; $prop{prop_name} = 'id'; $prop{old_value} = undef; $prop{new_value} = $arg{obj}->id; push @record, $class->SUPER::new( prop=>\%prop, error=>$error ); } elsif( $arg{deleted} ) { $prop{slaved_by} = undef; $prop{prop_name} = 'id'; $prop{old_value} = $arg{obj}->id; $prop{new_value} = undef; $prop{slaved_by} = $class->SUPER::new( prop=>\%prop, error=>$error ); push @record, $prop{slaved_by}; for my $prop ( (ref $arg{obj})->_not_mandatory_props ) { if( $error->fatal ) { last; } else { $prop{prop_name} = $prop; $prop{old_value} = $arg{obj}{_ORM_data}{$prop}; $prop{new_value} = undef; push @record, $class->SUPER::new( prop=>\%prop, error=>$error ); } } } else { $prop{slaved_by} = undef; for my $prop ( keys %{$arg{changed}} ) { my $record; if( $error->fatal ) { last; } else { $prop{prop_name} = $prop; $prop{old_value} = $arg{changed}{$prop}[0]; $prop{new_value} = $arg{changed}{$prop}[1]; $record = $class->SUPER::new( prop=>\%prop, %arg ); $prop{slaved_by} = $record unless( $prop{slaved_by} ); push @record, $record; } } } # Rollback creation of history object if error occured if( $error->fatal ) { while( my $record = pop @record ) { $record->SUPER::delete( error=>$error ) if( defined $record ); } } $error->upto( $arg{error} ); return $record[0]; } ## ## PROPERTIES ## sub obj { my $self = shift; unless( $self->{obj} ) { $self->_load_ORM_class( $self->obj_class ); $self->{obj} = $self->obj_class->find_id( id=>$self->obj_id ); } return $self->{obj}; } sub master { ! $_[0]->slaved_by; } ## ## METHODS ## sub update { my $self = shift; my %arg = @_; $arg{error} && $arg{error}->add_fatal( "Updates of history have no sense" ); } sub delete { my $self = shift; my $class = ref $self; if( $self->slaved_by ) { $arg{error}->add_fatal( "You should not delete slaved objects, delete master instead" ); } else { my @slave = $class->find ( filter => ( $class->M->slaved_by == $self ), error => $error, ); for my $slave ( @slave ) { $slave->delete( @_ ); } $self->SUPER::delete( @_ ); } } sub rollback { my $self = shift; my $class = ref $self; my %arg = @_; if( $self->slaved_by ) { $arg{error}->add_fatal ( "You should not rollback slaved object, rollback its master instead" ); } else { my $error = ORM::Error->new; my $obj; my @slave; # Case of created object if( $self->prop_name eq 'id' && $self->old_value == undef ) { $obj = $self->obj_class->find_id( id=>$self->obj_id, error=>$error ); if( $obj ) { $obj->delete( error=>$error, history=>0 ); } else { $error->add_fatal ( "Can't rollback creation of object #" . $self->obj_id . " of class '".$self->obj_class."' because it doesn't exist" ); } } # Case of deleted object elsif( $self->prop_name eq 'id' && $self->new_value == undef ) { @slave = $class->find ( filter => ( $class->M->slaved_by == $self ), error => $error, ); unless( $error->fatal ) { my %prop; for my $slave ( @slave ) { $prop{$slave->prop_name} = $slave->old_value; } $obj = $self->obj_class->new ( prop => \%prop, repair_id => $self->old_value, error => $error, history => 0, ); } } # Case of changed object else { $obj = $self->obj_class->find_id( id=>$self->obj_id, error=>$error ); if( $obj ) { @slave = $class->find ( filter => ( $class->M->slaved_by == $self ), error => $error, ); unless( $error->fatal ) { my %prop; my %old_prop; for my $slave ( $self, @slave ) { $prop{$slave->prop_name} = $slave->old_value; $old_prop{$slave->prop_name} = $slave->new_value; } $obj->update ( prop => \%prop, old_prop => \%old_prop, error => $error, history => 0, ); } } else { $error->add_fatal ( "Can't rollback update of object #" . $self->obj_id . " of class '".$self->obj_class."' because it doesn't exist" ); } } unless( $error->fatal ) { $self->delete( error=>$error ); } $error->upto( $arg{error} ); } } sub metaprop_class { 'ORM::Meta::ORM::History'; }