Class::DBI::Relationship::HasManyOrdered - A Class::DBI module for Ordered 'Has Many' relationships

 package ContentManager::DBI;
 use base 'Class::DBI';

 ContentManager::DBI->connection('dbi:mysql:dbname', 'username', 'password');
 __PACKAGE__->add_relationship_type(has_many_ordered => 'Class::DBI::Relationship::IsA');

 ...

 package ContentManager::Image;
 use base 'ContentManager::DBI';

 ContentManager::Image->table('images');
 ContentManager::Image->columns(All => qw/image_id name position filename/);

 ...

 package ContentManager::Page;
 use base 'ContentManager::DBI';

 ContentManager::Page->table('pages');
 ContentManager::Page->columns(All => qw/page_id title date_to_publish date_to_archive/);
 Page->has_a(category => Category);
 Page->has_many(authors => Authors);
 Page->has_many_ordered(paragraphs => Paragraphs => {sort => 'position', map => 'PageParagraphs'});
 Page->has_many_ordered(images => Images => {sort => 'position', map => 'PageImages'});

 use ContentManager::Page;
 my $page = ContentManager::Page->create( {title=>'Extending Class::DBI', date_to_publish=>'dd/mm/yyyy'});




 my $image1 = Image->search(name=>'Class::DBI logo');
 my @figures = Image->search(name=>'Class Diagram (CDBI)', order_by => 'filename');
 my $author_image = Image->search(name=>'Aaron Trevena - portrait');

 $page->insert_Images(@figures); # inserts figures into next/last available positions, sets positions

 ...

 $page->prepend_Images($image1); # inserts image into first position, resets other image positions

 $page->append_Images($author_image); # appends image to last position

 ...

 $page->update();

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";
		}
		$f_object_id = $data;
	    }

	    if ($maptable) {
		# reset positions
		unless ($mode eq 'append') {
		    my $query = "update $maptable set $orderby = $orderby + 1 where $orderby >= ? and $pk = ?";
		    my $sth = $self->db_Main->prepare($query);
		    my $rv = $sth->execute($position,$self->id);
		}

		# insert new side-table entry
		my $sth = $self->db_Main->prepare("insert into $maptable ($pk, $f_key, $orderby) values ( ?, ?, ? )");
		my $rv = $sth->execute($self->id, $f_object_id ,$position);
	    } else {
		unless ($mode eq 'append') {
		    my $query = "update $fclass_table set $orderby =  $orderby + 1 where $orderby >= ? and $pk = ?";
		    my $sth = $self->db_Main->prepare($query);
		    my $rv = $sth->execute($position,$self->id);
		}
		$f_object = $f_class->retrieve($f_object_id) unless (ref $f_object eq $f_class);
		$f_object->{$f_key} = $self->id;
		$f_object->{$orderby} = $position;
		$f_object->update();
	    }
	    $position++;
	}
	return scalar @objects;
    };
}


sub _method_delete {
    my $self = shift;
    my $accessor = $self->accessor;
    my $methodname = "delete_$accessor";
    return sub {
	my ($self, @args) = @_;
	my $class = ref $self
	    or return $self->_croak("$methodname called as class method");
	return $self->_croak("$methodname needs position or objects")
	    unless defined $args[0];
	my $meta = $class->meta_info(has_many_ordered => $accessor);
	my $pk = $self->columns('Primary');
	my ($f_class, $f_key) = ($meta->foreign_class, $meta->foreign_class->columns('Primary'));
	my $fclass_table = $f_class->table;

	if ($args[0] =~ /object/) {
	    # data must be one of string (must be id) or object or array of either
	    my $data = $args[1];
	    my @objects = ((ref $data eq 'ARRAY') ? @$data : $data);
	    foreach my $data (@objects) {
		if (ref $data eq $f_class) { # is object of foreign class
		    if ($meta->args->{map}) { # check if using mapping table
			my $sth = $self->db_Main->prepare("delete from ".$meta->args->{map}." where $pk = ? and $f_key = ?");
			my $rv = $sth->execute($self->id, $data->id);
		    } else {
			$data->{$f_key} = $self->id; # FIXME: may not work for inherited relationships
			$data->delete();
		    }
		} else {	# is object id
		    if (ref $data) { # check is scalar
			die "$methodname requires one or more valid object ids, objects, or hashes - got an unexpected reference";
		    }

		    if ($data =~ /\D/) { # check is numeric
			die "$methodname requires one or more valid object ids, objects, or hashes - got an unexpected value";
		    }

		    if ($meta->args->{map}) { # check if using mapping table
			my $sth = $self->db_Main->prepare("delete from ".$meta->args->{map}." where $pk = ? and $f_key = ?");
			my $rv = $sth->execute($self->id, $data);
		    } else {
			my $f_object = $f_class->retrieve($data);
			unless ($f_object) {
			    die "$data is not a valid id for ".$f_class->table." in $methodname\n";
			}
			$f_object->delete();
		    }
		}
	    }
	} else {
	    my @elements = ((ref $args[0] eq 'ARRAY') ? @{$args[0]} : @args);
	    my $placeholder = join(',',map( '?',@elements));
	    my $orderby = $meta->args->{order_by};
	    if ($meta->args->{map}) { # check if using mapping table
		my $sth = $self->db_Main->prepare("delete from ".$meta->args->{map}." where $pk = ? and $orderby IN ($placeholder)");
		my $rv = $sth->execute($self->id, @elements);
	    } else {
		my $query = "select $f_key as PK from $fclass_table where $pk = ? and $orderby in ($placeholder)";
		my $sth = $self->db_Main->prepare($query);
		my $rv = $sth->execute(@elements);
		my @ids = keys %{$sth->fetchall_hashref( 'PK' )};
		foreach (@ids) {
		    my $f_object = $f_class->retrieve($_);
		    $f_object->delete();
		}
	    }
	}
    };
}

