File Coverage

blib/lib/Text/FIGlet/Control.pm

Criterion	Covered	Total	%
statement	56	56	100.0
branch	20	22	90.9
condition	7	11	63.6
subroutine	7	7	100.0
pod	2	2	100.0
total	92	98	93.8

package Text::FIGlet::Control;
use strict;
use vars '$VERSION';
use Carp 'croak';
$VERSION = 2.15;

#'import' core support functions from parent with circular dependency
foreach( qw/_canonical _no/){
  no strict 'refs';
  *$_ = *{'Text::FIGlet::'.$_};
}

sub new{
  my $proto = shift;
  my $self = {-C=>[]};
  local($_, *FLC);

  my $code = '';
  my(@t_pre, @t_post);
  while( @_ ){
    my $s = shift;
    if( $s eq '-C' ){
	push(@{$self->{-C}}, shift); }
    else{
	$self->{$s} = shift; }
  }
  $self->{-d} ||= $ENV{FIGLIB}  || '/usr/games/lib/figlet/';
  $self->{"_\\"} = 1 if $^O =~ /MSWin32|DOS/i;


#  my $no = qr/0x[\da-fA-F]+|\d+/;

  foreach my $flc ( @{$self->{-C}} ){
    $self->{'_file'} = _canonical($self->{-d},
						$flc,
						qr/\.flc/,
						$self->{"_\\"});
    open(FLC, $self->{'_file'}) || croak("$!: $flc [$self->{_file}]");
    while(){
      next if /^flc2a|\s*#|^\s*$/;

      #XXX Is this adequate?
      $code .= 'use utf8;' if /^\s*u/;

      if( /^\s*$Text::FIGlet::RE{no}\s+$Text::FIGlet::RE{no}\s*/ ){
	#Only needed for decimals?!

	push @t_pre,  sprintf('\\x{%x}', _no($1, $2, $3));
	push @t_post, sprintf('\\x{%x}', _no($4, $5, $6));
      }
      elsif( /^\s*t\s+\\?$Text::FIGlet::RE{no}(?:-\\$Text::FIGlet::RE{no})?\s+\\?$Text::FIGlet::RE{no}(?:-\\$Text::FIGlet::RE{no})?\s*/ ){
	push @t_pre,  sprintf( '\\x{%x}', _no( $1, $2, $3));
	push @t_post, sprintf( '\\x{%x}', _no( $7, $8, $9));
	$t_pre[-1] .= sprintf('-\\x{%x}', _no( $4, $5, $6)) if$5;
	$t_post[-1].= sprintf('-\\x{%x}', _no($10,$11,$12))if$11;
      }
      elsif( /^\s*t\s+([^\s](?:-[^\s])?)\s+([^\s](?:-[^\s])?)\s*/ ){
	push @t_pre,  $1;
	push @t_post, $2;
      }
      if( /^\s*f/ || eof(FLC) ){
	@{$_} = map { s%/%\\/%g, $_ } @{$_} for( \@t_pre, \@t_post );
	$code  .= 'tr/' . join('', @t_pre) . '/' . join('', @t_post) . '/;';
	@t_pre = @t_post = ();
      }
    }
    close(FLC);
  }
  $self->{_sub} = eval "sub { local \$_ = shift; $code; return \$_ }";
  bless($self);
}

sub tr($){
  my $self = shift;
  $self->{_sub}->( shift || $_ );
}
1;
__END__