r10904 - in /branches/upstream/libclass-accessor-lvalue-perl: ./ current/ current/lib/ current/lib/Class/ current/lib/Class/Accessor/ current/lib/Class/Accessor/Lvalue/ current/t/
ghostbar-guest at users.alioth.debian.org
ghostbar-guest at users.alioth.debian.org
Thu Dec 6 19:29:49 UTC 2007
Author: ghostbar-guest
Date: Thu Dec 6 19:29:49 2007
New Revision: 10904
URL: http://svn.debian.org/wsvn/?sc=1&rev=10904
Log:
[svn-inject] Installing original source of libclass-accessor-lvalue-perl
Added:
branches/upstream/libclass-accessor-lvalue-perl/
branches/upstream/libclass-accessor-lvalue-perl/current/
branches/upstream/libclass-accessor-lvalue-perl/current/Build.PL
branches/upstream/libclass-accessor-lvalue-perl/current/Changes
branches/upstream/libclass-accessor-lvalue-perl/current/MANIFEST
branches/upstream/libclass-accessor-lvalue-perl/current/META.yml
branches/upstream/libclass-accessor-lvalue-perl/current/Makefile.PL
branches/upstream/libclass-accessor-lvalue-perl/current/NINJA
branches/upstream/libclass-accessor-lvalue-perl/current/README
branches/upstream/libclass-accessor-lvalue-perl/current/lib/
branches/upstream/libclass-accessor-lvalue-perl/current/lib/Class/
branches/upstream/libclass-accessor-lvalue-perl/current/lib/Class/Accessor/
branches/upstream/libclass-accessor-lvalue-perl/current/lib/Class/Accessor/Lvalue/
branches/upstream/libclass-accessor-lvalue-perl/current/lib/Class/Accessor/Lvalue.pm
branches/upstream/libclass-accessor-lvalue-perl/current/lib/Class/Accessor/Lvalue/Fast.pm
branches/upstream/libclass-accessor-lvalue-perl/current/t/
branches/upstream/libclass-accessor-lvalue-perl/current/t/lval-core.pl
branches/upstream/libclass-accessor-lvalue-perl/current/t/lval-fast.t
branches/upstream/libclass-accessor-lvalue-perl/current/t/lval.t
Added: branches/upstream/libclass-accessor-lvalue-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-accessor-lvalue-perl/current/Build.PL?rev=10904&op=file
==============================================================================
--- branches/upstream/libclass-accessor-lvalue-perl/current/Build.PL (added)
+++ branches/upstream/libclass-accessor-lvalue-perl/current/Build.PL Thu Dec 6 19:29:49 2007
@@ -1,0 +1,16 @@
+use strict;
+use Module::Build;
+
+Module::Build
+ ->new( module_name => "Class::Accessor::Lvalue",
+ license => 'perl',
+ build_requires => {
+ 'Test::More' => 0,
+ },
+ requires => {
+ 'Want' => 0,
+ 'Class::Accessor' => 0,
+ },
+ create_makefile_pl => 'traditional',
+ )
+ ->create_build_script;
Added: branches/upstream/libclass-accessor-lvalue-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-accessor-lvalue-perl/current/Changes?rev=10904&op=file
==============================================================================
--- branches/upstream/libclass-accessor-lvalue-perl/current/Changes (added)
+++ branches/upstream/libclass-accessor-lvalue-perl/current/Changes Thu Dec 6 19:29:49 2007
@@ -1,0 +1,10 @@
+0.11 Tuesday 16th December, 2003
+ Fix MANIFEST
+ add NINJA support.
+
+0.10 Monday, 15th December, 2003
+ Implement proper proxy ties so that the main class correctly emulates
+ Class::Accessor
+
+0.01 Friday, 12th December, 2003
+ Initial CPAN release
Added: branches/upstream/libclass-accessor-lvalue-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-accessor-lvalue-perl/current/MANIFEST?rev=10904&op=file
==============================================================================
--- branches/upstream/libclass-accessor-lvalue-perl/current/MANIFEST (added)
+++ branches/upstream/libclass-accessor-lvalue-perl/current/MANIFEST Thu Dec 6 19:29:49 2007
@@ -1,0 +1,12 @@
+Build.PL
+Changes
+MANIFEST
+Makefile.PL
+README
+META.yml
+NINJA
+lib/Class/Accessor/Lvalue.pm
+lib/Class/Accessor/Lvalue/Fast.pm
+t/lval.t
+t/lval-fast.t
+t/lval-core.pl
Added: branches/upstream/libclass-accessor-lvalue-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-accessor-lvalue-perl/current/META.yml?rev=10904&op=file
==============================================================================
--- branches/upstream/libclass-accessor-lvalue-perl/current/META.yml (added)
+++ branches/upstream/libclass-accessor-lvalue-perl/current/META.yml Thu Dec 6 19:29:49 2007
@@ -1,0 +1,22 @@
+--- #YAML:1.0
+name: Class-Accessor-Lvalue
+version: 0.11
+license: perl
+distribution_type: module
+requires:
+ Class::Accessor: 0
+ Want: 0
+recommends: {}
+build_requires:
+ Test::More: 0
+conflicts: {}
+provides:
+ Class::Accessor::Lvalue:
+ file: lib/Class/Accessor/Lvalue.pm
+ version: 0.11
+ Class::Accessor::Lvalue::Fast:
+ file: lib/Class/Accessor/Lvalue/Fast.pm
+ Class::Accessor::Lvalue::Tied:
+ file: lib/Class/Accessor/Lvalue.pm
+ version: 0.11
+generated_by: Module::Build version 0.21
Added: branches/upstream/libclass-accessor-lvalue-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-accessor-lvalue-perl/current/Makefile.PL?rev=10904&op=file
==============================================================================
--- branches/upstream/libclass-accessor-lvalue-perl/current/Makefile.PL (added)
+++ branches/upstream/libclass-accessor-lvalue-perl/current/Makefile.PL Thu Dec 6 19:29:49 2007
@@ -1,0 +1,15 @@
+# Generated by Module::Build::Compat->create_makefile_pl
+
+use ExtUtils::MakeMaker;
+WriteMakefile
+ (
+ NAME => 'Class::Accessor::Lvalue',
+ VERSION => '0.11',
+ PL_FILES => {},
+ INSTALLDIRS => 'site',
+ PREREQ_PM => {
+ 'Test::More' => '0',
+ 'Want' => '0',
+ 'Class::Accessor' => '0',
+ },
+ );
Added: branches/upstream/libclass-accessor-lvalue-perl/current/NINJA
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-accessor-lvalue-perl/current/NINJA?rev=10904&op=file
==============================================================================
--- branches/upstream/libclass-accessor-lvalue-perl/current/NINJA (added)
+++ branches/upstream/libclass-accessor-lvalue-perl/current/NINJA Thu Dec 6 19:29:49 2007
@@ -1,0 +1,8 @@
+--- #YAML:1.0
+attributes:
+ charisma: 0.13
+ constitution: 0.47
+ dexterity: 0.47
+ intelligence: 0.93
+ strength: 0.67
+ wisdom: 0.07
Added: branches/upstream/libclass-accessor-lvalue-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-accessor-lvalue-perl/current/README?rev=10904&op=file
==============================================================================
--- branches/upstream/libclass-accessor-lvalue-perl/current/README (added)
+++ branches/upstream/libclass-accessor-lvalue-perl/current/README Thu Dec 6 19:29:49 2007
@@ -1,0 +1,73 @@
+README for Class::Accessor::Lvalue 0.11
+
+=head1 NAME
+
+Class::Accessor::Lvalue - create Lvalue accessors
+
+=head1 SYNOPSIS
+
+ package Foo;
+ use base qw( Class::Accessor::Lvalue );
+ __PACKAGE__->mk_accessors(qw( bar ))
+
+ my $foo = Foo->new;
+ $foo->bar = 42;
+ print $foo->bar; # prints 42
+
+
+=head1 DEPENDENCIES
+
+This module has external dependencies on the following modules:
+
+ Class::Accessor
+ Want
+
+=head1 INSTALLATION
+
+ perl Build.PL
+ perl Build test
+
+and if all goes well
+
+ perl Build install
+
+=head1 HISTORY
+
+What changed over the last 3 revisions
+
+=over
+
+=item 0.11 Tuesday 16th December, 2003
+
+ Fix MANIFEST
+ add NINJA support.
+
+
+=item 0.10 Monday, 15th December, 2003
+
+ Implement proper proxy ties so that the main class correctly emulates
+ Class::Accessor
+
+
+=item 0.01 Friday, 12th December, 2003
+
+ Initial CPAN release
+=back
+
+=head1 AUTHOR
+
+Richard Clamp <richardc at unixbeard.net> with many thanks to Yuval
+Kogman for helping with the groovy lvalue tie magic used in the main
+class.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2003 Richard Clamp. All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<Class::Accessor>, L<Class::Accessor::Lvalue::Fast>
+
Added: branches/upstream/libclass-accessor-lvalue-perl/current/lib/Class/Accessor/Lvalue.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-accessor-lvalue-perl/current/lib/Class/Accessor/Lvalue.pm?rev=10904&op=file
==============================================================================
--- branches/upstream/libclass-accessor-lvalue-perl/current/lib/Class/Accessor/Lvalue.pm (added)
+++ branches/upstream/libclass-accessor-lvalue-perl/current/lib/Class/Accessor/Lvalue.pm Thu Dec 6 19:29:49 2007
@@ -1,0 +1,121 @@
+use strict;
+package Class::Accessor::Lvalue;
+use base qw( Class::Accessor );
+use Scalar::Util qw(weaken);
+use Want qw( want );
+our $VERSION = '0.11';
+
+sub make_accessor {
+ my ($class, $field) = @_;
+
+ return sub :lvalue {
+ tie my $tie, "Class::Accessor::Lvalue::Tied" => $field, @_;
+ $tie;
+ };
+}
+
+sub make_ro_accessor {
+ my ($class, $field) = @_;
+
+ return sub :lvalue {
+ if (want 'LVALUE') {
+ my $caller = caller;
+ require Carp;
+ Carp::croak("'$caller' cannot alter the value of '$field' on ".
+ "objects of class '$class'");
+ }
+ tie my $tie, "Class::Accessor::Lvalue::Tied" => $field, @_;
+ $tie;
+ };
+}
+
+sub make_wo_accessor {
+ my($class, $field) = @_;
+
+ return sub :lvalue {
+ unless (want 'LVALUE') {
+ my $caller = caller;
+ require Carp;
+ Carp::croak("'$caller' cannot access the value of '$field' on ".
+ "objects of class '$class'");
+ }
+ tie my $tie, "Class::Accessor::Lvalue::Tied" => $field, @_;
+ $tie;
+ };
+}
+
+
+package Class::Accessor::Lvalue::Tied;
+sub TIESCALAR { shift; bless [@_] }
+
+sub STORE {
+ my ($field, $self) = @{ shift() };
+ $self->set( $field, @_ );
+}
+
+sub FETCH {
+ my ($field, $self) = @{ shift() };
+ $self->get( $field );
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Class::Accessor::Lvalue - create Lvalue accessors
+
+=head1 SYNOPSIS
+
+ package Foo;
+ use base qw( Class::Accessor::Lvalue );
+ __PACKAGE__->mk_accessors(qw( bar ))
+
+ my $foo = Foo->new;
+ $foo->bar = 42;
+ print $foo->bar; # prints 42
+
+=head1 DESCRIPTION
+
+This module subclasses L<Class::Accessor> in order to provide lvalue
+accessor makers.
+
+=head1 CAVEATS
+
+=over
+
+=item
+
+Though L<Class::Accessor> mutators allows for the setting of multiple
+values to an attribute, the mutators that this module creates handle
+single scalar values only. This should not be too much of a
+hinderance as you can still explictly use an anonymous array.
+
+=item
+
+Due to the hoops we have to jump through to preserve the
+Class::Accessor ->get and ->set behaviour this module is potentially
+slow. Should you not need the flexibility granted by the ->get and
+->set methods, it's highly reccomended that you use
+L<Class::Accessor::Lvalue::Fast> which is simpler and much faster.
+
+=back
+
+=head1 AUTHOR
+
+Richard Clamp <richardc at unixbeard.net> with many thanks to Yuval
+Kogman for helping with the groovy lvalue tie magic used in the main
+class.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2003 Richard Clamp. All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<Class::Accessor>, L<Class::Accessor::Lvalue::Fast>
+
+=cut
Added: branches/upstream/libclass-accessor-lvalue-perl/current/lib/Class/Accessor/Lvalue/Fast.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-accessor-lvalue-perl/current/lib/Class/Accessor/Lvalue/Fast.pm?rev=10904&op=file
==============================================================================
--- branches/upstream/libclass-accessor-lvalue-perl/current/lib/Class/Accessor/Lvalue/Fast.pm (added)
+++ branches/upstream/libclass-accessor-lvalue-perl/current/lib/Class/Accessor/Lvalue/Fast.pm Thu Dec 6 19:29:49 2007
@@ -1,0 +1,83 @@
+use strict;
+package Class::Accessor::Lvalue::Fast;
+use base qw(Class::Accessor::Fast);
+use Want;
+
+sub make_accessor {
+ my ($class, $field) = @_;
+
+ return sub :lvalue {
+ my $self = shift;
+ $self->{$field};
+ };
+}
+
+sub make_ro_accessor {
+ my($class, $field) = @_;
+
+ return sub :lvalue {
+ my $self = shift;
+ if (want 'LVALUE') {
+ my $caller = caller;
+ require Carp;
+ Carp::croak("'$caller' cannot alter the value of '$field' on ".
+ "objects of class '$class'");
+ }
+ return $self->{$field};
+ };
+}
+
+sub make_wo_accessor {
+ my($class, $field) = @_;
+
+ return sub :lvalue {
+ my $self = shift;
+ unless (want 'LVALUE') {
+ my $caller = caller;
+ require Carp;
+ Carp::croak("'$caller' cannot access the value of '$field' on ".
+ "objects of class '$class'");
+ }
+ $self->{$field};
+ };
+}
+
+1;
+__END__
+
+
+=head1 NAME
+
+Class::Accessor::Lvalue::Fast - create simplified Lvalue accessors
+
+=head1 SYNOPSIS
+
+ package Foo;
+ use base qw( Class::Accessor::Lvalue::Fast );
+ __PACKAGE__->mk_accessors(qw( bar ))
+
+ my $foo = Foo->new;
+ $foo->bar = 42;
+ print $foo->bar; # prints 42
+
+
+=head1 DESCRIPTION
+
+This module subclassess L<Class::Accessor::Fast> in order to provide
+lvalue accessors.
+
+=head1 AUTHOR
+
+Richard Clamp <richardc at unixbeard.net>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2003 Richard Clamp. All Rights Reserved.
+This module is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<Class::Accessor::Fast>, L<Want>
+
+=cut
Added: branches/upstream/libclass-accessor-lvalue-perl/current/t/lval-core.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-accessor-lvalue-perl/current/t/lval-core.pl?rev=10904&op=file
==============================================================================
--- branches/upstream/libclass-accessor-lvalue-perl/current/t/lval-core.pl (added)
+++ branches/upstream/libclass-accessor-lvalue-perl/current/t/lval-core.pl Thu Dec 6 19:29:49 2007
@@ -1,0 +1,54 @@
+#!perl -w
+use strict;
+use Test::More tests => 12;
+my $class;
+
+BEGIN {
+ $class = $ENV{'CLASS_ACCESSOR_LVALUE_CLASS'};
+ require_ok( $class );
+}
+
+package Foo;
+use base $class;
+__PACKAGE__->mk_accessors(qw( foo bar ));
+__PACKAGE__->mk_ro_accessors(qw( baz ));
+__PACKAGE__->mk_wo_accessors(qw( quux ));
+package main;
+
+my $foo = Foo->new;
+
+isa_ok( $foo, 'Foo' );
+eval { $foo->bar = "test" };
+is( $@, '', "assigned without errors" );
+is( $foo->bar, "test", "got what I expected back" );
+
+eval { $foo->baz = "test" };
+like( $@, qr/^'main' cannot alter the value of 'baz' on objects of class 'Foo'/,
+ "assigning to a readonly accessor fails" );
+
+eval { $foo->quux = "test" };
+is( $@, "", "wo: assign to an lvalue" );
+is( $foo->{quux}, "test", "wo: really set it" );
+
+eval { $foo->quux };
+like( $@, qr/^'main' cannot access the value of 'quux' on objects of class 'Foo'/,
+ "wo: read fails" );
+
+# The ->foo = ->bar might have failed, handily though, the order of
+# evalution is
+# LVAL(bar) FETCH LVAL(bar) STORE
+# otherwise our speed cheat of reusing the same tie would fall over
+
+$foo->foo = 'foo';
+$foo->bar = 'bar';
+$foo->foo = $foo->bar;
+is( $foo->foo, 'bar', "accessor = accessor" );
+is( $foo->bar, 'bar' );
+
+
+# for C<$foo->foo = $foo->bar = 'constant';> it does fall over,
+# the order of evaluation is probably
+# LVAL(bar) LVAL(foo) STORE STORE
+$foo->foo = $foo->bar = 'chain';
+is( $foo->foo, 'chain', "accessor = accessor = val" );
+is( $foo->bar, 'chain');
Added: branches/upstream/libclass-accessor-lvalue-perl/current/t/lval-fast.t
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-accessor-lvalue-perl/current/t/lval-fast.t?rev=10904&op=file
==============================================================================
--- branches/upstream/libclass-accessor-lvalue-perl/current/t/lval-fast.t (added)
+++ branches/upstream/libclass-accessor-lvalue-perl/current/t/lval-fast.t Thu Dec 6 19:29:49 2007
@@ -1,0 +1,4 @@
+#!perl -w
+$ENV{'CLASS_ACCESSOR_LVALUE_CLASS'} = 'Class::Accessor::Lvalue::Fast';
+use lib qw(t);
+require 'lval-core.pl';
Added: branches/upstream/libclass-accessor-lvalue-perl/current/t/lval.t
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-accessor-lvalue-perl/current/t/lval.t?rev=10904&op=file
==============================================================================
--- branches/upstream/libclass-accessor-lvalue-perl/current/t/lval.t (added)
+++ branches/upstream/libclass-accessor-lvalue-perl/current/t/lval.t Thu Dec 6 19:29:49 2007
@@ -1,0 +1,4 @@
+#!perl -w
+$ENV{'CLASS_ACCESSOR_LVALUE_CLASS'} = 'Class::Accessor::Lvalue';
+use lib qw(t);
+require 'lval-core.pl';
More information about the Pkg-perl-cvs-commits
mailing list