r26054 - in /trunk/libcoat-persistent-perl: debian/changelog lib/Coat/Persistent.pm lib/Coat/Persistent/Meta.pm t/019_mix.t
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Wed Oct 15 16:36:19 UTC 2008
Author: ansgar-guest
Date: Wed Oct 15 16:36:16 2008
New Revision: 26054
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=26054
Log:
New upstream release.
Added:
trunk/libcoat-persistent-perl/t/019_mix.t
- copied unchanged from r26053, branches/upstream/libcoat-persistent-perl/current/t/019_mix.t
Modified:
trunk/libcoat-persistent-perl/debian/changelog
trunk/libcoat-persistent-perl/lib/Coat/Persistent.pm
trunk/libcoat-persistent-perl/lib/Coat/Persistent/Meta.pm
Modified: trunk/libcoat-persistent-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/debian/changelog?rev=26054&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/debian/changelog (original)
+++ trunk/libcoat-persistent-perl/debian/changelog Wed Oct 15 16:36:16 2008
@@ -1,3 +1,9 @@
+libcoat-persistent-perl (0.102-1) unstable; urgency=low
+
+ * New upstream release.
+
+ -- Ansgar Burchardt <ansgar at 43-1.org> Wed, 15 Oct 2008 18:35:01 +0200
+
libcoat-persistent-perl (0.101-1) unstable; urgency=low
[ Ansgar Burchardt ]
Modified: trunk/libcoat-persistent-perl/lib/Coat/Persistent.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/lib/Coat/Persistent.pm?rev=26054&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/lib/Coat/Persistent.pm (original)
+++ trunk/libcoat-persistent-perl/lib/Coat/Persistent.pm Wed Oct 15 16:36:16 2008
@@ -6,6 +6,8 @@
use Coat::Persistent::Meta;
use Carp 'confess';
+use Data::Dumper;
+
# Low-level helpers
use Digest::MD5 qw(md5_base64);
use Scalar::Util qw(blessed looks_like_number);
@@ -20,7 +22,7 @@
use vars qw($VERSION @EXPORT $AUTHORITY);
use base qw(Exporter);
-$VERSION = '0.101';
+$VERSION = '0.102';
$AUTHORITY = 'cpan:SUKRIA';
@EXPORT = qw(has_p has_one has_many);
@@ -134,6 +136,7 @@
$CONSTRAINTS->{'!syntax'}{$caller}{$attr} = $options{syntax} || undef;
Coat::has( $attr, ( '!caller' => $caller, %options ) );
+ Coat::Persistent::Meta->attribute($caller, $attr);
# find_by_
my $sub_find_by = sub {
@@ -427,19 +430,20 @@
# if any rows, let's process them
if (@$rows) {
# we have to find out which fields are real attributes
- my $class_attr = Coat::Meta->all_attributes( $class );
- my @attrs = keys %$class_attr;
-
- # from the columns selected, where are real attributes and virtual ones?
+ my @attrs = Coat::Persistent::Meta->linearized_attributes( $class );
my $lc = new List::Compare(\@attrs, [keys %{ $rows->[0] }]);
my @given_attr = $lc->get_intersection;
my @virtual_attr = $lc->get_symdiff;
# create the object with attributes, and set virtual ones
foreach my $r (@$rows) {
+
my $obj = $class->new(map { ($_ => $r->{$_}) } @given_attr);
$obj->init_on_find();
- $obj->{$_} = $r->{$_} for @virtual_attr;
+ foreach my $field (@virtual_attr) {
+ $obj->{$field} = $r->{$field};
+ }
+
push @objects, $obj;
}
}
@@ -469,7 +473,7 @@
my $table_name = Coat::Persistent::Meta->table_name($class);
my $primary_key = Coat::Persistent::Meta->primary_key($class);
- foreach my $attr (keys %{ Coat::Meta->all_attributes($class)} ) {
+ foreach my $attr (Coat::Persistent::Meta->linearized_attributes($class) ) {
# checking for syntax validation
if (defined $CONSTRAINTS->{'!syntax'}{$class}{$attr}) {
my $regexp = $CONSTRAINTS->{'!syntax'}{$class}{$attr};
@@ -550,7 +554,7 @@
$self->validate();
# all the attributes of the class
- my @fields = keys %{ Coat::Meta->all_attributes( ref $self ) };
+ my @fields = Coat::Persistent::Meta->linearized_attributes( ref $self );
# a hash containing attr/value pairs for the current object.
my %values = map { $_ => $self->$_ } @fields;
Modified: trunk/libcoat-persistent-perl/lib/Coat/Persistent/Meta.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/lib/Coat/Persistent/Meta.pm?rev=26054&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/lib/Coat/Persistent/Meta.pm (original)
+++ trunk/libcoat-persistent-perl/lib/Coat/Persistent/Meta.pm Wed Oct 15 16:36:16 2008
@@ -13,6 +13,35 @@
# accessor to the meta information of a model
# ex: Coat::Persistent::Meta->model('User')
sub registry { $META->{ $_[1] } }
+
+sub attribute {
+ my ($self, $class, $attribute) = @_;
+ $META->{ $class }{attributes} ||= [];
+ push @{ $META->{ $class }{'attributes'} }, $attribute;
+}
+
+sub attribute_exists {
+ my ($self, $class, $attribute) = @_;
+ return grep /^$attribute$/, @{ $META->{ $class }{'attributes'} };
+}
+
+sub attributes {
+ my ($self, $class) = @_;
+ $META->{ $class }{'attributes'} ||= [];
+ return @{ $META->{ $class }{'attributes'} };
+}
+
+sub linearized_attributes {
+ my ($self, $class) = @_;
+
+ my @all = ();
+ foreach my $c (reverse Coat::Meta->linearized_isa( $class ) ) {
+ foreach my $attr (Coat::Persistent::Meta->attributes( $c )) {
+ push(@all, $attr) unless (grep(/^$attr$/, @all));
+ }
+ }
+ return @all;
+}
# this is to avoid writing several times the same setters and
# writers for the class
More information about the Pkg-perl-cvs-commits
mailing list