git.maemo.org Git - pkg-perl/blob - deb-src/libspiffy-perl/libspiffy-perl-0.30/lib/Spiffy.pm

   1 package Spiffy;
   2 use strict;
   3 use 5.006001;
   4 use warnings;
   5 use Carp;
   6 require Exporter;
   7 our $VERSION = '0.30';
   8 our @EXPORT = ();
   9 our @EXPORT_BASE = qw(field const stub super);
  10 our @EXPORT_OK = (@EXPORT_BASE, qw(id WWW XXX YYY ZZZ));
  11 our %EXPORT_TAGS = (XXX => [qw(WWW XXX YYY ZZZ)]);
  12
  13 my $stack_frame = 0;
  14 my $dump = 'yaml';
  15 my $bases_map = {};
  16
  17 sub WWW; sub XXX; sub YYY; sub ZZZ;
  18
  19 # This line is here to convince "autouse" into believing we are autousable.
  20 sub can {
  21     ($_[1] eq 'import' and caller()->isa('autouse'))
  22         ? \&Exporter::import        # pacify autouse's equality test
  23         : $_[0]->SUPER::can($_[1])  # normal case
  24 }
  25
  26 # TODO
  27 #
  28 # Exported functions like field and super should be hidden so as not to
  29 # be confused with methods that can be inherited.
  30 #
  31
  32 sub new {
  33     my $class = shift;
  34     $class = ref($class) || $class;
  35     my $self = bless {}, $class;
  36     while (@_) {
  37         my $method = shift;
  38         $self->$method(shift);
  39     }
  40     return $self;
  41 }
  42
  43 my $filtered_files = {};
  44 my $filter_dump = 0;
  45 my $filter_save = 0;
  46 our $filter_result = '';
  47 sub import {
  48     no strict 'refs';
  49     no warnings;
  50     my $self_package = shift;
  51
  52     # XXX Using parse_arguments here might cause confusion, because the
  53     # subclass's boolean_arguments and paired_arguments can conflict, causing
  54     # difficult debugging. Consider using something truly local.
  55     my ($args, @export_list) = do {
  56         local *boolean_arguments = sub {
  57             qw(
  58                 -base -Base -mixin -selfless
  59                 -XXX -dumper -yaml
  60                 -filter_dump -filter_save
  61             )
  62         };
  63         local *paired_arguments = sub { qw(-package) };
  64         $self_package->parse_arguments(@_);
  65     };
  66     return spiffy_mixin_import(scalar(caller(0)), $self_package, @export_list)
  67       if $args->{-mixin};
  68
  69     $filter_dump = 1 if $args->{-filter_dump};
  70     $filter_save = 1 if $args->{-filter_save};
  71     $dump = 'yaml' if $args->{-yaml};
  72     $dump = 'dumper' if $args->{-dumper};
  73
  74     local @EXPORT_BASE = @EXPORT_BASE;
  75
  76     if ($args->{-XXX}) {
  77         push @EXPORT_BASE, @{$EXPORT_TAGS{XXX}}
  78           unless grep /^XXX$/, @EXPORT_BASE;
  79     }
  80
  81     spiffy_filter()
  82       if ($args->{-selfless} or $args->{-Base}) and
  83          not $filtered_files->{(caller($stack_frame))[1]}++;
  84
  85     my $caller_package = $args->{-package} || caller($stack_frame);
  86     push @{"$caller_package\::ISA"}, $self_package
  87       if $args->{-Base} or $args->{-base};
  88
  89     for my $class (@{all_my_bases($self_package)}) {
  90         next unless $class->isa('Spiffy');
  91         my @export = grep {
  92             not defined &{"$caller_package\::$_"};
  93         } ( @{"$class\::EXPORT"},
  94             ($args->{-Base} or $args->{-base})
  95               ? @{"$class\::EXPORT_BASE"} : (),
  96           );
  97         my @export_ok = grep {
  98             not defined &{"$caller_package\::$_"};
  99         } @{"$class\::EXPORT_OK"};
 100
 101         # Avoid calling the expensive Exporter::export
 102         # if there is nothing to do (optimization)
 103         my %exportable = map { ($_, 1) } @export, @export_ok;
 104         next unless keys %exportable;
 105
 106         my @export_save = @{"$class\::EXPORT"};
 107         my @export_ok_save = @{"$class\::EXPORT_OK"};
 108         @{"$class\::EXPORT"} = @export;
 109         @{"$class\::EXPORT_OK"} = @export_ok;
 110         my @list = grep {
 111             (my $v = $_) =~ s/^[\!\:]//;
 112             $exportable{$v} or ${"$class\::EXPORT_TAGS"}{$v};
 113         } @export_list;
 114         Exporter::export($class, $caller_package, @list);
 115         @{"$class\::EXPORT"} = @export_save;
 116         @{"$class\::EXPORT_OK"} = @export_ok_save;
 117     }
 118 }
 119
 120 sub spiffy_filter {
 121     require Filter::Util::Call;
 122     my $done = 0;
 123     Filter::Util::Call::filter_add(
 124         sub {
 125             return 0 if $done;
 126             my ($data, $end) = ('', '');
 127             while (my $status = Filter::Util::Call::filter_read()) {
 128                 return $status if $status < 0;
 129                 if (/^__(?:END|DATA)__\r?$/) {
 130                     $end = $_;
 131                     last;
 132                 }
 133                 $data .= $_;
 134                 $_ = '';
 135             }
 136             $_ = $data;
 137             my @my_subs;
 138             s[^(sub\s+\w+\s+\{)(.*\n)]
 139              [${1}my \$self = shift;$2]gm;
 140             s[^(sub\s+\w+)\s*\(\s*\)(\s+\{.*\n)]
 141              [${1}${2}]gm;
 142             s[^my\s+sub\s+(\w+)(\s+\{)(.*)((?s:.*?\n))\}\n]
 143              [push @my_subs, $1; "\$$1 = sub$2my \$self = shift;$3$4\};\n"]gem;
 144             my $preclare = '';
 145             if (@my_subs) {
 146                 $preclare = join ',', map "\$$_", @my_subs;
 147                 $preclare = "my($preclare);";
 148             }
 149             $_ = "use strict;use warnings;$preclare${_};1;\n$end";
 150             if ($filter_dump) { print; exit }
 151             if ($filter_save) { $filter_result = $_; $_ = $filter_result; }
 152             $done = 1;
 153         }
 154     );
 155 }
 156
 157 sub base {
 158     push @_, -base;
 159     goto &import;
 160 }
 161
 162 sub all_my_bases {
 163     my $class = shift;
 164
 165     return $bases_map->{$class}
 166       if defined $bases_map->{$class};
 167
 168     my @bases = ($class);
 169     no strict 'refs';
 170     for my $base_class (@{"${class}::ISA"}) {
 171         push @bases, @{all_my_bases($base_class)};
 172     }
 173     my $used = {};
 174     $bases_map->{$class} = [grep {not $used->{$_}++} @bases];
 175 }
 176
 177 my %code = (
 178     sub_start =>
 179       "sub {\n",
 180     set_default =>
 181       "  \$_[0]->{%s} = %s\n    unless exists \$_[0]->{%s};\n",
 182     init =>
 183       "  return \$_[0]->{%s} = do { my \$self = \$_[0]; %s }\n" .
 184       "    unless \$#_ > 0 or defined \$_[0]->{%s};\n",
 185     weak_init =>
 186       "  return do {\n" .
 187       "    \$_[0]->{%s} = do { my \$self = \$_[0]; %s };\n" .
 188       "    Scalar::Util::weaken(\$_[0]->{%s}) if ref \$_[0]->{%s};\n" .
 189       "    \$_[0]->{%s};\n" .
 190       "  } unless \$#_ > 0 or defined \$_[0]->{%s};\n",
 191     return_if_get =>
 192       "  return \$_[0]->{%s} unless \$#_ > 0;\n",
 193     set =>
 194       "  \$_[0]->{%s} = \$_[1];\n",
 195     weaken =>
 196       "  Scalar::Util::weaken(\$_[0]->{%s}) if ref \$_[0]->{%s};\n",
 197     sub_end =>
 198       "  return \$_[0]->{%s};\n}\n",
 199 );
 200
 201 sub field {
 202     my $package = caller;
 203     my ($args, @values) = do {
 204         no warnings;
 205         local *boolean_arguments = sub { (qw(-weak)) };
 206         local *paired_arguments = sub { (qw(-package -init)) };
 207         Spiffy->parse_arguments(@_);
 208     };
 209     my ($field, $default) = @values;
 210     $package = $args->{-package} if defined $args->{-package};
 211     die "Cannot have a default for a weakened field ($field)"
 212         if defined $default && $args->{-weak};
 213     return if defined &{"${package}::$field"};
 214     require Scalar::Util if $args->{-weak};
 215     my $default_string =
 216         ( ref($default) eq 'ARRAY' and not @$default )
 217         ? '[]'
 218         : (ref($default) eq 'HASH' and not keys %$default )
 219           ? '{}'
 220           : default_as_code($default);
 221
 222     my $code = $code{sub_start};
 223     if ($args->{-init}) {
 224         my $fragment = $args->{-weak} ? $code{weak_init} : $code{init};
 225         $code .= sprintf $fragment, $field, $args->{-init}, ($field) x 4;
 226     }
 227     $code .= sprintf $code{set_default}, $field, $default_string, $field
 228       if defined $default;
 229     $code .= sprintf $code{return_if_get}, $field;
 230     $code .= sprintf $code{set}, $field;
 231     $code .= sprintf $code{weaken}, $field, $field
 232       if $args->{-weak};
 233     $code .= sprintf $code{sub_end}, $field;
 234
 235     my $sub = eval $code;
 236     die $@ if $@;
 237     no strict 'refs';
 238     *{"${package}::$field"} = $sub;
 239     return $code if defined wantarray;
 240 }
 241
 242 sub default_as_code {
 243     require Data::Dumper;
 244     local $Data::Dumper::Sortkeys = 1;
 245     my $code = Data::Dumper::Dumper(shift);
 246     $code =~ s/^\$VAR1 = //;
 247     $code =~ s/;$//;
 248     return $code;
 249 }
 250
 251 sub const {
 252     my $package = caller;
 253     my ($args, @values) = do {
 254         no warnings;
 255         local *paired_arguments = sub { (qw(-package)) };
 256         Spiffy->parse_arguments(@_);
 257     };
 258     my ($field, $default) = @values;
 259     $package = $args->{-package} if defined $args->{-package};
 260     no strict 'refs';
 261     return if defined &{"${package}::$field"};
 262     *{"${package}::$field"} = sub { $default }
 263 }
 264
 265 sub stub {
 266     my $package = caller;
 267     my ($args, @values) = do {
 268         no warnings;
 269         local *paired_arguments = sub { (qw(-package)) };
 270         Spiffy->parse_arguments(@_);
 271     };
 272     my ($field, $default) = @values;
 273     $package = $args->{-package} if defined $args->{-package};
 274     no strict 'refs';
 275     return if defined &{"${package}::$field"};
 276     *{"${package}::$field"} =
 277     sub {
 278         require Carp;
 279         Carp::confess
 280           "Method $field in package $package must be subclassed";
 281     }
 282 }
 283
 284 sub parse_arguments {
 285     my $class = shift;
 286     my ($args, @values) = ({}, ());
 287     my %booleans = map { ($_, 1) } $class->boolean_arguments;
 288     my %pairs = map { ($_, 1) } $class->paired_arguments;
 289     while (@_) {
 290         my $elem = shift;
 291         if (defined $elem and defined $booleans{$elem}) {
 292             $args->{$elem} = (@_ and $_[0] =~ /^[01]$/)
 293             ? shift
 294             : 1;
 295         }
 296         elsif (defined $elem and defined $pairs{$elem} and @_) {
 297             $args->{$elem} = shift;
 298         }
 299         else {
 300             push @values, $elem;
 301         }
 302     }
 303     return wantarray ? ($args, @values) : $args;
 304 }
 305
 306 sub boolean_arguments { () }
 307 sub paired_arguments { () }
 308
 309 # get a unique id for any node
 310 sub id {
 311     if (not ref $_[0]) {
 312         return 'undef' if not defined $_[0];
 313         \$_[0] =~ /\((\w+)\)$/o or die;
 314         return "$1-S";
 315     }
 316     require overload;
 317     overload::StrVal($_[0]) =~ /\((\w+)\)$/o or die;
 318     return $1;
 319 }
 320
 321 #===============================================================================
 322 # It's super, man.
 323 #===============================================================================
 324 package DB;
 325 {
 326     no warnings 'redefine';
 327     sub super_args {
 328         my @dummy = caller(@_ ? $_[0] : 2);
 329         return @DB::args;
 330     }
 331 }
 332
 333 package Spiffy;
 334 sub super {
 335     my $method;
 336     my $frame = 1;
 337     while ($method = (caller($frame++))[3]) {
 338         $method =~ s/.*::// and last;
 339     }
 340     my @args = DB::super_args($frame);
 341     @_ = @_ ? ($args[0], @_) : @args;
 342     my $class = ref $_[0] ? ref $_[0] : $_[0];
 343     my $caller_class = caller;
 344     my $seen = 0;
 345     my @super_classes = reverse grep {
 346         ($seen or $seen = ($_ eq $caller_class)) ? 0 : 1;
 347     } reverse @{all_my_bases($class)};
 348     for my $super_class (@super_classes) {
 349         no strict 'refs';
 350         next if $super_class eq $class;
 351         if (defined &{"${super_class}::$method"}) {
 352             ${"$super_class\::AUTOLOAD"} = ${"$class\::AUTOLOAD"}
 353               if $method eq 'AUTOLOAD';
 354             return &{"${super_class}::$method"};
 355         }
 356     }
 357     return;
 358 }
 359
 360 #===============================================================================
 361 # This code deserves a spanking, because it is being very naughty.
 362 # It is exchanging base.pm's import() for its own, so that people
 363 # can use base.pm with Spiffy modules, without being the wiser.
 364 #===============================================================================
 365 my $real_base_import;
 366 my $real_mixin_import;
 367
 368 BEGIN {
 369     require base unless defined $INC{'base.pm'};
 370     $INC{'mixin.pm'} ||= 'Spiffy/mixin.pm';
 371     $real_base_import = \&base::import;
 372     $real_mixin_import = \&mixin::import;
 373     no warnings;
 374     *base::import = \&spiffy_base_import;
 375     *mixin::import = \&spiffy_mixin_import;
 376 }
 377
 378 # my $i = 0;
 379 # while (my $caller = caller($i++)) {
 380 #     next unless $caller eq 'base' or $caller eq 'mixin';
 381 #     croak <<END;
 382 # Spiffy.pm must be loaded before calling 'use base' or 'use mixin' with a
 383 # Spiffy module. See the documentation of Spiffy.pm for details.
 384 # END
 385 # }
 386
 387 sub spiffy_base_import {
 388     my @base_classes = @_;
 389     shift @base_classes;
 390     no strict 'refs';
 391     goto &$real_base_import
 392       unless grep {
 393           eval "require $_" unless %{"$_\::"};
 394           $_->isa('Spiffy');
 395       } @base_classes;
 396     my $inheritor = caller(0);
 397     for my $base_class (@base_classes) {
 398         next if $inheritor->isa($base_class);
 399         croak "Can't mix Spiffy and non-Spiffy classes in 'use base'.\n",
 400               "See the documentation of Spiffy.pm for details\n  "
 401           unless $base_class->isa('Spiffy');
 402         $stack_frame = 1; # tell import to use different caller
 403         import($base_class, '-base');
 404         $stack_frame = 0;
 405     }
 406 }
 407
 408 sub mixin {
 409     my $self = shift;
 410     my $target_class = ref($self);
 411     spiffy_mixin_import($target_class, @_)
 412 }
 413
 414 sub spiffy_mixin_import {
 415     my $target_class = shift;
 416     $target_class = caller(0)
 417       if $target_class eq 'mixin';
 418     my $mixin_class = shift
 419       or die "Nothing to mixin";
 420     eval "require $mixin_class";
 421     my @roles = @_;
 422     my $pseudo_class = join '-', $target_class, $mixin_class, @roles;
 423     my %methods = spiffy_mixin_methods($mixin_class, @roles);
 424     no strict 'refs';
 425     no warnings;
 426     @{"$pseudo_class\::ISA"} = @{"$target_class\::ISA"};
 427     @{"$target_class\::ISA"} = ($pseudo_class);
 428     for (keys %methods) {
 429         *{"$pseudo_class\::$_"} = $methods{$_};
 430     }
 431 }
 432
 433 sub spiffy_mixin_methods {
 434     my $mixin_class = shift;
 435     no strict 'refs';
 436     my %methods = spiffy_all_methods($mixin_class);
 437     map {
 438         $methods{$_}
 439           ? ($_, \ &{"$methods{$_}\::$_"})
 440           : ($_, \ &{"$mixin_class\::$_"})
 441     } @_
 442       ? (get_roles($mixin_class, @_))
 443       : (keys %methods);
 444 }
 445
 446 sub get_roles {
 447     my $mixin_class = shift;
 448     my @roles = @_;
 449     while (grep /^!*:/, @roles) {
 450         @roles = map {
 451             s/!!//g;
 452             /^!:(.*)/ ? do {
 453                 my $m = "_role_$1";
 454                 map("!$_", $mixin_class->$m);
 455             } :
 456             /^:(.*)/ ? do {
 457                 my $m = "_role_$1";
 458                 ($mixin_class->$m);
 459             } :
 460             ($_)
 461         } @roles;
 462     }
 463     if (@roles and $roles[0] =~ /^!/) {
 464         my %methods = spiffy_all_methods($mixin_class);
 465         unshift @roles, keys(%methods);
 466     }
 467     my %roles;
 468     for (@roles) {
 469         s/!!//g;
 470         delete $roles{$1}, next
 471           if /^!(.*)/;
 472         $roles{$_} = 1;
 473     }
 474     keys %roles;
 475 }
 476
 477 sub spiffy_all_methods {
 478     no strict 'refs';
 479     my $class = shift;
 480     return if $class eq 'Spiffy';
 481     my %methods = map {
 482         ($_, $class)
 483     } grep {
 484         defined &{"$class\::$_"} and not /^_/
 485     } keys %{"$class\::"};
 486     my %super_methods;
 487     %super_methods = spiffy_all_methods(${"$class\::ISA"}[0])
 488       if @{"$class\::ISA"};
 489     %{{%super_methods, %methods}};
 490 }
 491
 492
 493 # END of naughty code.
 494 #===============================================================================
 495 # Debugging support
 496 #===============================================================================
 497 sub spiffy_dump {
 498     no warnings;
 499     if ($dump eq 'dumper') {
 500         require Data::Dumper;
 501         $Data::Dumper::Sortkeys = 1;
 502         $Data::Dumper::Indent = 1;
 503         return Data::Dumper::Dumper(@_);
 504     }
 505     require YAML;
 506     $YAML::UseVersion = 0;
 507     return YAML::Dump(@_) . "...\n";
 508 }
 509
 510 sub at_line_number {
 511     my ($file_path, $line_number) = (caller(1))[1,2];
 512     "  at $file_path line $line_number\n";
 513 }
 514
 515 sub WWW {
 516     warn spiffy_dump(@_) . at_line_number;
 517     return wantarray ? @_ : $_[0];
 518 }
 519
 520 sub XXX {
 521     die spiffy_dump(@_) . at_line_number;
 522 }
 523
 524 sub YYY {
 525     print spiffy_dump(@_) . at_line_number;
 526     return wantarray ? @_ : $_[0];
 527 }
 528
 529 sub ZZZ {
 530     require Carp;
 531     Carp::confess spiffy_dump(@_);
 532 }
 533
 534 1;
 535
 536 __END__
 537
 538 =head1 NAME
 539
 540 Spiffy - Spiffy Perl Interface Framework For You
 541
 542 =head1 SYNOPSIS
 543
 544     package Keen;
 545     use Spiffy -Base;
 546     field 'mirth';
 547     const mood => ':-)';
 548
 549     sub happy {
 550         if ($self->mood eq ':-(') {
 551             $self->mirth(-1);
 552             print "Cheer up!";
 553         }
 554         super;
 555     }
 556
 557 =head1 DESCRIPTION
 558
 559 "Spiffy" is a framework and methodology for doing object oriented (OO)
 560 programming in Perl. Spiffy combines the best parts of Exporter.pm,
 561 base.pm, mixin.pm and SUPER.pm into one magic foundation class. It
 562 attempts to fix all the nits and warts of traditional Perl OO, in a
 563 clean, straightforward and (perhaps someday) standard way.
 564
 565 Spiffy borrows ideas from other OO languages like Python, Ruby,
 566 Java and Perl 6. It also adds a few tricks of its own.
 567
 568 If you take a look on CPAN, there are a ton of OO related modules. When
 569 starting a new project, you need to pick the set of modules that makes
 570 most sense, and then you need to use those modules in each of your
 571 classes. Spiffy, on the other hand, has everything you'll probably need
 572 in one module, and you only need to use it once in one of your classes.
 573 If you make Spiffy.pm the base class of the basest class in your
 574 project, Spiffy will automatically pass all of its magic to all of your
 575 subclasses. You may eventually forget that you're even using it!
 576
 577 The most striking difference between Spiffy and other Perl object
 578 oriented base classes, is that it has the ability to export things.
 579 If you create a subclass of Spiffy, all the things that Spiffy
 580 exports will automatically be exported by your subclass, in addition to
 581 any more things that you want to export. And if someone creates a
 582 subclass of your subclass, all of those things will be exported
 583 automatically, and so on. Think of it as "Inherited Exportation", and it
 584 uses the familiar Exporter.pm specification syntax.
 585
 586 To use Spiffy or any subclass of Spiffy as a base class of your class,
 587 you specify the C<-base> argument to the C<use> command.
 588
 589     use MySpiffyBaseModule -base;
 590
 591 You can also use the traditional C<use base 'MySpiffyBaseModule';>
 592 syntax and everything will work exactly the same. The only caveat is
 593 that Spiffy.pm must already be loaded. That's because Spiffy rewires
 594 base.pm on the fly to do all the Spiffy magics.
 595
 596 Spiffy has support for Ruby-like mixins with Perl6-like roles. Just like
 597 C<base> you can use either of the following invocations:
 598
 599     use mixin 'MySpiffyBaseModule';
 600     use MySpiffyBaseModule -mixin;
 601
 602 The second version will only work if the class being mixed in is a
 603 subclass of Spiffy.  The first version will work in all cases, as long
 604 as Spiffy has already been loaded.
 605
 606 To limit the methods that get mixed in, use roles. (Hint: they work just like
 607 an Exporter list):
 608
 609     use MySpiffyBaseModule -mixin => qw(:basics x y !foo);
 610
 611 In object oriented Perl almost every subroutine is a method. Each method
 612 gets the object passed to it as its first argument. That means
 613 practically every subroutine starts with the line:
 614
 615      my $self = shift;
 616
 617 Spiffy provides a simple, optional filter mechanism to insert that line
 618 for you, resulting in cleaner code. If you figure an average method has
 619 10 lines of code, that's 10% of your code! To turn this option on, you
 620 just use the C<-Base> option instead of the C<-base> option, or add the
 621 C<-selfless> option. If source filtering makes you queazy, don't use the
 622 feature. I personally find it addictive in my quest for writing squeaky
 623 clean, maintainable code.
 624
 625 A useful feature of Spiffy is that it exports two functions: C<field>
 626 and C<const> that can be used to declare the attributes of your class,
 627 and automatically generate accessor methods for them. The only
 628 difference between the two functions is that C<const> attributes can not
 629 be modified; thus the accessor is much faster.
 630
 631 One interesting aspect of OO programming is when a method calls the same
 632 method from a parent class. This is generally known as calling a super
 633 method. Perl's facility for doing this is butt ugly:
 634
 635     sub cleanup {
 636         my $self = shift;
 637         $self->scrub;
 638         $self->SUPER::cleanup(@_);
 639     }
 640
 641 Spiffy makes it, er, super easy to call super methods. You just use
 642 the C<super> function. You don't need to pass it any arguments
 643 because it automatically passes them on for you. Here's the same
 644 function with Spiffy:
 645
 646     sub cleanup {
 647         $self->scrub;
 648         super;
 649     }
 650
 651 Spiffy has a special method for parsing arguments called
 652 C<parse_arguments>, that it also uses for parsing its own arguments. You
 653 declare which arguments are boolean (singletons) and which ones are
 654 paired, with two special methods called C<boolean_arguments> and
 655 C<paired_arguments>. Parse arguments pulls out the booleans and pairs
 656 and returns them in an anonymous hash, followed by a list of the
 657 unmatched arguments.
 658
 659 Finally, Spiffy can export a few debugging functions C<WWW>, C<XXX>,
 660 C<YYY> and C<ZZZ>. Each of them produces a YAML dump of its arguments.
 661 WWW warns the output, XXX dies with the output, YYY prints the output,
 662 and ZZZ confesses the output. If YAML doesn't suit your needs, you can
 663 switch all the dumps to Data::Dumper format with the C<-dumper> option.
 664
 665 That's Spiffy!
 666
 667 =head1 Spiffy EXPORTING
 668
 669 Spiffy implements a completely new idea in Perl. Modules that act both
 670 as object oriented classes and that also export functions. But it
 671 takes the concept of Exporter.pm one step further; it walks the entire
 672 C<@ISA> path of a class and honors the export specifications of each
 673 module. Since Spiffy calls on the Exporter module to do this, you can
 674 use all the fancy interface features that Exporter has, including tags
 675 and negation.
 676
 677 Spiffy considers all the arguments that don't begin with a dash to
 678 comprise the export specification.
 679
 680     package Vehicle;
 681     use Spiffy -base;
 682     our $SERIAL_NUMBER = 0;
 683     our @EXPORT = qw($SERIAL_NUMBER);
 684     our @EXPORT_BASE = qw(tire horn);
 685
 686     package Bicycle;
 687     use Vehicle -base, '!field';
 688     $self->inflate(tire);
 689
 690 In this case, C<Bicycle->isa('Vehicle')> and also all the things
 691 that C<Vehicle> and C<Spiffy> export, will go into C<Bicycle>,
 692 except C<field>.
 693
 694 Exporting can be very helpful when you've designed a system with
 695 hundreds of classes, and you want them all to have access to some
 696 functions or constants or variables. Just export them in your main base
 697 class and every subclass will get the functions they need.
 698
 699 You can do almost everything that Exporter does because Spiffy delegates
 700 the job to Exporter (after adding some Spiffy magic). Spiffy offers a
 701 C<@EXPORT_BASE> variable which is like C<@EXPORT>, but only for usages
 702 that use C<-base>.
 703
 704 =head1 Spiffy MIXINs & ROLEs
 705
 706 If you've done much OO programming in Perl you've probably used Multiple
 707 Inheritance (MI), and if you've done much MI you've probably run into
 708 weird problems and headaches. Some languages like Ruby, attempt to
 709 resolve MI issues using a technique called mixins. Basically, all Ruby
 710 classes use only Single Inheritance (SI), and then I<mixin>
 711 functionality from other modules if they need to.
 712
 713 Mixins can be thought of at a simplistic level as I<importing> the
 714 methods of another class into your subclass. But from an implementation
 715 standpoint that's not the best way to do it. Spiffy does what Ruby
 716 does. It creates an empty anonymous class, imports everything into that
 717 class, and then chains the new class into your SI ISA path. In other
 718 words, if you say:
 719
 720     package A;
 721     use B -base;
 722     use C -mixin;
 723     use D -mixin;
 724
 725 You end up with a single inheritance chain of classes like this:
 726
 727     A << A-D << A-C << B;
 728
 729 C<A-D> and C<A-C> are the actual package names of the generated
 730 classes. The nice thing about this style is that mixing in C doesn't
 731 clobber any methods in A, and D doesn't conflict with A or C either. If
 732 you mixed in a method in C that was also in A, you can still get to it
 733 by using C<super>.
 734
 735 When Spiffy mixes in C, it pulls in all the methods in C that do not
 736 begin with an underscore. Actually it goes farther than that. If C is a
 737 subclass it will pull in every method that C C<can> do through
 738 inheritance. This is very powerful, maybe too powerful.
 739
 740 To limit what you mixin, Spiffy borrows the concept of Roles from
 741 Perl6. The term role is used more loosely in Spiffy though. It's much
 742 like an import list that the Exporter module uses, and you can use
 743 groups (tags) and negation. If the first element of your list uses
 744 negation, Spiffy will start with all the methods that your mixin
 745 class can do.
 746
 747     use E -mixin => qw(:tools walk !run !:sharp_tools);
 748
 749 In this example, C<walk> and C<run> are methods that E can do, and
 750 C<tools> and C<sharp_tools> are roles of class E. How does class E
 751 define these roles? It very simply defines methods called C<_role_tools>
 752 and C<_role_sharp_tools> which return lists of more methods. (And
 753 possibly other roles!) The neat thing here is that since roles are just
 754 methods, they too can be inherited. Take B<that> Perl6!
 755
 756 =head1 Spiffy FILTERING
 757
 758 By using the C<-Base> flag instead of C<-base> you never need to write the
 759 line:
 760
 761     my $self = shift;
 762
 763 This statement is added to every subroutine in your class by using a source
 764 filter. The magic is simple and fast, so there is litte performance penalty
 765 for creating clean code on par with Ruby and Python.
 766
 767     package Example;
 768     use Spiffy -Base;
 769
 770     sub crazy {
 771         $self->nuts;
 772     }
 773     sub wacky { }
 774     sub new() {
 775         bless [], shift;
 776     }
 777
 778 is exactly the same as:
 779
 780     package Example;
 781     use Spiffy -base;
 782     use strict;use warnings;
 783     sub crazy {my $self = shift;
 784         $self->nuts;
 785     }
 786     sub wacky {my $self = shift; }
 787     sub new {
 788         bless [], shift;
 789     }
 790     ;1;
 791
 792 Note that the empty parens after the subroutine C<new> keep it from
 793 having a $self added. Also note that the extra code is added to existing
 794 lines to ensure that line numbers are not altered.
 795
 796 C<-Base> also turns on the strict and warnings pragmas, and adds that
 797 annoying '1;' line to your module.
 798
 799 =head1 PRIVATE METHODS
 800
 801 Spiffy now has support for private methods when you use the '-Base' filter
 802 mechanism. You just declare the subs with the C<my> keyword, and call them
 803 with a C<'$'> in front. Like this:
 804
 805     package Keen;
 806     use SomethingSpiffy -Base;
 807
 808     # normal public method
 809     sub swell {
 810         $self->$stinky;
 811     }
 812
 813     # private lexical method. uncallable from outside this file.
 814     my sub stinky {
 815         ...
 816     }
 817
 818 =head1 Spiffy DEBUGGING
 819
 820 The XXX function is very handy for debugging because you can insert it
 821 almost anywhere, and it will dump your data in nice clean YAML. Take the
 822 following statement:
 823
 824     my @stuff = grep { /keen/ } $self->find($a, $b);
 825
 826 If you have a problem with this statement, you can debug it in any of the
 827 following ways:
 828
 829     XXX my @stuff = grep { /keen/ } $self->find($a, $b);
 830     my @stuff = XXX grep { /keen/ } $self->find($a, $b);
 831     my @stuff = grep { /keen/ } XXX $self->find($a, $b);
 832     my @stuff = grep { /keen/ } $self->find(XXX $a, $b);
 833
 834 XXX is easy to insert and remove. It is also a tradition to mark
 835 uncertain areas of code with XXX. This will make the debugging dumpers
 836 easy to spot if you forget to take them out.
 837
 838 WWW and YYY are nice because they dump their arguments and then return the
 839 arguments. This way you can insert them into many places and still have the
 840 code run as before. Use ZZZ when you need to die with both a YAML dump and a
 841 full stack trace.
 842
 843 The debugging functions are exported by default if you use the C<-base>
 844 option, but only if you have previously used the C<-XXX> option. To
 845 export all 4 functions use the export tag:
 846
 847     use SomeSpiffyModule ':XXX';
 848
 849 To force the debugging functions to use Data::Dumper instead of YAML:
 850
 851     use SomeSpiffyModule -dumper;
 852
 853 =head1 Spiffy FUNCTIONS
 854
 855 This section describes the functions the Spiffy exports. The C<field>,
 856 C<const>, C<stub> and C<super> functions are only exported when you use
 857 the C<-base> or C<-Base> options.
 858
 859 =over 4
 860
 861 =item * field
 862
 863 Defines accessor methods for a field of your class:
 864
 865     package Example;
 866     use Spiffy -Base;
 867
 868     field 'foo';
 869     field bar => [];
 870
 871     sub lalala {
 872         $self->foo(42);
 873         push @{$self->{bar}}, $self->foo;
 874     }
 875
 876 The first parameter passed to C<field> is the name of the attribute
 877 being defined. Accessors can be given an optional default value.
 878 This value will be returned if no value for the field has been set
 879 in the object.
 880
 881 =item * const
 882
 883     const bar => 42;
 884
 885 The C<const> function is similar to <field> except that it is immutable.
 886 It also does not store data in the object. You probably always want to
 887 give a C<const> a default value, otherwise the generated method will be
 888 somewhat useless.
 889
 890 =item * stub
 891
 892     stub 'cigar';
 893
 894 The C<stub> function generates a method that will die with an
 895 appropriate message. The idea is that subclasses must implement these
 896 methods so that the stub methods don't get called.
 897
 898 =item * super
 899
 900 If this function is called without any arguments, it will call the same
 901 method that it is in, higher up in the ISA tree, passing it all the
 902 same arguments. If it is called with arguments, it will use those
 903 arguments with C<$self> in the front. In other words, it just works
 904 like you'd expect.
 905
 906     sub foo {
 907         super;             # Same as $self->SUPER::foo(@_);
 908         super('hello');    # Same as $self->SUPER::foo('hello');
 909         $self->bar(42);
 910     }
 911
 912     sub new() {
 913         my $self = super;
 914         $self->init;
 915         return $self;
 916     }
 917
 918 C<super> will simply do nothing if there is no super method. Finally,
 919 C<super> does the right thing in AUTOLOAD subroutines.
 920
 921 =back
 922
 923 =head1 Spiffy METHODS
 924
 925 This section lists all of the methods that any subclass of Spiffy
 926 automatically inherits.
 927
 928 =over 4
 929
 930 =item * mixin
 931
 932 A method to mixin a class at runtime. Takes the same arguments as C<use
 933 mixin ...>. Makes the target class a mixin of the caller.
 934
 935     $self->mixin('SomeClass');
 936     $object->mixin('SomeOtherClass' => 'some_method');
 937
 938 =item * parse_arguments
 939
 940 This method takes a list of arguments and groups them into pairs. It
 941 allows for boolean arguments which may or may not have a value
 942 (defaulting to 1). The method returns a hash reference of all the pairs
 943 as keys and values in the hash. Any arguments that cannot be paired, are
 944 returned as a list. Here is an example:
 945
 946     sub boolean_arguments { qw(-has_spots -is_yummy) }
 947     sub paired_arguments { qw(-name -size) }
 948     my ($pairs, @others) = $self->parse_arguments(
 949         'red', 'white',
 950         -name => 'Ingy',
 951         -has_spots =>
 952         -size => 'large',
 953         'black',
 954         -is_yummy => 0,
 955     );
 956
 957 After this call, C<$pairs> will contain:
 958
 959     {
 960         -name => 'Ingy',
 961         -has_spots => 1,
 962         -size => 'large',
 963         -is_yummy => 0,
 964     }
 965
 966 and C<@others> will contain 'red', 'white', and 'black'.
 967
 968 =item * boolean_arguments
 969
 970 Returns the list of arguments that are recognized as being boolean. Override
 971 this method to define your own list.
 972
 973 =item * paired_arguments
 974
 975 Returns the list of arguments that are recognized as being paired. Override
 976 this method to define your own list.
 977
 978 =back
 979
 980 =head1 Spiffy ARGUMENTS
 981
 982 When you C<use> the Spiffy module or a subclass of it, you can pass it a
 983 list of arguments. These arguments are parsed using the
 984 C<parse_arguments> method described above. The special argument
 985 C<-base>, is used to make the current package a subclass of the Spiffy
 986 module being used.
 987
 988 Any non-paired parameters act like a normal import list; just like those
 989 used with the Exporter module.
 990
 991 =head1 USING Spiffy WITH base.pm
 992
 993 The proper way to use a Spiffy module as a base class is with the C<-base>
 994 parameter to the C<use> statement. This differs from typical modules where you
 995 would want to C<use base>.
 996
 997     package Something;
 998     use Spiffy::Module -base;
 999     use base 'NonSpiffy::Module';
1000
1001 Now it may be hard to keep track of what's Spiffy and what is not.
1002 Therefore Spiffy has actually been made to work with base.pm. You can
1003 say:
1004
1005     package Something;
1006     use base 'Spiffy::Module';
1007     use base 'NonSpiffy::Module';
1008
1009 C<use base> is also very useful when your class is not an actual module (a
1010 separate file) but just a package in some file that has already been loaded.
1011 C<base> will work whether the class is a module or not, while the C<-base>
1012 syntax cannot work that way, since C<use> always tries to load a module.
1013
1014 =head2 base.pm Caveats
1015
1016 To make Spiffy work with base.pm, a dirty trick was played. Spiffy swaps
1017 C<base::import> with its own version. If the base modules are not Spiffy,
1018 Spiffy calls the original base::import. If the base modules are Spiffy,
1019 then Spiffy does its own thing.
1020
1021 There are two caveats.
1022
1023 =over 4
1024
1025 =item * Spiffy must be loaded first.
1026
1027 If Spiffy is not loaded and C<use base> is invoked on a Spiffy module,
1028 Spiffy will die with a useful message telling the author to read this
1029 documentation. That's because Spiffy needed to do the import swap
1030 beforehand.
1031
1032 If you get this error, simply put a statement like this up front in
1033 your code:
1034
1035     use Spiffy ();
1036
1037 =item * No Mixing
1038
1039 C<base.pm> can take multiple arguments. And this works with Spiffy as
1040 long as all the base classes are Spiffy, or they are all non-Spiffy. If
1041 they are mixed, Spiffy will die. In this case just use separate C<use
1042 base> statements.
1043
1044 =back
1045
1046 =head1 Spiffy TODO LIST
1047
1048 Spiffy is a wonderful way to do OO programming in Perl, but it is still
1049 a work in progress. New things will be added, and things that don't work
1050 well, might be removed.
1051
1052 =head1 AUTHOR
1053
1054 Ingy döt Net <ingy@cpan.org>
1055
1056 =head1 COPYRIGHT
1057
1058 Copyright (c) 2006. Ingy döt Net. All rights reserved.
1059 Copyright (c) 2004. Brian Ingerson. All rights reserved.
1060
1061 This program is free software; you can redistribute it and/or modify it
1062 under the same terms as Perl itself.
1063
1064 See L<http://www.perl.com/perl/misc/Artistic.html>
1065
1066 =cut