view release on metacpan or  search on metacpan

lib/App/RecordStream/Operation/frommultire.pm  view on Meta::CPAN

    $string = $2;
  }

  push @{$this->{'REGEXES'}}, [$string, $fields, $pre_flush, $post_flush]
}

sub _get_regexes {
  my ($this) = @_;
  return $this->{'REGEXES'} || [];
}

sub _set_clobber {
  my ($this, $value) = @_;
  $this->{'CLOBBER'} = $value;
}

sub get_clobber {
  my ($this) = @_;
  return $this->{'CLOBBER'} || 0;
}

sub _set_keep_all {
  my ($this, $value) = @_;
  $this->{'KEEP_ALL'} = $value;
}

sub get_keep_all {
  my ($this) = @_;
  return $this->{'KEEP_ALL'} || 0;
}

sub add_keep {
  my $this = shift;
  $this->{'KEEP'} ||= {};
  for my $field (@_) {
    $this->{'KEEP'}->{$field} = 1;
  }
}

sub check_keep {
  my ($this, $field) = @_;

  $this->{'KEEP'} ||= {};
  return $this->get_keep_all() || exists($this->{'KEEP'}->{$field});
}

sub accept_line {
  my $this = shift;
  my $line = shift;

  my $regex_index = 0;
  for my $regex (@{$this->_get_regexes()}) {
    my ($string, $fields, $pre_flush, $post_flush) = @$regex;
    my $field_prefix = "$regex_index-";

    if(my @groups = ($line =~ $string)) {
      my $pairs = $this->get_field_value_pairs(\@groups, $fields, $field_prefix);
      if(!$this->get_clobber()) {
        foreach my $pair ( @$pairs ) {
          my ($name, $value) = @$pair;
          if(defined ${$this->{'RECORD'}->guess_key_from_spec($name)}) {
            $pre_flush = 1;
          }
        }
      }

      if($pre_flush) {
        $this->flush_record();
      }

      foreach my $pair ( @$pairs ) {
        my ($name, $value) = @$pair;
        ${$this->{'RECORD'}->guess_key_from_spec($name)} = $value;
      }

      if($post_flush) {
        $this->flush_record();
      }
    }
    ++$regex_index;
  }

  return 1;
}

sub stream_done {
  my $this = shift;
  my $record = $this->{'RECORD'};

  if(!$this->get_clobber() && scalar($record->keys())) {
    $this->flush_record();
  }
}

sub get_field_value_pairs {
  my ($this, $groups, $fields, $prefix) = @_;

  my @field_names;
  my %groups_used;

  for(my $i = 0; $i < @$fields; ++$i) {
    my $field = $fields->[$i];
    my $field_name;
    if($field =~ /^\$(\d+)$/) {
      my $n = $1 - 1;
      $field_name = $groups->[$n];
      $groups_used{$n} = 1;
    }
    else {
      $field_name = $field;
    }
    push @field_names, $field_name;
  }

  my @pairs;
  my $pair_index = 0;
  for(my $i = 0; $i < @$groups; ++$i) {
    if($groups_used{$i}) {
      next;
    }
    my $field_name = ($pair_index < @field_names) ? $field_names[$pair_index] : ($prefix . $pair_index);
    push @pairs, [$field_name, $groups->[$i]];
    $pair_index++;
  }

  return \@pairs;
}

sub flush_record {
  my $this = shift;
  my $record = $this->{'RECORD'};
  my $record2 = App::RecordStream::Record->new();
  for my $field ($record->keys()) {