File Coverage

blib/lib/Text/Template/Permute.pm

Criterion	Covered	Total	%
statement	64	82	78.0
branch	11	22	50.0
condition			n/a
subroutine	10	12	83.3
pod	0	4	0.0
total	85	120	70.8

package Text::Template::Permute;

use 5.010001;
use strict;
use warnings;

use Permute::Unnamed ();

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2026-02-21'; # DATE
our $DIST = 'Text-Template-Permute'; # DIST
our $VERSION = '0.004'; # VERSION

sub new {
    my $class = shift;

    bless {}, $class;
}

sub _process_directive {
    my $self = shift;
    my $directive = shift;

    my ($command, $opts, $args) = $directive =~ /\A(\w+)\s*([^:]*)\s*:\s*(.+)\z/s
        or die "Invalid directive syntax '$directive', please use COMMAND[OPTIONS]: ...";
    #use DD; dd {command=>$command, opts=>$opts, args=>$args};
    if ($command eq 'comment') {
        return ();
    } elsif ($command eq 'permute') {
        $args =~ s!/\*.*?\*/!!g;
        my @items = split /\|/, $args;
        push @{ $self->{_permute_args} }, \@items;
        my $i = $self->{_permute_idx}++;
        return (sub { $self->{_permute_items}[$_[0]][$i] });
    } elsif ($command eq 'pick') {
        $args =~ s!/\*.*?\*/!!g;
        my @choices = split /\|/, $args;
       if ($opts eq 'once') {
           return ($choices[rand @choices]);
        } else {
            return (sub { $choices[rand @choices] });
        }
    } else {
        die "Unknown command '$command'";
    }
}

sub template {
    my $self = shift;

    if (@_) {
        my $template = shift;
        $self->{template} = $template;
        $self->{_permute_args} = [];
        $self->{_var_array} = [];
        $self->{_var_idx} = {};
        $self->{_idx} = 0;
        $self->{_template_parts} = [];
        $self->{_permute_idx} = 0;
        $template =~ s{(    # 1. whole match
            \{\{(.*?)\}\} | # 2.   directive
            (?:[^\{]+) |    # -.   normal text
            (?:[\{\}]+)     # -.   normal text
        )
        }{
            if (defined $2) {
                push @{ $self->{_template_parts} }, $self->_process_directive($2);
            } else {
                push @{ $self->{_template_parts} }, $1;
            }

        }egsx;
    }
    return $self->{template};
}

sub _fill {
    my $self = shift;
    my $i = shift;
    my @res;
    for my $part (@{ $self->{_template_parts} }) {
        if (ref $part) {
            push @res, $part->($i);
        } else {
            push @res, $part;
        }
    }
    join "", @res;
}

sub var {
    my $self = shift;

    my $name = shift;
    my $val;
    if (exists $self->{_var_idx}{$name}) {
        $val = $self->{vars}{$name};
    } else {
        die "Variable '$name' not mentioned in template";
    }
    if (@_) {
        $val = shift;
        $self->{vars}{$name} = $val;
        $self->{_var_array}[ $self->{_var_idx}{$name} - 1] = $val;
    }
    $val;
}

sub process {
    #no warnings 'uninitialized';

    my $self = shift;

    # generate the permutations of args
    $self->{_permute_items} = [];
    if (@{ $self->{_permute_args} }) {
        $self->{_permute_items} = Permute::Unnamed::permute_unnamed(@{ $self->{_permute_args} });
    } else {
        push @{ $self->{_permute_items} }, [];
    }
    #use DD; dd $self->{_permute_items};

    # generate the permutations of text
    my @res;
    for my $i (0 .. $#{ $self->{_permute_items} }) {
        push @res, $self->_fill($i);
    }

    @res;
}

1;
# ABSTRACT: Template for generating permutation of text

__END__