Many to Many support for Maypole (patches)

[prev] [thread] [next] [Date index for 2004/06/22]

From: Yuval Kogman
Subject: Many to Many support for Maypole (patches)
Date: 01:13 on 22 Jun 2004
--3oCie2+XPXTnK5a5
Content-Type: multipart/mixed; boundary="0QFb0wBpEddLcDHQ"
Content-Disposition: inline


--0QFb0wBpEddLcDHQ
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline
Content-Transfer-Encoding: quoted-printable

Hiya...

Please see:

	http://nothingmuch.woobling.org/beerdb/

That is a mini beerdb. Pubs serve beers, beers are served in pubs. Each
has a name. C'est tout.

Feel free to muck with the data, it's obviously not very useful, if you
want to see it working.


Attached are the two patches needed to make this happen, to Class::DBI
0.96 and Maypole 1.5.

It is arguable that Class::DBI might not need all of the changes, or
that the changes are insufficient. I sort of went for a median.

Docs/tests have not yet been written. I'll do that tomorrow. Now i'm
very tired.


I must say this has been a wonderful learning experience - over the past
week i've started using, read the docs, and hacked the code of both
Maypole and Class::DBI. They are both excellent modules in terms of
maintainability, because they do OO the right way. If you want to dive
into these two modules and really get to know them, hack around. But you
will probably need a purpose to keep going.. ;-)

P.S.
onemany support for the 'addition' forms is not yet ready because I
barely know left from right, as evident from my previous message to the
maypole mailing list.

Ciao!

--=20
 ()  Yuval Kogman <nothingmuch@xxxxxxxx.xxx> 0xEBD27418  perl hacker &
 /\  kung foo master: /me does not drink tibetian laxative tea: neeyah!


--0QFb0wBpEddLcDHQ
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="Class-DBI-0.96-for-Maypole-manymany.patch"
Content-Transfer-Encoding: quoted-printable

Only in Class-DBI-0.96-screwed/: Makefile
Only in Class-DBI-0.96-screwed/: blib
Only in Class-DBI-0.96-screwed/lib/Class/DBI/Relationship: .HasMany.pm.swp
diff -ur Class-DBI-0.96/lib/Class/DBI/Relationship/HasMany.pm Class-DBI-0.9=
6-screwed/lib/Class/DBI/Relationship/HasMany.pm
--- Class-DBI-0.96/lib/Class/DBI/Relationship/HasMany.pm	2004-04-25 18:33:3=
6.000000000 +0300
+++ Class-DBI-0.96-screwed/lib/Class/DBI/Relationship/HasMany.pm	2004-06-22=
 04:04:06.000000000 +0300
@@ -46,6 +46,26 @@
 	return ($class, $accessor, $f_class, $args);
 }
=20
+sub mapped_class {
+	my $self =3D shift;
+	my $f_class =3D $self->foreign_class;
+
+	if (my $meta =3D $f_class->meta_info("has_a")){
+		if (my $accessor =3D $self->args->{mapping}[0]){
+			my $mapping =3D $meta->{$accessor};
+			return $mapping->foreign_class if $mapping;
+		}
+	}
+	if (my $meta =3D $f_class->meta_info("has_many")){
+		if (my $accessor =3D $self->args->{mapping}[0]){
+			my $mapping =3D $meta->{$accessor};
+			return $mapping->foreign_class if $mapping;
+		}
+	}
+=09
+	return $f_class;
+}
+
 sub _set_up_class_data {
 	my $self =3D shift;
 	$self->class->_extend_class_data(
@@ -67,8 +87,9 @@
 	my $self     =3D shift;
 	my $accessor =3D $self->accessor;
 	return (
-		$accessor          =3D> $self->_has_many_method,
-		"add_to_$accessor" =3D> $self->_method_add_to,
+		$accessor               =3D> $self->_has_many_method,
+		"add_to_$accessor"      =3D> $self->_method_add_to,
+		"remove_from_$accessor" =3D> $self->_method_remove_from,
 	);
 }
=20
@@ -86,10 +107,47 @@
 		my ($f_class, $f_key, $args) =3D
 			($meta->foreign_class, $meta->args->{foreign_key}, $meta->args);
 		$data->{$f_key} =3D $self->id;
-		$f_class->create($data);
+		$f_class->find_or_create($data);
 	};
 }
