commit perl-Class-Accessor for openSUSE:Factory
Hello community, here is the log from the commit of package perl-Class-Accessor for openSUSE:Factory checked in at Tue May 19 02:30:34 CEST 2009. -------- --- perl-Class-Accessor/perl-Class-Accessor.changes 2007-07-25 15:39:02.000000000 +0200 +++ perl-Class-Accessor/perl-Class-Accessor.changes 2009-05-18 17:46:57.000000000 +0200 @@ -1,0 +2,6 @@ +Mon May 18 15:48:57 CEST 2009 - anicka@suse.cz + +- update to 0.33 + * small cleanups to fix RT#45592 and RT#43493 + +------------------------------------------------------------------- calling whatdependson for head-i586 Old: ---- Class-Accessor-0.31.tar.bz2 New: ---- Class-Accessor-0.33.tar.bz2 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Class-Accessor.spec ++++++ --- /var/tmp/diff_new_pack.m20782/_old 2009-05-19 02:28:13.000000000 +0200 +++ /var/tmp/diff_new_pack.m20782/_new 2009-05-19 02:28:13.000000000 +0200 @@ -1,25 +1,33 @@ # -# spec file for package perl-Class-Accessor (Version 0.31) +# spec file for package perl-Class-Accessor (Version 0.33) # -# Copyright (c) 2007 SUSE LINUX Products GmbH, Nuernberg, Germany. -# This file and all modifications and additions to the pristine -# package are under the same license as the package itself. +# Copyright (c) 2009 SUSE LINUX Products GmbH, Nuernberg, Germany. # +# All modifications and additions to the file contributed by third parties +# remain the property of their copyright owners, unless otherwise agreed +# upon. The license for this file, and modifications and additions to the +# file, is the same license as for the pristine package itself (unless the +# license for the pristine package is not an Open Source License, in which +# case the license is the MIT License). An "Open Source License" is a +# license that conforms to the Open Source Definition (Version 1.9) +# published by the Open Source Initiative. + # Please submit bugfixes or comments via http://bugs.opensuse.org/ # # norootforbuild + Name: perl-Class-Accessor BuildRequires: perl-Carp-Assert -Version: 0.31 +Version: 0.33 Release: 1 Requires: perl-Carp-Assert Requires: perl = %{perl_version} -Autoreqprov: on +AutoReqProv: on Group: Development/Libraries/Perl License: Artistic License -URL: http://cpan.org/modules/by-module/Class/ +Url: http://cpan.org/modules/by-module/Class/ Summary: Automated accessor generation Source: Class-Accessor-%{version}.tar.bz2 BuildRoot: %{_tmppath}/%{name}-%{version}-build @@ -59,38 +67,41 @@ /var/adm/perl-modules/%{name} %changelog -* Wed Jul 25 2007 - anicka@suse.cz +* Mon May 18 2009 anicka@suse.cz +- update to 0.33 + * small cleanups to fix RT#45592 and RT#43493 +* Wed Jul 25 2007 anicka@suse.cz - update to 0.31 * applied performance patch from RUZ -* Wed Dec 13 2006 - anicka@suse.cz +* Wed Dec 13 2006 anicka@suse.cz - update to 0.30 * added version numbers back into each class -* Mon Jul 24 2006 - anicka@suse.cz +* Mon Jul 24 2006 anicka@suse.cz - update to 0.27 * added Class::Accessor::Faster that uses an array internally -* Tue Jul 11 2006 - anicka@suse.cz +* Tue Jul 11 2006 anicka@suse.cz - update to 0.25 - minor release -* Wed Jan 25 2006 - mls@suse.de +* Wed Jan 25 2006 mls@suse.de - converted neededforbuild to BuildRequires -* Tue Jan 03 2006 - anicka@suse.cz +* Tue Jan 03 2006 anicka@suse.cz - update to 0.22 -* Wed Sep 28 2005 - dmueller@suse.de +* Wed Sep 28 2005 dmueller@suse.de - add norootforbuild -* Fri Aug 13 2004 - mjancar@suse.cz +* Fri Aug 13 2004 mjancar@suse.cz - update to 0.19 -* Fri Aug 22 2003 - mjancar@suse.cz +* Fri Aug 22 2003 mjancar@suse.cz - require the perl version we build with -* Tue Jul 15 2003 - mjancar@suse.cz +* Tue Jul 15 2003 mjancar@suse.cz - adapt to perl-5.8.1 - use %%perl_process_packlist -* Wed Jun 18 2003 - mjancar@suse.cz +* Wed Jun 18 2003 mjancar@suse.cz - fix filelist -* Tue May 20 2003 - mjancar@suse.cz +* Tue May 20 2003 mjancar@suse.cz - remove unpackaged files -* Tue Jul 02 2002 - mls@suse.de +* Tue Jul 02 2002 mls@suse.de - remove race in .packlist generation -* Wed Jun 26 2002 - prehak@suse.cz +* Wed Jun 26 2002 prehak@suse.cz - correct permissions of examples directories -* Wed Jan 23 2002 - rvasice@suse.cz +* Wed Jan 23 2002 rvasice@suse.cz - initial package release (version 0.17) ++++++ Class-Accessor-0.31.tar.bz2 -> Class-Accessor-0.33.tar.bz2 ++++++ diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Class-Accessor-0.31/Changes new/Class-Accessor-0.33/Changes --- old/Class-Accessor-0.31/Changes 2007-07-11 17:22:45.000000000 +0200 +++ new/Class-Accessor-0.33/Changes 2009-05-04 17:18:41.000000000 +0200 @@ -1,3 +1,9 @@ +0.33 Tue May 5 00:15:09 JST 2009 + - small cleanups to fix RT#45592 and RT#43493 + +0.32 Tue Jun 10 10:31:06 JST 2008 + - use Sub::Name to give names to anon subs to fix RT#17856 + 0.31 Wed Jul 11 23:03:47 JST 2007 - applied performance patch from RUZ diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Class-Accessor-0.31/examples/benchmark new/Class-Accessor-0.33/examples/benchmark --- old/Class-Accessor-0.31/examples/benchmark 2007-07-11 18:30:47.000000000 +0200 +++ new/Class-Accessor-0.33/examples/benchmark 2009-05-04 17:37:53.000000000 +0200 @@ -10,17 +10,6 @@ package Bench::Direct; use base qw(Bench::Base); -package Bench::ByHand; -use base qw(Bench::Base); - -sub test { - my($self) = shift; - if( @_ ) { - $self->{test} = (@_ == 1 ? $_[0] : [@_]); - } - return $self->{test}; -} - package Bench::Class::Accessor; use base qw(Class::Accessor); __PACKAGE__->mk_accessors(qw(test)); @@ -39,7 +28,6 @@ my $fast = Bench::Class::Accessor::Fast->new(\%init); my $faster = Bench::Class::Accessor::Faster->new(\%init); my $direct = Bench::Direct->new; -my $byhand = Bench::ByHand->new; my $foo; my $control = 42; @@ -55,7 +43,6 @@ 'Basic' => sub { $foo = $ca->test; }, 'Fast' => sub { $foo = $fast->test; }, 'Faster' => sub { $foo = $faster->test; }, - 'Average' => sub { $foo = $byhand->test; }, 'Direct' => sub { $foo = $direct->{test}; } } ); @@ -66,7 +53,6 @@ 'Acc' => sub { $ca->test(42); }, 'Fast' => sub { $fast->test(42); }, 'Faster' => sub { $faster->test(42); }, - 'By hand' => sub { $byhand->test(42); }, 'Direct' => sub { $direct->{test} = 42; } } ); diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Class-Accessor-0.31/lib/Class/Accessor/Faster.pm new/Class-Accessor-0.33/lib/Class/Accessor/Faster.pm --- old/Class-Accessor-0.31/lib/Class/Accessor/Faster.pm 2007-07-11 17:56:47.000000000 +0200 +++ new/Class-Accessor-0.33/lib/Class/Accessor/Faster.pm 2009-05-04 15:50:31.000000000 +0200 @@ -1,7 +1,7 @@ package Class::Accessor::Faster; use base 'Class::Accessor'; use strict; -$Class::Accessor::Faster::VERSION = '0.31'; +$Class::Accessor::Faster::VERSION = '0.33'; =head1 NAME diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Class-Accessor-0.31/lib/Class/Accessor/Fast.pm new/Class-Accessor-0.33/lib/Class/Accessor/Fast.pm --- old/Class-Accessor-0.31/lib/Class/Accessor/Fast.pm 2007-07-11 17:58:31.000000000 +0200 +++ new/Class-Accessor-0.33/lib/Class/Accessor/Fast.pm 2009-05-04 15:50:38.000000000 +0200 @@ -1,7 +1,7 @@ package Class::Accessor::Fast; use base 'Class::Accessor'; use strict; -$Class::Accessor::Fast::VERSION = '0.31'; +$Class::Accessor::Fast::VERSION = '0.33'; =head1 NAME diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Class-Accessor-0.31/lib/Class/Accessor.pm new/Class-Accessor-0.33/lib/Class/Accessor.pm --- old/Class-Accessor-0.31/lib/Class/Accessor.pm 2007-07-11 18:37:39.000000000 +0200 +++ new/Class-Accessor-0.33/lib/Class/Accessor.pm 2009-05-04 17:37:11.000000000 +0200 @@ -1,7 +1,7 @@ package Class::Accessor; require 5.00502; use strict; -$Class::Accessor::VERSION = '0.31'; +$Class::Accessor::VERSION = '0.33'; =head1 NAME @@ -9,16 +9,17 @@ =head1 SYNOPSIS - package Employee; + package Foo; use base qw(Class::Accessor); - Employee->mk_accessors(qw(name role salary)); + Foo->follow_best_practice; + Foo->mk_accessors(qw(name role salary)); # Meanwhile, in a nearby piece of code! # Class::Accessor provides new(). my $mp = Foo->new({ name => "Marty", role => "JAPH" }); my $job = $mp->role; # gets $mp->{role} - $mp->salary(400000); # sets $mp->{salary} = 400000 (I wish) + $mp->salary(400000); # sets $mp->{salary} = 400000 # I wish # like my @info = @{$mp}{qw(name role)} my @info = $mp->get(qw(name role)); @@ -55,7 +56,7 @@ One for each piece of data in your object. While some will be unique, doing value checks and special storage tricks, most will simply be exercises in repetition. Not only is it Bad Style to have a bunch of -repetitious code, but its also simply not lazy, which is the real +repetitious code, but it's also simply not lazy, which is the real tragedy. If you make your module a subclass of Class::Accessor and declare your @@ -65,13 +66,23 @@ The basic set up is very simple: - package My::Class; + package Foo; use base qw(Class::Accessor); - My::Class->mk_accessors( qw(foo bar car) ); + Foo->mk_accessors( qw(far bar car) ); -Done. My::Class now has simple foo(), bar() and car() accessors +Done. Foo now has simple far(), bar() and car() accessors defined. +Alternatively, if you want to follow Damian's I<best practice> guidelines +you can use: + + package Foo; + use base qw(Class::Accessor); + Foo->follow_best_practice; + Foo->mk_accessors( qw(far bar car) ); + +B<Note:> you must call C<follow_best_practice> before calling C<mk_accessors>. + =head2 What Makes This Different? What makes this module special compared to all the other method @@ -86,10 +97,10 @@ =head2 new - my $obj = Class->new; + my $obj = Foo->new; my $obj = $other_obj->new; - my $obj = Class->new(\%fields); + my $obj = Foo->new(\%fields); my $obj = $other_obj->new(\%fields); Class::Accessor provides a basic constructor. It generates a @@ -104,7 +115,7 @@ use base qw(Class::Accessor); Foo->mk_accessors('foo'); - my $obj = Class->new({ foo => 42 }); + my $obj = Foo->new({ foo => 42 }); print $obj->foo; # 42 however %fields can contain anything, new() will shove them all into @@ -124,7 +135,7 @@ =head2 mk_accessors - Class->mk_accessors(@fields); + __PACKAGE__->mk_accessors(@fields); This creates accessor/mutator methods for each named field given in @fields. Foreach field in @fields it will generate two accessors. @@ -132,7 +143,7 @@ example: # Generates foo(), _foo_accessor(), bar() and _bar_accessor(). - Class->mk_accessors(qw(foo bar)); + __PACKAGE__->mk_accessors(qw(foo bar)); See L<CAVEATS AND TRICKS/"Overriding autogenerated accessors"> for details. @@ -145,10 +156,20 @@ $self->_mk_accessors('rw', @fields); } +if (eval { require Sub::Name }) { + Sub::Name->import; +} { no strict 'refs'; + sub follow_best_practice { + my($self) = @_; + my $class = ref $self || $self; + *{"${class}::accessor_name_for"} = \&best_practice_accessor_name_for; + *{"${class}::mutator_name_for"} = \&best_practice_mutator_name_for; + } + sub _mk_accessors { my($self, $access, @fields) = @_; my $class = ref $self || $self; @@ -170,37 +191,43 @@ } else { $accessor = $self->make_wo_accessor($field); } - unless (defined &{"${class}::$accessor_name"}) { - *{"${class}::$accessor_name"} = $accessor; + my $fullname = "${class}::$accessor_name"; + my $subnamed = 0; + unless (defined &{$fullname}) { + subname($fullname, $accessor) if defined &subname; + $subnamed = 1; + *{$fullname} = $accessor; } if ($accessor_name eq $field) { # the old behaviour - my $alias = "_${field}_accessor"; - *{"${class}::$alias"} = $accessor unless defined &{"${class}::$alias"}; + my $alias = "${class}::_${field}_accessor"; + subname($alias, $accessor) if defined &subname and not $subnamed; + *{$alias} = $accessor unless defined &{$alias}; } } else { - if ($ra and not defined &{"${class}::$accessor_name"}) { - *{"${class}::$accessor_name"} = $self->make_ro_accessor($field); + my $fullaccname = "${class}::$accessor_name"; + my $fullmutname = "${class}::$mutator_name"; + if ($ra and not defined &{$fullaccname}) { + my $accessor = $self->make_ro_accessor($field); + subname($fullaccname, $accessor) if defined &subname; + *{$fullaccname} = $accessor; } - if ($wa and not defined &{"${class}::$mutator_name"}) { - *{"${class}::$mutator_name"} = $self->make_wo_accessor($field); + if ($wa and not defined &{$fullmutname}) { + my $mutator = $self->make_wo_accessor($field); + subname($fullmutname, $mutator) if defined &subname; + *{$fullmutname} = $mutator; } } } } - sub follow_best_practice { - my($self) = @_; - my $class = ref $self || $self; - *{"${class}::accessor_name_for"} = \&best_practice_accessor_name_for; - *{"${class}::mutator_name_for"} = \&best_practice_mutator_name_for; - } - } + + =head2 mk_ro_accessors - Class->mk_ro_accessors(@read_only_fields); + __PACKAGE__->mk_ro_accessors(@read_only_fields); Same as mk_accessors() except it will generate read-only accessors (ie. true accessors). If you attempt to set a value with these @@ -209,7 +236,7 @@ package Foo; use base qw(Class::Accessor); - Class->mk_ro_accessors(qw(foo bar)); + Foo->mk_ro_accessors(qw(foo bar)); # Let's assume we have an object $foo of class Foo... print $foo->foo; # ok, prints whatever the value of $foo->{foo} is @@ -226,19 +253,19 @@ =head2 mk_wo_accessors - Class->mk_wo_accessors(@write_only_fields); + __PACKAGE__->mk_wo_accessors(@write_only_fields); Same as mk_accessors() except it will generate write-only accessors (ie. mutators). If you attempt to read a value with these accessors it will throw an exception. It only uses set() and not get(). B<NOTE> I'm not entirely sure why this is useful, but I'm sure someone -will need it. If you've found a use, let me know. Right now its here -for orthoginality and because its easy to implement. +will need it. If you've found a use, let me know. Right now it's here +for orthoginality and because it's easy to implement. package Foo; use base qw(Class::Accessor); - Class->mk_wo_accessors(qw(foo bar)); + Foo->mk_wo_accessors(qw(foo bar)); # Let's assume we have an object $foo of class Foo... $foo->foo(42); # OK. Sets $self->{foo} = 42 @@ -281,6 +308,8 @@ __PACKAGE__->follow_best_practice +B<before> you call mk_accessors. + =head2 accessor_name_for / mutator_name_for You may have your own crazy ideas for the names of the accessors, so you can @@ -369,7 +398,7 @@ =head2 make_accessor - $accessor = Class->make_accessor($field); + $accessor = __PACKAGE__->make_accessor($field); Generates a subroutine reference which acts as an accessor for the given $field. It calls get() and set(). @@ -397,7 +426,7 @@ =head2 make_ro_accessor - $read_only_accessor = Class->make_ro_accessor($field); + $read_only_accessor = __PACKAGE__->make_ro_accessor($field); Generates a subroutine refrence which acts as a read-only accessor for the given $field. It only calls get(). @@ -424,7 +453,7 @@ =head2 make_wo_accessor - $read_only_accessor = Class->make_wo_accessor($field); + $read_only_accessor = __PACKAGE__->make_wo_accessor($field); Generates a subroutine refrence which acts as a write-only accessor (mutator) for the given $field. It only calls set(). @@ -478,20 +507,18 @@ ones you'd write yourself. accessors: - Rate Basic Average Fast Faster Direct - Basic 189150/s -- -42% -51% -55% -89% - Average 327679/s 73% -- -16% -22% -82% - Fast 389212/s 106% 19% -- -8% -78% - Faster 421646/s 123% 29% 8% -- -76% - Direct 1771243/s 836% 441% 355% 320% -- + Rate Basic Fast Faster Direct + Basic 367589/s -- -51% -55% -89% + Fast 747964/s 103% -- -9% -77% + Faster 819199/s 123% 10% -- -75% + Direct 3245887/s 783% 334% 296% -- mutators: - Rate Basic Average Fast Faster Direct - Basic 173769/s -- -34% -53% -59% -90% - Average 263046/s 51% -- -29% -38% -85% - Fast 371158/s 114% 41% -- -13% -78% - Faster 425821/s 145% 62% 15% -- -75% - Direct 1699081/s 878% 546% 358% 299% -- + Rate Acc Fast Faster Direct + Acc 265564/s -- -54% -63% -91% + Fast 573439/s 116% -- -21% -80% + Faster 724710/s 173% 26% -- -75% + Direct 2860979/s 977% 399% 295% -- Class::Accessor::Fast is faster than methods written by an average programmer (where "average" is based on Schwern's example code). @@ -505,7 +532,7 @@ Direct hash access is, of course, much faster than all of these, but it provides no encapsulation. -Of course, its not as simple as saying "Class::Accessor is slower than +Of course, it's not as simple as saying "Class::Accessor is slower than average". These are benchmarks for a simple accessor. If your accessors do any sort of complicated work (such as talking to a database or writing to a file) the time spent doing that work will quickly swamp the time spend just @@ -549,7 +576,7 @@ package Foo; use base qw(Class::Accessor); - Foo->mk_accessor(qw(this that up down)); + Foo->mk_accessors(qw(this that up down)); sub get { my $self = shift; @@ -611,7 +638,7 @@ return $self->SUPER::email(@_); } -There's a subtle problem in the last example, and its in this line: +There's a subtle problem in the last example, and it's in this line: return $self->SUPER::email(@_); diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Class-Accessor-0.31/Makefile.PL new/Class-Accessor-0.33/Makefile.PL --- old/Class-Accessor-0.31/Makefile.PL 2006-11-26 05:09:17.000000000 +0100 +++ new/Class-Accessor-0.33/Makefile.PL 2009-05-04 17:49:14.000000000 +0200 @@ -6,5 +6,6 @@ NAME => 'Class::Accessor', VERSION_FROM => 'lib/Class/Accessor.pm', AUTHOR => 'Marty Pauley <marty+perl@kasei.com>', + LICENSE => 'perl', PREREQ_PM => { base => $] == 5.006 ? 1.02 : 1.01, }, ); diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Class-Accessor-0.31/MANIFEST new/Class-Accessor-0.33/MANIFEST --- old/Class-Accessor-0.31/MANIFEST 2006-11-26 05:09:17.000000000 +0100 +++ new/Class-Accessor-0.33/MANIFEST 2009-05-04 17:42:56.000000000 +0200 @@ -13,3 +13,4 @@ t/bestpractice.t t/croak.t t/getset.t +t/caller.t diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Class-Accessor-0.31/META.yml new/Class-Accessor-0.33/META.yml --- old/Class-Accessor-0.31/META.yml 2007-07-11 18:41:01.000000000 +0200 +++ new/Class-Accessor-0.33/META.yml 2009-05-04 17:53:59.000000000 +0200 @@ -1,11 +1,14 @@ -# http://module-build.sourceforge.net/META-spec.html -#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# -name: Class-Accessor -version: 0.31 -version_from: lib/Class/Accessor.pm -installdirs: site -requires: +--- #YAML:1.0 +name: Class-Accessor +version: 0.33 +abstract: ~ +license: perl +author: + - Marty Pauley <marty+perl@kasei.com> +generated_by: ExtUtils::MakeMaker version 6.42 +distribution_type: module +requires: base: 1.01 - -distribution_type: module -generated_by: ExtUtils::MakeMaker version 6.30_01 +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.3.html + version: 1.3 diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Class-Accessor-0.31/README new/Class-Accessor-0.33/README --- old/Class-Accessor-0.31/README 2007-07-11 18:39:53.000000000 +0200 +++ new/Class-Accessor-0.33/README 2009-05-04 17:37:43.000000000 +0200 @@ -8,35 +8,14 @@ This module automagically generates accessors/mutators for your class. Most of the time, writing accessors is an exercise in cutting and - pasting. You usually wind up with a series of methods like this: - - sub name { - my $self = shift; - if(@_) { - $self->{name} = $_[0]; - } - return $self->{name}; - } - - sub salary { - my $self = shift; - if(@_) { - $self->{salary} = $_[0]; - } - return $self->{salary}; - } - - # etc... - - One for each piece of data in your object. While some will be unique, + pasting. You usually wind up with a series of almost identical methods, + one for each piece of data in your object. While some will be unique, doing value checks and special storage tricks, most will simply be - exercises in repetition. Not only is it Bad Style to have a bunch of - repetitious code, but its also simply not lazy, which is the real - tragedy. + exercises in repetition. If you make your module a subclass of Class::Accessor and declare your accessor fields with mk_accessors() then you'll find yourself with a set - of automatically generated accessors which can even be customized! + of automatically generated accessors, which can even be customized! The basic set up is very simple: @@ -49,24 +28,22 @@ BENCHMARKS accessors: - Rate Basic Average Fast Faster Direct - Basic 189150/s -- -42% -51% -55% -89% - Average 327679/s 73% -- -16% -22% -82% - Fast 389212/s 106% 19% -- -8% -78% - Faster 421646/s 123% 29% 8% -- -76% - Direct 1771243/s 836% 441% 355% 320% -- + Rate Basic Fast Faster Direct + Basic 367589/s -- -51% -55% -89% + Fast 747964/s 103% -- -9% -77% + Faster 819199/s 123% 10% -- -75% + Direct 3245887/s 783% 334% 296% -- mutators: - Rate Basic Average Fast Faster Direct - Basic 173769/s -- -34% -53% -59% -90% - Average 263046/s 51% -- -29% -38% -85% - Fast 371158/s 114% 41% -- -13% -78% - Faster 425821/s 145% 62% 15% -- -75% - Direct 1699081/s 878% 546% 358% 299% -- + Rate Acc Fast Faster Direct + Acc 265564/s -- -54% -63% -91% + Fast 573439/s 116% -- -21% -80% + Faster 724710/s 173% 26% -- -75% + Direct 2860979/s 977% 399% 295% -- AUTHORS - Copyright 2007 Marty Pauley <marty+perl@kasei.com> + Copyright 2009 Marty Pauley <marty+perl@kasei.com> This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. That means either (a) the GNU diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Class-Accessor-0.31/t/caller.t new/Class-Accessor-0.33/t/caller.t --- old/Class-Accessor-0.31/t/caller.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Class-Accessor-0.33/t/caller.t 2009-05-04 17:27:12.000000000 +0200 @@ -0,0 +1,49 @@ +#!perl +use strict; +use Test::More; + +unless (eval {require Sub::Name}) { + plan skip_all => "Sub::Name is not installed"; + exit 0; +} + +plan tests => 6; + +require_ok("Class::Accessor"); +require_ok("Class::Accessor::Fast"); + +package Foo; +our @ISA = qw(Class::Accessor); +sub get { + my ($self, $key) = @_; + my @c = caller(1); + main::is $c[3], "Foo::$key", "correct name for Foo sub $key"; + return $self->SUPER::get($key); +} +__PACKAGE__->mk_accessors(qw( foo )); + +package Tricky; +require Tie::Hash; +our @ISA = qw(Tie::StdHash); +sub FETCH { + my ($self, $key) = @_; + my @c = caller(1); + main::is $c[3], "Bar::$key", "correct name for Bar sub $key"; + return $self->SUPER::FETCH($key); +} +package Bar; +our @ISA = qw(Class::Accessor::Fast); +sub new { + my ($class, $init) = @_; + my %store; + tie %store, "Tricky"; + %store = %$init; + bless \%store, $class; +} +__PACKAGE__->mk_accessors(qw( bar )); + +package main; +my $foo = Foo->new({ foo => 12345 }); +is $foo->foo, 12345, "get initial foo"; +my $bar = Bar->new({ bar => 54321 }); +is $bar->bar, 54321, "get initial bar"; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Remember to have fun... -- To unsubscribe, e-mail: opensuse-commit+unsubscribe@opensuse.org For additional commands, e-mail: opensuse-commit+help@opensuse.org
participants (1)
-
root@Hilbert.suse.de