r1754 - in packages: . libclass-data-accessor-perl
libclass-data-accessor-perl/branches
libclass-data-accessor-perl/branches/upstream
libclass-data-accessor-perl/branches/upstream/current
libclass-data-accessor-perl/branches/upstream/current/lib
libclass-data-accessor-perl/branches/upstream/current/lib/Class
libclass-data-accessor-perl/branches/upstream/current/lib/Class/Data
libclass-data-accessor-perl/branches/upstream/current/t
Krzysztof Krzyzaniak
eloy at costa.debian.org
Tue Dec 27 09:09:19 UTC 2005
Author: eloy
Date: 2005-12-27 09:09:18 +0000 (Tue, 27 Dec 2005)
New Revision: 1754
Added:
packages/libclass-data-accessor-perl/
packages/libclass-data-accessor-perl/branches/
packages/libclass-data-accessor-perl/branches/upstream/
packages/libclass-data-accessor-perl/branches/upstream/current/
packages/libclass-data-accessor-perl/branches/upstream/current/Build.PL
packages/libclass-data-accessor-perl/branches/upstream/current/Changes
packages/libclass-data-accessor-perl/branches/upstream/current/MANIFEST
packages/libclass-data-accessor-perl/branches/upstream/current/MANIFEST.SKIP
packages/libclass-data-accessor-perl/branches/upstream/current/META.yml
packages/libclass-data-accessor-perl/branches/upstream/current/Makefile.PL
packages/libclass-data-accessor-perl/branches/upstream/current/README
packages/libclass-data-accessor-perl/branches/upstream/current/lib/
packages/libclass-data-accessor-perl/branches/upstream/current/lib/Class/
packages/libclass-data-accessor-perl/branches/upstream/current/lib/Class/Data/
packages/libclass-data-accessor-perl/branches/upstream/current/lib/Class/Data/Accessor.pm
packages/libclass-data-accessor-perl/branches/upstream/current/t/
packages/libclass-data-accessor-perl/branches/upstream/current/t/Accessor.t
packages/libclass-data-accessor-perl/branches/upstream/current/t/pod-coverage.t
packages/libclass-data-accessor-perl/branches/upstream/current/t/pod.t
packages/libclass-data-accessor-perl/tags/
Log:
[svn-inject] Installing original source of libclass-data-accessor-perl
Added: packages/libclass-data-accessor-perl/branches/upstream/current/Build.PL
===================================================================
--- packages/libclass-data-accessor-perl/branches/upstream/current/Build.PL 2005-12-25 18:22:17 UTC (rev 1753)
+++ packages/libclass-data-accessor-perl/branches/upstream/current/Build.PL 2005-12-27 09:09:18 UTC (rev 1754)
@@ -0,0 +1,14 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use Module::Build;
+
+Module::Build->new(
+ module_name => 'Class::Data::Accessor',
+ license => 'perl',
+ requires => {
+ Carp => 0
+ },
+ create_makefile_pl => 'passthrough',
+ create_readme => 1,
+)->create_build_script;
Added: packages/libclass-data-accessor-perl/branches/upstream/current/Changes
===================================================================
--- packages/libclass-data-accessor-perl/branches/upstream/current/Changes 2005-12-25 18:22:17 UTC (rev 1753)
+++ packages/libclass-data-accessor-perl/branches/upstream/current/Changes 2005-12-27 09:09:18 UTC (rev 1754)
@@ -0,0 +1,8 @@
+Revision history for Class::Data::Accessor.
+
+0.02
+ - Doc fixes
+ - Added no warnings qw/redefine/ for usage with C3
+
+0.01 2005-11-27 21:21:46
+ - initial release
Added: packages/libclass-data-accessor-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libclass-data-accessor-perl/branches/upstream/current/MANIFEST 2005-12-25 18:22:17 UTC (rev 1753)
+++ packages/libclass-data-accessor-perl/branches/upstream/current/MANIFEST 2005-12-27 09:09:18 UTC (rev 1754)
@@ -0,0 +1,11 @@
+Build.PL
+Changes
+lib/Class/Data/Accessor.pm
+MANIFEST This list of files
+MANIFEST.SKIP
+t/Accessor.t
+t/pod-coverage.t
+t/pod.t
+META.yml
+Makefile.PL
+README
Added: packages/libclass-data-accessor-perl/branches/upstream/current/MANIFEST.SKIP
===================================================================
--- packages/libclass-data-accessor-perl/branches/upstream/current/MANIFEST.SKIP 2005-12-25 18:22:17 UTC (rev 1753)
+++ packages/libclass-data-accessor-perl/branches/upstream/current/MANIFEST.SKIP 2005-12-27 09:09:18 UTC (rev 1754)
@@ -0,0 +1,34 @@
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+,v$
+,B$
+,D$
+\B\.svn\b
+aegis.log$
+\bconfig$
+\bbuild$
+
+# Avoid Makemaker generated and utility files.
+\bMakefile$
+\bblib
+\bMakeMaker-\d
+\bpm_to_blib$
+\bblibdirs$
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build
+
+# Avoid temp and backup files.
+~$
+\.gz$
+\.old$
+\.bak$
+\.swp$
+\.tdy$
+\#$
+\b\.#
+
+# Avoid author test files.
+\bpod-spelling.t$
Added: packages/libclass-data-accessor-perl/branches/upstream/current/META.yml
===================================================================
--- packages/libclass-data-accessor-perl/branches/upstream/current/META.yml 2005-12-25 18:22:17 UTC (rev 1753)
+++ packages/libclass-data-accessor-perl/branches/upstream/current/META.yml 2005-12-27 09:09:18 UTC (rev 1754)
@@ -0,0 +1,13 @@
+---
+name: Class-Data-Accessor
+version: 0.02
+author: ~
+abstract: 'Inheritable, overridable class and instance data accessor creation'
+license: perl
+requires:
+ Carp: 0
+provides:
+ Class::Data::Accessor:
+ file: lib/Class/Data/Accessor.pm
+ version: 0.02
+generated_by: Module::Build version 0.26
Added: packages/libclass-data-accessor-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libclass-data-accessor-perl/branches/upstream/current/Makefile.PL 2005-12-25 18:22:17 UTC (rev 1753)
+++ packages/libclass-data-accessor-perl/branches/upstream/current/Makefile.PL 2005-12-27 09:09:18 UTC (rev 1754)
@@ -0,0 +1,31 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.03
+
+ unless (eval "use Module::Build::Compat 0.02; 1" ) {
+ print "This module requires Module::Build to install itself.\n";
+
+ require ExtUtils::MakeMaker;
+ my $yn = ExtUtils::MakeMaker::prompt
+ (' Install Module::Build now from CPAN?', 'y');
+
+ unless ($yn =~ /^y/i) {
+ die " *** Cannot install without Module::Build. Exiting ...\n";
+ }
+
+ require Cwd;
+ require File::Spec;
+ require CPAN;
+
+ # Save this 'cause CPAN will chdir all over the place.
+ my $cwd = Cwd::cwd();
+ my $makefile = File::Spec->rel2abs($0);
+
+ CPAN::Shell->install('Module::Build::Compat')
+ or die " *** Cannot install without Module::Build. Exiting ...\n";
+
+ chdir $cwd or die "Cannot chdir() back to $cwd: $!";
+ }
+ eval "use Module::Build::Compat 0.02; 1" or die $@;
+ use lib '_build/lib';
+ Module::Build::Compat->run_build_pl(args => \@ARGV);
+ require Module::Build;
+ Module::Build::Compat->write_makefile(build_class => 'Module::Build');
Added: packages/libclass-data-accessor-perl/branches/upstream/current/README
===================================================================
--- packages/libclass-data-accessor-perl/branches/upstream/current/README 2005-12-25 18:22:17 UTC (rev 1753)
+++ packages/libclass-data-accessor-perl/branches/upstream/current/README 2005-12-27 09:09:18 UTC (rev 1754)
@@ -0,0 +1,139 @@
+NAME
+ Class::Data::Accessor - Inheritable, overridable class and instance data
+ accessor creation
+
+SYNOPSIS
+ package Stuff;
+ use base qw(Class::Data::Accessor);
+
+ # Set up DataFile as inheritable class data.
+ Stuff->mk_classaccessor('DataFile');
+
+ # Declare the location of the data file for this class.
+ Stuff->DataFile('/etc/stuff/data');
+
+ # Or, all in one shot:
+ Stuff->mk_classaccessor(DataFile => '/etc/stuff/data');
+
+ Stuff->DataFile; # returns /etc/stuff/data
+
+ my $stuff = Stuff->new; # your new, not ours
+
+ $stuff->DataFile; # returns /etc/stuff/data
+
+ $stuff->DataFile('/etc/morestuff'); # sets it on the object
+
+ Stuff->DataFile; # still returns /etc/stuff/data
+
+DESCRIPTION
+ Class::Data::Accessor is the marriage of Class::Accessor and
+ Class::Data::Inheritable into a single module. It is used for creating
+ accessors to class data that overridable in subclasses as well as in
+ class instances.
+
+ For example:
+
+ Pere::Ubu->mk_classaccessor('Suitcase');
+
+ will generate the method Suitcase() in the class Pere::Ubu.
+
+ This new method can be used to get and set a piece of class data.
+
+ Pere::Ubu->Suitcase('Red');
+ $suitcase = Pere::Ubu->Suitcase;
+
+ Taking this one step further, you can make a subclass that inherits from
+ Pere::Ubu:
+
+ package Raygun;
+ use base qw(Pere::Ubu);
+
+ # Raygun's suitcase is Red.
+ $suitcase = Raygun->Suitcase;
+
+ Raygun inherits its Suitcase class data from Pere::Ubu.
+
+ Inheritance of class data works analogous to method inheritance. As long
+ as Raygun does not "override" its inherited class data (by using
+ Suitcase() to set a new value) it will continue to use whatever is set
+ in Pere::Ubu and inherit further changes:
+
+ # Both Raygun's and Pere::Ubu's suitcases are now Blue
+ Pere::Ubu->Suitcase('Blue');
+
+ However, should Raygun decide to set its own Suitcase() it has now
+ "overridden" Pere::Ubu and is on its own, just like if it had overridden
+ a method:
+
+ # Raygun has an orange suitcase, Pere::Ubu's is still Blue.
+ Raygun->Suitcase('Orange');
+
+ Now that Raygun has overridden Pere::Ubu, further changes by Pere::Ubu
+ no longer effect Raygun.
+
+ # Raygun still has an orange suitcase, but Pere::Ubu is using Samsonite.
+ Pere::Ubu->Suitcase('Samsonite');
+
+ You can also override this class data on a per-object basis. If $obj isa
+ Pere::Ubu then
+
+ $obj->Suitcase; # will return Samsonite
+
+ $obj->Suitcase('Purple'); # will set Suitcase *for this object only*
+
+ And after you've done that,
+
+ $obj->Suitcase; # will return Purple
+
+ but
+
+ Pere::Ubu->Suitcase; # will still return Samsonite
+
+ If you don't want this behaviour use Class::Data::Inheritable instead.
+
+Methods
+ mk_classaccessor
+ Class->mk_classaccessor($data_accessor_name);
+ Class->mk_classaccessor($data_accessor_name => $value);
+
+ This is a class method used to declare new class data accessors. A new
+ accessor will be created in the Class using the name from
+ $data_accessor_name, and optionally initially setting it to the given
+ value.
+
+ To facilitate overriding, mk_classaccessor creates an alias to the
+ accessor, _field_accessor(). So Suitcase() would have an alias
+ _Suitcase_accessor() that does the exact same thing as Suitcase(). This
+ is useful if you want to alter the behavior of a single accessor yet
+ still get the benefits of inheritable class data. For example.
+
+ sub Suitcase {
+ my($self) = shift;
+ warn "Fashion tragedy" if @_ and $_[0] eq 'Plaid';
+
+ $self->_Suitcase_accessor(@_);
+ }
+
+AUTHORS
+ Based on the creative stylings of Damian Conway, Michael G Schwern, Tony
+ Bowden (Class::Data::Inheritable) and Michael G Schwern, Marty Pauley
+ (Class::Accessor).
+
+ Coded by Matt S Trout Tweaks by Christopher H. Laco.
+
+BUGS and QUERIES
+ If your object isn't hash-based, this will currently break. My
+ modifications aren't exactly sophisticated so far.
+
+ mstrout at cpan.org or bug me on irc.perl.org, nick mst claco at cpan.org or
+ irc.perl.org, nick claco
+
+LICENSE
+ This module is free software. It may be used, redistributed and/or
+ modified under the terms of the Perl Artistic License (see
+ http://www.perl.com/perl/misc/Artistic.html)
+
+SEE ALSO
+ perltootc has a very elaborate discussion of class data in Perl.
+ Class::Accessor, Class::Data::Inheritable
+
Added: packages/libclass-data-accessor-perl/branches/upstream/current/lib/Class/Data/Accessor.pm
===================================================================
--- packages/libclass-data-accessor-perl/branches/upstream/current/lib/Class/Data/Accessor.pm 2005-12-25 18:22:17 UTC (rev 1753)
+++ packages/libclass-data-accessor-perl/branches/upstream/current/lib/Class/Data/Accessor.pm 2005-12-27 09:09:18 UTC (rev 1754)
@@ -0,0 +1,188 @@
+package Class::Data::Accessor;
+use strict qw(vars subs);
+use vars qw($VERSION);
+$VERSION = '0.02';
+
+sub mk_classaccessor {
+ my ($declaredclass, $attribute, $data) = @_;
+
+ if( ref $declaredclass ) {
+ require Carp;
+ Carp::croak("mk_classaccessor() is a class method, not an object method");
+ }
+
+ my $accessor = sub {
+ if (ref $_[0]) {
+ return $_[0]->{$attribute} = $_[1] if @_ > 1;
+ return $_[0]->{$attribute} if exists $_[0]->{$attribute};
+ }
+
+ my $wantclass = ref($_[0]) || $_[0];
+
+ return $wantclass->mk_classaccessor($attribute)->(@_)
+ if @_>1 && $wantclass ne $declaredclass;
+
+ $data = $_[1] if @_>1;
+ return $data;
+ };
+
+ no warnings qw/redefine/;
+ my $alias = "_${attribute}_accessor";
+ *{$declaredclass.'::'.$attribute} = $accessor;
+ *{$declaredclass.'::'.$alias} = $accessor;
+}
+
+__END__
+
+=head1 NAME
+
+Class::Data::Accessor - Inheritable, overridable class and instance data accessor creation
+
+=head1 SYNOPSIS
+
+ package Stuff;
+ use base qw(Class::Data::Accessor);
+
+ # Set up DataFile as inheritable class data.
+ Stuff->mk_classaccessor('DataFile');
+
+ # Declare the location of the data file for this class.
+ Stuff->DataFile('/etc/stuff/data');
+
+ # Or, all in one shot:
+ Stuff->mk_classaccessor(DataFile => '/etc/stuff/data');
+
+
+ Stuff->DataFile; # returns /etc/stuff/data
+
+ my $stuff = Stuff->new; # your new, not ours
+
+ $stuff->DataFile; # returns /etc/stuff/data
+
+ $stuff->DataFile('/etc/morestuff'); # sets it on the object
+
+ Stuff->DataFile; # still returns /etc/stuff/data
+
+=head1 DESCRIPTION
+
+Class::Data::Accessor is the marriage of L<Class::Accessor> and
+L<Class::Data::Inheritable> into a single module. It is used for creating
+accessors to class data that overridable in subclasses as well as in
+class instances.
+
+For example:
+
+ Pere::Ubu->mk_classaccessor('Suitcase');
+
+will generate the method Suitcase() in the class Pere::Ubu.
+
+This new method can be used to get and set a piece of class data.
+
+ Pere::Ubu->Suitcase('Red');
+ $suitcase = Pere::Ubu->Suitcase;
+
+Taking this one step further, you can make a subclass that inherits from
+Pere::Ubu:
+
+ package Raygun;
+ use base qw(Pere::Ubu);
+
+ # Raygun's suitcase is Red.
+ $suitcase = Raygun->Suitcase;
+
+Raygun inherits its Suitcase class data from Pere::Ubu.
+
+Inheritance of class data works analogous to method inheritance. As
+long as Raygun does not "override" its inherited class data (by using
+Suitcase() to set a new value) it will continue to use whatever is set
+in Pere::Ubu and inherit further changes:
+
+ # Both Raygun's and Pere::Ubu's suitcases are now Blue
+ Pere::Ubu->Suitcase('Blue');
+
+However, should Raygun decide to set its own Suitcase() it has now
+"overridden" Pere::Ubu and is on its own, just like if it had
+overridden a method:
+
+ # Raygun has an orange suitcase, Pere::Ubu's is still Blue.
+ Raygun->Suitcase('Orange');
+
+Now that Raygun has overridden Pere::Ubu, further changes by Pere::Ubu
+no longer effect Raygun.
+
+ # Raygun still has an orange suitcase, but Pere::Ubu is using Samsonite.
+ Pere::Ubu->Suitcase('Samsonite');
+
+You can also override this class data on a per-object basis.
+If $obj isa Pere::Ubu then
+
+ $obj->Suitcase; # will return Samsonite
+
+ $obj->Suitcase('Purple'); # will set Suitcase *for this object only*
+
+And after you've done that,
+
+ $obj->Suitcase; # will return Purple
+
+but
+
+ Pere::Ubu->Suitcase; # will still return Samsonite
+
+If you don't want this behaviour use L<Class::Data::Inheritable> instead.
+
+=head1 Methods
+
+=head2 mk_classaccessor
+
+ Class->mk_classaccessor($data_accessor_name);
+ Class->mk_classaccessor($data_accessor_name => $value);
+
+This is a class method used to declare new class data accessors.
+A new accessor will be created in the Class using the name from
+$data_accessor_name, and optionally initially setting it to the given
+value.
+
+To facilitate overriding, mk_classaccessor creates an alias to the
+accessor, _field_accessor(). So Suitcase() would have an alias
+_Suitcase_accessor() that does the exact same thing as Suitcase().
+This is useful if you want to alter the behavior of a single accessor
+yet still get the benefits of inheritable class data. For example.
+
+ sub Suitcase {
+ my($self) = shift;
+ warn "Fashion tragedy" if @_ and $_[0] eq 'Plaid';
+
+ $self->_Suitcase_accessor(@_);
+ }
+
+=head1 AUTHORS
+
+Based on the creative stylings of Damian Conway, Michael G Schwern,
+Tony Bowden (Class::Data::Inheritable) and Michael G Schwern, Marty Pauley
+(Class::Accessor).
+
+Coded by Matt S Trout
+Tweaks by Christopher H. Laco.
+
+=head1 BUGS and QUERIES
+
+If your object isn't hash-based, this will currently break. My modifications
+aren't exactly sophisticated so far.
+
+mstrout at cpan.org or bug me on irc.perl.org, nick mst
+claco at cpan.org or irc.perl.org, nick claco
+
+=head1 LICENSE
+
+This module is free software. It may be used, redistributed and/or
+modified under the terms of the Perl Artistic License (see
+http://www.perl.com/perl/misc/Artistic.html)
+
+=head1 SEE ALSO
+
+L<perltootc> has a very elaborate discussion of class data in Perl.
+L<Class::Accessor>, L<Class::Data::Inheritable>
+
+=cut
+
+1;
Added: packages/libclass-data-accessor-perl/branches/upstream/current/t/Accessor.t
===================================================================
--- packages/libclass-data-accessor-perl/branches/upstream/current/t/Accessor.t 2005-12-25 18:22:17 UTC (rev 1753)
+++ packages/libclass-data-accessor-perl/branches/upstream/current/t/Accessor.t 2005-12-27 09:09:18 UTC (rev 1754)
@@ -0,0 +1,51 @@
+use strict;
+use Test::More tests => 17;
+
+package Ray;
+use base qw(Class::Data::Accessor);
+Ray->mk_classaccessor('Ubu');
+Ray->mk_classaccessor(DataFile => '/etc/stuff/data');
+
+package Gun;
+use base qw(Ray);
+Gun->Ubu('Pere');
+
+package Suitcase;
+use base qw(Gun);
+Suitcase->DataFile('/etc/otherstuff/data');
+
+package main;
+
+foreach my $class (qw/Ray Gun Suitcase/) {
+ can_ok $class =>
+ qw/mk_classaccessor Ubu _Ubu_accessor DataFile _DataFile_accessor/;
+}
+
+# Test that superclasses effect children.
+is +Gun->Ubu, 'Pere', 'Ubu in Gun';
+is +Suitcase->Ubu, 'Pere', "Inherited into children";
+is +Ray->Ubu, undef, "But not set in parent";
+
+# Set value with data
+is +Ray->DataFile, '/etc/stuff/data', "Ray datafile";
+is +Gun->DataFile, '/etc/stuff/data', "Inherited into gun";
+is +Suitcase->DataFile, '/etc/otherstuff/data', "Different in suitcase";
+
+# Now set the parent
+ok +Ray->DataFile('/tmp/stuff'), "Set data in parent";
+is +Ray->DataFile, '/tmp/stuff', " - it sticks";
+is +Gun->DataFile, '/tmp/stuff', "filters down to unchanged children";
+is +Suitcase->DataFile, '/etc/otherstuff/data', "but not to changed";
+
+
+my $obj = bless {}, 'Gun';
+eval { $obj->mk_classaccessor('Ubu') };
+ok $@ =~ /^mk_classaccessor\(\) is a class method, not an object method/,
+"Can't create classaccessor for an object";
+
+is $obj->DataFile, "/tmp/stuff", "But objects can access the data";
+
+is $obj->DataFile("/tmp/morestuff"), "/tmp/morestuff",
+ "And they can set their own copy";
+
+is +Gun->DataFile, "/tmp/stuff", "But it doesn't touch the value on the class";
Added: packages/libclass-data-accessor-perl/branches/upstream/current/t/pod-coverage.t
===================================================================
--- packages/libclass-data-accessor-perl/branches/upstream/current/t/pod-coverage.t 2005-12-25 18:22:17 UTC (rev 1753)
+++ packages/libclass-data-accessor-perl/branches/upstream/current/t/pod-coverage.t 2005-12-27 09:09:18 UTC (rev 1754)
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod::Coverage 1.00";
+plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
Added: packages/libclass-data-accessor-perl/branches/upstream/current/t/pod.t
===================================================================
--- packages/libclass-data-accessor-perl/branches/upstream/current/t/pod.t 2005-12-25 18:22:17 UTC (rev 1753)
+++ packages/libclass-data-accessor-perl/branches/upstream/current/t/pod.t 2005-12-27 09:09:18 UTC (rev 1754)
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
More information about the Pkg-perl-cvs-commits
mailing list