File Coverage

blib/lib/Macro/Micro.pm

Criterion	Covered	Total	%
statement	89	95	93.6
branch	44	54	81.4
condition	8	12	66.6
subroutine	21	22	95.4
pod	10	10	100.0
total	172	193	89.1

use strict;
use warnings;
package Macro::Micro;
{
  $Macro::Micro::VERSION = '0.054';
}
# ABSTRACT: really simple templating for really simple templates

use Carp ();


my $DEFAULT_MACRO_FORMAT = qr/(?\]])/x;

sub new {
  my ($class, %arg) = @_;

  my $self = bless { } => $class;

  $arg{macro_format} = $DEFAULT_MACRO_FORMAT unless $arg{macro_format};

  $self->macro_format($arg{macro_format});

  return $self;
}


sub macro_format {
  my $self = shift;

  return $self->{macro_format} unless @_;

  my $macro_format = shift;
  Carp::croak "macro format must be a regexp reference"
    unless ref $macro_format eq 'Regexp';

  $self->{macro_format} = $macro_format;
}


sub register_macros {
  my ($self, @macros) = @_;

  for (my $i = 0; $i < @macros; $i += 2) {
    my ($name, $value) = @macros[ $i, $i+1 ];
    Carp::croak "macro value must be a string or code reference"
      if (ref $value) and (ref $value ne 'CODE');

    if (not ref $name) {
      $self->{macro}{$name} = $value;
    } elsif (ref $name eq 'Regexp') {
      $self->{macro_regexp}{$name} = [ $name, $value ];
    } else {
      Carp::croak "macro name '$name' must be a string or a regexp";
    }
  }

  return $self;
}


sub clear_macros {
  my ($self, @macros) = @_;

  if (@macros) {
    Carp::croak "partial deletion not implemented";
  } else {
    delete @$self{qw(macro macro_regexp)};
  }

  return;
}


sub get_macro {
  my ($self, $macro_name) = @_;

  return $self->{macro}{$macro_name} if exists $self->{macro}{$macro_name};

  foreach my $regexp (values %{ $self->{macro_regexp} }) {
    return $regexp->[1] if $macro_name =~ $regexp->[0];
  }

  return;
}


sub expand_macros {
  my ($self, $object, $stash) = @_;

  if (eval { $object->isa('Macro::Micro::Template') }) {
    return $self->_expand_template($object, $stash);
  }

  $self->fast_expander($stash)->($object);
}

sub _expand_template {
  my ($self, $object, $stash) = @_;
  # expects to be passed ($whole_macro, $macro_inside_delim, $whole_text)
  my $expander = sub {
    my $macro = $self->get_macro($_[1]);
    return $_[0] unless defined $macro;
    return ref $macro ? $macro->($_[1], $_[2], $stash)||'' : $macro;
  };

  return ${ $object->_text } unless $object->_parts;

  return join '', map { ref $_ ? $expander->(@$_[0, 1], $object->_text) : $_ }
                  $object->_parts;
}


sub expand_macros_in {
  my ($self, $object, $stash) = @_;

  Carp::croak "object of in-place expansion must be a scalar reference"
    if (not ref $object)
    or (ref $object ne 'SCALAR');

  my $fast_expander = $self->fast_expander($stash);

  $$object = $fast_expander->($$object);
}


sub string_expander {
  my ($self, $stash) = @_;

  my $expander = $self->macro_expander($stash);
  my $regex    = $self->macro_format;

  my $applicator = sub {
    my ($object) = @_;

    return unless defined $object;
    Carp::croak "object of expansion must not be a reference" if ref $object;

    $object =~ s/$regex/$expander->($1,$2)/eg;

    return $object;
  }
}

BEGIN { *fast_expander = \&string_expander }


sub macro_expander {
  my ($self, $stash) = @_;

  my %cached;

  if (values %{ $self->{macro_regexp} }) {
    return sub {
      return $cached{ $_[0] } if defined $cached{ $_[0] };

      my $macro = $self->get_macro($_[1]);

      $cached{ $_[0] } = defined $macro
                       ? ref $macro
                         ? $macro->($_[1], $_[2], $stash)||'' : $macro
                       : $_[0];

      return $cached{ $_[0] };
    };
  } else {
    return sub {
      return $cached{ $_[0] } if defined $cached{ $_[0] };

      my $macro = $self->{macro}{ $_[1] };

      $cached{ $_[0] } = defined $macro
                       ? ref $macro
                         ? $macro->($_[1], $_[2], $stash)||'' : $macro
                       : $_[0];

      return $cached{ $_[0] };
    };
  }
}



sub study {
  my ($self, $text) = @_;

  my $macro_format = $self->macro_format;

  my @total;

  my $pos;
  while ($text =~ m/\G(.*?)$macro_format/gsm) {
    my ($snippet, $whole, $name) = ($1, $2, $3);
    push @total, (length $snippet ? $snippet : ()),
                 ($whole ? [ $whole, $name ] : ());
    $pos = pos $text;
  }

  push @total, substr $text, $pos if defined $pos;

  return Macro::Micro::Template->_new(\$text, \@total);
}

{
  package Macro::Micro::Template;
{
  $Macro::Micro::Template::VERSION = '0.054';
}
  sub _new   { bless [ $_[1], $_[2] ] => $_[0] }
  sub _parts { @{ $_[0][1] } }
  sub _text  {    $_[0][0]   }
}

"[MAGIC_TRUE_VALUE]";

__END__