| CC: | |
| From: | "Ruslan U. Zakirov" <cubic [...] acronis.ru> |
| Subject: | [rt-devel] [PATCH] DBIx::SB Foriegn keys to objects mapping |
| Date: | Sat, 28 Feb 2004 22:23:51 +0300 |
| To: | rt-devel [...] lists.fsck.com |
Hello.
New feature to SB.
Allow field to object mapping via AUTOLOAD
Best regards. Ruslan.
diff -rubB DBIx-SearchBuilder-0.97/SearchBuilder/Record.pm
DBIx-SearchBuilder-0.97-c1/SearchBuilder/Record.pm
--- DBIx-SearchBuilder-0.97/SearchBuilder/Record.pm 2004-02-04
22:00:42.000000000 +0300
+++ DBIx-SearchBuilder-0.97-c1/SearchBuilder/Record.pm 2004-02-28
22:16:59.000000000 +0300
@@ -408,9 +408,7 @@
*{$AUTOLOAD} = sub { return ($_[0]->_Value($Attrib))};
return($self->_Value($Attrib));
- }
-
- elsif ($AUTOLOAD =~ /.*::[sS]et_?(\w+)/o) {
+ } elsif ($AUTOLOAD =~ /.*::[sS]et_?(\w+)/o) {
if ($self->_Accessible($1,'write')) {
my $Attrib = $1;
@@ -432,8 +430,28 @@
else {
return(0, 'Nonexistant field?');
}
+ } elsif ($AUTOLOAD =~ /.*::(\w+?)_?[oO]bj$/o) {
+ if ($self->_Accessible($1,'read')) {
+ if ($self->_Accessible($1,'object')) {
+ my $Attrib = $1;
+ *{$AUTOLOAD} = sub {
+ my $s = shift;
+ my $args = [@_];
+ return $s->_Object(
+ Field => $Attrib,
+ ConstructorArgs => $args
+ );
+ };
+ return $self->_Object( Field => $Attrib );
+ } else {
+ return(0, 'No object mapping for field');
+ }
+ } else {
+ return(0, 'Nonexistant field?');
+ }
}
+
#Previously, I checked for writability here. but I'm not sure that's
the
#right idea. it breaks the ability to do ValidateQueue for a ticket
#on creation.
@@ -721,6 +739,44 @@
# }}}
+sub _Object
+{
+ my $self = shift;
+ my $args = {
+ Field => '',
+ ConstructorArgs => undef,
+ @_
+ };
+ return $self->_Object(@_);
+}
+
+sub __Object
+{
+ my $self = shift;
+ my $args = {
+ Field => '',
+ ConstructorArgs => undef,
+ @_
+ };
+ my $class = $self->_Accessible( $args->{'Field'}, 'object' );
+ unless ( $class =~ /::/ ) {
+ my ($namespace) = ref($self) =~ /^(.*::)/;
+ $class = $namespace.$class;
+ }
+ no strict qw( refs );
+ my $vglob = ${ $class . '::' }{'VERSION'};
+ unless ( $vglob && *$vglob{'SCALAR'} ) {
+ eval "require $class";
+ die "Use of $class: $@" if ( $@ );
+ unless ( $vglob && *$vglob{'SCALAR'} ) {
+ *{$class."::VERSION"} = '-1, By DBIx::SerchBuilder';
+ }
+ }
+ my $object = $class->new( @{$args->{'ConstructorArgs'}} );
+ $object->LoadById( $self->__Value($args->{'Field'}) );
+ return $object;
+}
+
# }}}
# {{{ routines dealing with loading
records_______________________________________________
rt-devel mailing list
rt-devel@lists.bestpractical.com
http://lists.bestpractical.com/mailman/listinfo/rt-devel