view release on metacpan or  search on metacpan

lib/Text/FIGlet/Control.pm  view on Meta::CPAN

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(<FLC>){
      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__
=pod

=head1 NAME

Text::FIGlet::Control - control file support for Text::FIGlet

=head1 SYNOPSIS

  use Text::FIGlet;

  my $flc = Text::FIGlet->new(-C=>'upper.flc');

  print $flc->tr("Hello World");

=head1 DESCRIPTION

Text::FIGlet::Control uses control files, which tell it to
map certain input characters to certain other characters,
similar to the Unix tr command. Control files can be
identified by the suffix I<.flc>. Most Text::FIGlet::Control
control files will be stored in FIGlet's default font directory.

The following control file commands are supported, for more
detail see F<figfont.txt> included with this distribution.

=over

=item f Freeze

A kind of "save state",
executes all previously accumulated translations before continuing.

=item t Translate

Both the explicit forms "t in out" and "t in-range out-range"
as well as the implicit form "number number".

B<Note that if you are mapping in negative characters,
you will need to C<figify> in Unicode mode I<-U>>. See also B<u> below.

=item u Unicode

Process text as Unicode (UTF-8).

Note that this is required for perl 5.6 if you are doing negative mapping.

=back

=head1 OPTIONS

=head2 C<new>

=over

=item B<-C=E<gt>>F<controlfile>