Class-Spiffy-0.15/0000755000076500007650000000000010367440735013723 5ustar ingyingy00000000000000Class-Spiffy-0.15/Changes0000644000076500007650000000123710367440457015222 0ustar ingyingy00000000000000--- version: 0.15 date: Mon Jan 30 08:38:32 PST 2006 changes: - Make examples not show affects of source filtering. draven++ --- version: 0.14 date: Sun Jan 29 23:50:19 PST 2006 changes: - Fixed bug in field3.t --- version: 0.13 date: Sun Jan 29 12:24:59 PST 2006 changes: - Use faster runtime code in `field`. - Added Class::Spiffy::mixin.pm to stop Apache::Reload warnings --- version: 0.12 date: Thu Jan 19 08:12:40 PST 2006 changes: - Squelch redefine warnings --- version: 0.11 date: Thu Jan 19 07:42:49 PST 2006 changes: - Test patch from Nicholas for older perls --- version: 0.10 date: Thu Jan 19 05:15:27 PST 2006 changes: - Maiden voyage Class-Spiffy-0.15/inc/0000755000076500007650000000000010367440735014474 5ustar ingyingy00000000000000Class-Spiffy-0.15/inc/Module/0000755000076500007650000000000010367440735015721 5ustar ingyingy00000000000000Class-Spiffy-0.15/inc/Module/Install/0000755000076500007650000000000010367440735017327 5ustar ingyingy00000000000000Class-Spiffy-0.15/inc/Module/Install/Base.pm0000644000076500007650000000211610366103556020533 0ustar ingyingy00000000000000#line 1 "inc/Module/Install/Base.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Module/Install/Base.pm" package Module::Install::Base; # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w } }; #line 30 sub new { my ($class, %args) = @_; foreach my $method (qw(call load)) { *{"$class\::$method"} = sub { +shift->_top->$method(@_); } unless defined &{"$class\::$method"}; } bless(\%args, $class); } #line 48 sub AUTOLOAD { my $self = shift; local $@; my $autoload = eval { $self->_top->autoload } or return; goto &$autoload; } #line 62 sub _top { $_[0]->{_top} } #line 73 sub admin { my $self = shift; $self->_top->{admin} or Module::Install::Base::FakeAdmin->new; } sub is_admin { my $self = shift; $self->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; my $Fake; sub new { $Fake ||= bless(\@_, $_[0]) } sub AUTOLOAD {} sub DESTROY {} 1; # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->() }; __END__ #line 120 Class-Spiffy-0.15/inc/Module/Install/Can.pm0000644000076500007650000000337010366103556020365 0ustar ingyingy00000000000000#line 1 "inc/Module/Install/Can.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Module/Install/Can.pm" package Module::Install::Can; use Module::Install::Base; @ISA = qw(Module::Install::Base); $VERSION = '0.01'; use strict; use Config (); use File::Spec (); use ExtUtils::MakeMaker (); # check if we can load some module sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= ".pm" unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { my $abs = File::Spec->catfile($dir, $_[1]); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ($^O eq 'cygwin') { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if (!defined(&ExtUtils::MM_Cygwin::maybe_command)) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; Class-Spiffy-0.15/inc/Module/Install/Fetch.pm0000644000076500007650000000463610366103556020723 0ustar ingyingy00000000000000#line 1 "inc/Module/Install/Fetch.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Module/Install/Fetch.pm" package Module::Install::Fetch; use Module::Install::Base; @ISA = qw(Module::Install::Base); $VERSION = '0.01'; sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ($scheme eq 'http' and !eval { require LWP::Simple; 1 }) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, << "."); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit . foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Class-Spiffy-0.15/inc/Module/Install/Makefile.pm0000644000076500007650000001000110366103556021366 0ustar ingyingy00000000000000#line 1 "inc/Module/Install/Makefile.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Module/Install/Makefile.pm" package Module::Install::Makefile; use Module::Install::Base; @ISA = qw(Module::Install::Base); $VERSION = '0.01'; use strict 'vars'; use vars '$VERSION'; use ExtUtils::MakeMaker (); sub Makefile { $_[0] } sub prompt { shift; goto &ExtUtils::MakeMaker::prompt; } sub makemaker_args { my $self = shift; my $args = ($self->{makemaker_args} ||= {}); %$args = ( %$args, @_ ) if @_; $args; } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join(" ", grep length, $clean->{FILES}, @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [shift]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args); $args->{VERSION} = $self->version || $self->determine_VERSION($args); $args->{NAME} =~ s/-/::/g; $args->{test} = {TESTS => $self->tests} if $self->tests; if ($] >= 5.005) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = $self->author; } if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) { $args->{NO_META} = 1; } if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 ) { $args->{SIGN} = 1 if $self->sign; } delete $args->{SIGN} unless $self->is_admin; # merge both kinds of requires into prereq_pm my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_, ($self->build_requires, $self->requires) ); # merge both kinds of requires into prereq_pm my $subdirs = ($args->{DIR} ||= []); if ($self->bundles) { foreach my $bundle (@{ $self->bundles }) { my ($file, $dir) = @$bundle; push @$subdirs, $dir if -d $dir; delete $prereq->{$file}; } } if (my $perl_version = $self->perl_version) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, ". "but we need version >= $perl_version"; } my %args = map {($_ => $args->{$_})} grep {defined($args->{$_})} keys %$args; if ($self->admin->preop) { $args{dist} = $self->admin->preop; } ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile(); } sub fix_up_makefile { my $self = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, '< Makefile' or die $!; my $makefile = do { local $/; }; close MAKEFILE; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 -Iinc/m; $makefile =~ s/^(PERL = .*)/$1 -Iinc/m; open MAKEFILE, '> Makefile' or die $!; print MAKEFILE "$preamble$makefile$postamble"; close MAKEFILE; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 286 Class-Spiffy-0.15/inc/Module/Install/Metadata.pm0000644000076500007650000001713210366103556021405 0ustar ingyingy00000000000000#line 1 "inc/Module/Install/Metadata.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Module/Install/Metadata.pm" package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base; use vars qw($VERSION @ISA); BEGIN { $VERSION = '0.06'; @ISA = 'Module::Install::Base'; } my @scalar_keys = qw{ name module_name abstract author version license distribution_type perl_version tests }; my @tuple_keys = qw{ build_requires requires recommends bundles }; sub Meta { shift } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } foreach my $key (@scalar_keys) { *$key = sub { my $self = shift; return $self->{values}{$key} if defined wantarray and !@_; $self->{values}{$key} = shift; return $self; }; } foreach my $key (@tuple_keys) { *$key = sub { my $self = shift; return $self->{values}{$key} unless @_; my @rv; while (@_) { my $module = shift or last; my $version = shift || 0; if ( $module eq 'perl' ) { $version =~ s{^(\d+)\.(\d+)\.(\d+)} {$1 + $2/1_000 + $3/1_000_000}e; $self->perl_version($version); next; } my $rv = [ $module, $version ]; push @rv, $rv; } push @{ $self->{values}{$key} }, @rv; @rv; }; } sub sign { my $self = shift; return $self->{'values'}{'sign'} if defined wantarray and !@_; $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 ); return $self; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die "all_from called with no args without setting name() first"; $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; die "all_from: cannot find $file from $name" unless -e $file; } $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; # The remaining probes read from POD sections; if the file # has an accompanying .pod, use that instead my $pod = $file; if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) { $file = $pod; } $self->author_from($file) unless $self->author; $self->license_from($file) unless $self->license; $self->abstract_from($file) unless $self->abstract; } sub provides { my $self = shift; my $provides = ( $self->{values}{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->{name}, dist_version => $self->{version}, license => $self->{license}, ); $self->provides(%{ $build->find_dist_packages || {} }); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return @{ $self->{values}{features} }; } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}{no_index}{$type} }, @_ if $type; return $self->{values}{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML', 0 ); require YAML; my $data = YAML::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { my ( $self, $file ) = @_; require ExtUtils::MM_Unix; $self->version( ExtUtils::MM_Unix->parse_version($file) ); } sub abstract_from { my ( $self, $file ) = @_; require ExtUtils::MM_Unix; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } sub _slurp { my ( $self, $file ) = @_; local *FH; open FH, "< $file" or die "Cannot open $file.pod: $!"; do { local $/; }; } sub perl_version_from { my ( $self, $file ) = @_; if ( $self->_slurp($file) =~ m/ ^ use \s* v? ([\d\.]+) \s* ; /ixms ) { $self->perl_version($1); } else { warn "Cannot determine perl version info from $file\n"; return; } } sub author_from { my ( $self, $file ) = @_; my $content = $self->_slurp($file); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; $author =~ s{E}{<}g; $author =~ s{E}{>}g; $self->author($author); } else { warn "Cannot determine author info from $file\n"; } } sub license_from { my ( $self, $file ) = @_; if ( $self->_slurp($file) =~ m/ =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b (.*?) (=head\\d.*|=cut.*|) \z /ixms ) { my $license_text = $1; my @phrases = ( 'under the same (?:terms|license) as perl itself' => 'perl', 'GNU public license' => 'gpl', 'GNU lesser public license' => 'gpl', 'BSD license' => 'bsd', 'Artistic license' => 'artistic', 'GPL' => 'gpl', 'LGPL' => 'lgpl', 'BSD' => 'bsd', 'Artistic' => 'artistic', ); while ( my ( $pattern, $license ) = splice( @phrases, 0, 2 ) ) { $pattern =~ s{\s+}{\\s+}g; if ( $license_text =~ /\b$pattern\b/i ) { $self->license($license); return 1; } } } warn "Cannot determine license info from $file\n"; return 'unknown'; } 1; Class-Spiffy-0.15/inc/Module/Install/Win32.pm0000644000076500007650000000364110366103556020567 0ustar ingyingy00000000000000#line 1 "inc/Module/Install/Win32.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Module/Install/Win32.pm" package Module::Install::Win32; use Module::Install::Base; @ISA = qw(Module::Install::Base); $VERSION = '0.02'; use strict; # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and $^O eq 'MSWin32' and !$self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); if (!$rv) { die << '.'; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- . } } 1; __END__ Class-Spiffy-0.15/inc/Module/Install/WriteAll.pm0000644000076500007650000000157610366103556021415 0ustar ingyingy00000000000000#line 1 "inc/Module/Install/WriteAll.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Module/Install/WriteAll.pm" package Module::Install::WriteAll; use Module::Install::Base; @ISA = qw(Module::Install::Base); sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_ ); $self->sign(1) if $args{sign}; $self->Meta->write if $args{meta}; $self->admin->WriteAll(%args) if $self->is_admin; if ($0 =~ /Build.PL$/i) { $self->Build->write; } else { $self->check_nmake if $args{check_nmake}; $self->makemaker_args( PL_FILES => {} ) unless $self->makemaker_args->{'PL_FILES'}; if ($args{inline}) { $self->Inline->write; } else { $self->Makefile->write; } } } 1; Class-Spiffy-0.15/inc/Module/Install.pm0000644000076500007650000001260310366103556017663 0ustar ingyingy00000000000000#line 1 "/Users/ingy/src/ingy/Class-Spiffy/inc/Module/Install.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Module/Install.pm" package Module::Install; use 5.004; use strict 'vars'; use vars qw{$VERSION}; BEGIN { # Don't forget to update Module::Install::Admin too! $VERSION = '0.54'; } # inc::Module::Install must be loaded first unless ( $INC{join('/', inc => split(/::/, __PACKAGE__)).'.pm'} ) { die <<"END_DIE"; Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE } use Cwd (); use FindBin; use File::Find (); use File::Path (); *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = 'Module::Install'; sub autoload { my $self = shift; my $caller = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "$caller\::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # delegate back to parent dirs goto &$code unless $cwd eq $pwd; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $caller - $sym"; unshift @_, ($self, $1); goto &{$self->can('call')} unless uc($1) eq $1; }; } sub import { my $class = shift; my $self = $class->new(@_); unless ( -f $self->{file} ) { require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new(_top => $self); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } *{$self->_caller . "::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; } sub preload { my ($self) = @_; unless ( $self->{extentions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { my $admin = $self->{admin}; @exts = $admin->load_all_extensions; } my %seen_method; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless defined *{$glob}{CODE}; next if $method =~ /^_/; next if $method eq uc($method); $seen_method{$method}++; } } my $caller = $self->_caller; foreach my $name (sort keys %seen_method) { *{"${caller}::$name"} = sub { ${"${caller}::AUTOLOAD"} = "${caller}::$name"; goto &{"${caller}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= '.author'; $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ($args{path}) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; bless(\%args, $class); } sub call { my $self = shift; my $method = shift; my $obj = $self->load($method) or return; unshift @_, $obj; goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top_obj) = @_; unshift @INC, $self->{prefix} unless grep { $_ eq $self->{prefix} } @INC; local @INC = ($path, @INC); foreach my $rv ($self->find_extensions($path)) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = delete $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top_obj ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; return if $1 eq $self->{dispatch}; $file = "$self->{path}/$1.pm"; my $pkg = "$self->{name}::$1"; $pkg =~ s!/!::!g; push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } sub _caller { my $depth = 0; my $caller = caller($depth); while ($caller eq __PACKAGE__) { $depth++; $caller = caller($depth); } $caller; } 1; Class-Spiffy-0.15/lib/0000755000076500007650000000000010367440735014471 5ustar ingyingy00000000000000Class-Spiffy-0.15/lib/Class/0000755000076500007650000000000010367440735015536 5ustar ingyingy00000000000000Class-Spiffy-0.15/lib/Class/Spiffy/0000755000076500007650000000000010367440735016776 5ustar ingyingy00000000000000Class-Spiffy-0.15/lib/Class/Spiffy/mixin.pm0000644000076500007650000000004110367222503020442 0ustar ingyingy00000000000000package Class::Spiffy::mixin; 1; Class-Spiffy-0.15/lib/Class/Spiffy.pm0000644000076500007650000007314110367440622017335 0ustar ingyingy00000000000000package Class::Spiffy; use strict; use 5.006001; use warnings; use Carp; require Exporter; our $VERSION = '0.15'; our @EXPORT = (); our @EXPORT_BASE = qw(field const stub super); our @EXPORT_OK = (@EXPORT_BASE, qw(id WWW XXX YYY ZZZ)); our %EXPORT_TAGS = (XXX => [qw(WWW XXX YYY ZZZ)]); my $stack_frame = 0; my $dump = 'yaml'; my $bases_map = {}; sub WWW; sub XXX; sub YYY; sub ZZZ; # This line is here to convince "autouse" into believing we are autousable. sub can { ($_[1] eq 'import' and caller()->isa('autouse')) ? \&Exporter::import # pacify autouse's equality test : $_[0]->SUPER::can($_[1]) # normal case } # TODO # # Exported functions like field and super should be hidden so as not to # be confused with methods that can be inherited. # sub new { my $class = shift; $class = ref($class) || $class; my $self = bless {}, $class; while (@_) { my $method = shift; $self->$method(shift); } return $self; } sub import { no strict 'refs'; no warnings; my $self_package = shift; # XXX Using parse_arguments here might cause confusion, because the # subclass's boolean_arguments and paired_arguments can conflict, causing # difficult debugging. Consider using something truly local. my ($args, @export_list) = do { local *boolean_arguments = sub { qw( -base -Base -mixin -selfless -XXX -dumper -yaml ) }; local *paired_arguments = sub { qw(-package) }; $self_package->parse_arguments(@_); }; return spiffy_mixin_import(scalar(caller(0)), $self_package, @export_list) if $args->{-mixin}; croak <<'...' if $args->{-Base}; Use of '-Base' with Class::Spiffy is illegal. Please use '-base' or 'use Spiffy -Base' ... $dump = 'yaml' if $args->{-yaml}; $dump = 'dumper' if $args->{-dumper}; local @EXPORT_BASE = @EXPORT_BASE; if ($args->{-XXX}) { push @EXPORT_BASE, @{$EXPORT_TAGS{XXX}} unless grep /^XXX$/, @EXPORT_BASE; } my $caller_package = $args->{-package} || caller($stack_frame); push @{"$caller_package\::ISA"}, $self_package if $args->{-base}; for my $class (@{all_my_bases($self_package)}) { next unless $class->isa('Class::Spiffy'); my @export = grep { not defined &{"$caller_package\::$_"}; } ( @{"$class\::EXPORT"}, $args->{-base} ? @{"$class\::EXPORT_BASE"} : (), ); my @export_ok = grep { not defined &{"$caller_package\::$_"}; } @{"$class\::EXPORT_OK"}; # Avoid calling the expensive Exporter::export # if there is nothing to do (optimization) my %exportable = map { ($_, 1) } @export, @export_ok; next unless keys %exportable; my @export_save = @{"$class\::EXPORT"}; my @export_ok_save = @{"$class\::EXPORT_OK"}; @{"$class\::EXPORT"} = @export; @{"$class\::EXPORT_OK"} = @export_ok; my @list = grep { (my $v = $_) =~ s/^[\!\:]//; $exportable{$v} or ${"$class\::EXPORT_TAGS"}{$v}; } @export_list; Exporter::export($class, $caller_package, @list); @{"$class\::EXPORT"} = @export_save; @{"$class\::EXPORT_OK"} = @export_ok_save; } } sub base { push @_, -base; goto &import; } sub all_my_bases { my $class = shift; return $bases_map->{$class} if defined $bases_map->{$class}; my @bases = ($class); no strict 'refs'; for my $base_class (@{"${class}::ISA"}) { push @bases, @{all_my_bases($base_class)}; } my $used = {}; $bases_map->{$class} = [grep {not $used->{$_}++} @bases]; } my %code = ( sub_start => "sub {\n", set_default => " \$_[0]->{%s} = %s\n unless exists \$_[0]->{%s};\n", init => " return \$_[0]->{%s} = do { my \$self = \$_[0]; %s }\n" . " unless \$#_ > 0 or defined \$_[0]->{%s};\n", weak_init => " return do {\n" . " \$_[0]->{%s} = do { my \$self = \$_[0]; %s };\n" . " Scalar::Util::weaken(\$_[0]->{%s}) if ref \$_[0]->{%s};\n" . " \$_[0]->{%s};\n" . " } unless \$#_ > 0 or defined \$_[0]->{%s};\n", return_if_get => " return \$_[0]->{%s} unless \$#_ > 0;\n", set => " \$_[0]->{%s} = \$_[1];\n", weaken => " Scalar::Util::weaken(\$_[0]->{%s}) if ref \$_[0]->{%s};\n", sub_end => " return \$_[0]->{%s};\n}\n", ); sub field { my $package = caller; my ($args, @values) = do { no warnings; local *boolean_arguments = sub { (qw(-weak)) }; local *paired_arguments = sub { (qw(-package -init)) }; Class::Spiffy->parse_arguments(@_); }; my ($field, $default) = @values; $package = $args->{-package} if defined $args->{-package}; die "Cannot have a default for a weakened field ($field)" if defined $default && $args->{-weak}; return if defined &{"${package}::$field"}; require Scalar::Util if $args->{-weak}; my $default_string = ( ref($default) eq 'ARRAY' and not @$default ) ? '[]' : (ref($default) eq 'HASH' and not keys %$default ) ? '{}' : default_as_code($default); my $code = $code{sub_start}; if ($args->{-init}) { my $fragment = $args->{-weak} ? $code{weak_init} : $code{init}; $code .= sprintf $fragment, $field, $args->{-init}, ($field) x 4; } $code .= sprintf $code{set_default}, $field, $default_string, $field if defined $default; $code .= sprintf $code{return_if_get}, $field; $code .= sprintf $code{set}, $field; $code .= sprintf $code{weaken}, $field, $field if $args->{-weak}; $code .= sprintf $code{sub_end}, $field; my $sub = eval $code; die $@ if $@; no strict 'refs'; *{"${package}::$field"} = $sub; return $code if defined wantarray; } sub default_as_code { require Data::Dumper; local $Data::Dumper::Sortkeys = 1; my $code = Data::Dumper::Dumper(shift); $code =~ s/^\$VAR1 = //; $code =~ s/;$//; return $code; } sub const { my $package = caller; my ($args, @values) = do { no warnings; local *paired_arguments = sub { (qw(-package)) }; Class::Spiffy->parse_arguments(@_); }; my ($field, $default) = @values; $package = $args->{-package} if defined $args->{-package}; no strict 'refs'; return if defined &{"${package}::$field"}; *{"${package}::$field"} = sub { $default } } sub stub { my $package = caller; my ($args, @values) = do { no warnings; local *paired_arguments = sub { (qw(-package)) }; Class::Spiffy->parse_arguments(@_); }; my ($field, $default) = @values; $package = $args->{-package} if defined $args->{-package}; no strict 'refs'; return if defined &{"${package}::$field"}; *{"${package}::$field"} = sub { require Carp; Carp::confess "Method $field in package $package must be subclassed"; } } sub parse_arguments { my $class = shift; my ($args, @values) = ({}, ()); my %booleans = map { ($_, 1) } $class->boolean_arguments; my %pairs = map { ($_, 1) } $class->paired_arguments; while (@_) { my $elem = shift; if (defined $elem and defined $booleans{$elem}) { $args->{$elem} = (@_ and $_[0] =~ /^[01]$/) ? shift : 1; } elsif (defined $elem and defined $pairs{$elem} and @_) { $args->{$elem} = shift; } else { push @values, $elem; } } return wantarray ? ($args, @values) : $args; } sub boolean_arguments { () } sub paired_arguments { () } # get a unique id for any node sub id { if (not ref $_[0]) { return 'undef' if not defined $_[0]; \$_[0] =~ /\((\w+)\)$/o or die; return "$1-S"; } require overload; overload::StrVal($_[0]) =~ /\((\w+)\)$/o or die; return $1; } #=============================================================================== # It's super, man. #=============================================================================== package DB; { no warnings 'redefine'; sub super_args { my @dummy = caller(@_ ? $_[0] : 2); return @DB::args; } } package Class::Spiffy; sub super { my $method; my $frame = 1; while ($method = (caller($frame++))[3]) { $method =~ s/.*::// and last; } my @args = DB::super_args($frame); @_ = @_ ? ($args[0], @_) : @args; my $class = ref $_[0] ? ref $_[0] : $_[0]; my $caller_class = caller; my $seen = 0; my @super_classes = reverse grep { ($seen or $seen = ($_ eq $caller_class)) ? 0 : 1; } reverse @{all_my_bases($class)}; for my $super_class (@super_classes) { no strict 'refs'; next if $super_class eq $class; if (defined &{"${super_class}::$method"}) { ${"$super_class\::AUTOLOAD"} = ${"$class\::AUTOLOAD"} if $method eq 'AUTOLOAD'; return &{"${super_class}::$method"}; } } return; } #=============================================================================== # This code deserves a spanking, because it is being very naughty. # It is exchanging base.pm's import() for its own, so that people # can use base.pm with Class::Spiffy modules, without being the wiser. #=============================================================================== my $real_base_import; my $real_mixin_import; BEGIN { require base unless defined $INC{'base.pm'}; $INC{'mixin.pm'} ||= 'Class/Spiffy/mixin.pm'; $real_base_import = \&base::import; $real_mixin_import = \&mixin::import; no warnings; *base::import = \&spiffy_base_import; *mixin::import = \&spiffy_mixin_import; } # my $i = 0; # while (my $caller = caller($i++)) { # next unless $caller eq 'base' or $caller eq 'mixin'; # croak <isa('Class::Spiffy'); } @base_classes; my $inheritor = caller(0); for my $base_class (@base_classes) { next if $inheritor->isa($base_class); croak "Can't mix Class::Spiffy and non-Class::Spiffy classes in 'use base'.\n", "See the documentation of Class::Spiffy for details\n " unless $base_class->isa('Class::Spiffy'); $stack_frame = 1; # tell import to use different caller import($base_class, '-base'); $stack_frame = 0; } } sub mixin { my $self = shift; my $target_class = ref($self); spiffy_mixin_import($target_class, @_) } sub spiffy_mixin_import { my $target_class = shift; $target_class = caller(0) if $target_class eq 'mixin'; my $mixin_class = shift or die "Nothing to mixin"; eval "require $mixin_class"; my @roles = @_; my $pseudo_class = join '-', $target_class, $mixin_class, @roles; my %methods = spiffy_mixin_methods($mixin_class, @roles); no strict 'refs'; no warnings; @{"$pseudo_class\::ISA"} = @{"$target_class\::ISA"}; @{"$target_class\::ISA"} = ($pseudo_class); for (keys %methods) { *{"$pseudo_class\::$_"} = $methods{$_}; } } sub spiffy_mixin_methods { my $mixin_class = shift; no strict 'refs'; my %methods = spiffy_all_methods($mixin_class); map { $methods{$_} ? ($_, \ &{"$methods{$_}\::$_"}) : ($_, \ &{"$mixin_class\::$_"}) } @_ ? (get_roles($mixin_class, @_)) : (keys %methods); } sub get_roles { my $mixin_class = shift; my @roles = @_; while (grep /^!*:/, @roles) { @roles = map { s/!!//g; /^!:(.*)/ ? do { my $m = "_role_$1"; map("!$_", $mixin_class->$m); } : /^:(.*)/ ? do { my $m = "_role_$1"; ($mixin_class->$m); } : ($_) } @roles; } if (@roles and $roles[0] =~ /^!/) { my %methods = spiffy_all_methods($mixin_class); unshift @roles, keys(%methods); } my %roles; for (@roles) { s/!!//g; delete $roles{$1}, next if /^!(.*)/; $roles{$_} = 1; } keys %roles; } sub spiffy_all_methods { no strict 'refs'; my $class = shift; return if $class eq 'Class::Spiffy'; my %methods = map { ($_, $class) } grep { defined &{"$class\::$_"} and not /^_/ } keys %{"$class\::"}; my %super_methods; %super_methods = spiffy_all_methods(${"$class\::ISA"}[0]) if @{"$class\::ISA"}; %{{%super_methods, %methods}}; } # END of naughty code. #=============================================================================== # Debugging support #=============================================================================== sub spiffy_dump { no warnings; if ($dump eq 'dumper') { require Data::Dumper; $Data::Dumper::Sortkeys = 1; $Data::Dumper::Indent = 1; return Data::Dumper::Dumper(@_); } require YAML; $YAML::UseVersion = 0; return YAML::Dump(@_) . "...\n"; } sub at_line_number { my ($file_path, $line_number) = (caller(1))[1,2]; " at $file_path line $line_number\n"; } sub WWW { warn spiffy_dump(@_) . at_line_number; return wantarray ? @_ : $_[0]; } sub XXX { die spiffy_dump(@_) . at_line_number; } sub YYY { print spiffy_dump(@_) . at_line_number; return wantarray ? @_ : $_[0]; } sub ZZZ { require Carp; Carp::confess spiffy_dump(@_); } 1; __END__ =head1 NAME Class::Spiffy - Spiffy Framework with No Source Filtering =head1 SYNOPSIS package Keen; use strict; use warnings; use Class::Spiffy -base; field 'mirth'; const mood => ':-)'; sub happy { my $self = shift; if ($self->mood eq ':-(') { $self->mirth(-1); print "Cheer up!"; } super; } 1; =head1 DESCRIPTION "Class::Spiffy" is a framework and methodology for doing object oriented (OO) programming in Perl. Class::Spiffy combines the best parts of Exporter.pm, base.pm, mixin.pm and SUPER.pm into one magic foundation class. It attempts to fix all the nits and warts of traditional Perl OO, in a clean, straightforward and (perhaps someday) standard way. Class::Spiffy borrows ideas from other OO languages like Python, Ruby, Java and Perl 6. It also adds a few tricks of its own. If you take a look on CPAN, there are a ton of OO related modules. When starting a new project, you need to pick the set of modules that makes most sense, and then you need to use those modules in each of your classes. Class::Spiffy, on the other hand, has everything you'll probably need in one module, and you only need to use it once in one of your classes. If you make Class::Spiffy the base class of the basest class in your project, Class::Spiffy will automatically pass all of its magic to all of your subclasses. You may eventually forget that you're even using it! The most striking difference between Class::Spiffy and other Perl object oriented base classes, is that it has the ability to export things. If you create a subclass of Class::Spiffy, all the things that Class::Spiffy exports will automatically be exported by your subclass, in addition to any more things that you want to export. And if someone creates a subclass of your subclass, all of those things will be exported automatically, and so on. Think of it as "Inherited Exportation", and it uses the familiar Exporter.pm specification syntax. To use Class::Spiffy or any subclass of Class::Spiffy as a base class of your class, you specify the C<-base> argument to the C command. use MySpiffyBaseModule -base; You can also use the traditional C syntax and everything will work exactly the same. The only caveat is that Class::Spiffy must already be loaded. That's because Class::Spiffy rewires base.pm on the fly to do all the Spiffy magics. Class::Spiffy has support for Ruby-like mixins with Perl6-like roles. Just like C you can use either of the following invocations: use mixin 'MySpiffyBaseModule'; use MySpiffyBaseModule -mixin; The second version will only work if the class being mixed in is a subclass of Class::Spiffy. The first version will work in all cases, as long as Class::Spiffy has already been loaded. To limit the methods that get mixed in, use roles. (Hint: they work just like an Exporter list): use MySpiffyBaseModule -mixin => qw(:basics x y !foo); A useful feature of Class::Spiffy is that it exports two functions: C and C that can be used to declare the attributes of your class, and automatically generate accessor methods for them. The only difference between the two functions is that C attributes can not be modified; thus the accessor is much faster. One interesting aspect of OO programming is when a method calls the same method from a parent class. This is generally known as calling a super method. Perl's facility for doing this is butt ugly: sub cleanup { my $self = shift; $self->scrub; $self->SUPER::cleanup(@_); } Class::Spiffy makes it, er, super easy to call super methods. You just use the C function. You don't need to pass it any arguments because it automatically passes them on for you. Here's the same function with Class::Spiffy: sub cleanup { my $self = shift; $self->scrub; super; } Class::Spiffy has a special method for parsing arguments called C, that it also uses for parsing its own arguments. You declare which arguments are boolean (singletons) and which ones are paired, with two special methods called C and C. Parse arguments pulls out the booleans and pairs and returns them in an anonymous hash, followed by a list of the unmatched arguments. Finally, Class::Spiffy can export a few debugging functions C, C, C and C. Each of them produces a YAML dump of its arguments. WWW warns the output, XXX dies with the output, YYY prints the output, and ZZZ confesses the output. If YAML doesn't suit your needs, you can switch all the dumps to Data::Dumper format with the C<- dumper> option. That's Spiffy! Pretty Classy, eh? =head1 A Spiffy NOTE Class::Spiffy started off as the Spiffy.pm module. Class::Spiffy does everything Spiffy does except clever source filtering. So you can be sure that any module that uses Class::Spiffy, (like YAML.pm) doesn't use source filtering. If you don't like source filtering, this may help you sleep better at night. =head1 Spiffy EXPORTING Class::Spiffy implements a completely new idea in Perl. Modules that act both as object oriented classes and that also export functions. But it takes the concept of Exporter.pm one step further; it walks the entire C<@ISA> path of a class and honors the export specifications of each module. Since Class::Spiffy calls on the Exporter module to do this, you can use all the fancy interface features that Exporter has, including tags and negation. Class::Spiffy considers all the arguments that don't begin with a dash to comprise the export specification. package Vehicle; use Spiffy -base; our $SERIAL_NUMBER = 0; our @EXPORT = qw($SERIAL_NUMBER); our @EXPORT_BASE = qw(tire horn); package Bicycle; use Vehicle -base, '!field'; In this case, Cisa('Vehicle')> and also all the things that C and C export, will go into C, except C. Exporting can be very helpful when you've designed a system with hundreds of classes, and you want them all to have access to some functions or constants or variables. Just export them in your main base class and every subclass will get the functions they need. You can do almost everything that Exporter does because Class::Spiffy delegates the job to Exporter (after adding some Spiffy magic). Class::Spiffy offers a C<@EXPORT_BASE> variable which is like C<@EXPORT>, but only for usages that use C<-base>. =head1 Spiffy MIXINs & ROLEs If you've done much OO programming in Perl you've probably used Multiple Inheritance (MI), and if you've done much MI you've probably run into weird problems and headaches. Some languages like Ruby, attempt to resolve MI issues using a technique called mixins. Basically, all Ruby classes use only Single Inheritance (SI), and then I functionality from other modules if they need to. Mixins can be thought of at a simplistic level as I the methods of another class into your subclass. But from an implementation standpoint that's not the best way to do it. Class::Spiffy does what Ruby does. It creates an empty anonymous class, imports everything into that class, and then chains the new class into your SI ISA path. In other words, if you say: package A; use B -base; use C -mixin; use D -mixin; You end up with a single inheritance chain of classes like this: A << A-D << A-C << B; C and C are the actual package names of the generated classes. The nice thing about this style is that mixing in C doesn't clobber any methods in A, and D doesn't conflict with A or C either. If you mixed in a method in C that was also in A, you can still get to it by using C. When Class::Spiffy mixes in C, it pulls in all the methods in C that do not begin with an underscore. Actually it goes farther than that. If C is a subclass it will pull in every method that C C do through inheritance. This is very powerful, maybe too powerful. To limit what you mixin, Class::Spiffy borrows the concept of Roles from Perl6. The term role is used more loosely in Class::Spiffy though. It's much like an import list that the Exporter module uses, and you can use groups (tags) and negation. If the first element of your list uses negation, Class::Spiffy will start with all the methods that your mixin class can do. use E -mixin => qw(:tools walk !run !:sharp_tools); In this example, C and C are methods that E can do, and C and C are roles of class E. How does class E define these roles? It very simply defines methods called C<_role_tools> and C<_role_sharp_tools> which return lists of more methods. (And possibly other roles!) The neat thing here is that since roles are just methods, they too can be inherited. Take B Perl6! =head1 Spiffy DEBUGGING The XXX function is very handy for debugging because you can insert it almost anywhere, and it will dump your data in nice clean YAML. Take the following statement: my @stuff = grep { /keen/ } $self->find($a, $b); If you have a problem with this statement, you can debug it in any of the following ways: XXX my @stuff = grep { /keen/ } $self->find($a, $b); my @stuff = XXX grep { /keen/ } $self->find($a, $b); my @stuff = grep { /keen/ } XXX $self->find($a, $b); my @stuff = grep { /keen/ } $self->find(XXX $a, $b); XXX is easy to insert and remove. It is also a tradition to mark uncertain areas of code with XXX. This will make the debugging dumpers easy to spot if you forget to take them out. WWW and YYY are nice because they dump their arguments and then return the arguments. This way you can insert them into many places and still have the code run as before. Use ZZZ when you need to die with both a YAML dump and a full stack trace. The debugging functions are exported by default if you use the C<-base> option, but only if you have previously used the C<-XXX> option. To export all 4 functions use the export tag: use SomeSpiffyModule ':XXX'; To force the debugging functions to use Data::Dumper instead of YAML: use SomeSpiffyModule -dumper; =head1 Spiffy FUNCTIONS This section describes the functions the Class::Spiffy exports. The C, C, C and C functions are only exported when you use the C<-base> option. =over 4 =item * field Defines accessor methods for a field of your class: package Example; use Classs::Spiffy -base; field 'foo'; field bar => []; sub lalala { my $self == shift; $self->foo(42); push @{$self->{bar}}, $self->foo; } The first parameter passed to C is the name of the attribute being defined. Accessors can be given an optional default value. This value will be returned if no value for the field has been set in the object. =item * const const bar => 42; The C function is similar to except that it is immutable. It also does not store data in the object. You probably always want to give a C a default value, otherwise the generated method will be somewhat useless. =item * stub stub 'cigar'; The C function generates a method that will die with an appropriate message. The idea is that subclasses must implement these methods so that the stub methods don't get called. =item * super If this function is called without any arguments, it will call the same method that it is in, higher up in the ISA tree, passing it all the same arguments. If it is called with arguments, it will use those arguments with C<$self> in the front. In other words, it just works like you'd expect. sub foo { my $self = shift; super; # Same as $self->SUPER::foo(@_); super('hello'); # Same as $self->SUPER::foo('hello'); $self->bar(42); } sub new { my $self = super; $self->init; return $self; } C will simply do nothing if there is no super method. Finally, C does the right thing in AUTOLOAD subroutines. =back =head1 Spiffy METHODS This section lists all of the methods that any subclass of Class::Spiffy automatically inherits. =over 4 =item * mixin A method to mixin a class at runtime. Takes the same arguments as C. Makes the target class a mixin of the caller. $self->mixin('SomeClass'); $object->mixin('SomeOtherClass' => 'some_method'); =item * parse_arguments This method takes a list of arguments and groups them into pairs. It allows for boolean arguments which may or may not have a value (defaulting to 1). The method returns a hash reference of all the pairs as keys and values in the hash. Any arguments that cannot be paired, are returned as a list. Here is an example: sub boolean_arguments { qw(-has_spots -is_yummy) } sub paired_arguments { qw(-name -size) } my ($pairs, @others) = $self->parse_arguments( 'red', 'white', -name => 'Ingy', -has_spots => -size => 'large', 'black', -is_yummy => 0, ); After this call, C<$pairs> will contain: { -name => 'Ingy', -has_spots => 1, -size => 'large', -is_yummy => 0, } and C<@others> will contain 'red', 'white', and 'black'. =item * boolean_arguments Returns the list of arguments that are recognized as being boolean. Override this method to define your own list. =item * paired_arguments Returns the list of arguments that are recognized as being paired. Override this method to define your own list. =back =head1 Spiffy ARGUMENTS When you C the Class::Spiffy module or a subclass of it, you can pass it a list of arguments. These arguments are parsed using the C method described above. The special argument C<- base>, is used to make the current package a subclass of the Class::Spiffy module being used. Any non-paired parameters act like a normal import list; just like those used with the Exporter module. =head1 USING Class::Spiffy WITH base.pm The proper way to use a Class::Spiffy module as a base class is with the C<-base> parameter to the C statement. This differs from typical modules where you would want to C. package Something; use Spiffy::Module -base; use base 'NonSpiffy::Module'; Now it may be hard to keep track of what's Spiffy and what is not. Therefore Class::Spiffy has actually been made to work with base.pm. You can say: package Something; use base 'Spiffy::Module'; use base 'NonSpiffy::Module'; C is also very useful when your class is not an actual module (a separate file) but just a package in some file that has already been loaded. C will work whether the class is a module or not, while the C<-base> syntax cannot work that way, since C always tries to load a module. =head2 base.pm Caveats To make Class::Spiffy work with base.pm, a dirty trick was played. Class::Spiffy swaps C with its own version. If the base modules are not Spiffy, Class::Spiffy calls the original base::import. If the base modules are Spiffy, then Class::Spiffy does its own thing. There are two caveats. =over 4 =item * Class::Spiffy must be loaded first. If Class::Spiffy is not loaded and C is invoked on a Class::Spiffy module, Class::Spiffy will die with a useful message telling the author to read this documentation. That's because Class::Spiffy needed to do the import swap beforehand. If you get this error, simply put a statement like this up front in your code: use Class::Spiffy (); =item * No Mixing C can take multiple arguments. And this works with Class::Spiffy as long as all the base classes are Spiffy, or they are all non-Spiffy. If they are mixed, Class::Spiffy will die. In this case just use separate C statements. =back =head1 AUTHOR Ingy döt Net =head1 COPYRIGHT Copyright (c) 2006. Ingy döt Net. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut Class-Spiffy-0.15/Makefile.PL0000644000076500007650000000024410366103556015671 0ustar ingyingy00000000000000use inc::Module::Install; name 'Class-Spiffy'; all_from 'lib/Class/Spiffy.pm'; requires perl => '5.6.1'; requires Scalar::Util => '0'; WriteAll; Class-Spiffy-0.15/MANIFEST0000644000076500007650000000124310367440733015052 0ustar ingyingy00000000000000Changes inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/Class/Spiffy.pm lib/Class/Spiffy/mixin.pm Makefile.PL MANIFEST This list of files META.yml README t/autoload.t t/base.t t/base2.t t/big-base.t t/cascade.t t/const.t t/early.t t/export1.t t/export2.t t/export3.t t/export4.t t/export5.t t/export6.t t/export7.t t/exporter.t t/field.t t/field2.t t/field3.t t/mixin.t t/mixin2.t t/mixin3.t t/new.t t/NonSpiffy.pm t/package.t t/parse.t t/Something.pm t/stub.t t/super.t t/super2.t t/Thing.pm Class-Spiffy-0.15/META.yml0000644000076500007650000000045310366103556015172 0ustar ingyingy00000000000000 no_index: directory: - inc - t generated_by: Module::Install version 0.54 distribution_type: module version: 0.27 name: Class-Spiffy author: "Ingy d\xC3\xB6t Net " license: perl requires: Scalar::Util: 0 perl: 5.6.1 abstract: Spiffy Perl Interface Framework For You Class-Spiffy-0.15/README0000644000076500007650000004221310367440627014605 0ustar ingyingy00000000000000NAME Class::Spiffy - Spiffy Framework with No Source Filtering SYNOPSIS package Keen; use strict; use warnings; use Class::Spiffy -base; field 'mirth'; const mood => ':-)'; sub happy { my $self = shift; if ($self->mood eq ':-(') { $self->mirth(-1); print "Cheer up!"; } super; } 1; DESCRIPTION "Class::Spiffy" is a framework and methodology for doing object oriented (OO) programming in Perl. Class::Spiffy combines the best parts of Exporter.pm, base.pm, mixin.pm and SUPER.pm into one magic foundation class. It attempts to fix all the nits and warts of traditional Perl OO, in a clean, straightforward and (perhaps someday) standard way. Class::Spiffy borrows ideas from other OO languages like Python, Ruby, Java and Perl 6. It also adds a few tricks of its own. If you take a look on CPAN, there are a ton of OO related modules. When starting a new project, you need to pick the set of modules that makes most sense, and then you need to use those modules in each of your classes. Class::Spiffy, on the other hand, has everything you'll probably need in one module, and you only need to use it once in one of your classes. If you make Class::Spiffy the base class of the basest class in your project, Class::Spiffy will automatically pass all of its magic to all of your subclasses. You may eventually forget that you're even using it! The most striking difference between Class::Spiffy and other Perl object oriented base classes, is that it has the ability to export things. If you create a subclass of Class::Spiffy, all the things that Class::Spiffy exports will automatically be exported by your subclass, in addition to any more things that you want to export. And if someone creates a subclass of your subclass, all of those things will be exported automatically, and so on. Think of it as "Inherited Exportation", and it uses the familiar Exporter.pm specification syntax. To use Class::Spiffy or any subclass of Class::Spiffy as a base class of your class, you specify the "-base" argument to the "use" command. use MySpiffyBaseModule -base; You can also use the traditional "use base 'MySpiffyBaseModule';" syntax and everything will work exactly the same. The only caveat is that Class::Spiffy must already be loaded. That's because Class::Spiffy rewires base.pm on the fly to do all the Spiffy magics. Class::Spiffy has support for Ruby-like mixins with Perl6-like roles. Just like "base" you can use either of the following invocations: use mixin 'MySpiffyBaseModule'; use MySpiffyBaseModule -mixin; The second version will only work if the class being mixed in is a subclass of Class::Spiffy. The first version will work in all cases, as long as Class::Spiffy has already been loaded. To limit the methods that get mixed in, use roles. (Hint: they work just like an Exporter list): use MySpiffyBaseModule -mixin => qw(:basics x y !foo); A useful feature of Class::Spiffy is that it exports two functions: "field" and "const" that can be used to declare the attributes of your class, and automatically generate accessor methods for them. The only difference between the two functions is that "const" attributes can not be modified; thus the accessor is much faster. One interesting aspect of OO programming is when a method calls the same method from a parent class. This is generally known as calling a super method. Perl's facility for doing this is butt ugly: sub cleanup { my $self = shift; $self->scrub; $self->SUPER::cleanup(@_); } Class::Spiffy makes it, er, super easy to call super methods. You just use the "super" function. You don't need to pass it any arguments because it automatically passes them on for you. Here's the same function with Class::Spiffy: sub cleanup { my $self = shift; $self->scrub; super; } Class::Spiffy has a special method for parsing arguments called "parse_arguments", that it also uses for parsing its own arguments. You declare which arguments are boolean (singletons) and which ones are paired, with two special methods called "boolean_arguments" and "paired_arguments". Parse arguments pulls out the booleans and pairs and returns them in an anonymous hash, followed by a list of the unmatched arguments. Finally, Class::Spiffy can export a few debugging functions "WWW", "XXX", "YYY" and "ZZZ". Each of them produces a YAML dump of its arguments. WWW warns the output, XXX dies with the output, YYY prints the output, and ZZZ confesses the output. If YAML doesn't suit your needs, you can switch all the dumps to Data::Dumper format with the "- dumper" option. That's Spiffy! Pretty Classy, eh? A Spiffy NOTE Class::Spiffy started off as the Spiffy.pm module. Class::Spiffy does everything Spiffy does except clever source filtering. So you can be sure that any module that uses Class::Spiffy, (like YAML.pm) doesn't use source filtering. If you don't like source filtering, this may help you sleep better at night. Spiffy EXPORTING Class::Spiffy implements a completely new idea in Perl. Modules that act both as object oriented classes and that also export functions. But it takes the concept of Exporter.pm one step further; it walks the entire @ISA path of a class and honors the export specifications of each module. Since Class::Spiffy calls on the Exporter module to do this, you can use all the fancy interface features that Exporter has, including tags and negation. Class::Spiffy considers all the arguments that don't begin with a dash to comprise the export specification. package Vehicle; use Spiffy -base; our $SERIAL_NUMBER = 0; our @EXPORT = qw($SERIAL_NUMBER); our @EXPORT_BASE = qw(tire horn); package Bicycle; use Vehicle -base, '!field'; In this case, "Bicycle-"isa('Vehicle')> and also all the things that "Vehicle" and "Class::Spiffy" export, will go into "Bicycle", except "field". Exporting can be very helpful when you've designed a system with hundreds of classes, and you want them all to have access to some functions or constants or variables. Just export them in your main base class and every subclass will get the functions they need. You can do almost everything that Exporter does because Class::Spiffy delegates the job to Exporter (after adding some Spiffy magic). Class::Spiffy offers a @EXPORT_BASE variable which is like @EXPORT, but only for usages that use "-base". Spiffy MIXINs & ROLEs If you've done much OO programming in Perl you've probably used Multiple Inheritance (MI), and if you've done much MI you've probably run into weird problems and headaches. Some languages like Ruby, attempt to resolve MI issues using a technique called mixins. Basically, all Ruby classes use only Single Inheritance (SI), and then *mixin* functionality from other modules if they need to. Mixins can be thought of at a simplistic level as *importing* the methods of another class into your subclass. But from an implementation standpoint that's not the best way to do it. Class::Spiffy does what Ruby does. It creates an empty anonymous class, imports everything into that class, and then chains the new class into your SI ISA path. In other words, if you say: package A; use B -base; use C -mixin; use D -mixin; You end up with a single inheritance chain of classes like this: A << A-D << A-C << B; "A-D" and "A-C" are the actual package names of the generated classes. The nice thing about this style is that mixing in C doesn't clobber any methods in A, and D doesn't conflict with A or C either. If you mixed in a method in C that was also in A, you can still get to it by using "super". When Class::Spiffy mixes in C, it pulls in all the methods in C that do not begin with an underscore. Actually it goes farther than that. If C is a subclass it will pull in every method that C "can" do through inheritance. This is very powerful, maybe too powerful. To limit what you mixin, Class::Spiffy borrows the concept of Roles from Perl6. The term role is used more loosely in Class::Spiffy though. It's much like an import list that the Exporter module uses, and you can use groups (tags) and negation. If the first element of your list uses negation, Class::Spiffy will start with all the methods that your mixin class can do. use E -mixin => qw(:tools walk !run !:sharp_tools); In this example, "walk" and "run" are methods that E can do, and "tools" and "sharp_tools" are roles of class E. How does class E define these roles? It very simply defines methods called "_role_tools" and "_role_sharp_tools" which return lists of more methods. (And possibly other roles!) The neat thing here is that since roles are just methods, they too can be inherited. Take that Perl6! Spiffy DEBUGGING The XXX function is very handy for debugging because you can insert it almost anywhere, and it will dump your data in nice clean YAML. Take the following statement: my @stuff = grep { /keen/ } $self->find($a, $b); If you have a problem with this statement, you can debug it in any of the following ways: XXX my @stuff = grep { /keen/ } $self->find($a, $b); my @stuff = XXX grep { /keen/ } $self->find($a, $b); my @stuff = grep { /keen/ } XXX $self->find($a, $b); my @stuff = grep { /keen/ } $self->find(XXX $a, $b); XXX is easy to insert and remove. It is also a tradition to mark uncertain areas of code with XXX. This will make the debugging dumpers easy to spot if you forget to take them out. WWW and YYY are nice because they dump their arguments and then return the arguments. This way you can insert them into many places and still have the code run as before. Use ZZZ when you need to die with both a YAML dump and a full stack trace. The debugging functions are exported by default if you use the "-base" option, but only if you have previously used the "-XXX" option. To export all 4 functions use the export tag: use SomeSpiffyModule ':XXX'; To force the debugging functions to use Data::Dumper instead of YAML: use SomeSpiffyModule -dumper; Spiffy FUNCTIONS This section describes the functions the Class::Spiffy exports. The "field", "const", "stub" and "super" functions are only exported when you use the "-base" option. * field Defines accessor methods for a field of your class: package Example; use Classs::Spiffy -base; field 'foo'; field bar => []; sub lalala { my $self == shift; $self->foo(42); push @{$self->{bar}}, $self->foo; } The first parameter passed to "field" is the name of the attribute being defined. Accessors can be given an optional default value. This value will be returned if no value for the field has been set in the object. * const const bar => 42; The "const" function is similar to except that it is immutable. It also does not store data in the object. You probably always want to give a "const" a default value, otherwise the generated method will be somewhat useless. * stub stub 'cigar'; The "stub" function generates a method that will die with an appropriate message. The idea is that subclasses must implement these methods so that the stub methods don't get called. * super If this function is called without any arguments, it will call the same method that it is in, higher up in the ISA tree, passing it all the same arguments. If it is called with arguments, it will use those arguments with $self in the front. In other words, it just works like you'd expect. sub foo { my $self = shift; super; # Same as $self->SUPER::foo(@_); super('hello'); # Same as $self->SUPER::foo('hello'); $self->bar(42); } sub new { my $self = super; $self->init; return $self; } "super" will simply do nothing if there is no super method. Finally, "super" does the right thing in AUTOLOAD subroutines. Spiffy METHODS This section lists all of the methods that any subclass of Class::Spiffy automatically inherits. * mixin A method to mixin a class at runtime. Takes the same arguments as "use mixin ...". Makes the target class a mixin of the caller. $self->mixin('SomeClass'); $object->mixin('SomeOtherClass' => 'some_method'); * parse_arguments This method takes a list of arguments and groups them into pairs. It allows for boolean arguments which may or may not have a value (defaulting to 1). The method returns a hash reference of all the pairs as keys and values in the hash. Any arguments that cannot be paired, are returned as a list. Here is an example: sub boolean_arguments { qw(-has_spots -is_yummy) } sub paired_arguments { qw(-name -size) } my ($pairs, @others) = $self->parse_arguments( 'red', 'white', -name => 'Ingy', -has_spots => -size => 'large', 'black', -is_yummy => 0, ); After this call, $pairs will contain: { -name => 'Ingy', -has_spots => 1, -size => 'large', -is_yummy => 0, } and @others will contain 'red', 'white', and 'black'. * boolean_arguments Returns the list of arguments that are recognized as being boolean. Override this method to define your own list. * paired_arguments Returns the list of arguments that are recognized as being paired. Override this method to define your own list. Spiffy ARGUMENTS When you "use" the Class::Spiffy module or a subclass of it, you can pass it a list of arguments. These arguments are parsed using the "parse_arguments" method described above. The special argument "- base", is used to make the current package a subclass of the Class::Spiffy module being used. Any non-paired parameters act like a normal import list; just like those used with the Exporter module. USING Class::Spiffy WITH base.pm The proper way to use a Class::Spiffy module as a base class is with the "-base" parameter to the "use" statement. This differs from typical modules where you would want to "use base". package Something; use Spiffy::Module -base; use base 'NonSpiffy::Module'; Now it may be hard to keep track of what's Spiffy and what is not. Therefore Class::Spiffy has actually been made to work with base.pm. You can say: package Something; use base 'Spiffy::Module'; use base 'NonSpiffy::Module'; "use base" is also very useful when your class is not an actual module (a separate file) but just a package in some file that has already been loaded. "base" will work whether the class is a module or not, while the "-base" syntax cannot work that way, since "use" always tries to load a module. base.pm Caveats To make Class::Spiffy work with base.pm, a dirty trick was played. Class::Spiffy swaps "base::import" with its own version. If the base modules are not Spiffy, Class::Spiffy calls the original base::import. If the base modules are Spiffy, then Class::Spiffy does its own thing. There are two caveats. * Class::Spiffy must be loaded first. If Class::Spiffy is not loaded and "use base" is invoked on a Class::Spiffy module, Class::Spiffy will die with a useful message telling the author to read this documentation. That's because Class::Spiffy needed to do the import swap beforehand. If you get this error, simply put a statement like this up front in your code: use Class::Spiffy (); * No Mixing "base.pm" can take multiple arguments. And this works with Class::Spiffy as long as all the base classes are Spiffy, or they are all non-Spiffy. If they are mixed, Class::Spiffy will die. In this case just use separate "use base" statements. AUTHOR Ingy döt Net COPYRIGHT Copyright (c) 2006. Ingy döt Net. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See Class-Spiffy-0.15/t/0000755000076500007650000000000010367440735014166 5ustar ingyingy00000000000000Class-Spiffy-0.15/t/autoload.t0000644000076500007650000000056210366103556016162 0ustar ingyingy00000000000000use lib 't', 'lib'; use strict; use warnings; use Class::Spiffy (); package A; use Class::Spiffy -base; sub AUTOLOAD { my $self = shift; super; join '+', $A::AUTOLOAD, @_; } package B; use base 'A'; sub AUTOLOAD { super; } package C; use base 'B'; sub AUTOLOAD { super; } package main; use Test::More tests => 1; is(C->foo(42), 'C::foo+42'); Class-Spiffy-0.15/t/base.t0000644000076500007650000000223710366103556015265 0ustar ingyingy00000000000000use lib 't', 'lib'; use strict; use warnings; package XXX; BEGIN {require Thing} use base 'Thing'; package Foo; use base 'Class::Spiffy'; BEGIN { @Foo::EXPORT=qw(xxx) } sub xxx {} package Bar; use base 'Foo', 'Thing'; package Boo; BEGIN { @Boo::EXPORT=qw(xxx) } sub xxx {} package Goo; use base 'Boo'; package Something; use base 'Class::Spiffy'; BEGIN { @Something::EXPORT = qw(qwerty) } sub qwerty {} package SomethingGood; use base 'Something'; package main; use Test::More tests => 24; ok(Thing->isa('Class::Spiffy')); ok(defined &XXX::thing); ok(defined &XXX::field); ok(defined &XXX::const); ok(defined &Foo::field); ok(defined &Foo::const); ok(defined &Foo::xxx); ok(Bar->isa('Class::Spiffy')); ok(Bar->isa('Foo')); ok(Bar->isa('Thing')); ok(defined &Bar::field); ok(defined &Bar::const); ok(defined &Bar::xxx); ok(defined &Bar::thing); ok(not Boo->isa('Class::Spiffy')); ok(defined &Boo::xxx); ok(not Goo->isa('Class::Spiffy')); ok(Goo->isa('Boo')); ok(not defined &Goo::xxx); ok(SomethingGood->isa('Something')); ok(SomethingGood->isa('Class::Spiffy')); ok(not SomethingGood->isa('Thing')); ok(not defined &SomethingGood::thing); ok(not @Class::Spiffy::ISA); Class-Spiffy-0.15/t/base2.t0000644000076500007650000000015310366103556015342 0ustar ingyingy00000000000000use Test::More tests => 1; use lib 't'; eval <<'...'; package Foo; use base 'NonSpiffy'; ... is $@, ''; Class-Spiffy-0.15/t/big-base.t0000644000076500007650000000027710366103556016026 0ustar ingyingy00000000000000use Test::More tests => 1; eval q{ package Foo; use Class::Spiffy -Base; }; like $@, qr{^\QUse of '-Base' with Class::Spiffy is illegal}, "Class::Spiffy users can't use -Base"; Class-Spiffy-0.15/t/cascade.t0000644000076500007650000000114310366103556015731 0ustar ingyingy00000000000000use lib 'lib'; package Foo; use strict; use Class::Spiffy -base; use Cwd; our @EXPORT = qw(cwd); package Bar; use strict; Foo->base; our @EXPORT = qw(doodle); sub doodle {} sub poodle {} package Baz; use strict; Bar->base; package main; use strict; use Test::More tests => 12; ok(not defined &Foo::import); ok(defined &Foo::cwd); ok(not defined &Foo::doodle); ok(not defined &Foo::poodle); ok(not defined &Bar::import); ok(defined &Bar::cwd); ok(defined &Bar::doodle); ok(defined &Bar::poodle); ok(not defined &Baz::import); ok(defined &Baz::cwd); ok(defined &Baz::doodle); ok(not defined &Baz::poodle); Class-Spiffy-0.15/t/const.t0000644000076500007650000000034210366103556015474 0ustar ingyingy00000000000000use lib 't', 'lib'; use strict; use warnings; package XXX; use Class::Spiffy -base; const foo => 42; package main; use Test::More tests => 3; my $xxx = XXX->new; is($xxx->foo, 42); is($xxx->foo(69), 42); is($xxx->foo, 42); Class-Spiffy-0.15/t/early.t0000644000076500007650000000046510366103556015470 0ustar ingyingy00000000000000use Test::More tests => 1; use lib 't'; SKIP: { skip 'XXX - fix later', 1; eval <<'...'; package Foo; use base 'Filter4'; ... like $@, qr/\QClass::Spiffy must be loaded before calling 'use base'/, "Caught attempt to use 'base' on Class::Spiffy module before loading Class::Spiffy"; } Class-Spiffy-0.15/t/export1.t0000644000076500007650000000136010366103556015751 0ustar ingyingy00000000000000package Foo; use strict; use Test::More tests => 20; use lib 't'; use Something; ok(not defined &Foo::import); ok(defined &Foo::thing); ok(ref(thing) eq 'Something'); ok(thing()->can('cool')); ok(thing()->isa('Something')); ok(thing()->isa('Thing')); ok(thing()->isa('Class::Spiffy')); is(join('-', @Foo::ISA), ''); ok(not defined &Foo::field); ok(not defined &Foo::spiffy_constructor); ok(not defined &Something::import); ok(defined &Something::thing); ok(defined &Something::field); ok(not defined &Something::spiffy_constructor); is(join('-', @Something::ISA), 'Thing'); ok(not defined &Thing::import); ok(defined &Thing::thing); ok(defined &Thing::field); ok(not defined &Thing::spiffy_constructor); is(join('-', @Thing::ISA), 'Class::Spiffy'); Class-Spiffy-0.15/t/export2.t0000644000076500007650000000063710366103556015760 0ustar ingyingy00000000000000use lib 't'; use strict; use warnings; package A; use Class::Spiffy -base; BEGIN {@A::EXPORT = qw($A1 $A2)} $A::A1 = 5; $A::A2 = 10; package B; use base 'A'; BEGIN {@B::EXPORT = qw($A2 $A3)} $B::A2 = 15; $B::A3 = 20; package main; use strict; use Test::More tests => 6; BEGIN {B->import} ok(defined $main::A1); ok(defined $main::A2); ok(defined $main::A3); is($main::A1, 5); is($main::A2, 15); is($main::A3, 20); Class-Spiffy-0.15/t/export3.t0000644000076500007650000000070510366103556015755 0ustar ingyingy00000000000000use lib 't'; use strict; use warnings; package A; use Class::Spiffy -base; BEGIN {@A::EXPORT_OK = qw($A1 $A2)} $A::A1 = 5; $A::A2 = 10; package B; use base 'A'; BEGIN {@B::EXPORT_OK = qw($A2 $A3)} $B::A2 = 15; $B::A3 = 20; package main; no warnings; use Test::More tests => 7; BEGIN {B->import(qw($A1 $A2 $A3 $A4))} ok(defined $main::A1); ok(defined $main::A2); ok(defined $main::A3); ok(not defined $main::A4); is($A1, 5); is($A2, 10); is($A3, 20); Class-Spiffy-0.15/t/export4.t0000644000076500007650000000172710366103556015763 0ustar ingyingy00000000000000use lib 't'; use strict; use warnings; package A; # Exporter before 5.8.4 needs the tag as the first thing imported use Class::Spiffy -base, qw(:XXX const); package B; use base 'A'; package C; use Class::Spiffy -XXX, -base; package D; use Class::Spiffy -base; package E; use Class::Spiffy -base, 'XXX'; package F; use Class::Spiffy -base; use Class::Spiffy 'XXX'; package main; use Test::More tests => 24; ok(not defined &A::field); ok(defined &A::const); ok(defined &A::XXX); ok(defined &A::YYY); ok(defined &B::field); ok(defined &B::const); ok(not defined &B::XXX); ok(not defined &B::YYY); ok(defined &C::field); ok(defined &C::const); ok(defined &C::XXX); ok(defined &C::YYY); ok(defined &D::field); ok(defined &D::const); ok(not defined &D::XXX); ok(not defined &D::YYY); ok(not defined &E::field); ok(not defined &E::const); ok(defined &E::XXX); ok(not defined &E::YYY); ok(defined &F::field); ok(defined &F::const); ok(defined &F::XXX); ok(not defined &F::YYY); Class-Spiffy-0.15/t/export5.t0000644000076500007650000000054610366103556015762 0ustar ingyingy00000000000000use lib 't', 'lib'; use strict; use warnings; package A; use Class::Spiffy -base; BEGIN {@A::EXPORT_OK = qw(dude)} const dude => 10; package B; use base 'A'; BEGIN { @B::EXPORT_OK = qw(dude); const dude => 20; } package C; BEGIN {B->import('dude')} package main; no warnings; use Test::More tests => 2; ok(defined $C::{dude}); is(C::dude(), 20); Class-Spiffy-0.15/t/export6.t0000644000076500007650000000042710366103556015761 0ustar ingyingy00000000000000use lib 't', 'lib'; use strict; use warnings; package A; use Class::Spiffy -base, ':XXX'; package B; use Class::Spiffy -base, ':XXX', 'field'; package main; use Test::More tests => 4; ok(not defined &A::field); ok(defined &B::field); ok(defined &A::XXX); ok(defined &B::XXX); Class-Spiffy-0.15/t/export7.t0000644000076500007650000000033710366103556015762 0ustar ingyingy00000000000000use Test::More; plan tests => 4; package B; use Class::Spiffy -base, -XXX; package A; use Class::Spiffy -base; package main; ok(not defined &A::XXX); ok(defined &A::field); ok(defined &B::XXX); ok(defined &B::field); Class-Spiffy-0.15/t/exporter.t0000644000076500007650000000025710366103556016223 0ustar ingyingy00000000000000package Foo; use Class::Spiffy -base; package autouse; use Test::More tests => 1; is 'Foo'->can('import'), \&Exporter::import, 'Class::Spiffy modules support autouse'; Class-Spiffy-0.15/t/field.t0000644000076500007650000000052610366103556015435 0ustar ingyingy00000000000000use lib 't', 'lib'; use strict; use warnings; use Class::Spiffy (); package Bar; package Foo; use base 'Class::Spiffy'; sub new { my $self = super; field -package => 'Bar', 'xxx'; } use Test::More tests => 4; Foo->new; ok(not defined $Foo::{-package}); ok(not defined &Foo::Bar); ok(not defined &Foo::xxx); ok(defined &Bar::xxx); Class-Spiffy-0.15/t/field2.t0000644000076500007650000000066310366103556015521 0ustar ingyingy00000000000000use lib 't', 'lib'; use strict; use warnings; package Foo; use Class::Spiffy -base; field one => []; field two => {}; field three => [1..4]; field four => {1..4}; package main; use Test::More tests => 5; use Class::Spiffy 'id'; my $f1 = Foo->new; my $f2 = Foo->new; ok(id($f1->one) ne id($f2->one)); ok(id($f1->two) ne id($f2->two)); is(scalar(@{$f1->three}), 4); is_deeply($f1->three, $f2->three); is_deeply($f1->four, $f2->four); Class-Spiffy-0.15/t/field3.t0000644000076500007650000000405010367342613015514 0ustar ingyingy00000000000000use lib 't', 'lib'; use strict; use warnings; package Foo; use Class::Spiffy -base; my $test1 = field test1 => []; my $test2 = field test2 => {}; my $test3 = field test3 => [1..4]; my $test4 = field test4 => {1..4}; my $test5 = field test5 => -weaken; my $test6 = field test6 => -init => '$self->setup(@_)'; my $test7 = field test7 => -weak => -init => '$self->setup(@_)'; package main; use Test::More tests => 7; my @expected = map { s/\r//g; $_ } split /\.\.\.\r?\n/, join '', ; my $i = 1; for my $expected (@expected) { is(eval '$test' . $i++, $expected); } __DATA__ sub { $_[0]->{test1} = [] unless exists $_[0]->{test1}; return $_[0]->{test1} unless $#_ > 0; $_[0]->{test1} = $_[1]; return $_[0]->{test1}; } ... sub { $_[0]->{test2} = {} unless exists $_[0]->{test2}; return $_[0]->{test2} unless $#_ > 0; $_[0]->{test2} = $_[1]; return $_[0]->{test2}; } ... sub { $_[0]->{test3} = [ 1, 2, 3, 4 ] unless exists $_[0]->{test3}; return $_[0]->{test3} unless $#_ > 0; $_[0]->{test3} = $_[1]; return $_[0]->{test3}; } ... sub { $_[0]->{test4} = { '1' => 2, '3' => 4 } unless exists $_[0]->{test4}; return $_[0]->{test4} unless $#_ > 0; $_[0]->{test4} = $_[1]; return $_[0]->{test4}; } ... sub { $_[0]->{test5} = '-weaken' unless exists $_[0]->{test5}; return $_[0]->{test5} unless $#_ > 0; $_[0]->{test5} = $_[1]; return $_[0]->{test5}; } ... sub { return $_[0]->{test6} = do { my $self = $_[0]; $self->setup(@_) } unless $#_ > 0 or defined $_[0]->{test6}; return $_[0]->{test6} unless $#_ > 0; $_[0]->{test6} = $_[1]; return $_[0]->{test6}; } ... sub { return do { $_[0]->{test7} = do { my $self = $_[0]; $self->setup(@_) }; Scalar::Util::weaken($_[0]->{test7}) if ref $_[0]->{test7}; $_[0]->{test7}; } unless $#_ > 0 or defined $_[0]->{test7}; return $_[0]->{test7} unless $#_ > 0; $_[0]->{test7} = $_[1]; Scalar::Util::weaken($_[0]->{test7}) if ref $_[0]->{test7}; return $_[0]->{test7}; } Class-Spiffy-0.15/t/mixin.t0000644000076500007650000000101410366103556015467 0ustar ingyingy00000000000000use lib 't', 'lib'; use strict; no strict 'refs'; use warnings; package A; use Class::Spiffy -base; field 'foo' => 17; package X; sub extra {99} package BB; use base 'X'; sub xxx {42} sub yyy {} sub _zzz {} package C; use base 'A'; use mixin 'BB'; package main; use Test::More tests => 10; my $c = C->new; ok($c->can('foo')); is($c->foo, 17); ok($c->can('extra')); is($c->extra, 99); ok($c->can('xxx')); is($c->xxx, 42); ok(not $c->can('_zzz')); is(@{C::ISA}, 1); is(${C::ISA}[0], 'C-BB'); is(${"C-BB::ISA"}[0], 'A'); Class-Spiffy-0.15/t/mixin2.t0000644000076500007650000000224510366103556015560 0ustar ingyingy00000000000000use lib 't', 'lib'; use Class::Spiffy (); package A; sub _role_a { qw(a1 a2 a3) } sub a1 {'a1' } sub a2 {'a2' } sub a3 {'a3' } sub _role_A { qw(A1 A2 A3) } sub A1 {'A1' } sub A2 {'A2' } sub A3 {'A3' } sub _role_aA { qw(:a :A foo) } sub foo {'foo'} package BB; use base 'A'; package X; use mixin A => qw(:a !a2); package X2; use mixin BB => qw(:a !a2); package X3; use mixin A => qw(!:A A2); package X4; use mixin A => qw(:aA !a1 !a1 !A1); package X5; use mixin A => qw(!:a !:A); package main; use Test::More tests => 32; ok(X->can('a1')); ok(not X->can('a2')); ok(X->can('a3')); ok(not X->can('A1')); is(X->a1, 'a1'); is(X->a3, 'a3'); ok(X2->can('a1')); ok(not X2->can('a2')); ok(X2->can('a3')); ok(not X2->can('A1')); is(X2->a1, 'a1'); is(X2->a3, 'a3'); ok(X3->can('a1')); ok(X3->can('a2')); ok(X3->can('a3')); ok(not X3->can('A1')); ok(X3->can('A2')); ok(not X3->can('A3')); ok(not X4->can('a1')); ok(X4->can('a2')); ok(X4->can('a3')); ok(not X4->can('A1')); ok(X4->can('A2')); ok(X4->can('A3')); ok(X4->can('foo')); ok(not X5->can('a1')); ok(not X5->can('a2')); ok(not X5->can('a3')); ok(not X5->can('A1')); ok(not X5->can('A2')); ok(not X5->can('A3')); ok(X5->can('foo')); Class-Spiffy-0.15/t/mixin3.t0000644000076500007650000000031310366103556015553 0ustar ingyingy00000000000000use lib 't', 'lib'; package A; use Class::Spiffy -base; package B; use Class::Spiffy -base; field foo => 42; package main; use Test::More tests => 1; my $a = A->new; $a->mixin('B'); is($a->foo, 42); Class-Spiffy-0.15/t/new.t0000644000076500007650000000052010366103556015135 0ustar ingyingy00000000000000use lib 't'; use strict; use warnings; package A; use Class::Spiffy -base; field 'x'; field 'y'; package main; use Test::More tests => 6; my $a1 = A->new; ok(not defined $a1->x); ok(not defined $a1->y); my $a2 = A->new(x => 5); is($a2->x, 5); ok(not defined $a2->y); my $a3 = A->new(x => 15, y => 10); is($a3->x, 15); is($a3->y, 10); Class-Spiffy-0.15/t/NonSpiffy.pm0000644000076500007650000000006710366103556016436 0ustar ingyingy00000000000000package NonSpiffy; use Thing; # Thing /is/ Spiffy 1; Class-Spiffy-0.15/t/package.t0000644000076500007650000000030510366103556015740 0ustar ingyingy00000000000000use lib 'lib'; use strict; use warnings; use Test::More tests => 2; package Foo; use Class::Spiffy -base => -package => 'Bar'; package main; ok(not defined &Foo::field); ok(defined &Bar::field); Class-Spiffy-0.15/t/parse.t0000644000076500007650000000025510366103556015463 0ustar ingyingy00000000000000use lib 'lib'; use strict; use warnings; use Test::More tests => 1; use Class::Spiffy; my $args = Class::Spiffy->parse_arguments(); ok(ref $args && ref($args) eq 'HASH'); Class-Spiffy-0.15/t/Something.pm0000644000076500007650000000022310366103556016452 0ustar ingyingy00000000000000package Something; use strict; sub thing { Something->new(@_) } our @EXPORT = qw(thing); use Thing -base; field color => 'blue'; sub cool {} 1; Class-Spiffy-0.15/t/stub.t0000644000076500007650000000034610366103556015327 0ustar ingyingy00000000000000use lib 't', 'lib'; use strict; use warnings; package XXX; use Class::Spiffy -base; stub 'foo'; package YYY; use base 'XXX'; package main; use Test::More tests => 1; my $y = YYY->new; eval {$y->foo}; like($@, qr/subclassed/); Class-Spiffy-0.15/t/super.t0000644000076500007650000000143210366103556015505 0ustar ingyingy00000000000000use lib 'lib'; package Foo; use strict; use Class::Spiffy -base; field 'xxx'; field 'dog'; field 'bog'; sub new { my $self = super; $self->xxx('XXX'); return $self; } sub poodle { my $self = shift; my $count = shift; $self->dog("$count poodle"); } sub doodle { my $self = shift; my $count = shift; $self->bog("$count doodle"); } package Bar; use strict; BEGIN { Foo->base } sub poodle { my $self = shift; super; $self->dog($self->dog . ' dogs'); } sub doodle { my $self = shift; eval 'eval "super"'; $self->bog($self->bog . ' bogs'); } package main; use strict; use Test::More tests => 3; my $f = Bar->new; is($f->{xxx}, 'XXX'); $f->poodle(3); is($f->{dog}, '3 poodle dogs'); $f->doodle(4); is($f->{bog}, '4 doodle bogs'); Class-Spiffy-0.15/t/super2.t0000644000076500007650000000113210366103556015564 0ustar ingyingy00000000000000use lib 'lib'; use strict; use warnings; package Alpha; use Class::Spiffy -base; sub three { print "ok 6\n"; } package Foo; use base 'Alpha'; sub one { super; print "ok 2\n"; } sub two { print "ok 4\n"; } package Bar; use base 'Foo'; sub one { super; print "ok 3\n"; } sub two { super; print "ok 5\n"; } package Baz; use base 'Bar'; sub one { print "ok 1\n"; super; } sub two { super; print "not ok 6\n"; } sub three { super; print "ok 7\n"; } package main; use strict; print "1..7\n"; Baz->new->one; Bar->new->two; Baz->new->three; Class-Spiffy-0.15/t/Thing.pm0000644000076500007650000000023610366103556015572 0ustar ingyingy00000000000000package Thing; use strict; use Class::Spiffy -base; use base 'Class::Spiffy'; our @EXPORT = qw(thing); field volume => 11; sub thing { Thing->new(@_) } 1;