Class-Inner-0.200001/0000755332127507135510000000000011302065466013565 5ustar arunbearpg864408Class-Inner-0.200001/MANIFEST0000644332127507135510000000022011302065466014710 0ustar arunbearpg864408Changes lib/Class/Inner.pm MANIFEST README Makefile.PL t/basic.t META.yml Module meta-data (added by MakeMaker) Class-Inner-0.200001/Makefile.PL0000644332127507135510000000066411302065315015536 0ustar arunbearpg864408use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Class::Inner', 'VERSION_FROM' => 'lib/Class/Inner.pm', # finds $VERSION 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 'META_MERGE' => { resources => { repository => 'http://github.com/arunbear/perl5-class-inner', }, }, ); Class-Inner-0.200001/META.yml0000644332127507135510000000047111302065466015040 0ustar arunbearpg864408# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Class-Inner version: 0.200001 version_from: lib/Class/Inner.pm installdirs: site requires: distribution_type: module generated_by: ExtUtils::MakeMaker version 6.30_01 Class-Inner-0.200001/README0000644332127507135510000000065511302065315014444 0ustar arunbearpg864408INSTALLATION Just perform the usual incantation: gunzip Class-Inner-0.1.tar.gz tar -xvf Class-Inner-0.1.tar cd Class-Inner-0.1 perl Makefile.PL make make test make install AUTHOR Copyright (c) 2001 Piers Cawley, . All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Class-Inner-0.200001/lib/0000755332127507135510000000000011302065466014333 5ustar arunbearpg864408Class-Inner-0.200001/lib/Class/0000755332127507135510000000000011302065466015400 5ustar arunbearpg864408Class-Inner-0.200001/lib/Class/Inner.pm0000644332127507135510000001073211302065315017005 0ustar arunbearpg864408package Class::Inner; use vars qw/$VERSION/; $VERSION = 0.200_001; use strict; use Carp; =head1 NAME Class::Inner - A perlish implementation of Java like inner classes =head1 SYNOPSIS use Class::Inner; my $object = Class::Inner->new( parent => 'ParentClass', methods => { method => sub { ... } }, }, constructor => 'new', args => [@constructor_args], ); =head1 DESCRIPTION Yet another implementation of an anonymous class with per object overrideable methods, but with the added attraction of sort of working dispatch to the parent class's method. =head2 METHODS =over 4 =item B Takes a hash like argument list with the following keys. =over 4 =item B The name of the parent class. Note that you can only get single inheritance with this or B won't work. =item B A hash, keys are method names, values are CODEREFs. =item B The name of the constructor method. Defaults to 'new'. =item B An anonymous array of arguments to pass to the constructor. Defaults to an empty list. =back Returns an object in an 'anonymous' class which inherits from the parent class. This anonymous class has a couple of 'extra' methods: =over 4 =item B If you were to pass something like $obj = Class::Inner->new( parent => 'Parent', methods => { method => sub { ...; $self->SUPER::method(@_) } }, ); then C<$self-CSUPER::method> almost certainly wouldn't do what you expect, so we provide the C method which dispatches to the parent implementation of the current method. There seems to be no good way of getting the full C functionality, but I'm working on it. =item B Because B works by creating a whole new class name for your object, it could potentially leak memory if you create a lot of them. So we add a C method that removes the class from the symbol table once it's finished with. If you need to override a parent's DESTROY method, adding a call to C to it. Do it at the end of the method or your other method calls won't work. =back =cut #' sub new { my $class = shift; my %args = ref($_[0]) ? %{$_[0]} : @_; my $parent = $args{parent} or croak "Can't work without a parent class\n"; my %methods = %{$args{methods}||{}}; my $constructor = $args{constructor} || 'new'; my @constructor_args = @{$args{args} || []}; my $anon_class = $class->new_classname; no strict 'refs'; @{"$anon_class\::ISA"} = $parent; foreach my $methodname (keys %methods) { *{"$anon_class\::$methodname"} = sub { local $Class::Inner::target_method = $methodname; $methods{$methodname}->(@_); }; } # Add the SUPER method. unless (exists $methods{SUPER}) { *{"$anon_class\::SUPER"} = sub { my $self = shift; my $target_method = join '::', $parent, $Class::Inner::target_method; $self->$target_method(@_); }; } unless (exists $methods{DESTROY}) { *{"$anon_class\::DESTROY"} = sub { my $self = shift; Class::Inner::clean_symbol_table($anon_class); bless $self, $parent; } } # Instantiate my $obj = $anon_class->new(@constructor_args); } =item B The helper subroutine that DESTROY uses to remove the class from the symbol table. =cut sub clean_symbol_table { my $class = shift; no strict 'refs'; undef %{"${class}::"}; } =item B Returns a name for the next anonymous class. =cut { my $class_counter; sub new_classname { my $baseclass = shift; return "$baseclass\::__A" . $class_counter++; } } 1; __END__ =back =head1 AUTHOR Maintained by Arun Prasaad C<< >> Copyright (c) 2001 by Piers Cawley Epdcawley@iterative-software.comE. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as perl itself. Thanks to the Iterative Software people: Leon Brocard, Natalie Ford and Dave Cross. Also, this module was written initially for use in the PerlUnit project, AKA Test::Unit. Kudos to Christian Lemburg and the rest of that team. =head1 SEE ALSO There are a million and one differen Class constructors available on CPAN, none of them does quite what I want, so I wrote this one to add to that population where hopefully it will live and thrive. =head1 BUGS Bound to be some. Actually the C method is a workaround for what I consider to be a bug in perl. Class-Inner-0.200001/t/0000755332127507135510000000000011302065466014030 5ustar arunbearpg864408Class-Inner-0.200001/t/basic.t0000755332127507135510000000236411302065315015277 0ustar arunbearpg864408#!/usr/bin/perl -w use strict; use Test::More tests => 13; BEGIN { use_ok( 'Class::Inner' ); } package Parent; sub new { my $class = shift; bless [@_], $class } sub a { 'A' }; sub b { 'B' }; sub poly { $_[0]->b } package main; ok(my $p = Parent->new, "Parent can instantiate"); ok($p->isa('Parent'), '$p is a Parent'); is($p->a(), 'A', '$p->a is A'); is($p->b(), 'B', '$p->b is B'); is($p->poly(), 'B', '$p->poly is B'); my $ic = Class::Inner->new( parent => 'Parent', methods => { b => sub { my $self = shift; lc($self->SUPER); }, c => sub { 'C' } }, args => [qw/a b c/] ); ok(ref($ic) && $ic->isa('Parent'), '$ic is a Parent'); my $ic_class = ref($ic); # Remember this for later... ok(eq_array($ic, [qw/a b c/]), 'constructor test'); is($ic->a(), 'A', '$ic->a is A'); is($ic->b(), 'b', '$ic->b is b'); is($ic->c(), 'C', '$ic->c is C'); is($ic->poly(), 'b', '$ic->poly is b'); # Check that destruction works. undef $ic; { no strict 'refs'; is_deeply(\%{"${ic_class}::"}, {}, 'Class dismissed'); } Class-Inner-0.200001/Changes0000644332127507135510000000071611302065315015055 0ustar arunbearpg8644082009-11-21 * Fixed http://rt.cpan.org/Ticket/Display.html?id=43938 http://rt.cpan.org/Ticket/Display.html?id=39140 http://rt.cpan.org/Ticket/Display.html?id=33533 Which are all really the same issue. 2001-08-12 Piers Cawley * Initial release. Everthing working as documented, I think. Now to find out if I'm right, and if what's documented is enough for people