File Coverage

blib/lib/Text/PromptBalanced.pm

Criterion	Covered	Total	%
statement	63	63	100.0
branch	32	34	94.1
condition	6	9	66.6
subroutine	10	10	100.0
pod	0	1	0.0
total	111	117	94.8

package Text::PromptBalanced;

use strict;
use warnings;

require Exporter;

use vars qw(@ISA $VERSION @EXPORT_OK);
@ISA = qw(Exporter);
$VERSION = 0.02;
@EXPORT_OK = qw(balance_factory);

# {{{ sub balance_factory
sub balance_factory {
  my %config = @_;
  # {{{ Clean up configuration
  # Assign default behavior
  #
  if(defined $config{escape} and !ref($config{escape})) {
    $config{escape} = { type => 'escape', open => '\\' }
  }
  # We implement the 'ignore_in' behavior of comments in code, so no
  # rejiggering of the hash should be needed.

  # Canonicalize the hash.
  # This basically means changing 'ignore_in' string values to arrays.
  #
  for my $key (keys %config) {
    next unless defined $config{$key}{ignore_in};
    next if ref($config{$key}{ignore_in});
    $config{$key}{ignore_in} = [$config{$key}{ignore_in}];
  }
  # }}}
  # {{{ Build state hash
  my $state = {};
  for(keys %config) {
    # An end-of-line comment is only valid until the end of the input line, so
    # it will never have any state.
    # Escape characters by design don't affect balance, so they don't have
    # a state either.
    #
    next if $_ eq 'comment' and $config{$_}{type} eq 'to-eol';
    next if $_ eq 'escape';
    $state->{$_} = 0;
  }
  # }}}
  # {{{ Build actions
  my $action = {};
  for my $key (keys %config) {
    my $conf = $config{$key};
    my $type = $conf->{type};
    # {{{ Balanced
    if($type eq 'balanced') {
      $action->{$conf->{open}} = {
        type => $type,
        name => $key,
        action => sub { $state->{$key}++ },
        ignore_in => $conf->{ignore_in},
      };
      $action->{$conf->{close}} = {
        type => $type,
        name => $key,
        action => sub { --$state->{$key} },
        ignore_in => $conf->{ignore_in},
      };
    }
    # }}}
    # {{{ Unbalanced
    elsif($type eq 'unbalanced') {
      $action->{$conf->{open}} = {
        type => $type,
        name => $key,
        action => sub { $state->{$key} = 1 },
        ignore_in => $conf->{ignore_in},
      };
      $action->{$conf->{close}} = {
        type => $type,
        name => $key,
        action => sub { $state->{$key} = 0 },
        ignore_in => $conf->{ignore_in},
      };
    }
    # }}}
    # {{{ To-EOL
    elsif($type eq 'to-eol') {
      $action->{$conf->{open}} = {
        type => $type,
        name => $key,
        ignore_in => $conf->{ignore_in} },
    }
    # }}}
    # {{{ Toggle
    elsif($type eq 'toggle') {
      $action->{$conf->{open}} = {
        type => $type,
        name => $key,
        action => sub { $state->{$key} = !$state->{$key} },
        ignore_in => $conf->{ignore_in},
      };
    }
    # }}}
    # {{{ Escape
    elsif($type eq 'escape') {
      $action->{$conf->{open}} = {
        type => $type,
        name => $key,
        ignore_in => $conf->{ignore_in},
      };
    }
    # }}}
  }
  # }}}
  # {{{ Build the closure
  return (
    $state,
    sub {
      my $input = shift;
      # {{{ Main loop
      my $cur_char = 0;
      my $escape = 0;
      SPLIT: for my $char(split //,$input) {
        $cur_char++;
        next unless exists $action->{$char}; # Skip non-metacharacters
        # {{{ Handle meta characters
        # Escape characters simply suppress the meta nature of the next
        # character to come along.
        #
        if($escape == 1) {
          $escape = 0;
          next;
        }
        elsif($action->{$char}{type} eq 'escape') {
          $escape = 1;
          next;
        }
        # }}}
        # {{{ Handle comments
        # Effectively skip to the end if a comment to the end of line is
        # encountered, unless the comment should be ignored.
        #
        if($action->{$char}{type} eq 'to-eol' and
           $action->{$char}{name} eq 'comment') {
          for(@{$action->{$char}{ignore_in}}) {
            next SPLIT if $state->{$_} > 0;
          }
          last;
        }
        # }}}
        # {{{ Handle ignore_in tags
        for(@{$action->{$char}{ignore_in}}) {
          next SPLIT if $state->{$_} == 1;
        }
        $action->{$char}{action}->();
        # }}}
      }
      # }}}
      # {{{ The string is balanced only if all states are zero.
      for my $key (keys %$state) {
        next if $state->{$key} == 0;
        return 0;
      }
      return 1;
      # }}}
    }
  );
  # }}}
}
# }}}

1;
__END__