#!/usr/bin/env perl
# vim: sts=3 ts=3 sw=3 et ai :

use strict;
use warnings;
my $VERSION = "0.723";
RUSE('Log::Log4perl::Tiny', qw< :easy LOGLEVEL >);
RUSE('Data::Tubes',         qw< pipeline >);

########################################################################
#
# Input options and logger initialization
#
########################################################################
my %config = get_options(
   ['loglevel|log=s', default => 'INFO'],

   # start putting your options here
   ['abstract|A=s', required => 1],
   ['author|a=s',   required => 1],
   ['email|e=s',    required => 1],
   ['name|n=s', required => 1],
   ['output|o=s', fallback => \*STDOUT],
   ['year|y=s', default => 1900 + (localtime)[5]],
);

# Remove following line if you remove 'loglevel' in options above
LOGLEVEL($config{loglevel});

########################################################################
#
# Business Logic
#
########################################################################

$config{modules_bundle} = modules_bundle($config{module});
pipeline(
   ['Renderer::with_template_perlish', template => template()],
   ['Writer::to_files', filename => $config{output}],
   {tap => 'sink'},
)->({structured => \%config});

if (! ref $config{output}) {
   my $mode = ((stat $config{output})[2] | 0111) & (~umask());
   chmod $mode, $config{output};
}

sub modules_bundle {
   open my $fh, '<', __FILE__ or die "open(): $!";
   local $/;
   my $ME = <$fh>;
   my ($text) = $ME =~ m{
      (
         ^\#\ __MOBUNDLE_INCLUSION__\s*
         .*
         ^\#\ __MOBUNDLE_INCLUSION__
      )
   }mxs;
   return $text;
}


########################################################################
#
# You should not need to fiddle any more beyond this point
#
########################################################################

# Ancillary scaffolding here
use Pod::Usage qw< pod2usage >;
use Getopt::Long qw< :config gnu_getopt >;

sub get_options {
   my %config;
   my @options = qw< usage! help! man! version! >;
   my (%fallback_for, @required);
   for my $option (@_) {
      if (ref $option) {
         my ($spec, %opts) = @$option;
         push @options, $spec;

         my ($name) = split /\|/, $spec, 2;
         if (exists $opts{default}) {
            $config{$name} = $opts{default};
         }
         if (exists $opts{fallback}) {
            $fallback_for{$name} = $opts{fallback};
         }
         if (exists $opts{required}) {
            push @required, $name;
         }
      } ## end if (ref $option)
      else {
         push @options, $option;
      }
   } ## end for my $option (@_)

   GetOptions(\%config, @options)
     or pod2usage(-verbose => 99, -sections => 'USAGE');
   pod2usage(message => "$0 $VERSION", -verbose => 99,
      -sections => ' ') if $config{version};
   pod2usage(-verbose => 99, -sections => 'USAGE') if $config{usage};
   pod2usage(-verbose => 99, -sections => 'USAGE|EXAMPLES|OPTIONS')
     if $config{help};
   pod2usage(-verbose => 2) if $config{man};

   while (my ($key, $value) = each %fallback_for) {
      next if exists $config{$key};
      $config{$key} = $value;
   }

   my @missing = grep { ! exists $config{$_} } @required;
   pod2usage(message => "missing options @missing",
      -verbose => 99, -sections => 'USAGE')
     if @missing;

   return %config if wantarray();
   return \%config;
} ## end sub get_options

sub RUSE {
   my $module = shift;
   (my $packfile = $module . '.pm') =~ s{::}{/}gmxs;
   require $packfile;
   $module->import(@_);
   return $module;
} ## end sub RUSE

# Embedded stuff here

