=head1 NAME

XML::Twig::Handlers - promoting laziness through magic

=head1 DESCRIPTION

An XML::Twig subclass which you subclass, so you don't have to write

    twig_handlers => {
        blah=>\&blah_handler,
        ...
    },

explicitly.


=head1 SYNOPSIS

So if you had

    package MyTwiggy;

    require XML::Twig::Handlers;
    use base qw( XML::Twig::Handlers ); 

    sub blah_handler {
    }

Creating a C<new MyTwiggy> would essentially be the same as

    my $t = MyTwiggy->new(
        twig_handlers => {
            blah=>\&blah_handler
        }
    );

You could also have

    sub blah_root { }

which would magically translate to

    twig_roots => {
        blah => \&blah_root;
    }


=head1 CAVEAT

B<BEWARE>!!! There really is no reason for you to write 

    sub blah_handler { ... }
    sub blah_root { ... }

It is sufficient to write

    sub blah_h
    sub blah_r { ... }

Because

    # this is the regex i use to match methods
    /^[^_]+_[hHrR]/

You will get no warnings about possible conflicts, for example

    sub blah_h { ... }
    sub blah_H { ... }

=head1 BUGS

_all_ and _default_ are not supported because I keep getting
"unrecognized expression in handler" carped by XML::Twig.
Hopefully this will be resolved in the next version.

=cut


package XML::Twig::Handlers;

use vars qw( $VERSION @ISA );
require XML::Twig;
@ISA = qw( XML::Twig );
$VERSION = 0.01;

# now ripping off
# Devel::GetSymbols::symbols;
# no strict 'refs';

sub _symbols {
    my ($type, $package) = @_;
    $package = (caller)[0] unless defined $package;
#    croak 'Usage: symbols(type[, package])' unless defined $type;
    grep defined *{"${package}::$_"}{$type}, keys %{"${package}::"}
}

sub _handlers {
    my $pack = shift or (caller)[0];

    return
        map {
            my($r) = split/_/,$_,2;
            ( $r => \&{"${pack}::$_"} );
        } grep {
            /^[^_]+_[hH]/
#            /^(?:_all|_default|[^_]+)_[hH]/
          }  _symbols('CODE',$pack);
}

sub _roots {
    my $pack = shift or (caller)[0];

    return
        map {
            my($r) = split/_/,$_,2;
            ( $r => \&{"${pack}::$_"} );
        } grep {
            /^[^_]+_[rR]/
#            /^(?:_all|_default|[^_]+)_[rR]/
          }  _symbols('CODE',$pack);    
}

use strict;
BEGIN{eval q{use warnings;};} # only if we got'em

sub new {
    my( $pack, @options ) = @_;
    my @Handlers = _handlers($pack);
    my @Roots = _roots($pack);

    push @options, twig_roots => { @Roots } if @Roots;
    push @options, twig_handlers => { @Handlers } if @Handlers;

    return $pack->SUPER::new(@options);
}

1;
[download]

################################
## The Example
package MyTwiggy;
use vars qw( @ISA );
eval q{require XML::Twig::Handlers;}; # just in case
@ISA = qw( XML::Twig::Handlers );

sub Doc_root {
    my( $t, $doc)= @_;
    $doc->print;
    print "\n",'x'x69,"\n";
}

sub foo_h {
    my( $t, $foo) = @_;
    print "\n\t\t## saw foo ##\n";
}

1;

package main;

my $t = MyTwiggy->new(); 
print "$t\n";

$t->parse(\*DATA);


__END__
<Stream>
<Doc>
<foo>hey man</foo>
<foo>hey man2</foo>
</Doc>
<Doc>
<bar>hey man, how's it goin'?</bar>
</Doc>
<Doc>
<baz>pretty right on.</baz>
</Doc>
</Stream>
[download]