File Coverage

blib/lib/Blatte.pm

Criterion	Covered	Total	%
statement	55	63	87.3
branch	19	28	67.8
condition	8	12	66.6
subroutine	14	15	93.3
pod	8	8	100.0
total	104	126	82.5

package Blatte;

use strict;
use base 'Exporter';
use vars qw($VERSION @EXPORT_OK);

use Blatte::Ws;

BEGIN {
  $VERSION = '0.9.4';
  @EXPORT_OK = qw(Parse traverse
                  flatten
                  wrapws unwrapws wsof
                  true quote);
}

my $parser;

sub Parse {
  my $input = shift;

  if (!defined($parser)) {
    use Blatte::Parser;
    $parser = new Blatte::Parser() unless defined($parser);
  }

  $parser->parse($input);
}

sub wrapws {
  my($ws, $obj) = @_;
  new Blatte::Ws($ws, $obj);
}

sub unwrapws {
  my $obj = shift;
  if (defined($obj) && UNIVERSAL::isa($obj, 'Blatte::Ws')) {
    return &unwrapws($obj->obj());
  }
  $obj;
}

sub wsof {
  my $obj = shift;
  if (defined($obj) && UNIVERSAL::isa($obj, 'Blatte::Ws')) {
    return $obj->ws();
  }
  '';
}

sub true {
  my $obj = &unwrapws(shift);

  if (defined($obj) && (ref($obj) eq 'ARRAY')) {
    @$obj && $obj;              # empty array counts as false
  } else {
    $obj;                       # else use Perl rules
  }
}

sub quote {
  my $str = shift;

  if ($str eq '') {
    $str = '\\"\\"';
  } elsif ($str =~ /\s/) {
    $str =~ s/\\/\\\\/g;
    $str = "\\\"$str\\\"";
  } else {
    $str =~ s/([\\{}])/\\$1/g;
  }
  $str;
}

sub traverse {
  my($obj, $cb, $ws) = @_;

  if (UNIVERSAL::isa($obj, 'Blatte::Ws')) {
    return &traverse($obj->obj(), $cb, (defined($ws) ? $ws : $obj->ws()));
  }

  if (ref($obj) eq 'ARRAY') {
    my $result;

    if (@$obj) {
      $result = &traverse($obj->[0], $cb, $ws);
      foreach my $subobj (@{$obj}[1 .. $#$obj]) {
        my $r2 = &traverse($subobj, $cb, ($result ? undef : $ws));
        $result ||= $r2;
      }
    }

    return $result;
  }

  return &$cb($ws, $obj);
}

sub flatten {
  my($obj, $inital_ws) = @_;

  my $result = '';

  &traverse($obj, sub {
    my($ws, $obj) = @_;
    $result .= $ws if defined($ws);
    $result .= $obj;
    return 1;
  }, $inital_ws);

  $result;
}

1;

__END__