[Catalyst] Attribute::Handlers wont work in own classes under catalyst

[John Napiorkowski]

--- Felix Antonius Wilhelm Ostmann
<ostmann at websuche.de> wrote:

> OK, first the problem:
> 
> we have build some classes with Attribute::Handlers
> (was inspired from 
> Attribute::Property)
> 
> This works realy fine!
> 
> after a few tests we gone use this classes under
> catalyst ... and ... 
> dont work :-/ under catalyst our classes dont use
> Attribute::Handlers 
> :-/ we declare UNIVERSAL::Property and then use "sub
> nondigit : Property 
> { defined && !m{[0-9]} }" (see the code)
> 
> then you can call: $obj->nondigit(4) and it will
> croak or 
> $obj->nondigit("car") and it will set the
> object-property nondigit to "car".
> 
> under catalyst he ignore the redefined sub in
> UNIVERSAL::Property ... 
> no, he dont call UNIVERSAL::Property to redefine sub
> :-/
> 
> 
> MfG
> Felix Ostmann
> 
> 
> 
> OK, here the code, you can test it with (works):
> perl -d -MData::Dumper -MmyExample -e 'my $e =
> myExample->create(); 
> $e->nondigit("car"); print Dumper($e);'
> or
> perl -d -MData::Dumper -MmyExample -e 'my $e =
> myExample->create(); 
> $e->nondigit(4); print Dumper($e);'
> 
> 
> under catalyst (wont work):
> sub default : Private {
> my ($self, $c) = @_;
> use myExample;
> use Data::Dumper;
> my $e = myExample->create();
> $e->nondigit("car");
> $c->response->body( Dumper($e) );
> }
> 
> 
> 
> CODE:
> 
> package myExample;
> 
> use strict;
> use warnings;
> 
> use 5.006;
> use Attribute::Handlers;
> use Carp qw/carp croak/;
> 
> $Carp::Internal{q/Attribute::Handlers/}++;  # may we
> be forgiven for our 
> sins
> $Carp::Internal{+__PACKAGE__}++;
> 
> sub UNIVERSAL::Property : ATTR(CODE) {
>     my (undef, $self_glob, $check_code) = @_;
> 
>     ref($self_glob)
>         or croak "Cannot use property attribute with
> anonymous sub";
> 
>     my $property = *$self_glob{NAME};
> 
>     defined(&$self_glob)
>         or undef $check_code;
> 
>     no warnings 'redefine';
> 
>     *$self_glob = sub {
>         (my $self, local $_) = @_;
> 
>         if( @_ == 1 ) {
>            
> exists($self->{_property}->{_current}->{$property})
>                 or croak "Property $property not
> loaded";
> 
>             return
> $self->{_property}->{_current}->{$property};
>         }
> 
>         if( @_ == 2 ) {
>             ref($_)
>                 and croak "Invalid value for
> $property property, no refs";
> 
>             # Property wurde geladen, sonst Abbruch
>             $self->{_in_storage} && 
> !exists($self->{_property}->{_storage}->{$property})
>                 and croak "Property $property not
> loaded";
> 
>             my $value = $_;
> 
>             # überprüfe neuen Wert auf Gültigkeit,
> sonst Abbruch
>             defined($check_code) &&
> !$check_code->($self, $_)
>                 and croak "Invalid value for
> $property property";
> 
>             if( !defined($self->{_in_storage}) ) {
>                 # status "schammig"es Objekt, dann
> alles laden als "from 
> storage"
> 
>                 # ist neuer Wert != alter Wert,
> warnung ausgeben
>                 if( defined($_) ^ defined($value) or
> defined($_) && $_ 
> ne $value ) {
>                     carp "Property $property from
> database are 
> inconsistent";
>                    
> $self->{_property}->{_storage}->{$property} =
> $value;
>                 }
>                 else {
>                    
> $self->{_property}->{_storage}->{$property} = $_;
>                 }
> 
>             }
>             # wenn Objekt in der Datenbank
>             elsif( $self->{_in_storage} ) {
>                 # lösche dirty-Status, wird neu
> berechnet
>                
> delete($self->{_property}->{_dirty}->{$property});
> 
>                 # ist neuer Wert != alter Wert,
> dirty-Status neu setzten
>                 defined($_) ^ 
> defined($self->{_property}->{_storage}->{$property})
>                     and
> $self->{_property}->{_dirty}->{$property} = undef;
> 
>                 # ist neuer Wert != alter Wert,
> dirty-Status neu setzten
>                 defined($_) && $_ ne 
> $self->{_property}->{_storage}->{$property}
>                     and
> $self->{_property}->{_dirty}->{$property} = undef;
>             }
>             # wenn nicht in der Datenbank
>             else {
>                 # auf jeden Fall auf dirty setzten
>                
> $self->{_property}->{_dirty}->{$property} = undef
>             }
> 
>             return
> $self->{_property}->{_current}->{$property} = $_;
>         }
> 
>         croak "Too many arguments for $property
> method";
>     };
> }
> 
> sub new {
>     my ($class, @args) = @_;
> 
>     @args
>         and croak q{Can't call method "new" with
> arguments};
> 
>     my $self = {
>         _property   => {
>             _current   => {},
>             _storage   => {},
>             _dirty     => {},
>         },
>         _in_storage => undef,
>     };
> 
>     bless($self, $class);
> 
>     return $self;
> }
> 
> sub create {
>     my ($class, @args) = @_;
> 
>     @args % 2
>         and croak "wrong count of arguments";
> 
>     my %customer_row = @args;
> 
>     # erstelle Objekt und setzte übergebene
> Parameter
>     my $self = $class->new();
>     $self->in_storage(0);
>     $self->$_($customer_row{$_})  for(
> keys(%customer_row) );
> 
>     return $self;
> }
> 
> sub in_storage {
>     my ($self, $in_storage) = @_;
> 
>     if( @_ == 1 ) {
>         return $self->{_in_storage};
>     }
> 
>     if( @_ == 2 ) {
>         if( !defined($in_storage) ) {
>             $self->{_property}->{_storage}->{$_} = 
> $self->{_property}->{_current}->{$_}  for(
> $self->is_changed );
>             $self->{_property}->{_dirty}         =
> {};
>         }
>         return $self->{_in_storage} = $in_storage;
>     }
> }
> 
> sub is_changed {
>     my ($self, $property) = @_;
> 
>     return keys(%{$self->{_property}->{_dirty}}) 
> if( !defined($property) );
>     return 1                                     
> if( 
> exists($self->{_property}->{_dirty}->{$property}) );
>     return 0;
> }
> 
> 
> ## PROPERTIES
> sub undef_or_digit : Property { !defined || m{^\d+$}
> };
> sub nondigit       : Property { defined && !m{\d} };
> 
> 
> 1;