sub _method_replace {
    my $self = shift;
    my $accessor = $self->accessor;
    my $methodname = "replace_$accessor";
    my $deletemethod = "delete_$accessor";
    my $insertmethod = "insert_$accessor";
    return sub {
	my ($self, $data) = @_;
	my $class = ref $self
	    or return $self->_croak("$methodname called as class method");
	return $self->_croak("$methodname needs objects or id's")
	    unless defined $data;
	# remove current object
	$self->$deletemethod($self->$accessor);
	# insert new objects
	return $self->$insertmethod($data);
    };
}

sub _has_many_ordered_asindex_method {
    my $self = shift;
    my $accessor = $self->accessor;
    return sub {
	my ($self,$id_field,$title_field) = @_;
	my $meta = ref($self)->meta_info(has_many_ordered => $accessor);
	my $pk = $self->columns('Primary');
	my ($f_class, $f_key) = ($meta->foreign_class, $meta->foreign_class->columns('Primary'));
	$id_field ||=  $f_key;
	if (ref $self) {
	    $title_field ||= $self->{"_${accessor}_index"} ||
		($self->{"_${accessor}_index"} = (grep(/(name|title)/i, sort($f_class->columns('All'))))[0]) ;
	} else {
	    $title_field ||= (grep(/(name|title)/i, sort($f_class->columns('All'))))[0];
	}
	die unless ($title_field);

	my $maptable = $meta->args->{map};
	my $orderby = $meta->args->{order_by};
	my $f_table = $f_class->table;
	# FIXME: probably doesn't handle inherited fields in id or title fields
	my @args = ();
	my $query = "select $id_field, $title_field from $f_table where $pk = ? order by $orderby";
	if ($maptable) {
	    $query = "select ${f_table}.${id_field}, ${f_table}.$title_field from ${f_table}, $maptable " .
		     "where ${maptable}.$f_key = ${f_table}.$f_key and ${maptable}.$pk = ? order by $orderby";
	}
	my $sth = $f_class->db_Main->prepare($query);
	my $rv = $sth->execute($self->id);
	return $sth->fetchall_arrayref();
    };
}

sub _has_many_ordered_method {
    my $self       = shift;
    my $accessor = $self->accessor;
    return sub {
	my ($self,$key,$value) = @_;
	my $meta = ref($self)->meta_info(has_many_ordered => $accessor);
	my $pk = $self->columns('Primary');
	my ($f_class, $f_key) = ($meta->foreign_class, $meta->foreign_class->columns('Primary'));
	my $maptable = $meta->args->{map};
	my $orderby = $meta->args->{order_by};

	if ($maptable) {
	    my $f_table = $f_class->table;
	    my @columns = ( $f_class->columns('Essential') ) ? $f_class->columns('Essential') : $f_class->columns('All');
	    my $query = 'SELECT '. join(', ',map { s/$f_key/$f_table.$f_key/i; $_; } @columns). " FROM $maptable, $f_table WHERE " .
		"${maptable}.$f_key = ${f_table}.$f_key and ${maptable}.$pk = ? order by ${maptable}.$orderby";
	    my $sth = $f_class->db_Main->prepare($query);
	    my $rv = $sth->execute($self->id);
	    return $f_class->sth_to_objects($sth);
	} else {
	    my @args = ($f_key => $self->id);
	    if ($key && defined $value) {
		push(@args,($key => $value));
	    } elsif (defined $key) {
		push(@args,($orderby => $key));
	    }
	    return $f_class->search(@args);
	}
    };
}

#

1;

__END__