r20162 - in /trunk/libcoat-perl: CHANGES debian/changelog lib/Coat.pm lib/Coat/Meta.pm lib/Coat/Object.pm t/027_handles.t t/028_build_demolish.t
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Mon May 19 17:48:50 UTC 2008
Author: gregoa
Date: Mon May 19 17:48:49 2008
New Revision: 20162
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=20162
Log:
New upstream release.
Added:
trunk/libcoat-perl/t/027_handles.t
- copied unchanged from r20161, branches/upstream/libcoat-perl/current/t/027_handles.t
trunk/libcoat-perl/t/028_build_demolish.t
- copied unchanged from r20161, branches/upstream/libcoat-perl/current/t/028_build_demolish.t
Modified:
trunk/libcoat-perl/CHANGES
trunk/libcoat-perl/debian/changelog
trunk/libcoat-perl/lib/Coat.pm
trunk/libcoat-perl/lib/Coat/Meta.pm
trunk/libcoat-perl/lib/Coat/Object.pm
Modified: trunk/libcoat-perl/CHANGES
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-perl/CHANGES?rev=20162&op=diff
==============================================================================
--- trunk/libcoat-perl/CHANGES (original)
+++ trunk/libcoat-perl/CHANGES Mon May 19 17:48:49 2008
@@ -1,3 +1,41 @@
+2008-05-18 -- release 0.320
+
+ * support for attr overloading (has '+foo')
+ * support for handles (with tests)
+ * fixed BUILD inheritance
+ * added DEMOLISH and BUILD support in Coat::Object
+ * added a dump() method in Coat::Object
+
+2008-05-15 -- release 0.310
+
+ * Fixing parameterized parsing
+
+2008-05-14 -- release 0.300
+
+ * support for anon type constraint
+
+
+2008-05-14 -- release 0.240
+
+ * Bugfix and support for real automatic class constraint
+
+2008-05-14 -- release 0.230
+
+ * support for parameterized type constraint HashRef[] and ArrayRef[]
+ * removed useless and buggy find_matching_types, fixed ->coerce()
+ * documentation of type-constraints & friends
+
+2008-05-12 -- release 0.210
+
+ * only coerce if attr want coercion
+ * Fixing an issue when Type constraint triggers and exception
+ * extends now try to import missing classes by himself
+ (closes: #35516).
+
+2008-05-11 -- release 0.200
+
+ * Support for real type constraints and coercion
+
2007-10-11 -- release 0.1_0.6
* Supports for "required" and "trigger" options
Modified: trunk/libcoat-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-perl/debian/changelog?rev=20162&op=diff
==============================================================================
--- trunk/libcoat-perl/debian/changelog (original)
+++ trunk/libcoat-perl/debian/changelog Mon May 19 17:48:49 2008
@@ -1,3 +1,9 @@
+libcoat-perl (0.320-1) UNRELEASED; urgency=low
+
+ * New upstream release.
+
+ -- gregor herrmann <gregoa at debian.org> Mon, 19 May 2008 19:47:33 +0200
+
libcoat-perl (0.310-1) unstable; urgency=low
* New upstream release.
Modified: trunk/libcoat-perl/lib/Coat.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-perl/lib/Coat.pm?rev=20162&op=diff
==============================================================================
--- trunk/libcoat-perl/lib/Coat.pm (original)
+++ trunk/libcoat-perl/lib/Coat.pm Mon May 19 17:48:49 2008
@@ -14,7 +14,7 @@
use Coat::Object;
use Coat::Types;
-$VERSION = '0.310';
+$VERSION = '0.320';
$AUTHORITY = 'cpan:SUKRIA';
# our exported keywords for class description
@@ -78,6 +78,26 @@
# now bind the subref to the appropriate symbol in the caller class
_bind_coderef_to_symbol( $accessor_code, $accessor );
+
+ my $handles = $attr->{'handles'};
+ if ($handles && ref $handles eq 'HASH') {
+
+ foreach my $method ( keys %{$handles} ) {
+ my $handler = "${class}::${method}";
+ my $handle = $handles->{$method};
+ my $handles_code = sub {
+ my ( $self, @args ) = @_;
+
+ if ( $self->$attribute->can( $handle ) ) {
+ return $self->$attribute->$handle( @args );
+ }
+ else {
+ confess( 'Cannot call ' . $handle . ' from ' . $attribute );
+ }
+ };
+ _bind_coderef_to_symbol( $handles_code, $handler );
+ }
+ }
}
# the public inheritance method, takes a list of class we should inherit from
Modified: trunk/libcoat-perl/lib/Coat/Meta.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-perl/lib/Coat/Meta.pm?rev=20162&op=diff
==============================================================================
--- trunk/libcoat-perl/lib/Coat/Meta.pm (original)
+++ trunk/libcoat-perl/lib/Coat/Meta.pm Mon May 19 17:48:49 2008
@@ -126,6 +126,19 @@
{
my ($self, $class) = @_;
{ no strict 'refs'; return \@{"${class}::ISA"}; }
+}
+
+sub class_precedence_list {
+ my ($self, $class) = @_;
+ return if !$class;
+
+ ( $class, map { $self->class_precedence_list($_) } @{$self->parents($class)} );
+}
+
+sub linearized_isa {
+ my ($self, $class) = @_;
+ my %seen;
+ grep { !( $seen{$_}++ ) } $self->class_precedence_list($class);
}
sub is_parent
Modified: trunk/libcoat-perl/lib/Coat/Object.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-perl/lib/Coat/Object.pm?rev=20162&op=diff
==============================================================================
--- trunk/libcoat-perl/lib/Coat/Object.pm (original)
+++ trunk/libcoat-perl/lib/Coat/Object.pm Mon May 19 17:48:49 2008
@@ -31,7 +31,6 @@
sub init {
my ( $self, %attrs ) = @_;
my $class_attr = Coat::Meta->all_attributes( ref( $self ) );
-
# setting all default values
foreach my $attr ( keys %{$class_attr} ) {
@@ -69,11 +68,49 @@
$class_attr->{$attr}{'is'} = $is;
}
+ $self->BUILDALL(\%attrs);
+ return $self;
+}
- # try to run the BUILD method, if exists
+# All the BUILD/DEMOLISH stuff here is taken from Moose and
+# uses some Coat::Meta.
+
+sub BUILDALL {
+ return unless $_[0]->can('BUILD');
+ my ($self, $params) = @_;
+
my $build_sub;
- { no strict 'refs'; $build_sub = *{ref($self)."::BUILD"}; }
- $self->BUILD( %attrs ) if ( defined &$build_sub );
+ foreach my $pkg (reverse Coat::Meta->linearized_isa(ref($self))) {
+ {
+ no strict 'refs';
+ $build_sub = *{$pkg."::BUILD"};
+ }
+ $self->$build_sub( %$params ) if defined &$build_sub;
+ }
+}
+
+sub DEMOLISHALL {
+ return unless $_[0]->can('DEMOLISH');
+ my ($self) = @_;
+
+ my $demolish_sub;
+ foreach my $pkg (reverse Coat::Meta->linearized_isa(ref($self))) {
+ {
+ no strict 'refs';
+ $demolish_sub = *{$pkg."::DEMOLISH"};
+ }
+ $self->$demolish_sub() if defined &$demolish_sub;
+ }
+}
+
+sub DESTROY { goto &DEMOLISHALL }
+
+# taken from Moose::Object
+sub dump {
+ my $self = shift;
+ require Data::Dumper;
+ local $Data::Dumper::Maxdepth = shift if @_;
+ Data::Dumper::Dumper $self;
}
# end Coat::Object
More information about the Pkg-perl-cvs-commits
mailing list