Hi,

To be honest I am not really sure what you are trying
to do.  Catalyst offers an easy way to create custom
attributes on your actions, since
$c->action->attributes is an arrayref of all the
subroutine attributes, like so:

sub myaction :Local :Custom(abc) :Custom(efg)
{
  my ($self, $c) = @_;
  
  $c->action->attributes->{Custom}[0]; # is 'abc'
  $c->action->attributes->{Custom}[1]; # is 'efg'
}

And you can access these in your custom ActionClass or
elsewhere.

If you want to add attributes to variables, take at
look at 'Catalyst::Controller::BindLex' at
http://search.cpan.org/~nuffin/Catalyst-Controller-BindLex-0.03/lib/Catalyst/Controller/BindLex.pm

which allows you to add your own variable attributes
(among other things). The docs to that module have an
example.

Otherwise if you think there is a bug in Catalyst
itself, please try to offer the bug demonstrated as a
test.  That way we can try to fix it.  Check out the
't' directory in the main catalyst package for some
guidence on this.  I know writing tests for Catalyst
can be a bit overwhelming if you are not used to
writing perl tests and have trouble understanding the
system, but it's well worth the trouble.  Also
submitting tests in this manner is MUCH more likely to
get some sort of attention from the core developers.

Please let us know what we can do to help.

--John



       
____________________________________________________________________________________
Got a little couch potato? 
Check out fun summer activities for kids.
http://search.yahoo.com/search?fr=oni_on_mail&p=summer+activities+for+kids&cs=bz