view release on metacpan or  search on metacpan

script/tubergen  view on Meta::CPAN

 
    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 $has_time_hires;
    my $gtod = sub { return (time(), 0) };
    eval {
       require Time::HiRes;
       $has_time_hires = 1;
       $gtod           = \&Time::HiRes::gettimeofday;
    };
 
    my $start_time = [$gtod->()];
 
    # For supporting %R
    my $last_log = $start_time;
 
    # Timezones are... differently supported somewhere
    my $strftime_has_tz_offset =
       POSIX::strftime('%z', localtime()) =~ m<\A [-+] \d{4} \z>mxs;
    if (! $strftime_has_tz_offset) {
       require Time::Local;
    }
 
    { # alias to the one in Log::Log4perl, for easier switching towards that
       no strict 'refs';
       *caller_depth = *Log::Log4perl::caller_depth;
    }
    our $caller_depth;
    $caller_depth ||= 0;
 

script/tubergen  view on Meta::CPAN

       ]
    );
    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/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.740';
 
 use Log::Log4perl::Tiny qw< :easy :dead_if_first >;
 
 use Data::Tubes::Util qw<
   assert_all_different
   generalized_hashy
   metadata
   normalize_args
   shorter_sub_names
   test_all_equal
   trim
   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, name => 'parse by format'}, 'format']);
    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}";
 
    my $value = $args{value} //= ['whatever'];
    $value = [$value] unless ref $value;
    my $multiple =
         (ref($value) ne 'ARRAY')
      || (scalar(@$value) > 1)
      || ($value->[0] ne 'whatever');
 
    return parse_by_separators(
       %args,
       keys       => $keys,
       separators => $separators
    ) if $multiple || !test_all_equal(@$separators);
 
    # a simple split will do if all separators are the same
    return parse_by_split(
       %args,
       keys      => $keys,
       separator => $separators->[0]
    );
 } ## end sub parse_by_format
 
 sub parse_by_regex {
    my %args =
      normalize_args(@_,
       [{%global_defaults, name => 'parse by regex'}, '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 _resolve_separator {