# __MOBUNDLE_INCLUSION__
BEGIN {
   my %file_for = (

# __MOBUNDLE_FILES__



# __MOBUNDLE_FILE__

      'Data/Tubes.pm' => <<'END_OF_FILE',
 package Data::Tubes;
 
 # vim: ts=3 sts=3 sw=3 et ai :
 
 use strict;
 use warnings;
 use English qw< -no_match_vars >;
 $Data::Tubes::VERSION = '0.723';
 use Exporter qw< import >;
 
 use Log::Log4perl::Tiny qw< :easy :dead_if_first LOGLEVEL >;
 use Data::Tubes::Util qw<
   args_array_with_options
   load_sub
   normalize_args
   resolve_module
 >;
 
 our @EXPORT_OK = (
    qw<
      drain
      pipeline
      summon
      tube
      >
 );
 our %EXPORT_TAGS = (all => \@EXPORT_OK,);
 
 sub drain {
    my $tube = shift;
    my ($type, $iterator) = $tube->(@_) or return;
    return unless defined($iterator) && ($type eq 'iterator');
    while (my @items = $iterator->()) { }
 } ## end sub drain
 
 sub pipeline {
    my ($tubes, $args) = args_array_with_options(@_, {name => 'sequence'});
 
    my $tap = delete $args->{tap};
    $tap = sub {
       my $iterator = shift;
       while (my @items = $iterator->()) { }
       return;
      }
      if defined($tap) && ($tap eq 'sink');
 
    if ((!defined($tap)) && (defined($args->{pump}))) {
       my $pump = delete $args->{pump};
       $tap = sub {
          my $iterator = shift;
          while (my ($record) = $iterator->()) {
             $pump->($record);
          }
          return;
         }
    } ## end if ((!defined($tap)) &&...)
    LOGDIE 'invalid tap or pump'
      if $tap && ref($tap) ne 'CODE';
 
    my $sequence = tube('+Plumbing::sequence', %$args, tubes => $tubes);
    return $sequence unless $tap;
 
    return sub {
       my (undef, $iterator) = $sequence->(@_) or return;
       return $tap->($iterator);
    };
 } ## end sub pipeline
 
 sub summon {    # sort-of import
    my ($imports, $args) = args_array_with_options(
       @_,
       {
          prefix  => 'Data::Tubes::Plugin',
          package => (caller(0))[0],
       }
    );
    my $prefix = $args->{prefix};
    my $cpack = $args->{package};
 
    for my $r (@_) {
       my @parts;
       if (ref($r) eq 'ARRAY') {
          @parts = $r;
       }
       else {
          my ($pack, $name) = $r =~ m{\A(.*)::(\w+)\z}mxs;
          @parts = [$pack, $name];
       }
       for my $part (@parts) {
          my ($pack, @names) = @$part;
          $pack = resolve_module($pack, $prefix);
          (my $fpack = "$pack.pm") =~ s{::}{/}gmxs;
          require $fpack;
          for my $name (@names) {
             my $sub = $pack->can($name)
               or LOGDIE "package '$pack' has no '$name' inside";
             no strict 'refs';
             *{$cpack . '::' . $name} = $sub;
          } ## end for my $name (@names)
       } ## end for my $part (@parts)
    } ## end for my $r (@_)
 } ## end sub summon
 
 sub tube {
    my $locator = shift;
    return load_sub($locator)->(@_);
 } ## end sub tube
 
 1;
 __END__

END_OF_FILE


# __MOBUNDLE_FILE__

      'Data/Tubes/Util.pm' => <<'END_OF_FILE',
 package Data::Tubes::Util;
 
 # vim: ts=3 sts=3 sw=3 et ai :
 
 use strict;
 use warnings;
 use Exporter 'import';
 our $VERSION = '0.722';
 
 use Log::Log4perl::Tiny qw< :easy :dead_if_first >;
 
 our @EXPORT_OK = qw<
   args_array_with_options
   assert_all_different
   load_module
   load_sub
   metadata
   normalize_args
   normalize_filename
   resolve_module
   shorter_sub_names
   sprintffy
   test_all_equal
   traverse
   unzip
 >;
 
 sub _load_module {
    my $module = shift;
    (my $packfile = $module . '.pm') =~ s{::}{/}gmxs;
    require $packfile;
    return $module;
 } ## end sub _load_module
 
 sub args_array_with_options {
    my %defaults = %{pop @_};
    %defaults = (%defaults, %{pop @_})
      if @_ && (ref($_[-1]) eq 'HASH');
    return ([@_], \%defaults);
 } ## end sub args_array_with_options
 
 sub assert_all_different {
    my $keys = (@_ && ref($_[0])) ? $_[0] : \@_;
    my %flag_for;
    for my $key (@$keys) {
       die {message => $key} if $flag_for{$key}++;
    }
    return 1;
 } ## end sub assert_all_different
 
 sub load_module {
    my $module = resolve_module(@_);
    (my $packfile = $module . '.pm') =~ s{::}{/}gmxs;
    require $packfile;
    return $module;
 } ## end sub load_module
 
 sub load_sub {
    my ($locator, $prefix) = @_;
    my ($module, $sub) =
      ref($locator) ? @$locator : $locator =~ m{\A(.*)::(\w+)\z}mxs;
    $module = resolve_module($module, $prefix);
 
    # optimistic first
    return $module->can($sub) // _load_module($module)->can($sub);
 } ## end sub load_sub
 
 sub metadata {
    my $input = shift;
    my %args  = normalize_args(
       @_,
       {
          chunks_separator    => ' ',
          key_value_separator => '=',
          default_key         => '',
       }
    );
 
    # split data into chunks, un-escape on the fly
    my $separator = $args{chunks_separator};
    my $qs        = quotemeta($separator);
    my $regexp    = qr/((?:\\.|[^\\$qs])+)(?:$qs+)?/;
    my @chunks    = map { s{\\(.)}{$1}g; $_ } $input =~ m{$regexp}gc;
 
    # ensure we consumed the whole $input
    die {message =>
         "invalid metadata (separator: '$separator', input: [$input])\n"
      }
      if pos($input) < length($input);
 
    $separator = $args{key_value_separator};
    return {
       map {
          my ($k, $v) = _split_pair($_, $separator);
          defined($v) ? ($k, $v) : ($args{default_key} => $k);
       } @chunks
    };
 } ## end sub metadata
 
 sub normalize_args {
    my $defaults = pop;
    my %retval =
      (%$defaults, ((@_ && ref($_[0]) eq 'HASH') ? %{$_[0]} : @_));
    return %retval if wantarray();
    return \%retval;
 } ## end sub normalize_args
 
 sub normalize_filename {
    my ($filename, $default_handle) = @_;
    return $filename       if ref($filename) eq 'GLOB';
    return $filename       if ref($filename) eq 'SCALAR';
    return $default_handle if $filename eq '-';
    return $filename       if $filename =~ s{\Afile:}{}mxs;
    if (my ($handlename) = $filename =~ m{\Ahandle:(?:std)?(.*)\z}imxs) {
       $handlename = lc $handlename;
       return \*STDOUT if $handlename eq 'out';
       return \*STDIN  if $handlename eq 'err';
       return \*STDERR if $handlename eq 'in';
       LOGDIE "normalize_filename: invalid filename '$filename', "
         . "use 'file:$filename' if name is correct";
    } ## end if (my ($handlename) =...)
    return $filename;
 } ## end sub normalize_filename
 
 sub resolve_module {
    my ($module, $prefix) = @_;
 
    my ($first) = substr $module, 0, 1;
    return substr $module, 1 if $first eq '!';
 
    $prefix //= 'Data::Tubes::Plugin';
    if ($first eq '+') {
       $module = substr $module, 1;
    }
    elsif ($module =~ m{::}mxs) {
       $prefix = undef;
    }
    return $module unless defined $prefix;
    return $prefix . '::' . $module;
 } ## end sub resolve_module
 
 sub shorter_sub_names {
    my $stash = shift(@_) . '::';
 
    no strict 'refs';
 
    # isolate all subs
    my %sub_for =
      map { *{$stash . $_}{CODE} ? ($_ => *{$stash . $_}{CODE}) : (); }
      keys %$stash;
 
    # iterate through inputs, work only on isolated subs and don't
    # consider shortened ones
    for my $prefix (@_) {
       while (my ($name, $sub) = each %sub_for) {
          next if index($name, $prefix) < 0;
          my $shortname = substr $name, length($prefix);
          *{$stash . $shortname} = $sub;
       }
    } ## end for my $prefix (@_)
 
    return;
 } ## end sub shorter_sub_names
 
 sub _split_pair {
    my ($input, $separator) = @_;
    my $qs     = quotemeta($separator);
    my $regexp = qr{(?mxs:\A((?:\\.|[^\\$qs])+)$qs(.*)\z)};
    my ($first, $second) = $input =~ m{$regexp};
    ($first, $second) = ($input, undef) unless defined($first);
    $first =~ s{\\(.)}{$1}gmxs;    # unescape metadata
    return ($first, $second);
 } ## end sub _split_pair
 
 sub sprintffy {
    my ($template, $substitutions) = @_;
    my $len = length $template;
    pos($template) = 0;            # initialize
    my @chunks;
  QUEST:
    while (pos($template) < $len) {
       $template =~ m{\G (.*?) (% | \z)}mxscg;
       my ($plain, $term) = ($1, $2);
       my $pos = pos($template);
       push @chunks, $plain;
       last unless $term;          # got a percent, have to continue
     CANDIDATE:
       for my $candidate ([qr{%} => '%'], @$substitutions) {
          my ($regex, $value) = @$candidate;
          $template =~ m{\G$regex}cg or next CANDIDATE;
          $value = $value->() if ref($value) eq 'CODE';
          push @chunks, $value;
          next QUEST;
       } ## end CANDIDATE: for my $candidate ([qr{%}...])
 
       # didn't find a matchin thing... time to complain
       die {message => "invalid sprintffy template '$template'"};
    } ## end QUEST: while (pos($template) < $len)
    return join '', @chunks;
 } ## end sub sprintffy
 
 sub test_all_equal {
    my $reference = shift;
    for my $candidate (@_) {
       return if $candidate ne $reference;
    }
    return 1;
 } ## end sub test_all_equal
 
 sub traverse {
    my ($data, @keys) = @_;
    for my $key (@keys) {
       if (ref($data) eq 'HASH') {
          $data = $data->{$key};
       }
       elsif (ref($data) eq 'ARRAY') {
          $data = $data->[$key];
       }
       else {
          return undef;
       }
       return undef unless defined $data;
    } ## end for my $key (@keys)
    return $data;
 } ## end sub traverse
 
 sub unzip {
    my $items = (@_ && ref($_[0])) ? $_[0] : \@_;
    my $n_items = scalar @$items;
    my (@evens, @odds);
    my $i = 0;
    while ($i < $n_items) {
       push @evens, $items->[$i++];
       push @odds, $items->[$i++] if $i < $n_items;
    }
    return (\@evens, \@odds);
 } ## end sub unzip
 
 1;

END_OF_FILE


# __MOBUNDLE_FILE__

      'Data/Tubes/Plugin/Source.pm' => <<'END_OF_FILE',
 package Data::Tubes::Plugin::Source;
 
 # vim: ts=3 sts=3 sw=3 et ai :
 
 use strict;
 use warnings;
 use English qw< -no_match_vars >;
 use Log::Log4perl::Tiny qw< :easy :dead_if_first LOGLEVEL >;
 our $VERSION = '0.722';
 
 use Data::Tubes::Util
   qw< normalize_args normalize_filename args_array_with_options >;
 use Data::Tubes::Plugin::Util qw< identify log_helper >;
 my %global_defaults = (
    input  => 'source',
    output => 'raw',
 );
 
 sub iterate_array {
    my %args = normalize_args(@_, {name => 'array iterator'});
    identify(\%args);
    my $logger       = log_helper(\%args);
    my $global_array = $args{array} || [];
    my $n_global     = @$global_array;
    return sub {
       my $local_array = shift || [];
       my $n_local     = @$local_array;
       my $i           = 0;
       return (
          iterator => sub {
             return if $i >= $n_global + $n_local;
             my $element =
               ($i < $n_global)
               ? $global_array->[$i++]
               : $local_array->[($i++) - $n_global];
             $logger->($element, \%args) if $logger;
             return $element;
          },
       );
    };
 } ## end sub iterate_array
 
 sub open_file {
    my %args = normalize_args(
       @_,
       {
          binmode => ':encoding(UTF-8)',
          output  => 'source',
          name    => 'open file',
       }
    );
    identify(\%args);
 
    # valid "output" sub-fields must be defined and at least one char long
    # otherwise output will be ignored
    my $binmode   = $args{binmode};
    my $output    = $args{output};
    my $input     = $args{input};
    my $has_input = defined($input) && length($input);
 
    return sub {
       my ($record, $file) =
         $has_input ? ($_[0], $_[0]{$input}) : ({}, $_[0]);
       $file = normalize_filename($file);
 
       if (ref($file) eq 'GLOB') {
          my $is_stdin = fileno($file) == fileno(\*STDIN);
          my $name = $is_stdin ? 'STDIN' : "$file";
          $record->{$output} = {
             fh    => $file,
             input => $file,
             type  => 'handle',
             name  => "handle\:$name",
          };
       } ## end if (ref($file) eq 'GLOB')
       else {
          open my $fh, '<', $file
            or die "open('$file'): $OS_ERROR";
          binmode $fh, $binmode;
          my $type = (ref($file) eq 'SCALAR') ? 'scalar' : 'file';
          $record->{$output} = {
             fh    => $fh,
             input => $file,
             type  => $type,
             name  => "$type\:$file",
          };
       } ## end else [ if (ref($file) eq 'GLOB')]
 
       return $record;
    };
 } ## end sub open_file
 
 sub iterate_files {
    my ($files, $args) = args_array_with_options(
       @_,
       {    # these are the default options
          name    => 'files',
 
          # options specific for sub-tubes
          iterate_array_args => {},
          open_file_args     => {},
          logger_args        => {
             target => sub {
                my $record = shift;
                return 'reading from ' . $record->{source}{name},;
             },
          },
       }
    );
    identify($args);
 
    use Data::Tubes::Plugin::Plumbing;
    return Data::Tubes::Plugin::Plumbing::sequence(
       tubes => [
          iterate_array(
             %{$args->{iterate_array_args}}, array => $files,
          ),
          open_file(%{$args->{open_file_args}}),
          Data::Tubes::Plugin::Plumbing::logger(%{$args->{logger_args}}),
       ]
    );
 } ## end sub iterate_files
 
 1;

END_OF_FILE


# __MOBUNDLE_FILE__

      'Data/Tubes/Plugin/Parser.pm' => <<'END_OF_FILE',
 package Data::Tubes::Plugin::Parser;
 use strict;
 use warnings;
 use English qw< -no_match_vars >;
 use Data::Dumper;
 our $VERSION = '0.722';
 
 use Log::Log4perl::Tiny qw< :easy :dead_if_first >;
 
 use Data::Tubes::Util qw<
   assert_all_different
   metadata
   normalize_args
   shorter_sub_names
   test_all_equal
   unzip
 >;
 use Data::Tubes::Plugin::Util qw< identify >;
 my %global_defaults = (
    input  => 'raw',
    output => 'structured',
 );
 
 sub parse_by_format {
    my %args = normalize_args(@_, {%global_defaults,});
    identify(\%args);
 
    my $format = $args{format};
    LOGDIE "parser of type 'format' needs a definition"
      unless defined $format;
 
    my @items = split m{(\W+)}, $format;
    return parse_single(key => $items[0]) if @items == 1;
 
    my ($keys, $separators) = unzip(\@items);
 
    # all keys MUST be different, otherwise some fields are just trumping
    # on each other
    eval { assert_all_different($keys); }
      or LOGDIE "'format' parser [$format] "
      . "has duplicate key $EVAL_ERROR->{message}";
 
    # a simple split will do if all separators are the same
    return parse_by_split(
       %args,
       keys      => $keys,
       separator => $separators->[0]
    ) if test_all_equal(@$separators);
 
    return parse_by_separators(
       %args,
       keys       => $keys,
       separators => $separators
    );
 } ## end sub parse_by_format
 
 sub parse_by_regex {
    my %args =
      normalize_args(@_, {%global_defaults, name => 'parse by regex'});
    identify(\%args);
 
    my $name  = $args{name};
    my $regex = $args{regex};
    LOGDIE "parse_by_regex needs a regex"
      unless defined $regex;
 
    $regex = qr{$regex};
    my $input  = $args{input};
    my $output = $args{output};
    return sub {
       my $record = shift;
       $record->{$input} =~ m{$regex}
         or die {
          message => "'$name': invalid record, regex is $regex",
          input   => $input,
          record  => $record,
         };
       my $retval = {%+};
       $record->{$output} = $retval;
       return $record;
    };
 } ## end sub parse_by_regex
 
 sub parse_by_separators {
    my %args = normalize_args(@_, {%global_defaults,});
    identify(\%args);
 
    my $keys = $args{keys};
    LOGDIE "parse_by_separators needs keys"
      unless defined $keys;
    my $separators = $args{separators};
    LOGDIE "parse_by_separators needs separators"
      unless defined $separators;
    my $delta = scalar(@$keys) - scalar(@$separators);
    LOGDIE "parse_by_separators 0 <= #keys - #separators <= 1"
      if ($delta < 0) || ($delta > 1);
 
    my @items;
    for my $i (0 .. $#$keys) {
       push @items, '(.*?)';                                     # keys
       push @items, '(?:' . quotemeta($separators->[$i]) . ')'
         if $i <= $#$separators;
    }
 
    # if not a separator, the last item becomes a catchall
    $items[-1] = '(.*)' if $delta > 0;
 
    # ready to generate the regexp. We bind the end to \z anyway because
    # the last element might be a separator
    my $format = join '', '(?:\\A', @items, '\\z)';
    my $regex = qr{$format};
    DEBUG "regex will be: $regex";
 
    # this sub will use the regexp above, do checking and return captured
    # values in a hash with @keys
    my $n_keys     = scalar @$keys;
    my $input      = $args{input};
    my $output     = $args{output};
    return sub {
       my $record = shift;
       my @values = $record->{$input} =~ m{$regex}
         or die {message => 'invalid record', record => $record};
       die      {message => "invalid record, wrong number of items", record => $record}
         if scalar(@values) != $n_keys;
       $record->{$output} = \my %retval;
       @retval{@$keys} = @values;
       return $record;
    };
 } ## end sub parse_by_separators
 
 sub parse_by_split {
    my %args =
      normalize_args(@_, {%global_defaults, name => 'parse by split'});
    identify(\%args);
 
    my $name      = $args{name};
    my $separator = $args{separator};
    LOGDIE "parse_by_split needs a separator"
      unless defined $separator;
    if (!ref $separator) {
       $separator = quotemeta($separator);
       $separator = qr{$separator};
    }
 
    my $keys   = $args{keys};
    my $n_keys = defined($keys) ? scalar(@$keys) : 0;
    my $input  = $args{input};
    my $output = $args{output};
 
    return sub {
       my $record = shift;
 
       my @values = split /$separator/, $record->{$input}, $n_keys;
       my $n_values = @values;
       die {
          message => "'$name': invalid record, expected $n_keys items, "
            . "got $n_values",
          input  => $input,
          record => $record,
         }
         if $n_values != $n_keys;
 
       $record->{$output} = \my %retval;
       @retval{@$keys} = @values;
       return $record;
      }
      if $n_keys;
 
    return sub {
       my $record = shift;
       my @retval = split /$separator/, $record->{$input};
       $record->{$output} = \@retval;
       return $record;
    };
 
 } ## end sub parse_by_split
 
 sub parse_hashy {
    my %args = normalize_args(
       @_,
       {
          chunks_separator    => ' ',
          default_key         => '',
          key_value_separator => '=',
          %global_defaults,
       }
    );
    identify(\%args);
    my %defaults = %{$args{defaults} || {}};
    my $input    = $args{input};
    my $output   = $args{output};
    return sub {
       my $record = shift;
       my $parsed = metadata($record->{$input}, %args);
       $record->{$output} = {%defaults, %$parsed};
       return $record;
    };
 } ## end sub parse_hashy
 
 sub parse_single {
    my %args = normalize_args(
       @_,
       {
          key => 'key',
          %global_defaults,
       }
    );
    identify(\%args);
    my $key     = $args{key};
    my $has_key = defined($key) && length($key);
    my $input   = $args{input};
    my $output  = $args{output};
    return sub {
       my $record = shift;
       $record->{$output} =
         $has_key ? {$key => $record->{$input}} : $record->{$input};
       return $record;
      }
 } ## end sub parse_single
 
 shorter_sub_names(__PACKAGE__, 'parse_');
 
 1;

END_OF_FILE


# __MOBUNDLE_FILE__

      'Data/Tubes/Plugin/Renderer.pm' => <<'END_OF_FILE',
 package Data::Tubes::Plugin::Renderer;
 use strict;
 use warnings;
 use English qw< -no_match_vars >;
 our $VERSION = '0.722';
 
 use Log::Log4perl::Tiny qw< :easy :dead_if_first >;
 
 use Data::Tubes::Util qw< normalize_args shorter_sub_names >;
 my %global_defaults = (
    input  => 'structured',
    output => 'rendered',
 );
 
 sub render_with_template_perlish {
    my %args = normalize_args(
       @_,
       {
          %global_defaults,
          start     => '[%',
          stop      => '%]',
          variables => {},
          name => 'render with Template::Perlish',
       }
    );
    my $name = $args{name};
    LOGDIE "$name: template is mandatory"
       unless defined $args{template};
 
    require Template::Perlish;
    my $tp = Template::Perlish->new(
       map { $_ => $args{$_} }
       grep { defined $args{$_} } qw< start stop variables >
    );
    my $template = $tp->compile($args{template});
 
    my $input      = $args{input};
    my $output     = $args{output};
    return sub {
       my $record    = shift;
       $record->{$output} = $tp->evaluate($template, $record->{$input});
       return $record;
    };
 } ## end sub render_template_perlish
 
 shorter_sub_names(__PACKAGE__, 'render_');
 
 1;

END_OF_FILE


# __MOBUNDLE_FILE__

      'Data/Tubes/Plugin/Reader.pm' => <<'END_OF_FILE',
 package Data::Tubes::Plugin::Reader;
 use strict;
 use warnings;
 use English qw< -no_match_vars >;
 our $VERSION = '0.722';
 
 use Log::Log4perl::Tiny qw< :easy :dead_if_first LOGLEVEL >;
 
 use Data::Tubes::Util qw< normalize_args shorter_sub_names >;
 use Data::Tubes::Plugin::Util qw< identify >;
 my %global_defaults = (
    input  => 'source',
    output => 'raw',
 );
 
 sub read_by_line {
    return read_by_separator(
       normalize_args(
          @_,
          {
             name           => 'read_by_line',
             identification => {caller => [caller(0)]},
          }
       ),
       separator => "\n",
    );
 } ## end sub read_by_line
 
 sub read_by_paragraph {
    return read_by_separator(
       normalize_args(
          @_,
          {
             name           => 'read_by_paragraph',
             identification => {caller => [caller(0)]},
          }
       ),
       separator => '',
    );
 } ## end sub read_by_paragraph
 
 sub read_by_record_reader {
    my %args = normalize_args(
       @_,
       {
          %global_defaults,
          emit_eof       => 0,
          name           => 'read_by_record_reader',
          identification => {caller => [caller(0)]},
       },
    );
    identify(\%args);
    my $emit_eof      = $args{emit_eof};
    my $input         = $args{input};
    my $has_input     = defined($input) && length($input);
    my $output        = $args{output};
    my $record_reader = $args{record_reader};
    return sub {
       my $record = shift;
       my $source = $has_input ? $record->{$input} : $record;
       my $fh     = $source->{fh};
 
       return (
          iterator => sub {
             my $read = $record_reader->($fh);
             my $retval = {%$record, $output => $read};
             return $retval if defined $read;
             if ($emit_eof) {
                $emit_eof = 0;
                return $retval;
             }
             return;
          },
       );
    };
 } ## end sub read_by_record_reader
 
 sub read_by_separator {
    my %args = normalize_args(
       @_,
       {
          name           => 'read_by_separator',
          chomp          => 1,
          identification => {caller => [caller(0)]},
       }
    );
    my $separator = $args{separator};
    my $chomp     = $args{chomp};
    return read_by_record_reader(
       %args,
       record_reader => sub {
          my $fh = shift;
          local $INPUT_RECORD_SEPARATOR = $separator;
          my $retval = <$fh>;
          chomp($retval) if defined($retval) && $chomp;
          return $retval;
       },
    );
 } ## end sub read_by_separator
 
 shorter_sub_names(__PACKAGE__, 'read_');
 
 1;

END_OF_FILE


# __MOBUNDLE_FILE__

      'Data/Tubes/Plugin/Plumbing.pm' => <<'END_OF_FILE',
 package Data::Tubes::Plugin::Plumbing;
 
 # vim: ts=3 sts=3 sw=3 et ai :
 
 use strict;
 use warnings;
 use English qw< -no_match_vars >;
 use Data::Dumper;
 use Scalar::Util qw< blessed >;
 our $VERSION = '0.722';
 
 use Log::Log4perl::Tiny
   qw< :easy :dead_if_first get_logger LOGLEVEL LEVELID_FOR >;
 use Data::Tubes qw< tube >;
 use Data::Tubes::Util
   qw< normalize_args traverse args_array_with_options >;
 use Data::Tubes::Plugin::Util qw< identify log_helper >;
 
 sub dispatch {
    my %args = normalize_args(@_,
       {default => undef, name => 'dispatch', loglevel => $INFO});
    identify(\%args);
    my $name = $args{name};
 
    my $selector = $args{selector};
    if (!defined($selector) && defined($args{key})) {
       my @key = ref($args{key}) ? @{$args{key}} : ($args{key});
       $selector = sub { return traverse($_[0], @key); };
    }
    LOGDIE "$name: required dispatch key or selector"
      unless defined $selector;
 
    my $handler_for = {%{$args{handlers} || {}}};    # our cache
    my $factory = $args{factory};
    if (!defined($factory)) {
       $factory = sub {
          my ($key, $record) = @_;
          die {
             message => "$name: unhandled selection key '$key'",
             record  => $record,
          };
       };
    } ## end if (!defined($factory))
    LOGDIE "$name: required factory or handlers"
      unless defined $factory;
 
    my $default = $args{default};
    return sub {
       my $record = shift;
 
       # get a key into the cache
       my $key = $selector->($record) // $default;
       die {
          message => "$name: selector key is undefined",
          record  => $record,
         }
         unless defined $key;
 
       # register a new handler... or die!
       $handler_for->{$key} = $factory->($key, $record)
         unless exists $handler_for->{$key};
 
       return $handler_for->{$key}->($record);
    };
 } ## end sub dispatch
 
 sub logger {
    my %args = normalize_args(@_, {name => 'log pipe', loglevel => $INFO});
    identify(\%args);
    my $loglevel = LEVELID_FOR($args{loglevel});
    my $mangler  = $args{target};
    if (!defined $mangler) {
       $mangler = sub { return shift; }
    }
    elsif (ref($mangler) ne 'CODE') {
       my @keys = ref($mangler) ? @$mangler : ($mangler);
       $mangler = sub {
          my $record = shift;
          return traverse($record, @keys);
       };
    } ## end elsif (ref($mangler) ne 'CODE')
    my $logger = get_logger();
    return sub {
       my $record = shift;
       $logger->log($loglevel, $mangler->($record));
       return $record;
    };
 } ## end sub logger
 
 sub sequence {
    my %args = normalize_args(@_, {name => 'sequence'});
    identify(\%args);
 
    # cope with an empty list of tubes - equivalent to an "id" function but
    # always returning an iterator for consistency
    my $tubes = $args{tubes} || [];
    return sub {
       my @record = shift;
       return (
          iterator => sub {
             return unless @record;
             return shift @record;
          }
       );
      }
      unless @$tubes;
 
    # auto-generate tubes if you get definitions
    my @tubes = map {
       my $ref = ref $_;
       ($ref eq 'CODE')
         ? $_
         : tube(($ref eq 'ARRAY') ? @$_ : $_)
    } @$tubes;
 
    my $logger = log_helper(\%args);
    my $name   = $args{name};
    return sub {
       my $record = shift;
       $logger->($record, \%args) if $logger;
 
       my @stack = ({record => $record});
       my $iterator = sub {
        STEP:
          while (@stack) {
             my $pos = $#stack;
 
             my $f = $stack[$pos];
             my @record =
                 exists($f->{record})   ? delete $f->{record}
               : exists($f->{iterator}) ? $f->{iterator}->()
               : @{$f->{records} || []} ? shift @{$f->{records}}
               :                          ();
             if (!@record) {    # no more at this level...
                my $n = @stack;
                TRACE "$name: level $n backtracking, no more records";
                pop @stack;
                next STEP;
             } ## end if (!@record)
 
             my $record = $record[0];
             return $record if @stack > @tubes;    # output cache
 
             # something must be done...
             my @outcome = $tubes[$pos]->($record)
               or next STEP;
 
             unshift @outcome, 'record' if @outcome == 1;
             push @stack, {@outcome};              # and go to next level
          } ## end STEP: while (@stack)
 
          return;    # end of output, empty list
       };
       return (iterator => $iterator);
    };
 } ## end sub sequence
 
 1;

END_OF_FILE


# __MOBUNDLE_FILE__

      'Data/Tubes/Plugin/Util.pm' => <<'END_OF_FILE',
 package Data::Tubes::Plugin::Util;
 use strict;
 use warnings;
 use English qw< -no_match_vars >;
 use Data::Dumper;
 our $VERSION = '0.722';
 
 use Template::Perlish;
 use Log::Log4perl::Tiny qw< :easy :dead_if_first get_logger >;
 use Data::Tubes::Util qw< normalize_args >;
 
 use Exporter qw< import >;
 our @EXPORT_OK = qw< identify log_helper read_file >;
 
 sub identify {
    my ($args, $opts) = @_;
    $args //= {};
    $opts //= $args->{identification} // {};
 
    my $name = $args->{name};
    $name = '*unknown*' unless defined $name;
 
    my @caller_fields = qw<
      package
      filename
      line
      subroutine
      hasargs
      wantarray
      evaltext
      is_require
      hints
      bitmask
      hintsh
    >;
    my %caller;
 
    if (exists $opts->{caller}) {
       @caller{@caller_fields} = @{$opts->{caller}};
    }
    else {
       my $level = $opts->{level};
       $level = 1 unless defined $level;
       @caller{@caller_fields} = caller($level);
    }
 
    my $message = $opts->{message};
    $message = 'building [% name %] as [% subroutine %]'
      unless defined $message;
 
    my $tp = Template::Perlish->new(%{$opts->{tp_opts} || {}});
    $message = $tp->process(
       $message,
       {
          %caller,
          name => $name,
          args => $args,
          opts => $opts,
       }
    );
 
    my $loglevel = $opts->{loglevel};
    $loglevel = $DEBUG unless defined $loglevel;
    get_logger->log($loglevel, $message);
 
    return;
 } ## end sub identify
 
 sub log_helper {
    my ($args, $opts) = @_;
    $opts //= $args->{logger};
    return unless $opts;
    return $opts if ref($opts) eq 'CODE';
 
    # generate one
    my $name = $args->{name};
    $name = '*unknown*' unless defined $name;
 
    my $message = $opts->{message};
    $message = '==> [% args.name %]' unless defined $message;
 
    my $tp = Template::Perlish->new(%{$opts->{tp_opts} || {}});
    $message = $tp->compile($message);
 
    my $logger   = get_logger();
    my $loglevel = $opts->{loglevel};
    $loglevel = $DEBUG unless defined $loglevel;
 
    return sub {
       my $level = $logger->level();
       return if $level < $loglevel;
       my $record = shift;
       my $rendered =
         $tp->evaluate($message,
          {record => $record, args => $args, opts => $opts});
       $logger->log($loglevel, $rendered);
    };
 } ## end sub log_helper
 
 sub read_file {
    my %args = normalize_args(
       @_,
       {
          binmode => ':encoding(UTF-8)',
       }
    );
    open my $fh, '<', $args{filename}
      or LOGDIE "open('$args{filename}'): $OS_ERROR";
    binmode $fh, $args{binmode} if defined $args{binmode};
    local $INPUT_RECORD_SEPARATOR;
    return <$fh>;
 } ## end sub read_file
 
 1;

END_OF_FILE


# __MOBUNDLE_FILE__

      'Data/Tubes/Plugin/Writer.pm' => <<'END_OF_FILE',
 package Data::Tubes::Plugin::Writer;
 
 # vim: ts=3 sts=3 sw=3 et ai :
 
 use strict;
 use warnings;
 use English qw< -no_match_vars >;
 use POSIX qw< strftime >;
 our $VERSION = '0.722';
 
 use Log::Log4perl::Tiny qw< :easy :dead_if_first LOGLEVEL >;
 use Template::Perlish;
 
 use Data::Tubes::Util qw< normalize_args shorter_sub_names sprintffy >;
 use Data::Tubes::Plugin::Util qw< identify log_helper >;
 use Data::Tubes::Plugin::Plumbing;
 my %global_defaults = (input => 'rendered',);
 
 sub _filenames_generator {
    my $template = shift;
 
    my $n             = 0; # counter, used in closures inside $substitutions
    my $substitutions = [
       [qr{(\d*)n} => sub { return sprintf "%${1}d",    $n; }],
       [qr{Y}      => sub { return strftime('%Y',       localtime()); }],
       [qr{m}      => sub { return strftime('%m',       localtime()); }],
       [qr{d}      => sub { return strftime('%d',       localtime()); }],
       [qr{H}      => sub { return strftime('%H',       localtime()); }],
       [qr{M}      => sub { return strftime('%M',       localtime()); }],
       [qr{S}      => sub { return strftime('%S',       localtime()); }],
       [qr{z}      => sub { return strftime('%z',       localtime()); }],
       [qr{D}      => sub { return strftime('%Y%m%d',   localtime()); }],
       [qr{T}      => sub { return strftime('%H%M%S%z', localtime()); }],
       [qr{t} => sub { return strftime('%Y%m%dT%H%M%S%z', localtime()); }],
    ];
 
    # see if the template depends on the counter
    my $expanded = sprintffy($template, $substitutions);
    return sub {
       my $retval = sprintffy($template, $substitutions);
       ++$n;
       return $retval;
      }
      if ($expanded ne $template);    # it does!
 
    # then, by default, revert to poor's man expansion of name...
    return sub {
       my $retval = $n ? "${template}_$n" : $template;
       ++$n;
       return $retval;
    };
 } ## end sub _filenames_generator
 
 sub dispatch_to_files {
    my %args = normalize_args(
       @_,
       {
          %global_defaults,
          name    => 'write dispatcher',
          binmode => ':encoding(UTF-8)'
       }
    );
    identify(\%args);
    my $name = delete $args{name};    # so that it can be overridden
 
    my $factory = delete $args{filename_factory};
    if (!defined($factory) && defined($args{filename_template})) {
       my $tp = Template::Perlish->new(%{$args{tp_opts} || {}});
       my $template = $tp->compile($args{filename_template});
       $factory = sub {
          my ($key, $record) = @_;
          return $tp->evaluate($template, {key => $key, record => $record});
       };
    } ## end if (!defined($factory)...)
 
    $args{factory} //= sub {
       my $filename = $factory->(@_);
       return write_to_files(%args, filename => $filename);
    };
 
    return Data::Tubes::Plugin::Plumbing::dispatch(%args);
 } ## end sub dispatch_to_files
 
 sub write_to_files {
    my %args = normalize_args(
       @_,
       {
          %global_defaults,
          name    => 'write to file',
          binmode => ':encoding(UTF-8)'
       }
    );
    identify(\%args);
    my $name = $args{name};
    LOGDIE "$name: need a filename" unless defined $args{filename};
    LOGDIE "$name: need an input"   unless defined $args{input};
 
    my $output = $args{filename};
    $output = _filenames_generator($output)
      unless ref($output);
    require Data::Tubes::Util::Output;
    my $output_handler = Data::Tubes::Util::Output->new(
       output => $output,
       map { ($_ => $args{$_}) }
         grep { exists $args{$_} }
         qw< binmode footer header interlude policy >
    );
 
    my $input = $args{input};
    return sub {
       my $record = shift;
       $output_handler->print($record->{$input});
       return $record;    # relaunch for further processing
    };
 } ## end sub write_to_files
 
 shorter_sub_names(__PACKAGE__, 'write_');
 
 1;

END_OF_FILE


# __MOBUNDLE_FILE__

      'Data/Tubes/Util/Output.pm' => <<'END_OF_FILE',
 package Data::Tubes::Util::Output;
 use strict;
 use warnings;
 use English qw< -no_match_vars >;
 use 5.010;
 use File::Path qw< make_path >;
 use File::Basename qw< dirname >;
 our $VERSION = '0.722';
 
 use Log::Log4perl::Tiny qw< :easy :dead_if_first >;
 use Mo qw< default >;
 has binmode => (default => ':raw');
 has footer  => ();
 has header  => ();
 has interlude => ();
 has output  => (default => \*STDOUT);
 has policy  => (default => undef);
 has track   => (
    default => sub {
       return {
          files       => 0,
          records     => 0,
          chars_file  => 0,
          chars_total => 0,
       };
    }
 );
 
 sub open {
    my ($self, $hint) = @_;
 
    # reset some tracking parameters
    my $track = $self->track();
    $track->{files}++;
    $track->{records}    = 0;
    $track->{chars_file} = 0;
 
    # get new filehandle
    my ($fh, $fh_releaser) =
      @{$track}{qw< current_fh current_fh_releaser>} = $self->get_fh($hint);
 
    # do header handling
    $self->_print($fh, $self->header(), $track);
 
    return $fh;
 } ## end sub open
 
 sub __open_file {
    my ($filename, $binmode) = @_;
 
    # ensure its directory exists
    make_path(dirname($filename), {error => \my $errors});
    if (@$errors) {
       my ($error) = values %{$errors->[0]};
       LOGCONFESS "make_path() for '$filename': $error";
    }
 
    # can open the file, at last
    CORE::open my $fh, '>', $filename
      or LOGCONFESS "open('$filename'): $OS_ERROR";
    binmode $fh, $binmode;
 
    return $fh;
 } ## end sub __open_file
 
 sub get_fh {
    my ($self, $handle) = @_;
    $handle //= $self->output();
 
    # define a default releaser, but not for GLOBs as they have their own
    # life outside of here
    my $releaser =
      ref($handle) eq 'GLOB' ? undef : sub {
         CORE::close $_[0] or LOGCONFESS "close(): $OS_ERROR";
         return undef;
      };
 
    # if $handle is a factory, treat it as such
    if (ref($handle) eq 'CODE') {
       my @items = $handle->($self);
       $handle = shift @items;
 
       # override the $releaser if and only if the factory instructed to
       # do so. Otherwise, the default one will be kept.
       $releaser = shift @items if @items;
    } ## end if (ref($handle) eq 'CODE')
 
    # now, we either have a filehandle, or a filename
    return ($handle, $releaser) if ref($handle) eq 'GLOB';
    return (__open_file($handle, $self->binmode()), $releaser);
 } ## end sub get_fh
 
 sub release_fh {
    my ($self, $fh) = @_;
    my $track = $self->track();
    if (my $releaser = delete $track->{current_fh_releaser}) {
       $releaser->($fh);
    }
    delete $track->{current_fh};
    return undef;
 } ## end sub release_fh
 
 sub close {
    my ($self, $fh, $track) = @_;
 
    # do footer handling
    $self->_print($fh, $self->footer(), $track);
 
    # call close, prepare $fh for other possible records
    return $self->release_fh($fh);
 } ## end sub close
 
 sub just_close {
    my $self  = shift;
    my $track = $self->track();
    my $fh    = $track->{current_fh} or return;
    $self->close($fh, $track);
    return;
 } ## end sub just_close
 
 sub print {
    my $self = shift;
 
    my $iterator = ref($_[0]) && $_[0];
    my $checker  = $self->checker();
    my $track    = $self->track();
    my $fh       = $track->{current_fh};
    my $interlude = $self->interlude();
 
    while ('necessary') {
       my $record = $iterator ? $iterator->() : shift(@_);
       last unless defined $record;
 
       # get filehandle if needed
       $fh ||= $self->open();
 
       # print interlude if we have previous records, increase count
       $self->_print($fh, $interlude, $track)
         if $track->{records};
 
       # print record
       $self->_print($fh, $record, $track);
 
       # increment number of records, for next print
       $track->{records}++;
 
       # do checks if activated
       $fh = $self->close($fh, $track)
         if $checker && (!$checker->($self));
    } ## end while ('necessary')
 
    return;
 } ## end sub print
 
 sub _print {
    my ($self, $fh, $data, $track) = @_;
    return unless defined $data;
    $data = $data->($self) if ref $data;
 
    # do print data
    ref($fh) or LOGCONFESS("$fh is not a reference");
    print {$fh} $data or LOGCONFESS "print(): $OS_ERROR";
 
    # update trackers
    my $new_chars = length($data);
    $track->{chars_file}  += $new_chars;
    $track->{chars_total} += $new_chars;
 
    return $new_chars;
 } ## end sub _print
 
 sub default_check {
    my $self = shift;
 
    my $policy = $self->policy()
      or return 1;    # no policy, always fine
    my $track = $self->track();
    if (my $mr = $policy->{records_threshold}) {
       return 0 if $track->{records} >= $mr;
    }
    if (my $cpf = $policy->{characters_threshold}) {
       return 0 if $track->{chars_file} >= $cpf;
    }
    return 1;
 } ## end sub default_check
 
 sub checker {
    my $self = shift;
 
    # allow for overriding tout-court
    if (my $method = $self->can('check')) {
       return $method;    # will eventually be called in the right way
    }
 
    # if no policy is set, there's no reason to do checks
    my $policy = $self->policy() or return;
 
    # at this point, let's use the default_check, whatever it is
    return $self->can('default_check');
 } ## end sub checker
 
 sub DESTROY { shift->just_close() }
 
 sub writer {
    my $package = shift;
    my $self    = $package->new(@_);
    return sub { return $self->print(@_) };
 }
 
 1;

END_OF_FILE


# __MOBUNDLE_FILE__

      'Template/Perlish.pm' => <<'END_OF_FILE',
 package Template::Perlish;
 
 use 5.008_000;
 use warnings;
 use strict;
 use Carp;
 use English qw( -no_match_vars );
 use constant ERROR_CONTEXT => 3;
 { our $VERSION = '1.50'; }
 
 # Function-oriented interface
 sub import {
    my ($package, @list) = @_;
 
    for my $sub (@list) {
       croak "subroutine '$sub' not exportable"
         unless grep { $sub eq $_ } qw< crumble render traverse >;
 
       my $caller = caller();
 
       no strict 'refs';    ## no critic (ProhibitNoStrict)
       local $SIG{__WARN__} = \&Carp::carp;
       *{$caller . q<::> . $sub} = \&{$package . q<::> . $sub};
    } ## end for my $sub (@list)
 
    return;
 } ## end sub import
 
 sub render {
    my ($template, @rest) = @_;
    my ($variables, %params);
    if (@rest) {
       $variables = ref($rest[0]) ? shift(@rest) : {splice @rest, 0};
       %params = %{shift @rest} if @rest;
    }
    return __PACKAGE__->new(%params)->process($template, $variables);
 } ## end sub render
 
 # Object-oriented interface
 sub new {
    my ($package, @rest) = @_;
    my $self = bless {
       start     => '[%',
       stop      => '%]',
       utf8      => 1,
       variables => {},
      },
      $package;
    %{$self} = (%{$self}, @rest == 1 ? %{$rest[0]} : @rest);
    return $self;
 } ## end sub new
 
 sub process {
    my ($self, $template, $vars) = @_;
    return $self->evaluate($self->compile($template), $vars);
 }
 
 sub evaluate {
    my ($self, $compiled, $vars) = @_;
    $self->_compile_sub($compiled)
      unless exists $compiled->{sub};
    return $compiled->{sub}->($vars);
 } ## end sub evaluate
 
 sub compile {    ## no critic (RequireArgUnpacking)
    my ($self, undef, %args) = @_;
    my $outcome = $self->_compile_code_text($_[1]);
    return $outcome if $args{no_check};
    return $self->_compile_sub($outcome);
 } ## end sub compile
 
 sub compile_as_sub {    ## no critic (RequireArgUnpacking)
    my $self = shift;
    return $self->compile($_[0])->{'sub'};
 }
 
 sub _compile_code_text {
    my ($self, $template) = @_;
 
    my $starter = $self->{start};
    my $stopper = $self->{stop};
 
    my $compiled = "# line 1 'input'\n";
    $compiled .= "use utf8;\n\n" if $self->{utf8};
    $compiled .= "print {*STDOUT} '';\n\n";
    my $pos     = 0;
    my $line_no = 1;
    while ($pos < length $template) {
 
       # Find starter and emit all previous text as simple text
       my $start = index $template, $starter, $pos;
       last if $start < 0;
       my $chunk = substr $template, $pos, $start - $pos;
       $compiled .= _simple_text($chunk)
         if $start > $pos;
 
       # Update scanning variables. The line counter is advanced for
       # the chunk but not yet for the $starter, so that error reporting
       # for unmatched $starter will point to the correct line
       $pos = $start + length $starter;
       $line_no += ($chunk =~ tr/\n//);
 
       # Grab code
       my $stop = index $template, $stopper, $pos;
       if ($stop < 0) {    # no matching $stopper, bummer!
          my $section = _extract_section({template => $template}, $line_no);
          croak "unclosed starter '$starter' at line $line_no\n$section";
       }
       my $code = substr $template, $pos, $stop - $pos;
 
       # Now I can advance the line count considering the $starter too
       $line_no += ($starter =~ tr/\n//);
 
       if (length $code) {
          if (my $path = crumble($code)) {
             $compiled .= _variable($path);
          }
          elsif (my ($scalar) =
             $code =~ m{\A\s* (\$ [[:alpha:]_]\w*) \s*\z}mxs)
          {
             $compiled .=
               "\nprint {*STDOUT} $scalar; ### straight scalar\n\n";
          } ## end elsif (my ($scalar) = $code...)
          elsif (substr($code, 0, 1) eq q<=>) {
             $compiled .= "\n# line $line_no 'template<3,$line_no>'\n"
               . _expression(substr $code, 1);
          }
          else {
             $compiled .=
               "\n# line $line_no 'template<0,$line_no>'\n" . $code;
          }
       } ## end if (length $code)
 
       # Update scanning variables
       $pos = $stop + length $stopper;
       $line_no += (($code . $stopper) =~ tr/\n//);
 
    } ## end while ($pos < length $template)
 
    # put last part of input string as simple text
    $compiled .= _simple_text(substr($template, $pos || 0));
 
    return {
       template  => $template,
       code_text => $compiled,
    };
 } ## end sub _compile_code_text
 
 # The following function is long and complex because it deals with many
 # different cases. It is kept as-is to avoid too many calls to other
 # subroutines; for this reason, it's reasonably commented.
 sub traverse {  ## no critic (RequireArgUnpacking,ProhibitExcessComplexity)
 
    ## no critic (ProhibitDoubleSigils)
    my $iref         = ref($_[0]);
    my $ref_wanted   = ($iref eq 'SCALAR') || ($iref eq 'REF');
    my $ref_to_value = $ref_wanted ? shift : \shift;
    return ($ref_wanted ? $ref_to_value : $$ref_to_value) unless @_;
 
    my $path_input = shift;
    return ($ref_wanted ? undef : '') unless defined $path_input;
 
    my $crumbs;
    if (ref $path_input) {
       $crumbs = $path_input;
    }
    else {
       return ($ref_wanted ? $ref_to_value : $$ref_to_value)
         if defined($path_input) && !length($path_input);
       $crumbs = crumble($path_input);
    }
    return ($ref_wanted ? undef : '') unless defined $crumbs;
 
    # go down the rabbit hole
    for my $crumb (@$crumbs) {
 
       # $key is what we will look into $$ref_to_value. We don't use
       # $crumb directly as we might change $key in the loop, and we
       # don't want to spoil $crumbs
       my $key = $crumb;
 
       # $ref tells me how to look down into $$ref_to_value, i.e. as
       # an ARRAY or a HASH
       my $ref = ref $$ref_to_value;
 
       # if $ref is not true, we hit a wall. How we proceed depends on
       # whether we were asked to auto-vivify or not.
       if (!$ref) {
          return '' unless $ref_wanted;    # don't bother going on
 
          # auto-vivification requested! $key will tell us how to
          # proceed further, hopefully
          $ref = ref $key;
       } ## end if (!$ref)
 
       # if $key is a reference, it will tell us what's expected now
       if (my $key_ref = ref $key) {
 
          # if $key_ref is not the same as $ref there is a mismatch
          # between what's available ($ref) and what' expected ($key_ref)
          return $ref_wanted ? undef : '' if $key_ref ne $ref;
 
          # OK, data and expectations agree. Get the "real" key
          if ($key_ref eq 'ARRAY') {
             $key = $crumb->[0];    # it's an array, key is (only) element
          }
          elsif ($key_ref eq 'HASH') {
             ($key) = keys %$crumb;    # hash... key is (only) key
          }
       } ## end if (my $key_ref = ref ...)
 
       # if $ref is still not true at this point, we're doing
       # auto-vivification and we have a plain key. Some guessing
       # will be needed! Plain non-negative integers resolve to ARRAY,
       # otherwise we'll consider $key as a HASH key
       $ref ||= ($key =~ m{\A (?: 0 | [1-9]\d*) \z}mxs) ? 'ARRAY' : 'HASH';
 
       # time to actually do the next step
       if ($ref eq 'HASH') {
          $ref_to_value = \($$ref_to_value->{$key});
       }
       elsif ($ref eq 'ARRAY') {
          $ref_to_value = \($$ref_to_value->[$key]);
       }
       else {    # don't know what to do with other references!
          return $ref_wanted ? undef : '';
       }
    } ## end for my $crumb (@$crumbs)
 
    # normalize output, substitute undef with '' unless $ref_wanted
    return
        $ref_wanted             ? $ref_to_value
      : defined($$ref_to_value) ? $$ref_to_value
      :                           '';
 
    ## use critic
 } ## end sub traverse
 
 sub V  { return '' }
 sub A  { return }
 sub H  { return }
 sub HK { return }
 sub HV { return }
 
 sub _compile_sub {
    my ($self, $outcome) = @_;
 
    my @warnings;
    {
       my $utf8 = $self->{utf8} ? 1 : 0;
       local $SIG{__WARN__} = sub { push @warnings, @_ };
       my $code = <<"END_OF_CODE";
    sub {
       my \%variables = \%{\$self->{variables}};
       my \$V = \\\%variables; # generic kid, as before by default
 
       {
          my \$vars = shift || {};
          if (ref(\$vars) eq 'HASH') { # old case
             \%variables = (\%variables, \%\$vars);
          }
          else {
             \$V = \$vars;
             \%variables = (HASH => { \%variables }, REF => \$V);
          }
       }
 
       no warnings 'redefine';
       local *V  = sub {
          my \$path = scalar(\@_) ? shift : [];
          my \$input = scalar(\@_) ? shift : \$V;
          return traverse(\$input, \$path);
       };
       local *A  = sub {
          my \$path = scalar(\@_) ? shift : [];
          my \$input = scalar(\@_) ? shift : \$V;
          return \@{traverse(\$input, \$path) || []};
       };
       local *H  = sub {
          my \$path = scalar(\@_) ? shift : [];
          my \$input = scalar(\@_) ? shift : \$V;
          return \%{traverse(\$input, \$path) || {}};
       };
       local *HK = sub {
          my \$path = scalar(\@_) ? shift : [];
          my \$input = scalar(\@_) ? shift : \$V;
          return keys \%{traverse(\$input, \$path) || {}};
       };
       local *HV = sub {
          my \$path = scalar(\@_) ? shift : [];
          my \$input = scalar(\@_) ? shift : \$V;
          return values \%{traverse(\$input, \$path) || {}};
       };
       use warnings 'redefine';
 
       local *STDOUT;
       open STDOUT, '>', \\my \$buffer or croak "open(): \$OS_ERROR";
       binmode STDOUT, ':encoding(utf8)' if $utf8;
       my \$previous_selection = select(STDOUT);
       { # double closure to free "my" variables
          my (\$buffer, \$previous_selection); # hide external ones
          { # this enclusure allows using "my" again
 $outcome->{code_text}
          }
       }
       select(\$previous_selection);
       close STDOUT;
       if ($utf8) {
          require Encode;
          \$buffer = Encode::decode(utf8 => \$buffer);
       }
       return \$buffer;
    }
 END_OF_CODE
 
       # print {*STDOUT} $code; exit 0;
       $outcome->{sub} = eval $code;    ## no critic (ProhibitStringyEval)
       return $outcome if $outcome->{sub};
    }
 
    my $error = $EVAL_ERROR;
    my ($offset, $starter, $line_no) =
      $error =~ m{at[ ]'template<(\d+),(\d+)>'[ ]line[ ](\d+)}mxs;
    $line_no -= $offset;
    s{at[ ]'template<\d+,\d+>'[ ]line[ ](\d+)}
     {'at line ' . ($1 - $offset)}egmxs
      for @warnings, $error;
    if ($line_no == $starter) {
       s{,[ ]near[ ]"[#][ ]line.*?\n\s+}{, near "}gmxs
         for @warnings, $error;
    }
 
    my $section = _extract_section($outcome, $line_no);
    $error = join '', @warnings, $error, "\n", $section;
 
    croak $error;
 } ## end sub _compile_sub
 
 sub _extract_section {
    my ($hash, $line_no) = @_;
    $line_no--;    # for proper comparison with 0-based array
    my $start = $line_no - ERROR_CONTEXT;
    my $end   = $line_no + ERROR_CONTEXT;
 
    my @lines = split /\n/mxs, $hash->{template};
    $start = 0       if $start < 0;
    $end   = $#lines if $end > $#lines;
    my $n_chars = length($end + 1);
    return join '', map {
       sprintf "%s%${n_chars}d| %s\n",
         (($_ == $line_no) ? '>>' : '  '), ($_ + 1), $lines[$_];
    } $start .. $end;
 } ## end sub _extract_section
 
 sub _simple_text {
    my $text = shift;
 
    return "print {*STDOUT} '$text';\n\n" if $text !~ /[\n'\\]/mxs;
 
    $text =~ s/^/ /gmxs;    # indent, trick taken from diff -u
    return <<"END_OF_CHUNK";
 ### Verbatim text
 print {*STDOUT} do {
    my \$text = <<'END_OF_INDENTED_TEXT';
 $text
 END_OF_INDENTED_TEXT
    \$text =~ s/^ //gms;      # de-indent
    substr \$text, -1, 1, ''; # get rid of added newline
    \$text;
 };
 
 END_OF_CHUNK
 } ## end sub _simple_text
 
 sub crumble {
    my ($input) = @_;
    return unless defined $input;
 
    $input =~ s{\A\s+|\s+\z}{}gmxs;
    return [] unless length $input;
 
    my $sq    = qr{(?mxs: ' [^']* ' )}mxs;
    my $dq    = qr{(?mxs: " (?:[^\\"] | \\.)* " )}mxs;
    my $ud    = qr{(?mxs: \w+ )}mxs;
    my $chunk = qr{(?mxs: $sq | $dq | $ud)+}mxs;
 
    # save and reset current pos() on $input
    my $prepos = pos($input);
    pos($input) = undef;
 
    my @path;
    ## no critic (RegularExpressions::ProhibitCaptureWithoutTest)
    push @path, $1 while $input =~ m{\G [.]? ($chunk) }cgmxs;
    ## use critic
 
    # save and restore pos() on $input
    my $postpos = pos($input);
    pos($input) = $prepos;
 
    return unless defined $postpos;
    return if $postpos != length($input);
 
    # cleanup @path components
    for my $part (@path) {
       my @subparts;
       while ((pos($part) || 0) < length($part)) {
          if ($part =~ m{\G ($sq) }cgmxs) {
             push @subparts, substr $1, 1, length($1) - 2;
          }
          elsif ($part =~ m{\G ($dq) }cgmxs) {
             my $subpart = substr $1, 1, length($1) - 2;
             $subpart =~ s{\\(.)}{$1}gmxs;
             push @subparts, $subpart;
          }
          elsif ($part =~ m{\G ($ud) }cgmxs) {
             push @subparts, $1;
          }
          else {    # shouldn't happen ever
             return;
          }
       } ## end while ((pos($part) || 0) ...)
       $part = join '', @subparts;
    } ## end for my $part (@path)
 
    return \@path;
 } ## end sub crumble
 
 sub _variable {
    my $path = shift;
    my $DQ   = q<">;    # double quotes
    $path = join ', ', map { $DQ . quotemeta($_) . $DQ } @{$path};
 
    return <<"END_OF_CHUNK";
 ### Variable from the stash (\$V)
 print {*STDOUT} V([$path]);
 
 END_OF_CHUNK
 } ## end sub _variable
 
 sub _expression {
    my $expression = shift;
    return <<"END_OF_CHUNK";
 # Expression to be evaluated and printed out
 {
    my \$value = do {{
 $expression
    }};
    print {*STDOUT} \$value if defined \$value;
 }
 
 END_OF_CHUNK
 
 } ## end sub _expression
 
 1;

END_OF_FILE


# __MOBUNDLE_FILE__

      'Log::Log4perl::Tiny.pm' => <<'END_OF_FILE',
 package Log::Log4perl::Tiny;
 $Log::Log4perl::Tiny::VERSION = '1.2.9';
 # ABSTRACT: mimic Log::Log4perl in one single module
 
 use warnings;
 use strict;
 use Carp;
 
 our ($TRACE, $DEBUG, $INFO, $WARN, $ERROR, $FATAL, $OFF, $DEAD);
 my ($_instance, %name_of, %format_for, %id_for);
 my $LOGDIE_MESSAGE_ON_STDERR = 1;
 
 sub import {
    my ($exporter, @list) = @_;
    my ($caller, $file, $line) = caller();
    no strict 'refs';
 
    if (grep { $_ eq ':full_or_fake' } @list) {
       @list = grep { $_ ne ':full_or_fake' } @list;
       my $sue = 'use Log::Log4perl (@list)';
       eval "
          package $caller;
          $sue;
          1;
       " and return;
       unshift @list, ':fake';
    } ## end if (grep { $_ eq ':full_or_fake'...
 
    my (%done, $level_set);
  ITEM:
    for my $item (@list) {
       next ITEM if $done{$item};
       $done{$item} = 1;
       if ($item =~ /^[a-zA-Z]/mxs) {
          *{$caller . '::' . $item} = \&{$exporter . '::' . $item};
       }
       elsif ($item eq ':levels') {
          for my $level (qw( TRACE DEBUG INFO WARN ERROR FATAL OFF DEAD )) {
             *{$caller . '::' . $level} = \${$exporter . '::' . $level};
          }
       }
       elsif ($item eq ':subs') {
          push @list, qw(
            ALWAYS TRACE DEBUG INFO WARN ERROR FATAL
            LOGWARN LOGDIE LOGEXIT LOGCARP LOGCLUCK LOGCROAK LOGCONFESS
            get_logger
          );
       } ## end elsif ($item eq ':subs')
       elsif ($item =~ /\A : (mimic | mask | fake) \z/mxs) {
 
          # module name as a string below to trick Module::ScanDeps
          if (!'Log::Log4perl'->can('easy_init')) {
             $INC{'Log/Log4perl.pm'} = __FILE__;
             *Log::Log4perl::import = sub { };
             *Log::Log4perl::easy_init = sub {
                my ($pack, $conf) = @_;
                if (ref $conf) {
                   $_instance = __PACKAGE__->new($conf);
                   $_instance->level($conf->{level})
                     if exists $conf->{level};
                   $_instance->format($conf->{format})
                     if exists $conf->{format};
                   $_instance->format($conf->{layout})
                     if exists $conf->{layout};
                } ## end if (ref $conf)
                elsif (defined $conf) {
                   $_instance->level($conf);
                }
             };
          } ## end if (!'Log::Log4perl'->can...
       } ## end elsif ($item =~ /\A : (mimic | mask | fake) \z/mxs)
       elsif ($item eq ':easy') {
          push @list, qw( :levels :subs :fake );
       }
       elsif (lc($item) eq ':dead_if_first') {
          get_logger()->_set_level_if_first($DEAD);
          $level_set = 1;
       }
       elsif (lc($item) eq ':no_extra_logdie_message') {
          $LOGDIE_MESSAGE_ON_STDERR = 0;
       }
    } ## end for my $item (@list)
 
    if (!$level_set) {
       my $logger = get_logger();
       $logger->_set_level_if_first($INFO);
       $logger->level($logger->level());
    }
 
    return;
 } ## end sub import
 
 sub new {
    my $package = shift;
    my %args = ref($_[0]) ? %{$_[0]} : @_;
 
    $args{format} = $args{layout} if exists $args{layout};
 
    my $channels_input = [ fh => \*STDERR ];
    if (exists $args{channels}) {
       $channels_input = $args{channels};
    }
    else {
       for my $key (qw< file_append file_create file_insecure file fh >) {
          next unless exists $args{$key};
          $channels_input = [ $key => $args{$key} ];
          last;
       }
    }
    my $channels = build_channels($channels_input);
    $channels = $channels->[0] if @$channels == 1; # remove outer shell
 
    my $self = bless {
       fh    => $channels,
       level => $INFO,
    }, $package;
 
    for my $accessor (qw( level fh format )) {
       next unless defined $args{$accessor};
       $self->$accessor($args{$accessor});
    }
 
    $self->format('[%d] [%5p] %m%n') unless exists $self->{format};
 
    return $self;
 } ## end sub new
 
 sub build_channels {
    my @pairs = (@_ && ref($_[0])) ? @{$_[0]} : @_;
    my @channels;
    while (@pairs) {
       my ($key, $value) = splice @pairs, 0, 2;
 
       # some initial validation
       croak "build_channels(): undefined key in list"
          unless defined $key;
       croak "build_channels(): undefined value for key $key"
          unless defined $value;
 
       # analyze the key-value pair and set the channel accordingly
       my ($channel, $set_autoflush);
       if ($key =~ m{\A(?: fh | sub | code | channel )\z}mxs) {
          $channel = $value;
       }
       elsif ($key eq 'file_append') {
          open $channel, '>>', $value
            or croak "open('$value') for appending: $!";
          $set_autoflush = 1;
       }
       elsif ($key eq 'file_create') {
          open $channel, '>', $value
            or croak "open('$value') for creating: $!";
          $set_autoflush = 1;
       }
       elsif ($key =~ m{\A file (?: _insecure )? \z}mxs) {
          open $channel, $value
            or croak "open('$value'): $!";
          $set_autoflush = 1;
       }
       else {
          croak "unsupported channel key '$key'";
       }
 
       # autoflush new filehandle if applicable
       if ($set_autoflush) {
          my $previous = select($channel);
          $|++;
          select($previous);
       } ## end if (exists $args{file})
 
       # record the channel, on to the next
       push @channels, $channel;
    }
    return \@channels;
 }
 
 sub get_logger { return $_instance ||= __PACKAGE__->new(); }
 sub LOGLEVEL { return get_logger()->level(@_); }
 sub LEVELID_FOR {
    my $level = shift;
    return $id_for{$level} if exists $id_for{$level};
    return;
 }
 sub LEVELNAME_FOR {
    my $id = shift;
    return $name_of{$id} if exists $name_of{$id};
    return $id if exists $id_for{$id};
    return;
 }
 
 sub format {
    my $self = shift;
 
    if (@_) {
       $self->{format} = shift;
       $self->{args} = \my @args;
       my $replace = sub {
          my ($num, $op) = @_;
          return '%%' if $op eq '%';
          return "%%$op" unless defined $format_for{$op};
          push @args, $op;
          return "%$num$format_for{$op}[0]";
       };
 
       # transform into real format
       my $format_chars = join '', keys %format_for;
       $self->{format} =~ s{
             %                      # format marker
             ( -? \d* (?:\.\d+)? )  # number
             ([$format_chars])      # specifier
          }
          {
             $replace->($1, $2);
          }gsmex;
    } ## end if (@_)
    return $self->{format};
 } ## end sub format
 
 *layout = \&format;
 
 sub emit_log {
    my ($self, $message) = @_;
    my $fh = $self->{fh};
    for my $channel ((ref($fh) eq 'ARRAY') ? (@$fh) : ($fh)) {
       (ref($channel) eq 'CODE') ? $channel->($message, $self)
                                 : print {$channel} $message;
    }
    return;
 }
 
 sub log {
    my $self = shift;
    return if $self->{level} == $DEAD;
 
    my $level = shift;
    return if $level > $self->{level};
 
    my %data_for = (
       level   => $level,
       message => \@_,
    );
    my $message = sprintf $self->{format},
      map { $format_for{$_}[1]->(\%data_for); } @{$self->{args}};
 
    return $self->emit_log($message);
 } ## end sub log
 
 sub ALWAYS { return $_instance->log($OFF, @_); }
 
 sub _exit {
    my $self = shift || $_instance;
    exit $self->{logexit_code} if defined $self->{logexit_code};
    exit $Log::Log4perl::LOGEXIT_CODE
      if defined $Log::Log4perl::LOGEXIT_CODE;
    exit 1;
 } ## end sub _exit
 
 sub logwarn {
    my $self = shift;
    $self->warn(@_);
 
    # default warning when nothing is passed to warn
    push @_, "Warning: something's wrong" unless @_;
 
    # add 'at <file> line <line>' unless argument ends in "\n";
    my (undef, $file, $line) = caller(1);
    push @_, sprintf " at %s line %d.\n", $file, $line
       if substr($_[-1], -1, 1) ne "\n";
 
    # go for it!
    CORE::warn(@_) if $LOGDIE_MESSAGE_ON_STDERR;
 } ## end sub logwarn
 
 sub logdie {
    my $self = shift;
    $self->fatal(@_);
 
    # default die message when nothing is passed to die
    push @_, "Died" unless @_;
 
    # add 'at <file> line <line>' unless argument ends in "\n";
    my (undef, $file, $line) = caller(1);
    push @_, sprintf " at %s line %d.\n", $file, $line
       if substr($_[-1], -1, 1) ne "\n";
 
    # go for it!
    CORE::die(@_) if $LOGDIE_MESSAGE_ON_STDERR;
 
    $self->_exit();
 } ## end sub logdie
 
 sub logexit {
    my $self = shift;
    $self->fatal(@_);
    $self->_exit();
 }
 
 sub logcarp {
    my $self = shift;
    require Carp;
    $Carp::Internal{$_} = 1 for __PACKAGE__;
    if ($self->is_warn()) { # avoid unless we're allowed to emit
       my $message = Carp::shortmess(@_);
       $self->warn($_) for split m{\n}mxs, $message;
    }
    if ($LOGDIE_MESSAGE_ON_STDERR) {
       local $Carp::CarpLevel = $Carp::CarpLevel + 1;
       Carp::carp(@_);
    }
    return;
 } ## end sub logcarp
 
 sub logcluck {
    my $self = shift;
    require Carp;
    $Carp::Internal{$_} = 1 for __PACKAGE__;
    if ($self->is_warn()) { # avoid unless we're allowed to emit
       my $message = Carp::longmess(@_);
       $self->warn($_) for split m{\n}mxs, $message;
    }
    if ($LOGDIE_MESSAGE_ON_STDERR) {
       local $Carp::CarpLevel = $Carp::CarpLevel + 1;
       Carp::cluck(@_);
    }
    return;
 } ## end sub logcluck
 
 sub logcroak {
    my $self = shift;
    require Carp;
    $Carp::Internal{$_} = 1 for __PACKAGE__;
    if ($self->is_fatal()) { # avoid unless we're allowed to emit
       my $message = Carp::shortmess(@_);
       $self->fatal($_) for split m{\n}mxs, $message;
    }
    if ($LOGDIE_MESSAGE_ON_STDERR) {
       local $Carp::CarpLevel = $Carp::CarpLevel + 1;
       Carp::croak(@_);
    }
    $self->_exit();
 } ## end sub logcroak
 
 sub logconfess {
    my $self = shift;
    require Carp;
    $Carp::Internal{$_} = 1 for __PACKAGE__;
    if ($self->is_fatal()) { # avoid unless we're allowed to emit
       my $message = Carp::longmess(@_);
       $self->fatal($_) for split m{\n}mxs, $message;
    }
    if ($LOGDIE_MESSAGE_ON_STDERR) {
       local $Carp::CarpLevel = $Carp::CarpLevel + 1;
       Carp::confess(@_);
    }
    $self->_exit();
 } ## end sub logconfess
 
 sub level {
    my $self = shift;
    $self = $_instance unless ref $self;
    if (@_) {
       my $level = shift;
       return unless exists $id_for{$level};
       $self->{level} = $id_for{$level};
       $self->{_count}++;
    } ## end if (@_)
    return $self->{level};
 } ## end sub level
 
 sub _set_level_if_first {
    my ($self, $level) = @_;
    if (!$self->{_count}) {
       $self->level($level);
       delete $self->{_count};
    }
    return;
 } ## end sub _set_level_if_first
 
 BEGIN {
 
    # Time tracking's start time. Used to be tied to $^T but Log::Log4perl
    # does differently and uses Time::HiRes if available
    my $start_time = time(); # default, according to Log::Log4perl
    my $has_time_hires;
    eval {
       require Time::HiRes;
       $has_time_hires = 1;
       $start_time = [ Time::HiRes::gettimeofday() ];
    };
 
    # For supporting %R
    my $last_log = $start_time;
 
    # %format_for idea from Log::Tiny by J. M. Adler
    %format_for = (    # specifiers according to Log::Log4perl
       c => [s => sub { 'main' }],
       C => [
          s => sub {
             my ($internal_package) = caller 0;
             for my $i (1 .. 4) {
                my ($package) = caller $i;
                last unless defined $package;
                return $package if $package ne $internal_package;
             }
             return '*undef*';
            }
       ],
       d => [
          s => sub {
             my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday,
                $isdst) = localtime();
             sprintf '%04d/%02d/%02d %02d:%02d:%02d',
               $year + 1900, $mon + 1, $mday, $hour, $min, $sec;
            }
       ],
       F => [
          s => sub {
             my ($internal_package) = caller 0;
             for my $i (1 .. 4) {
                my ($package, $file) = caller $i;
                last unless defined $package;
                return $file if $package ne $internal_package;
             }
             return '*undef*';
            }
       ],
       H => [
          s => sub {
             eval { require Sys::Hostname; Sys::Hostname::hostname() }
               || '';
            }
       ],
       l => [
          s => sub {
             my (undef, undef, undef, $subroutine) = caller(4);
             my (undef, $filename, $line) = caller(3);
             sprintf '%s %s (%d)', $subroutine, $filename, $line;
            }
       ],
       L => [
          d => sub {
             my ($internal_package) = caller 0;
             for my $i (1 .. 4) {
                my ($package, undef, $line) = caller $i;
                last unless defined $package;
                return $line if $package ne $internal_package;
             }
             return -1;
            }
       ],
       m => [
          s => sub {
             join(
                (defined $, ? $, : ''),
                map { ref($_) eq 'CODE' ? $_->() : $_; } @{shift->{message}}
             );
          },
       ],
       M => [
          s => sub {
             my ($internal_package) = caller 0;
             for my $i (1 .. 4) {
                my ($package) = caller $i;
                last unless defined $package;
                return (caller($i + 1))[3] if $package ne $internal_package;
             }
             return '*undef*';
            }
       ],
       n => [s => sub { "\n" },],
       p => [s => sub { $name_of{shift->{level}} },],
       P => [d => sub { $$ },],
       r => [d => ( $has_time_hires # install sub depending on Time::HiRes
          ?  sub {
                my ($s, $m) = Time::HiRes::gettimeofday();
                $s -= $start_time->[0];
                $m = int(($m - $start_time->[1]) / 1000);
                ($s, $m) = ($s - 1, $m + 1000) if $m < 0;
                return $m + 1000 * $s;
             }
          :  sub {
                return 1000 * (time() - $start_time);
             }
       ) ],
       R => [d => ( $has_time_hires # install sub depending on Time::HiRes
          ?  sub {
                my ($sx, $mx) = Time::HiRes::gettimeofday();
                my $s = $sx - $last_log->[0];
                my $m = int(($mx - $last_log->[1]) / 1000);
                ($s, $m) = ($s - 1, $m + 1000) if $m < 0;
                $last_log = [ $sx, $mx ];
                return $m + 1000 * $s;
             }
          :  sub {
                my $l = $last_log;
                return 1000 * (($last_log = time()) - $l);
             }
       ) ],
       T => [
          s => sub {
             my $level = 4;
             my @chunks;
             while (my @caller = caller($level++)) {
                push @chunks,
                  "$caller[3]() called at $caller[1] line $caller[2]";
             }
             join ', ', @chunks;
          },
       ],
    );
 
    # From now on we're going to play with GLOBs...
    no strict 'refs';
 
    for my $name (qw( FATAL ERROR WARN INFO DEBUG TRACE )) {
 
       # create the ->level methods
       *{__PACKAGE__ . '::' . lc($name)} = sub {
          my $self = shift;
          return $self->log($$name, @_);
       };
 
       # create ->is_level and ->isLevelEnabled methods as well
       *{__PACKAGE__ . '::is' . ucfirst(lc($name)) . 'Enabled'} =
         *{__PACKAGE__ . '::is_' . lc($name)} = sub {
          return 0 if $_[0]->{level} == $DEAD || $$name > $_[0]->{level};
          return 1;
         };
    } ## end for my $name (qw( FATAL ERROR WARN INFO DEBUG TRACE ))
 
    for my $name (
       qw(
       FATAL ERROR WARN INFO DEBUG TRACE
       LOGWARN LOGDIE LOGEXIT
       LOGCARP LOGCLUCK LOGCROAK LOGCONFESS
       )
      )
    {
       *{__PACKAGE__ . '::' . $name} = sub {
          $_instance->can(lc $name)->($_instance, @_);
       };
    } ## end for my $name (qw( FATAL ERROR WARN INFO DEBUG TRACE...
 
    for my $accessor (qw( fh logexit_code )) {
       *{__PACKAGE__ . '::' . $accessor} = sub {
          my $self = shift;
          $self = $_instance unless ref $self;
          $self->{$accessor} = shift if @_;
          return $self->{$accessor};
       };
    } ## end for my $accessor (qw( fh logexit_code ))
 
    my $index = -1;
    for my $name (qw( DEAD OFF FATAL ERROR WARN INFO DEBUG TRACE )) {
       $name_of{$$name = $index} = $name;
       $id_for{$name}  = $index;
       $id_for{$index} = $index;
       ++$index;
    } ## end for my $name (qw( DEAD OFF FATAL ERROR WARN INFO DEBUG TRACE ))
 
    get_logger();    # initialises $_instance;
 } ## end BEGIN
 
 1;                  # Magic true value required at end of module
 
 __END__
 
 =pod
 
 =encoding UTF-8
 
 =head1 NAME
 
 Log::Log4perl::Tiny - mimic Log::Log4perl in one single module
 
 =head1 VERSION
 
 version 1.2.9
 
 =head1 DESCRIPTION
 
 Yes... yet another logging module. Nothing particularly fancy nor
 original, too, but a single-module implementation of the features I
 use most from L<Log::Log4perl> for quick things, namely:
 
 =over
 
 =item *
 
 easy mode and stealth loggers (aka log functions C<INFO>, C<WARN>, etc.);
 
 =item *
 
 debug message filtering by log level;
 
 =item *
 
 line formatting customisation;
 
 =item *
 
 quick sending of messages to a log file.
 
 =back
 
 There are many, many things that are not included; probably the most
 notable one is the ability to provide a configuration file.
 
 =head2 Why?
 
 I have really nothing against L<Log::Log4perl>, to the point that
 one of the import options is to check whether L<Log::Log4perl> is installed
 and use it if possible. I just needed to crunch the plethora of
 modules down to a single-file module, so that I can embed it easily in
 scripts I use in machines where I want to reduce my impact as much as
 possible.
 
 =head2 Log Levels
 
 L<Log::Log4perl::Tiny> implements all I<standard> L<Log::Log4perl>'s
 log levels, without the possibility to change them. The correspondent
 values are available in the following variables (in order of increasing
 severity or I<importance>):
 
 =over
 
 =item C<< $TRACE >>
 
 =item C<< $DEBUG >>
 
 =item C<< $INFO >>
 
 =item C<< $WARN >>
 
 =item C<< $ERROR >>
 
 =item C<< $FATAL >>
 
 =back
 
 The default log level is C<$INFO>. In addition to the above, the following
 levels are defined as well:
 
 =over
 
 =item C<< $OFF >>
 
 also in L<Log::Log4perl>, useful to turn off all logging except for C<ALWAYS>
 
 =item C<< $DEAD >>
 
 not in L<Log::Log4perl>, when the threshold log level is set to this value
 every log is blocked (even when called from the C<ALWAYS> stealth logger).
 
 =back
 
 You can import these variables using the C<:levels> import facility,
 or you can use the directly from the L<Log::Log4perl::Tiny> namespace.
 They are imported automatically if the C<:easy> import option is specified.
 
 =head3 Default Log Level
 
 As of version 1.1.0 the default logging level is still C<$INFO> like
 any previous version, but it is possible to modify this value to C<$DEAD>
 through the C<:dead_if_first> import key.
 
 This import key is useful to load Log::Log4perl in modules that you
 want to publish but where you don't want to force the end user to
 actually use it. In other terms, if you do this:
 
    package My::Module;
    use Log::Log4perl::Tiny qw( :easy :dead_if_first );
 
 you will import all the functionalities associated to C<:easy> but
 will silence the logger off I<unless> somewhere else the module
 is loaded (and imported) without this option. In this way:
 
 =over
 
 =item *
 
 if the user of your module does I<not> import L<Log::Log4perl::Tiny>,
 all log messages will be dropped (thanks to the log level set to
 C<$DEAD>)
 
 =item *
 
 otherwise, if the user imports L<Log::Log4perl::Tiny> without the
 option, the log level will be set to the default value (unless it
 has already been explicitly set somewhere else).
 
 =back
 
 =head2 Easy Mode Overview
 
 I love L<Log::Log4perl>'s easy mode because it lets you set up a
 sophisticated logging infrastructure with just a few keystrokes:
 
    use Log::Log4perl qw( :easy );
    Log::Log4perl->easy_init({
       file   => '>>/var/log/something.log',
       layout => '[%d] [%-5P:%-5p] %m%n',
       level  => $INFO,
    });
    INFO 'program started, yay!';
 
    use Data::Dumper;
    DEBUG 'Some stuff in main package', sub { Dumper(\%main::) };
 
 If you want, you can replicate it with just a change in the first line:
 
    use Log::Log4perl::Tiny qw( :easy );
    Log::Log4perl->easy_init({
       file   => '>>/var/log/something.log',
       layout => '[%d] [%-5P:%-5p] %m%n',
       level  => $INFO,
    });
    INFO 'program started, yay!';
 
    use Data::Dumper;
    DEBUG 'Some stuff in main package', sub { Dumper(\%main::) };
 
 Well... yes, I'm invading the L<Log::Log4perl> namespace in order to
 reduce the needed changes as mush as possible. This is useful when I
 begin using L<Log::Log4perl> and then realise I want to make a single
 script with all modules embedded. There is also another reason why
 I put C<easy_init()> in L<Log::Log4perl> namespace:
 
    use Log::Log4perl::Tiny qw( :full_or_fake :easy );
    Log::Log4perl->easy_init({
       file   => '>>/var/log/something.log',
       layout => '[%d] [%-5P:%-5p] %m%n',
       level  => $INFO,
    });
    INFO 'program started, yay!';
 
    use Data::Dumper;
    DEBUG 'Some stuff in main package', sub { Dumper(\%main::) };
 
 With import option C<full_or_fake>, in fact, the module first tries to
 load L<Log::Log4perl> in the caller's namespace with the provided
 options (except C<full_or_fake>, of course), returning immediately if
 it is successful; otherwise, it tries to "fake" L<Log::Log4perl> and
 installs its own logging functions. In this way, if L<Log::Log4perl>
 is available it will be used, but you don't have to change anything
 if it isn't.
 
 Easy mode tries to mimic what L<Log::Log4perl> does, or at least
 the things that (from a purely subjective point of view) are most
 useful: C<easy_init()> and I<stealth loggers>.
 
 =head2 C<easy_init()>
 
 L<Log::Log4perl::Tiny> only supports three options from the big
 brother:
 
 =over
 
 =item C<< level >>
 
 the log level threshold. Logs sent at a higher or equal priority
 (i.e. at a more I<important> level, or equal) will be printed out,
 the others will be ignored. The default value is C<$INFO>;
 
 =item C<< file >>
 
 a file name where to send the log lines. For compatibility with
 L<Log::Log4perl>, a 2-arguments C<open()> will be performed, which
 means you can easily set the opening mode, e.g. C<<< >>filename >>>.
 
 Note that the 2-arguments C<open()> is intrinsically insecure and will
 trigger the following error when running setuid:
 
    Insecure dependency in open while running setuid
 
 so be sure to use either C<file_create> or C<file_append> instead if
 you're running setuid. These are extensions added by Log::Log4perl::Tiny
 to cope with this specific case (and also to allow you avoid the 2-args
 C<open()> anyway).
 
 Another Log::Log4perl::Tiny extension added as of version 1.3.0 is
 the key C<channels> where you can pass an array reference with
 channels descriptions (see L</build_channels> for details).
 
 The default is to send logging messages to C<STDERR>;
 
 =item C<< layout >>
 
 the log line layout (it can also be spelled C<format>, they are
 synonims). The default value is the following:
 
    [%d] [%5p] %m%n
 
 which means I<date in brackets, then log level in brackets always
 using five chars, left-aligned, the log message and a newline>.
 
 =back
 
 If you call C<easy_init()> with a single unblessed scalar, it is
 considered to be the C<level> and it will be set accordingly.
 Otherwise, you have to pass a hash ref with the keys above.
 
 In addition to the above keys, the C<easy_init()> method installed
 by Log::Log4perl::Tiny also accepts all keys defined for L</new>, e.g.
 C<format> (an alias for C<layout>) and the different alternatives to
 C<file> (C<file_insecure>, C<file_create> and C<file_append>).
 
 =head2 Stealth Loggers
 
 Stealth loggers are functions that emit a log message at a given
 severity; they are installed when C<:easy> mode is turned on
 (see L</Easy Mode Overview>).
 
 They are named after the corresponding level:
 
 =over
 
 =item C<< TRACE >>
 
 =item C<< DEBUG >>
 
 =item C<< INFO >>
 
 =item C<< WARN >>
 
 =item C<< ERROR >>
 
 =item C<< FATAL >>
 
 =back
 
 Additionally, you get the following logger functions (again, these are
 in line with L<Log::Log4perl>):
 
 =over
 
 =item C<< ALWAYS >>
 
 emit log whatever the configured logging level, apart from C<$DEAD> that
 disables all logging;
 
 =item C<< LOGWARN >>
 
 emit log at C<WARN> level and then C<warn()> it;
 
 =item C<< LOGDIE >>
 
 emit log at C<FATAL> level, C<die()> and then exit (if C<die()>
 didn't already exit);
 
 =item C<< LOGEXIT >>
 
 emit log at C<FATAL> level and then exit;
 
 =item C<< LOGCARP >>
 
 emit log at C<WARN> level and then call C<Carp::carp()>;
 
 =item C<< LOGCLUCK >>
 
 emit log at C<WARN> level and then call C<Carp::cluck()>;
 
 =item C<< LOGCROAK >>
 
 emit log at C<FATAL> level and then call C<Carp::croak()>;
 
 =item C<< LOGCONFESS >>
 
 emit log at C<FATAL> level and then call C<Carp::confess()>;
 
 =back
 
 If you want to set the exit code for C<LOGEXIT> above
 (and C<LOGDIE> as well, in case C<die()> does not exit by itself),
 you can go "the L<Log::Log4perl> way" and set
 C<$Log::Log4perl::LOGEXIT_CODE>, or set a code with
 C<logexit_code()> - but you have to wait to read something about the
 object-oriented interface before doing this!
 
 There is also one additional stealth function that L<Log::Log4perl>
 misses but that I think is of the outmoste importance: C<LOGLEVEL>, to
 set the log level threshold for printing. If you want to be 100%
 compatible with Log::Log4perl, anyway, you should rather do the following:
 
    get_logger()->level(...);  # instead of LOGLEVEL(...)
 
 This function does not get imported when you specify C<:easy>, anyway,
 so you have to import it explicitly. This will help you remembering that
 you are deviating from L<Log::Log4perl>.
 
 =head2 Emitting Logs
 
 To emit a log, you can call any of the stealth logger functions or any
 of the corresponding log methods. All the parameters that you pass are
 sent to the output stream as they are, except code references that are
 first evaluated. This lets you embed costly evaluations (e.g. generate
 heavy dumps of variabls) inside subroutines, and avoid the cost
 of evaluation in case the log is filtered out:
 
    use Data::Dumper;
    LOGLEVEL($INFO); # cut DEBUG and TRACE out
    TRACE 'costly evaluation: ', sub { Dumper($heavy_object) };
    # Dumper() is not actually called because DEBUG level is
    # filtered out
 
 If you use the C<log()> method, the first parameter is the log level,
 then the others are interpreted as described above.
 
 =head2 Log Line Layout
 
 The log line layout sets the contents of a log line. The layout is
 configured as a C<printf>-like string, with placeholder identifiers
 that are modeled (with simplifications) after L<Log::Log4perl>'s ones:
 
     %c Category of the logging event.
     %C Fully qualified package (or class) name of the caller
     %d Current date in yyyy/MM/dd hh:mm:ss format
     %F File where the logging event occurred
     %H Hostname
     %l Fully qualified name of the calling method followed by the
        callers source the file name and line number between 
        parentheses.
     %L Line number within the file where the log statement was issued
     %m The message to be logged
     %M Method or function where the logging request was issued
     %n Newline (OS-independent)
     %p Priority of the logging event
     %P pid of the current process
     %r Number of milliseconds elapsed from program start to logging 
        event
     %R Number of milliseconds elapsed from last logging event including
        a %R to current logging event
     %% A literal percent (%) sign
 
 Notably, both C<%x> (NDC) and C<%X> (MDC) are missing. Moreover, the
 extended specifier feature with additional info in braces (like
 C<%d{HH:mm}>) is missing, i.e. the structure of each specifier above
 is fixed. (Thanks to C<Log::Tiny> for the cool trick of how to handle
 the C<printf>-like string, which is probably mutuated from
 C<Log::Log4perl> itself according to the comments).
 
 =head1 SYNOPSYS
 
    use Log::Log4perl::Tiny qw( :easy );
    Log::Log4perl->easy_init({
       file   => '/var/log/something.log',
       layout => '[%d] [%-5P:%-5p] %m%n',
       level  => $INFO,
    });
 
    WARN 'something weird happened';
    INFO 'just doing it';
    DEBUG 'this does not get printed at $INFO level';
 
    # LOGLEVEL isn't in Log::Log4perl, but might come handy
    LOGLEVEL($DEBUG);   # enable debugging for small section
    # otherwise, "get_logger()->level($DEBUG)", see below
 
    DEBUG 'now this gets printed';
    LOGLEVEL($INFO);    # disable debugging again
    DEBUG 'skipped, again';
    DEBUG 'complex evaluation value:', sub { 
       # evaluation skipped if log level filters DEBUG out
    };
 
    # Object-oriented interface is available as well
    my $logger = get_logger();
    $logger->level($DEBUG);   # enable debugging for small section
    $logger->debug('whatever you want');
    $logger->level($INFO);    # disable debugging again
 
    # All stealth loggers are available
    LOGCONFESS 'I cannot accept this, for a whole stack of reasons!';
 
    # Want to change layout?
    $logger->layout('[%d %p] %m%n');
    # or, equivalently
    $logger->format('[%d %p] %m%n');
 
    # Want to send the output somewhere else?
    use IO::Handle;
    open my $fh, '>>', '/path/to/new.log';
    $fh->autoflush();
    $logger->fh($fh);
 
    # Want to multiplex output to different channels?
    $logger->fh(
       build_channels(
          fh          => \*STDERR,
          file_create => '/var/log/lastrun.log',
          file_append => '/var/log/overall.log',
       )
    );
 
    # Want to handle the output message by yourself?
    my @queue; # e.g. all log messages will be put here
    $logger->fh(sub { push @queue, $_[0] });
 
 =head1 INTERFACE 
 
 You have two interfaces at your disposal, the functional one (with all
 the stealth logger functions) and the object-oriented one (with
 explicit actions upon a logger object). Choose your preferred option.
 
 =head2 Functional Interface
 
 The functional interface sports the following functions (imported
 automatically when C<:easy> is passed as import option except for
 C<LEVELID_FOR>, C<LEVELNAME_FOR> and C<LOGLEVEL>):
 
 =over
 
 =item C<< TRACE >>
 
 =item C<< DEBUG >>
 
 =item C<< INFO >>
 
 =item C<< WARN >>
 
 =item C<< ERROR >>
 
 =item C<< FATAL >>
 
 stealth logger functions, each emits a log at the corresponding level;
 
 =item C<< ALWAYS >>
 
 emit log whatever the configured logging level (except C<$DEAD>);
 
 =item C<< LEVELID_FOR >>
 
 returns the identifier related to a certain level. The input level can be
 either a name or an identifier itself. Returns C<undef> if it is neither.
 
 It can be used e.g. if you want to use L</log> but you only have the level
 name, not its identifier;
 
 =item C<< LEVELNAME_FOR >>
 
 returns the name related to a certain level. The input level can be either
 a name or an identifier itself. Returns C<undef> if it is neither.
 
 =item C<< LOGWARN >>
 
 emit log at C<WARN> level and then C<warn()> it;
 
 =item C<< LOGDIE >>
 
 emit log at C<FATAL> level, C<die()> and then exit (if C<die()>
 didn't already exit);
 
 =item C<< LOGEXIT >>
 
 emit log at C<FATAL> level and then exit;
 
 =item C<< LOGCARP >>
 
 emit log at C<WARN> level and then call C<Carp::carp()>;
 
 =item C<< LOGCLUCK >>
 
 emit log at C<WARN> level and then call C<Carp::cluck()>;
 
 =item C<< LOGCROAK >>
 
 emit log at C<FATAL> level and then call C<Carp::croak()>;
 
 =item C<< LOGCONFESS >>
 
 emit log at C<FATAL> level and then call C<Carp::confess()>;
 
 =item C<< LOGLEVEL >>
 
 (Not in L<Log::Log4perl>) (Not imported with C<:easy>)
 
 set the minimum log level for sending a log message to the output;
 
 =item C<< build_channels >>
 
 (Not in L<Log::Log4perl>) (Not imported with C<:easy>)
 
 build multiple channels for emitting logs.
 
    my $channels = build_channels(@key_value_pairs);  # OR
    my $channels = build_channels(\@key_value_pairs);
 
 The input is a sequence of key-value pairs, provided either as
 a list or through a reference to an array containing them. They
 are not forced into a hash because the same key can appear
 multiple times to initialize multiple channels.
 
 The key specifies the type of the channel, while the value
 is specific to the key:
 
 =over
 
 =item B<< fh >>
 
 value is a filehandle (or anything that can be passed to the
 C<print> function)
 
 =item B<< sub >>
 
 =item B<< code >>
 
 value is a reference to a subroutine. This will be called with
 two positional parameters: the message (already properly formatted)
 and a reference to the logger message
 
 =item B<channel>
 
 whatever can be passed to keys C<fh> or to C<sub>/C<code> above
 
 =item B<< file >>
 
 =item B<< file_insecure >>
 
 =item B<< file_create >>
 
 =item B<< file_append >>
 
 value is the file where log data should be sent.
 
 The first one is kept for compliance with Log::Log4perl::easy_init's way
 of accepting a file. It eventually results in a two-arguments C<open()>
 call, so that you can quickly set how you want to open the file:
 
    file => '>>/path/to/appended', # append mode
    file => '>/path/to/new-file',  # create mode
 
 You should avoid doing this, because it is intrinsically insecure and will
 yield an error message when running setuid:
 
    Insecure dependency in open while running setuid
 
 C<file_insecure> is an alias to C<file>, so that you can explicitly signal
 to the maintainer that you know what you're doing.
 
 C<file_create> and C<file_append> will use the three-arguments C<open()>
 call and thus they don't trigger the error above when running setuid. As
 the respective names suggest the former creates the file from scratch
 (possibly deleting any previous file with the same path) while the latter
 opens the file in append mode.
 
 =back
 
 =back
 
 =head2 Object-Oriented Interface
 
 The functional interface is actually based upon actions on
 a pre-defined fixed instance of a C<Log::Log4perl::Tiny> object,
 so you can do the same with a logger object as well:
 
 =over
 
 =item C<< get_logger >>
 
 this function gives you the pre-defined logger instance (i.e. the
 same used by the stealth logger functions described above).
 
 =item C<< new >>
 
 if for obscure reasons the default logger isn't what you want, you
 can get a brand new object! The constructor accepts either a
 list of key-values or a reference to a hash, supporting the
 following keys:
 
 =over
 
 =item B<< channels >>
 
 set a list (through an array reference) of channels. See
 L</build_channels> for additional information.
 
 =item B<< file >>
 
 =item B<< file_insecure >>
 
 =item B<< file_create >>
 
 =item B<< file_append >>
 
 set the file where the log data will be sent.
 
 The first one is kept for compliance with Log::Log4perl::easy_init's way
 of accepting a file. It eventually results in a two-arguments C<open()>,
 so you might want to take care when running in taint mode.
 
 See also L</build_channels> for additional information. This option takes
 precedence over C<fh> described below.
 
 =item B<< format >>
 
 =item B<< layout >>
 
 =item B<< level >>
 
 see L<< C<easy_init()> >> and the methods below with the same
 name
 
 =item B<< fh >>
 
 see method C<fh> below
 
 =back
 
 =back
 
 The methods you can call upon the object mimic the functional
 interface, but with lowercase method names:
 
 =over
 
 =item C<< trace >>
 
 =item C<< debug >>
 
 =item C<< info >>
 
 =item C<< warn >>
 
 =item C<< error >>
 
 =item C<< fatal >>
 
 logging functions, each emits a log at the corresponding level;
 
 =item C<< is_trace >>
 
 =item C<< is_debug >>
 
 =item C<< is_info >>
 
 =item C<< is_warn >>
 
 =item C<< is_error >>
 
 =item C<< is_fatal >>
 
 =item C<< isTraceEnabled >>
 
 =item C<< isDebugEnabled >>
 
 =item C<< isInfoEnabled >>
 
 =item C<< isWarnEnabled >>
 
 =item C<< isErrorEnabled >>
 
 =item C<< isFatalEnabled >>
 
 log level test functions, each returns the status of the corresponding level;
 
 =item C<< always >>
 
 emit log whatever the configured logging level;
 
 =item C<< logwarn >>
 
 emit log at C<WARN> level (if allowed) and C<warn()> (always);
 
 =item C<< logdie >>
 
 emit log at C<FATAL> level, C<die()> and then exit (if C<die()>
 didn't already exit);
 
 =item C<< logexit >>
 
 emit log at C<FATAL> level and then exit;
 
 =item C<< logcarp >>
 
 emit log at C<WARN> level and then call C<Carp::carp()>;
 
 =item C<< logcluck >>
 
 emit log at C<WARN> level and then call C<Carp::cluck()>;
 
 =item C<< logcroak >>
 
 emit log at C<FATAL> level and then call C<Carp::croak()>;
 
 =item C<< logconfess >>
 
 emit log at C<FATAL> level and then call C<Carp::confess()>;
 
 =back
 
 The main logging function is actually the following:
 
 =over
 
 =item C<< log >>
 
 the first parameter is the log level, the rest is the message to log
 apart from references to subroutines that are first evaluated
 
 =item C<< emit_log >>
 
 emit the message in the first positional parameter to all logging
 channels
 
 =back
 
 Additionally, you have the following accessors:
 
 =over
 
 =item C<< level >>
 
 get/set the minimum level for sending messages to the output stream.
 By default the level is set to C<$INFO>.
 
 =item C<< fh >>
 
 get/set the output channel.
 
 As an extention over L<Log::Log4perl>,
 you can also pass a reference to a subroutine or to an array.
 
 If you set a reference to a sub,
 it will be called with two parameters: the message
 that would be print and a reference to the logger object that is
 calling the sub. For example, if you simply want to collect the log
 messages without actually outputting them anywhere, you can do this:
 
    my @messages;
    get_logger()->fh(sub {
       my ($message, $logger) = @_;
       push @messages, $message;
       return;
    });
 
 If you set a reference to an array, each item inside will be used
 for log output; its elements can be either filehandles or sub
 references, used as described above. This is a handy way to set
 multiple output channels (it might be implemented externally
 through a proper subroutine reference of course).
 
 By default this parameter is set to be equal to C<STDERR>.
 
 =item C<< format >>
 
 =item C<< layout >>
 
 get/set the line formatting;
 
 =item C<< logexit_code >>
 
 get/set the exit code to be used with C<logexit()> (and
 C<logdie()> as well if C<die()> doesn't exit).
 
 =back
 
 =head1 DEPENDENCIES
 
 None.
 
 =head1 BUGS AND LIMITATIONS
 
 No bugs have been reported.
 
 Please report any bugs or feature requests through http://rt.cpan.org/
 
 =head1 SEE ALSO
 
 L<Log::Log4perl> is one of the most useful modules I ever used, go check it!
 
 =head1 AUTHOR
 
 Flavio Poletti <polettix@cpan.org>
 
 =head1 COPYRIGHT AND LICENSE
 
 Copyright (C) 2010-2016 by Flavio Poletti <polettix@cpan.org>.
 
 This module is free software.  You can redistribute it and/or
 modify it under the terms of the Artistic License 2.0.
 
 This program is distributed in the hope that it will be useful,
 but without any warranty; without even the implied warranty of
 merchantability or fitness for a particular purpose.
 
 =cut

END_OF_FILE



# __MOBUNDLE_FILE__
   );

   unshift @INC, sub {
      my ($me, $packfile) = @_;
      return unless exists $file_for{$packfile};
      (my $text = $file_for{$packfile}) =~ s/^\ //gmxs;
      chop($text); # added \n at the end
      open my $fh, '<', \$text or die "open(): $!\n";
      return $fh;
   };
} ## end BEGIN
# __MOBUNDLE_INCLUSION__


sub template {
   my $template = <<'END_OF_TEMPLATE';
 #!/usr/bin/env perl
 # vim: sts=3 ts=3 sw=3 et ai :
 
 use strict;
 use warnings;
 my $VERSION = '0.0.1';
 RUSE('Log::Log4perl::Tiny', qw< :easy LOGLEVEL >);
 RUSE('Data::Tubes',         qw< pipeline >);
 
 ########################################################################
 #
 # Input options and logger initialization
 #
 ########################################################################
 my %config = get_options(
    ['loglevel|log=s', 'INFO'],    # leave this alone unless you know better
 
    # start putting your options here
    'foo|f=s',
    ['bar|b=s', 'default value for bar'], 'baz|B=i',
 );
 
 # Remove following line if you remove 'loglevel' in options above
 LOGLEVEL($config{loglevel});
 
 ########################################################################
 #
 # Business Logic
 #
 ########################################################################
 
 # this is just an example to get you started, works with an input file
 # like this:
 #
 #    Flavio,44,salad
 #    FooBar,23,kiwi
 
 my $template = <<'END_OF_TEMPLATE';
 [[%%]% name %] is [[%%]% age %] and likes [[%%]% food %].
 -----------------------------------------------------------
 END_OF_TEMPLATE
 
 pipeline(
    'Source::iterate_files',
 
    # Choose a reader
    #
    'Reader::by_line',
    #
    #'Reader::by_paragraph',
    #
    #['Reader::by_separator', separator => "\n---\n"],
 
    # Choose a parser
    #
    #['Parser::hashy',
    #   chunks_separator    => ';',
    #   key_value_separator => ':',
    #   default_key         => 'name'],
    #
    ['Parser::by_format', format => 'name,age,food'],
    #
    #['Parser::by_regex',
    #   regex => qr{(?mxs:\A(?<name>.*?),(?<age>\d+),(^<food>.*))}],
 
    # There's little choiche for a renderer initially...
    ['Renderer::with_template_perlish', template => $template],
 
    # Choose a writer
    ['Writer::to_files', filename => \*STDOUT],
    #
    #['Writer::to_files',
    #    filename  => '[% name %]-output-%02d.txt',
    #    header    => "-- here comes the data:\n",
    #    interlude => "-- end of record, start of next record --\n",
    #    footer    => "-- end of data\n",
    #    binmode   => ':encoding(UTF-8)',
    #    policy    => {records_threshold => 100}],
    #
    #['Writer::dispatch_to_files',
    #    filename_factory => sub {...},
    #    filename_template => '[% name %]-{{ key }}-output-%02d.txt',
    #    tp_opts  => {start => '{{', stop => '}}'},
 
    {tap => 'sink'},
 )->([@ARGV]);
 
 
 ########################################################################
 #
 # You should not need to fiddle any more beyond this point
 #
 ########################################################################
 
 # Ancillary scaffolding here
 use Pod::Usage qw< pod2usage >;
 use Getopt::Long qw< :config gnu_getopt >;
 
 sub get_options {
    my %config;
    my @options = qw< usage! help! man! version! >;
    for my $option (@_) {
       if (ref $option) {
          my ($spec, $default) = @$option;
          push @options, $spec;
          my ($name) = split /\|/, $spec, 2;
          $config{$name} = $default;
       } ## end if (ref $option)
       else {
          push @options, $option;
       }
    } ## end for my $option (@_)
 
    GetOptions(\%config, @options)
      or pod2usage(-verbose => 99, -sections => 'USAGE');
    pod2usage(message => "$0 $VERSION", -verbose => 99, -sections => ' ')
      if $config{version};
    pod2usage(-verbose => 99, -sections => 'USAGE') if $config{usage};
    pod2usage(-verbose => 99, -sections => 'USAGE|EXAMPLES|OPTIONS')
      if $config{help};
    pod2usage(-verbose => 2) if $config{man};
 
    return %config if wantarray();
    return \%config;
 } ## end sub get_options
 
 sub RUSE {
    my $module = shift;
    (my $packfile = $module . '.pm') =~ s{::}{/}gmxs;
    require $packfile;
    $module->import(@_);
    return $module;
 } ## end sub RUSE
 
 [% modules_bundle %]
 
 __END__
 
 =head1 NAME
 
 [% name %] - [% abstract %]
 
 =head1 USAGE
 
    [% name %] [--usage] [--help] [--man] [--version]
 
    [% name %]
 
 =head1 EXAMPLES
 
    shell$ [% name %]
 
 =for author, to fill in
     Put a few examples of how to use your program
 
 
 =head1 DESCRIPTION
 
 =for author, to fill in
     Put a thorough description of your program
 
 
 =head1 OPTIONS
 
 =for author, to fill in
     Description of all command-line options
 
 =over
 
 =item --help
 
 print a somewhat more verbose help, showing usage, this description of
 the options and some examples from the synopsis.
 
 =item --man
 
 print out the full documentation for the script.
 
 =item --usage
 
 print a concise usage line and exit.
 
 =item --version
 
 print the version of the script.
 
 =back
 
 =head1 DIAGNOSTICS
 
 =for author, to fill in
     List and describe all warnings/error messages
 
 =over
 
 =item C<< Error message here, perhaps with %s placeholders >>
 
 [Error description...]
 
 =item C<< Another error message here >>
 
 [Error description...]
 
 [You get the idea...]
 
 =back
 
 
 =head1 CONFIGURATION AND ENVIRONMENT
 
 =for author, to fill in
     Explain any configuration that can be used by the program, via some
     file or via environment variables.
 
 [% name %] requires no configuration files or environment variables.
 
 
 =head1 BUGS AND LIMITATIONS
 
 =for author, to fill in
     List any known bugs and limitations of your program
 
 No bugs have been reported.
 
 
 =head1 AUTHOR
 
 [% author %] [% email %]
 
 
 =head1 LICENCE AND COPYRIGHT
 
 Copyright (c) [% year %], [% author %] [% email %]
 
 This module is free software.  You can redistribute it and/or
 modify it under the terms of the Artistic License 2.0.
 
 This program is distributed in the hope that it will be useful,
 but without any warranty; without even the implied warranty of
 merchantability or fitness for a particular purpose.
 
 =cut

END_OF_TEMPLATE
   $template =~ s{^\ }{}gmxs;
   $template =~ s{\n\z}{}mxs;
   return $template;
}

__END__

=head1 NAME

tubergen - generate Data::Tubes programs

=head1 USAGE

   tubergen [--usage] [--help] [--man] [--version]

   tubergen

=head1 EXAMPLES

   shell$ tubergen

=for author, to fill in
    Put a few examples of how to use your program


=head1 DESCRIPTION

=for author, to fill in
    Put a thorough description of your program


=head1 OPTIONS

=for author, to fill in
    Description of all command-line options

=over

=item --help

print a somewhat more verbose help, showing usage, this description of
the options and some examples from the synopsis.

=item --man

print out the full documentation for the script.

=item --usage

print a concise usage line and exit.

=item --version

print the version of the script.

=back

=head1 DIAGNOSTICS

=for author, to fill in
    List and describe all warnings/error messages

=over

=item C<< Error message here, perhaps with %s placeholders >>

[Error description...]

=item C<< Another error message here >>

[Error description...]

[You get the idea...]

=back


=head1 CONFIGURATION AND ENVIRONMENT

=for author, to fill in
    Explain any configuration that can be used by the program, via some
    file or via environment variables.

tubergen requires no configuration files or environment variables.


=head1 BUGS AND LIMITATIONS

=for author, to fill in
    List any known bugs and limitations of your program

No bugs have been reported.


=head1 AUTHOR

Flavio Poletti polettix@cpan.org


=head1 LICENCE AND COPYRIGHT

Copyright (c) 2016, Flavio Poletti polettix@cpan.org

This module is free software.  You can redistribute it and/or
modify it under the terms of the Artistic License 2.0.

This program is distributed in the hope that it will be useful,
but without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=cut
