Bundle::ToolSet - write-once ToolSet+Bundle hybrid

package Bundle::ToolSet;
use ToolSet 0.99;
use base 'ToolSet';
our $VERSION = 0.1;

BEGIN{
  #Extra-funky user customization here
}

#NO USER SERVICABLE PARTS BELOW, edit POD =head1 CONTENTS
my $parser = Bundle::ToolSet_Pod->new();

#Permit fat commas, otherwise: parse_file( *Bundle::ToolSet_Pod::DATA );
my @LINES;
while(<Bundle::ToolSet_Pod::DATA>){
  s/\s*=>\s*/ /g;
  push @LINES, $_;
}
$parser->parse_lines(@LINES, undef);

ToolSet->export(@{$_}) for @{$parser->{module}};

foreach( @{$parser->{pragma}} ){
  my $toggle = pop @${_};

  if( $toggle eq '-' ){
    ToolSet->use_pragma($_->[0], split/\s+/, $_->[1]); }
  elsif( $toggle eq '+' ){
    ToolSet->no_pragma ($_->[0], split/\s+/, $_->[1]); }
  else{
    warn "Something's rotten in Denmark.";  }
}

1;

package Bundle::ToolSet_Pod;
our $VERSION = 0.01;
use base qw(Pod::Simple);

#<grumble>Parser makes you do some of the heavy lifting</grumble>
our $MODE;

sub _handle_element_start {
  my($undef, $elem) = @_;
  $MODE = 1 if $elem =~ /head1/i;
  $MODE = 0 unless $elem =~ /head1|Para/;
}

sub _handle_text{
  my($self, $text) = @_;

  if( $MODE && $text =~ /^CONTENTS/i ){
    $MODE = 2;
    $self->{module} = [];
    $self->{pragma} = [];
    return;
  }
  return unless $MODE == 2;

  if( $text =~
	/\s*             #padding
		([\w:']+)        #package

	 	 \s*             #padding
		(\d*(?:\.\d+)*)? #optional version

		(?:              #optional comment

                (?:              #"Comment"
	    	    \s*          #padding
                    -\s+           #delimiter

                    (?:            #optional extensions
	    	    \s*          #padding
	    	    (.*)         #import
                        ([+-])       #no?
	    	    \s*          #padding
                    )?

                    (.+)?          #actual comment 
                )?
            )?
            /x ){
#    print "#$text \nP<$1> V<$2> I<$3> N<$4> C<$5>\n";

    #XXX ToolSet doesn't support version specifications...
    if( $1 eq lc($1) ){ #ISA pragma
      push @{$self->{pragma}}, [$1, $3, $4];
    }
    else{
      push @{$self->{module}}, [$1, $3];
    }
  }
}

1;

__DATA__