Skip Menu |
 

This queue is for tickets about the DBIx-SearchBuilder CPAN distribution.

Report information
The Basics
Id: 5486
Status: resolved
Priority: 0/
Queue: DBIx-SearchBuilder

People
Owner: Nobody in particular
Requestors: cubic [...] acronis.ru
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



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
Download (untitled) / with headers
text/plain 2.6k
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]-&gt;_Value($Attrib))}; return($self-&gt;_Value($Attrib)); - } - - elsif ($AUTOLOAD =~ /.*::[sS]et_?(\w+)/o) { + } elsif ($AUTOLOAD =~ /.*::[sS]et_?(\w+)/o) { if ($self-&gt;_Accessible($1,'write')) { my $Attrib = $1; @@ -432,8 +430,28 @@ else { return(0, 'Nonexistant field?'); } + } elsif ($AUTOLOAD =~ /.*::(\w+?)_?[oO]bj$/o) { + if ($self-&gt;_Accessible($1,'read')) { + if ($self-&gt;_Accessible($1,'object')) { + my $Attrib = $1; + *{$AUTOLOAD} = sub { + my $s = shift; + my $args = [@_]; + return $s-&gt;_Object( + Field =&gt; $Attrib, + ConstructorArgs =&gt; $args + ); + }; + return $self-&gt;_Object( Field =&gt; $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 =&gt; '', + ConstructorArgs =&gt; undef, + @_ + }; + return $self-&gt;_Object(@_); +} + +sub __Object +{ + my $self = shift; + my $args = { + Field =&gt; '', + ConstructorArgs =&gt; undef, + @_ + }; + my $class = $self-&gt;_Accessible( $args-&gt;{'Field'}, 'object' ); + unless ( $class =~ /::/ ) { + my ($namespace) = ref($self) =~ /^(.*::)/; + $class = $namespace.$class; + } + no strict qw( refs ); + my $vglob = ${ $class . '::' }{'VERSION'}; + unless ( $vglob &amp;&amp; *$vglob{'SCALAR'} ) { + eval "require $class"; + die "Use of $class: $@" if ( $@ ); + unless ( $vglob &amp;&amp; *$vglob{'SCALAR'} ) { + *{$class."::VERSION"} = '-1, By DBIx::SerchBuilder'; + } + } + my $object = $class-&gt;new( @{$args-&gt;{'ConstructorArgs'}} ); + $object-&gt;LoadById( $self-&gt;__Value($args-&gt;{'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
Download (untitled) / with headers
text/plain 160b
[cubic@acronis.ru - Sat Feb 28 17:29:47 2004]: Show quoted text
> Hello. > New feature to SB. > > Allow field to object mapping via AUTOLOAD
Applied a long time ago


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.