pax_global_header00006660000000000000000000000064116361507750014525gustar00rootroot0000000000000052 comment=765f60fb7e44ed20432c9a7a1faf7a09afcb2507 libtie-simple-perl-1.03/000077500000000000000000000000001163615077500151475ustar00rootroot00000000000000libtie-simple-perl-1.03/Changes000066400000000000000000000006301163615077500164410ustar00rootroot000000000000002006-01-09 Andrew Sterling Hanenkamp * Fixed a typo in Tie::Simple::Hash. 2004-06-04 Andrew Sterling Hanenkamp * Fixed a compile bug that I somehow let into the 1.01 distro. 2004-06-02 Andrew Sterling Hanenkamp * Initial release with basic scalar, array, hash, and handle simplified tie functionality. libtie-simple-perl-1.03/MANIFEST000066400000000000000000000003651163615077500163040ustar00rootroot00000000000000Changes Makefile.PL MANIFEST README Simple/Array.pm Simple/Handle.pm Simple/Hash.pm Simple/Scalar.pm Simple/Util.pm Simple.pm t/array.t t/handle.t t/hash.t t/scalar.t META.yml Module meta-data (added by MakeMaker) libtie-simple-perl-1.03/META.yml000066400000000000000000000004501163615077500164170ustar00rootroot00000000000000# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Tie-Simple version: 1.03 version_from: Simple.pm installdirs: site requires: distribution_type: module generated_by: ExtUtils::MakeMaker version 6.21 libtie-simple-perl-1.03/Makefile.PL000066400000000000000000000002741163615077500171240ustar00rootroot00000000000000use strict; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Tie::Simple', VERSION_FROM => 'Simple.pm', AUTHOR => 'Andrew Sterling Hanenkamp ', ); libtie-simple-perl-1.03/README000066400000000000000000000023611163615077500160310ustar00rootroot00000000000000Tie::Simple ============= Andrew Sterling Hanenkamp, This is a cousin of my Tie::Filter module. Tie::Simple basically dumbs down the implementation of simple ties so that a full-blown package need not be created for the very simple stuff that should be tied. In fact, Tie::Filter could be reimplemented using Tie::Simple--it won't, but it could. The implementation is a little nasty, but it works (I think...). Anyway, if you need some quick tied variables, this can be the way to go. All the ties "implement" the Tie::Scalar, Tie::Array, Tie::Hash, or Tie::Handle classes depending on the tie type to make things just a little easier. The way this has been done isn't precisely intuitive, but I was too lazy to do it better. If someone wants to modify the code and improve it, please do and send me some patches. INSTALLATION Follow the typical Perl custom: perl Makefile.PL make make test make install I use PerlIO for the handle tie tests, so 5.8.0 or better is required for the all tests to succeed, but the classes themselves will probably work with 5.6. COPYRIGHT AND LICENSE Copyright 2004 Andrew Sterling hanenkamp. All Rights Reserved. This library is made available under the same terms as Perl itself. libtie-simple-perl-1.03/Simple.pm000066400000000000000000000134761163615077500167510ustar00rootroot00000000000000package Tie::Simple; use strict; use warnings; our $VERSION = '1.03'; use Tie::Simple::Scalar; use Tie::Simple::Array; use Tie::Simple::Hash; use Tie::Simple::Handle; =head1 NAME Tie::Simple - Variable ties made easier: much, much, much easier... =head1 SYNOPSIS use Tie::Simple; tie $scalar, 'Tie::Simple', $data, FETCH => sub { ... }, STORE => sub { ... }; tie @array, 'Tie::Simple', $data, FETCH => sub { ... }, STORE => sub { ... }, FETCHSIZE => sub { ... }, STORESIZE => sub { ... }, EXTEND => sub { ... }, EXISTS => sub { ... }, DELETE => sub { ... }, CLEAR => sub { ... }, PUSH => sub { ... }, POP => sub { ... }, SHIFT => sub { ... }, UNSHIFT => sub { ... }, SPLICE => sub { ... }; tie %hash, 'Tie::Simple', $data, FETCH => sub { ... }, STORE => sub { ... }, DELETE => sub { ... }, CLEAR => sub { ... }, EXISTS => sub { ... }, FIRSTKEY => sub { ... }, NEXTKEY => sub { ... }; tie *HANDLE, 'Tie::Simple', $data, WRITE => sub { ... }, PRINT => sub { ... }, PRINTF => sub { ... }, READ => sub { ... }, READLINE => sub { ... }, GETC => sub { ... }, CLOSE => sub { ... }; =head1 DESCRIPTION This module adds the ability to quickly create new types of tie objects without creating a complete class. It does so in such a way as to try and make the programmers life easier when it comes to single-use ties that I find myself wanting to use from time-to-time. The C package is actually a front-end to other classes which really do all the work once tied, but this package does the dwimming to automatically figure out what you're trying to do. I've tried to make this as intuitive as possible and dependent on other bits of Perl where I can to minimize the need for documentation and to make this extra, extra spiffy. =head1 SIMPLE TYING To setup your quick tie, simply start with the typical tie statement on the variable you're tying. You should always tie to the C package and not directly to the other packages included with this module as those are only present as helpers (even though they are really the tie classes). The type of tie depends upon the type of the first argument given to tie. This should be rather obvious from the L above. Therefore, the arguments are: =over =item 1. The variable to be tied. =item 2. The string C<'Tie::Simple'>. =item 3. A scalar value (hereafter called the "local data"). =item 4. A list of name/CODE pairs. =back At this point, you'll need to have some understanding of tying before you can continue. I suggest looking through L. As you will note in the L documentation, every tie package defines functions whose first argument is called C. The third argument, local data, will take the place of C in all the subroutine calls you define in the name/CODE pair list. Each name should be the name of the function that would be defined for the appropriate tie-type if you were to do a full-blown package definition. The subroutine matched to that name will take the exact arguments specified in the L documentation, but instead of C it will be given the local data scalar value you set (which could even be C if you don't need it). =head1 TIES CAN BE SIMPLER STILL The synopsis above shows the typical subroutines you could define. (I left out the C and C methods, but you may define these if you need them, but be sure to read the L documentation on possible caveats.) However, the L is way more complete then you probably need to be in most cases. This is because C does it's best to make use of some of the handy Perl built-ins which help with creating tie packages. =head2 SCALARS If you are creating a scalar tie, then you can assume all the benefits of being a L. =head2 ARRAYS If you are creating an array tie, then you may assume all the benefits of being a L. =head2 HASHES If you are creating a hash tie, then you may assume all the benefits of being a L. =head2 HANDLES If you are creating a handle tie, then you may assume all the benefits of being a L. =cut sub TIESCALAR { my ($class, $data, %subs) = @_; die "Eat dirt and die! Use Tie::Simple and read the docs, you turkey!" unless $class eq 'Tie::Simple'; bless { data => $data, subs => \%subs }, 'Tie::Simple::Scalar'; } sub TIEARRAY { my ($class, $data, %subs) = @_; die "Eat dirt and die! Use Tie::Simple and read the docs, you turkey!" unless $class eq 'Tie::Simple'; bless { data => $data, subs => \%subs }, 'Tie::Simple::Array'; } sub TIEHASH { my ($class, $data, %subs) = @_; die "Eat dirt and die! Use Tie::Simple and read the docs, you turkey!" unless $class eq 'Tie::Simple'; bless { data => $data, subs => \%subs }, 'Tie::Simple::Hash'; } sub TIEHANDLE { my ($class, $data, %subs) = @_; die "Eat dirt and die! Use Tie::Simple and read the docs, you turkey!" unless $class eq 'Tie::Simple'; bless { data => $data, subs => \%subs }, 'Tie::Simple::Handle'; } =head1 TO DO It sure would be nice if you could declare custom C<@ISA> lists, wouldn't it? I'd like to add such a feature, but coming up with some custom C dispatch code or generating new "anonymous" packages are the only ways I can think to do it. I don't really have time to add such a feature just now. =head1 SEE ALSO L, L, L, L, L =head1 AUTHOR Andrew Sterling Hanenkamp, Ehanenkamp@users.sourceforge.netE =head1 COPYRIGHT AND LICENSE Copyright 2004 Andrew Sterling Hanenkamp. All Rights Reserved. This library is made available under the same terms as Perl itself. =cut 1 libtie-simple-perl-1.03/Simple/000077500000000000000000000000001163615077500164005ustar00rootroot00000000000000libtie-simple-perl-1.03/Simple/Array.pm000066400000000000000000000017411163615077500200170ustar00rootroot00000000000000package Tie::Simple::Array; use strict; use warnings; our $VERSION = '1.01'; use base qw(Tie::Array Tie::Simple); # Copyright 2004 Andrew Sterling Hanenkamp. All Rights Reserved. This software # is made available under the same terms as Perl itself. sub _doit { my $self = shift; Tie::Simple::Util::_doit($self, 'Tie::Array', @_); } sub FETCH { shift->_doit('FETCH', @_) } sub STORE { shift->_doit('STORE', @_) } sub FETCHSIZE { shift->_doit('FETCHSIZE') } sub STORESIZE { shift->_doit('STORESIZE', @_) } sub EXTEND { shift->_doit('EXTEND', @_) } sub EXISTS { shift->_doit('EXISTS', @_) } sub DELETE { shift->_doit('DELETE', @_) } sub CLEAR { shift->_doit('CLEAR') } sub PUSH { shift->_doit('PUSH', @_) } sub POP { shift->_doit('POP') } sub SHIFT { shift->_doit('SHIFT') } sub UNSHIFT { shift->_doit('UNSHIFT', @_) } sub SPLICE { shift->_doit('SPLICE', @_) } sub UNTIE { shift->_doit('UNTIE') } sub DESTROY { shift->_doit('DESTROY') } 1 libtie-simple-perl-1.03/Simple/Handle.pm000066400000000000000000000012671163615077500201370ustar00rootroot00000000000000package Tie::Simple::Handle; use strict; use warnings; our $VERSION = '1.01'; use base qw(Tie::Handle Tie::Simple); # Copyright 2004 Andrew Sterling Hanenkamp. All Rights Reserved. This software # is made available under the same terms as Perl itself. sub _doit { my $self = shift; Tie::Simple::Util::_doit($self, 'Tie::Handle', @_); } sub WRITE { shift->_doit('WRITE', @_) } sub PRINT { shift->_doit('PRINT', @_) } sub PRINTF { shift->_doit('PRINTF', @_) } sub READ { shift->_doit('READ', @_) } sub READLINE { shift->_doit('READLINE') } sub GETC { shift->_doit('GETC') } sub CLOSE { shift->_doit('CLOSE') } sub UNTIE { shift->_doit('UNTIE') } sub DESTORY { shift->_doit('DESTORY') } 1 libtie-simple-perl-1.03/Simple/Hash.pm000066400000000000000000000012771163615077500176300ustar00rootroot00000000000000package Tie::Simple::Hash; use strict; use warnings; our $VERSION = '1.03'; use base qw(Tie::Hash Tie::Simple); # Copyright 2004 Andrew Sterling Hanenkamp. All Rights Reserved. This software # is made available under the same terms as Perl itself. sub _doit { my $self = shift; Tie::Simple::Util::_doit($self, 'Tie::Hash', @_); } sub FETCH { shift->_doit('FETCH', @_) } sub STORE { shift->_doit('STORE', @_) } sub DELETE { shift->_doit('DELETE', @_) } sub CLEAR { shift->_doit('CLEAR') } sub EXISTS { shift->_doit('EXISTS', @_) } sub FIRSTKEY { shift->_doit('FIRSTKEY') } sub NEXTKEY { shift->_doit('NEXTKEY', @_) } sub UNTIE { shift->_doit('UNTIE') } sub DESTROY { shift->_doit('DESTROY') } 1 libtie-simple-perl-1.03/Simple/Scalar.pm000066400000000000000000000010121163615077500201350ustar00rootroot00000000000000package Tie::Simple::Scalar; use strict; use warnings; our $VESRION = '1.01'; use base qw(Tie::Scalar Tie::Simple); use Tie::Simple::Util; # Copyright 2004 Andrew Sterling Hanenkamp. All Rights Reserved. This software # is made available under the same terms as Perl itself. sub _doit { my $self = shift; Tie::Simple::Util::_doit($self, 'Tie::Scalar', @_); } sub FETCH { shift->_doit('FETCH') } sub STORE { shift->_doit('STORE', @_) } sub UNTIE { shift->_doit('UNTIE') } sub DESTROY { shift->_doit('DESTROY') } 1 libtie-simple-perl-1.03/Simple/Util.pm000066400000000000000000000007531163615077500176600ustar00rootroot00000000000000package Tie::Simple::Util; use strict; use warnings; our $VERSION = '1.01'; # Copyright 2004 Andrew Sterling Hanenkamp. All Rights Reserved. This software # is made available under the same terms as Perl itself. sub _doit { my $self = shift; my $parent = shift; my $method = shift; if (defined $$self{subs}{$method}) { $$self{subs}{$method}->($$self{data}, @_); } elsif ($parent->can($method)) { no strict 'refs'; my $sub = "$parent\::$method"; &{$sub}($self, @_); } } 1 libtie-simple-perl-1.03/t/000077500000000000000000000000001163615077500154125ustar00rootroot00000000000000libtie-simple-perl-1.03/t/array.t000066400000000000000000000030501163615077500167130ustar00rootroot00000000000000# vim: set ft=perl : use strict; use Test::More tests => 16; use Tie::Simple; my @y = qw(A B C); my $c = 3; tie my @x, 'Tie::Simple', [ \@y, \$c ], FETCH => sub { my ($a, $i) = @_; $$a[0][$i] }, STORE => sub { my ($a, $i, $v) = @_; $$a[0][$i] = $v }, FETCHSIZE => sub { my $a = shift; scalar @{$$a[0]} }, STORESIZE => sub { my ($a, $c) = @_; $#{$$a[0]} = $c - 1 }, EXTEND => sub { my ($a, $c) = @_; ${$$a[1]} = $c }, EXISTS => sub { my ($a, $i) = @_; exists $$a[0][$i] }, DELETE => sub { my ($a, $i) = @_; delete $$a[0][$i] }, CLEAR => sub { my $a = shift; @{$$a[0]} = () }, PUSH => sub { my $a = shift; push @{$$a[0]}, @_ }, POP => sub { my $a = shift; pop @{$$a[0]} }, SHIFT => sub { my $a = shift; shift @{$$a[0]} }, UNSHIFT => sub { my $a = shift; unshift @{$$a[0]}, @_ }, SPLICE => sub { my ($a, $o, $c, @l) = @_; splice @{$$a[0]}, $o, $c, @l }; is_deeply(\@x, [ qw(A B C) ], 'FETCH'); ($x[0], $x[1], $x[2]) = qw(X Y Z); is_deeply(\@y, [ qw(X Y Z) ], 'STORE'); is(@x, 3, 'FETCHSIZE'); $#x = 4; is(scalar @y, 5, 'STORESIZE'); ok(exists $x[$_], "EXISTS $_") foreach (0 .. 2); ok(!exists $x[3], "EXISTS 3"); delete $x[0]; ok(!defined $y[0], 'DELETE'); @x = (); is($c, 0, 'EXTEND'); is(scalar @y, 0, 'CLEAR'); push @x, 'M', 'N', 'O', 'P'; is_deeply(\@y, [ qw(M N O P) ], 'PUSH'); pop @x; is_deeply(\@y, [ qw(M N O) ], 'POP'); shift @x; is_deeply(\@y, [ qw(N O) ], 'SHIFT'); unshift @x, qw(Q R S); is_deeply(\@y, [ qw(Q R S N O) ], 'UNSHIFT'); splice @x, 2, 2, qw(F G H); is_deeply(\@y, [ qw(Q R F G H O) ], 'SPLICE'); libtie-simple-perl-1.03/t/handle.t000066400000000000000000000021661163615077500170370ustar00rootroot00000000000000# vim: set ft=perl : use strict; use Test::More tests => 6; use Tie::Simple; my $reader = "foo\nbar\nbaz\nqux\n"; open my $in, "<", \$reader or die $!; my $writer = ''; open my $out, ">", \$writer or die $!; tie *X, 'Tie::Simple', \$in, READ => sub { my $a = shift; my $buf; my (undef, $len, $off) = @_; my $res = read $$a, $buf, $len, $off || 0; $_[0] = $buf; return $res }, READLINE => sub { my $a = shift; readline $$a }, GETC => sub { my $a = shift; getc $$a }, CLOSE => sub { my $a = shift; close $$a }; tie *Y, 'Tie::Simple', \$out, WRITE => sub { my ($a, $b, $l, $o) = @_; print $$a (substr $b, $o || 0, $l) }, PRINT => sub { my $a = shift; print $$a (@_) }, PRINTF => sub { my $a = shift; printf $$a (@_) }, CLOSE => sub { my $a = shift; close $$a }; my $buf; read X, $buf, 4; is($buf, "foo\n", 'READ'); $buf = readline X; is($buf, "bar\n", 'READLINE'); $buf = getc X; is($buf, 'b', 'GETC'); ok(close X, 'CLOSE'); $buf = "foo\nbar\n"; syswrite Y, $buf, 4; print Y "baz\n"; printf Y "%d %s\n", 10, 'qux'; ok(close Y, 'CLOSE'); is($writer, "foo\nbaz\n10 qux\n", 'WRITE/PRINT/PRINTF'); libtie-simple-perl-1.03/t/hash.t000066400000000000000000000013411163615077500165210ustar00rootroot00000000000000# vim: set ft=perl : use strict; use Test::More tests => 7; use Tie::Simple; my %y = (A => 1, B => 2, C => 3); tie my %x, 'Tie::Simple', \%y, FETCH => sub { my ($a, $k) = @_; $$a{$k} }, STORE => sub { my ($a, $k, $v) = @_; $$a{$k} = $v }, DELETE => sub { my ($a, $k) = @_; delete $$a{$k} }, CLEAR => sub { my $a = shift; %$a = () }, EXISTS => sub { my ($a, $k) = @_; exists $$a{$k} }, FIRSTKEY => sub { my $a = shift; keys %$a; each %$a }, NEXTKEY => sub { my $a = shift; each %$a }; is($x{A}, 1, 'FETCH'); $x{A} = 4; is($y{A}, 4, 'STORE'); delete $x{A}; ok(!exists $y{A}, 'DELETE'); %x = (); ok(!%y, 'CLEAR'); %x = (X => 5, Y => 6, Z => 7); while (my ($k, $v) = each %x) { is($v, $y{$k}, 'FIRSTKEY/NEXTKEY'); } libtie-simple-perl-1.03/t/scalar.t000066400000000000000000000004071163615077500170450ustar00rootroot00000000000000# vim: set ft=perl : use strict; use Test::More tests => 2; use Tie::Simple; my $y = 'A'; tie my $x, 'Tie::Simple', \$y, FETCH => sub { my $a = shift; $$a }, STORE => sub { my $a = shift; $$a = shift; }; is($x, 'A', 'FETCH'); $x = 'Z'; is($y, 'Z', 'STORE');