view release on metacpan or  search on metacpan

lib/Class/DBI/Relationship/HasManyOrdered.pm  view on Meta::CPAN

package Class::DBI::Relationship::HasManyOrdered;

use strict;
use warnings;

our $VERSION = '0.03';

use base qw(Class::DBI::Relationship::HasMany);

##########
# over-ridden Class::DBI::Relationship methods

sub methods {
    my $self     = shift;
    my $accessor = $self->accessor;
    return (
	    $accessor => $self->_has_many_ordered_method,
	    "${accessor}_asIndex" => $self->_has_many_ordered_asindex_method,
	    "append_to_$accessor" => $self->_method_insert('append'),
	    "prepend_to_$accessor" => $self->_method_insert('prepend'),
	    "append_$accessor" => $self->_method_insert('append'),
	    "prepend_$accessor" => $self->_method_insert('prepend'),
	    "insert_$accessor" => $self->_method_insert,
	    "delete_$accessor" => $self->_method_delete,
	    "replace_$accessor" => $self->_method_replace,
	   );
}

sub triggers {
	my $self = shift;
	my $accessor = $self->accessor;
	return (
		before_delete => sub {
		    my $self = shift;
		    my $meta = ref($self)->meta_info(has_many => $accessor);
		    my ($f_class, $f_key, $args) =
			($meta->foreign_class, $meta->args->{foreign_key}, $meta->args);
		    if ($meta->args->{map}) {
			my $pk = $self->columns('Primary');
			my $sth = $self->db_Main->prepare("delete from ".$meta->args->{map}." where $pk = ?");
			my $rv = $sth->execute($self->id);
		    } else {
			return if $self->args->{no_cascade_delete};    # undocumented and untested!
			$f_class->search($f_key => $self->id)->delete_all;
		    }
		});
}

###########

sub _method_insert {
    my $self = shift;
    my $mode = shift;
    my $accessor = $self->accessor;
    my $methodname = ($mode) ? "${mode}_to_$accessor" :  "insert_$accessor" ;
    return sub {
	my ($self, $data,$position) = @_;
	$mode = 'append' unless (defined $position || $mode);
	$position = 0 if ($mode eq 'prepend');
	my $class = ref $self
	    or return $self->_croak("$methodname called as class method");
	return $self->_croak("$methodname needs data")
	    unless defined $data;

	my $meta = $class->meta_info(has_many_ordered => $accessor);
	my $order_column = $meta->args->{order_by};
	my $pk = $self->columns('Primary');
	my ($f_class, $f_key) = ($meta->foreign_class, $meta->foreign_class->columns('Primary'));

	if ($mode eq 'append') {
	    my $sql = ($meta->args->{map}) ? "select max($order_column) + 1 from ".$meta->args->{map} ." where $pk = ?" : "select max($order_column) + 1 from ".$self->table." where $f_key = ?";
	    my $sth = $self->db_Main->prepare($sql);
	    my $rv = $sth->execute($self->id);
	    if ($rv) {
		($position) = $sth->fetchrow_array();
	    }
	}
	$position ||= 0;
	my $maptable = $meta->args->{map} || '';
	my $orderby = $meta->args->{order_by};
	my $fclass_table = $f_class->table;

	my @objects = ((ref $data eq 'ARRAY') ? @$data : $data);
	foreach my $data (@objects) {
	    # check if data is one of string (must be id), object, hash or array of either
	    my $f_object;
	    my $f_object_id;
	    if (ref $data eq 'HASH') {
		# create new object
		$f_object = $f_class->create($data);
		$f_object_id = $f_object->id;
	    } elsif (ref $data eq $f_class) { # data is object of foreign class
		$f_object = $data;
		$f_object_id = $f_object->id;
	    } else { # data is object id
		if (ref $data) { # check is scalar
		    warn "got ",ref $data," expected $f_class \n";
		    die "$methodname requires one or more valid object ids, objects, or hashes - got an unexpected reference";
		}
 		$data =~ s/\s//g;
		if ($data =~ /\D/) { # check is numeric
		    die "$methodname requires one or more valid object ids, objects, or hashes - got an unexpected value";
		}