=20
+sub _method_remove_from {
+	my $self     =3D shift;
+	my $accessor =3D $self->accessor;
+	return sub {
+		my ($self, $data) =3D @_;
+
+		my $class =3D ref $self
+			or return $self->_croak("remove_from_$accessor called as class method");
+		ref $data
+			or return $self->_croak("remove_from_$accessor must be called on object=
s");
+
+		# find out who we're related to, and what key in them points to us
+		my $self_many_rel =3D $class->meta_info( has_many =3D> $accessor );
+		my $self_f_class =3D $self_many_rel->foreign_class;
+		my $self_f_key =3D $self_many_rel->args->{foreign_key};
+
+		if ($self_f_class ne $self_many_rel->mapped_class){ # figure what kind o=
f link we're working with
+			my $lookup_mapping =3D $self_many_rel->args->{mapping}[0]; # this is th=
e mapping the foreign_class does to give us the next step towards mapped_cl=
ass
+
+			my $lookup_one_rel =3D $self_f_class->meta_info( has_a =3D> $lookup_map=
ping );
+			my $lookup_wants_class =3D $lookup_one_rel->foreign_class; # this is th=
e class $data should belong to
+		=09
+			ref $data eq $lookup_wants_class # not mapped_class - that is too deep.
+				or return $self->_croak("$accessor contains objects of class $lookup_w=
ants_class, not " . ref $data);
+		=09
+			my $data_f_key =3D $lookup_one_rel->accessor; # huh? but that's what Ha=
sA::inflator uses. What the hell.
+		=09
+			$self_f_class->retrieve( $data_f_key =3D> $data->id, $self_f_key =3D> $=
self->id )->delete; # remove the link, in mamymany
+		} else {
+			ref $data eq $self_many_rel->foreign_class
+				or return $self->_croak("$accessor contains objects of class $self_f_c=
lass, not " . ref $data);
+		=09
+			$data->$self_f_key(undef); # break the link by unpointig them to us
+		}
+	}
+}
+
 sub _has_many_method {
 	my $self       =3D shift;
 	my $run_search =3D $self->_hm_run_search;
Only in Class-DBI-0.96-screwed/lib/Class/DBI/Relationship: HasMany.pm~
diff -ur Class-DBI-0.96/lib/Class/DBI.pm Class-DBI-0.96-screwed/lib/Class/D=
BI.pm
--- Class-DBI-0.96/lib/Class/DBI.pm	2004-04-30 10:22:12.000000000 +0300
+++ Class-DBI-0.96-screwed/lib/Class/DBI.pm	2004-06-21 21:33:15.000000000 +=
0300
@@ -315,7 +315,7 @@
=20
 	# we don't use get() here because all objects should have
 	# exisitng values for PK columns, or else loop endlessly
-	my @pk_values =3D $self->_attrs($self->primary_columns);
+	my @pk_values =3D map { UNIVERSAL::can($_, "id") ? $_->id : $_ } $self->_=
attrs($self->primary_columns);
 	return @pk_values if wantarray;
 	$self->_croak(
 		"id called in scalar context for class with multiple primary key columns=
")
Only in Class-DBI-0.96-screwed/lib/Class: DBI.pm~
Only in Class-DBI-0.96-screwed/: pm_to_blib

--0QFb0wBpEddLcDHQ
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="Maypole-1.5-manymany.patch"
Content-Transfer-Encoding: quoted-printable

diff -ur Maypole-1.5/lib/Maypole/Model/CDBI.pm Maypole-1.5-screwed/lib/Mayp=
ole/Model/CDBI.pm
--- Maypole-1.5/lib/Maypole/Model/CDBI.pm	2004-06-21 16:30:24.000000000 +03=
00
+++ Maypole-1.5-screwed/lib/Maypole/Model/CDBI.pm	2004-06-22 03:55:52.00000=
0000 +0300
@@ -149,5 +149,54 @@
     return $r->config->{loader}->_table2class($table);
 }
=20
+sub link :Exported {
+	my ($self, $r) =3D (@_);
+	my $p =3D CGI::Untaint->new(%{$r->{params}});
+	my $k =3D CGI::Untaint->new(map { ($_) x 2 } %{$r->{params}}); # nasty wa=
y of untainting parameter /keys/
+
+	my $obj =3D ($r->objects || [])->[0];
+
+	if ($obj){
+		foreach my $field (map { $k->extract( -as_printable =3D> $_ ) } keys %{$=
r->{params}}){
+			my $class =3D $self->class_of($r, $field);
+			my $has_many =3D $self->meta_info("has_many");
+		=09
+			my $relationship =3D ( grep { $_->mapped_class eq $class } values %$has=
_many )[0];
+			my $add_to =3D 'add_to_' . $relationship->accessor;
+
+			my $will_add =3D $class->retrieve($p->extract( -as_printable =3D> $fiel=
d ));
+
+			$obj->$add_to({ $field =3D> $will_add });
+		}
+	}
+
+	$r->{template} =3D "view";
+	$r->objects([ $obj ]);
+}
+
+sub unlink :Exported {
+	my ($self, $r) =3D (@_);
+	my $p =3D CGI::Untaint->new(%{$r->{params}});
+	my $k =3D CGI::Untaint->new(map { ($_) x 2 } %{$r->{params}});
+
+	my $obj =3D ($r->objects || [])->[0];
+
+	if ($obj){
+		foreach my $field (map { $k->extract( -as_printable =3D> $_ ) } keys %{$=
r->{params}}){
+			my $class =3D $self->class_of($r, $field);
+			my $has_many =3D $self->meta_info("has_many");
+			my $relationship =3D ( grep { $_->mapped_class eq $class } values %$has=
_many )[0];
+			my $remove_from =3D 'remove_from_' . $relationship->accessor;
+
+			my $will_remove =3D $class->retrieve($p->extract( -as_printable =3D> $f=
ield ));
+
+			$obj->$remove_from( $will_remove );
+		}
+	}
+
+	$r->{template} =3D "view";
+	$r->objects([ $obj ]);
+}
+
 1;
=20
Only in Maypole-1.5-screwed/lib/Maypole/Model: CDBI.pm~
Only in Maypole-1.5-screwed/lib/Maypole/View: Base.pm~
diff -ur Maypole-1.5/lib/Maypole.pm Maypole-1.5-screwed/lib/Maypole.pm
--- Maypole-1.5/lib/Maypole.pm	2004-06-21 16:34:47.000000000 +0300
+++ Maypole-1.5-screwed/lib/Maypole.pm	2004-06-22 03:34:05.000000000 +0300
@@ -52,7 +52,7 @@
     my $class =3D shift;
     $class->init unless $class->init_done;
     my $r =3D bless { config =3D> $class->config }, $class;
-    $r->get_request();
+    $r->get_request(@_);
     $r->parse_location();
     my $status =3D $r->handler_guts();
     return $status unless $status =3D=3D OK;
Only in Maypole-1.5-screwed/lib: Maypole.pm~
Only in Maypole-1.5-screwed/t: beerdb.db
diff -ur Maypole-1.5/templates/factory/macros Maypole-1.5-screwed/templates=
/factory/macros
--- Maypole-1.5/templates/factory/macros	2004-04-02 20:16:56.000000000 +0200
+++ Maypole-1.5-screwed/templates/factory/macros	2004-06-22 04:02:14.000000=
000 +0300
@@ -100,11 +100,26 @@
 MACRO view_related(object) BLOCK;
     FOR accessor =3D classmetadata.related_accessors.list;
         "<H3>"; accessor | ucfirst; "</H3>\n";
+		USE class =3D Class(classmetadata.name);
+		SET relationship =3D class.meta_info("has_many").$accessor;
+		IF relationship.args.mapping.size;
+			'<form method=3D"get" action=3D"'; base _ '/' _ classmetadata.table _ '=
/link/' _ object.id _ '/">';
+			SET col =3D relationship.args.foreign_key;
+			USE f_class =3D Class(relationship.foreign_class);
+			SET mapped_accessor =3D relationship.args.mapping.last;
+			f_class.to_field(mapped_accessor).as_HTML;
+			'<input type=3D"submit" value=3D"add">';
+			'</form>';
+		ELSE;
+			"<!-- FIXME -->";
+		END;
         "<UL id=3D\"vlist\">";
         FOR thing =3D object.$accessor;
-            "<LI>"; maybe_link_view(thing); "</LI>\n";
+	    SET additional =3D object.id _ '/?' _ thing.table _ '=3D' _ thing.id;
+            "<LI><nobr>"; maybe_link_view(thing); link(object.table, 'unli=
nk', additional, '<small>remove</small>'); "</nobr></LI>\n";
         END;
         "</UL>";
+=09
     END;=20
 END;
=20
Only in Maypole-1.5-screwed/templates/factory: macros~

--0QFb0wBpEddLcDHQ--

--3oCie2+XPXTnK5a5
Content-Type: application/pgp-signature
Content-Disposition: inline

-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.2.4 (Darwin)

iD8DBQFA14fLVCwRwOvSdBgRAh35AJ0S8K6SSCPnwd9YuCqEstw6ig03QQCggTWx
VPTBhCqXVV/6Lc9Z5fVovhs=
=U65E
-----END PGP SIGNATURE-----

--3oCie2+XPXTnK5a5--

Many to Many support for Maypole (patches)
Yuval Kogman 01:13 on 22 Jun 2004

Re: Many to Many support for Maypole (patches)
William McKee 12:39 on 23 Jun 2004

Re: Many to Many support for Maypole (patches)
Yuval Kogman 13:50 on 22 Jun 2004

Re: Many to Many support for Maypole (patches)
Tony Bowden 15:24 on 23 Jun 2004

Re: Many to Many support for Maypole (patches)
Yuval Kogman 16:18 on 22 Jun 2004

Re: Many to Many support for Maypole (patches)
Tony Bowden 12:41 on 23 Jun 2004

Re: Many to Many support for Maypole (patches)
Yuval Kogman 13:59 on 22 Jun 2004

Generated at 11:34 on 01 Dec 2004 by mariachi v0.52