Class-Accessor-Lvalue-0.11/0042755000175000017500000000000007767556704015643 5ustar richardcrichardcClass-Accessor-Lvalue-0.11/t/0042755000175000017500000000000007767556704016106 5ustar richardcrichardcClass-Accessor-Lvalue-0.11/t/lval-core.pl0100444000175000017500000000270007767305727020314 0ustar richardcrichardc#!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'); Class-Accessor-Lvalue-0.11/t/lval-fast.t0100444000175000017500000000017007767305727020150 0ustar richardcrichardc#!perl -w $ENV{'CLASS_ACCESSOR_LVALUE_CLASS'} = 'Class::Accessor::Lvalue::Fast'; use lib qw(t); require 'lval-core.pl'; Class-Accessor-Lvalue-0.11/t/lval.t0100444000175000017500000000016207767305726017215 0ustar richardcrichardc#!perl -w $ENV{'CLASS_ACCESSOR_LVALUE_CLASS'} = 'Class::Accessor::Lvalue'; use lib qw(t); require 'lval-core.pl'; Class-Accessor-Lvalue-0.11/lib/0042755000175000017500000000000007767556704016411 5ustar richardcrichardcClass-Accessor-Lvalue-0.11/lib/Class/0042755000175000017500000000000007767556704017456 5ustar richardcrichardcClass-Accessor-Lvalue-0.11/lib/Class/Accessor/0042755000175000017500000000000007767556704021220 5ustar richardcrichardcClass-Accessor-Lvalue-0.11/lib/Class/Accessor/Lvalue.pm0100444000175000017500000000531707767556522023003 0ustar richardcrichardcuse 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 in order to provide lvalue accessor makers. =head1 CAVEATS =over =item Though L 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 which is simpler and much faster. =back =head1 AUTHOR Richard Clamp 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, L =cut Class-Accessor-Lvalue-0.11/lib/Class/Accessor/Lvalue/0042755000175000017500000000000007767556704022450 5ustar richardcrichardcClass-Accessor-Lvalue-0.11/lib/Class/Accessor/Lvalue/Fast.pm0100444000175000017500000000320507767305727023671 0ustar richardcrichardcuse 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 in order to provide lvalue accessors. =head1 AUTHOR Richard Clamp =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, L =cut Class-Accessor-Lvalue-0.11/NINJA0100444000175000017500000000020707767556635016420 0ustar richardcrichardc--- #YAML:1.0 attributes: charisma: 0.13 constitution: 0.47 dexterity: 0.47 intelligence: 0.93 strength: 0.67 wisdom: 0.07 Class-Accessor-Lvalue-0.11/META.yml0100444000175000017500000000076407767556704017114 0ustar richardcrichardc--- #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 Class-Accessor-Lvalue-0.11/Changes0100444000175000017500000000036507767556572017136 0ustar richardcrichardc0.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 Class-Accessor-Lvalue-0.11/MANIFEST0100444000175000017500000000024107767556444016763 0ustar richardcrichardcBuild.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 Class-Accessor-Lvalue-0.11/Build.PL0100444000175000017500000000060707766325200017113 0ustar richardcrichardcuse 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; Class-Accessor-Lvalue-0.11/Makefile.PL0100444000175000017500000000050307767556704017604 0ustar richardcrichardc# 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', }, ); Class-Accessor-Lvalue-0.11/README0100444000175000017500000000233307767556657016524 0ustar richardcrichardcREADME 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 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, L