File Coverage

blib/lib/Bundle/ToolSet.pm

Criterion	Covered	Total	%
statement	26	26	100.0
branch	11	12	91.6
condition	3	3	100.0
subroutine	6	6	100.0
pod			n/a
total	46	47	97.8

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(){
  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);

#Parser makes you do some of the heavy lifting
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__