view release on metacpan or  search on metacpan

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

package App::RecordStream::Operation::toptable;

our $VERSION = "4.0.25";

use strict;
use warnings;

use base qw(App::RecordStream::Accumulator App::RecordStream::Operation);

use App::RecordStream::Record;

# TODO: amling, this format is so ugly it hurts.  Think of something better.

sub init {
  my $this = shift;
  my $args = shift;

  my %pins;
  my $headers = 1;
  my $full = 0;

  my $xgroup = App::RecordStream::KeyGroups->new();
  my $ygroup = App::RecordStream::KeyGroups->new();
  my $vgroup = App::RecordStream::KeyGroups->new();
  my $output_records = 0;
  my $all_at_end = 0;
  my %sorts = ();

  my $spec = {
    "x-field|x=s"        => sub { $xgroup->add_groups($_[1]); },
    "y-field|y=s"        => sub { $ygroup->add_groups($_[1]); },
    "v-field|v=s"        => sub { $vgroup->add_groups($_[1]); },
    "pin=s"              => sub { for(split(/,/, $_[1])) { if(/^(.*)=(.*)$/) { $pins{$1} = $2; } } },
    "sort=s"             => sub { for(split(/,/, $_[1])) { my ($comparator, $field) = App::RecordStream::Record::get_comparator_and_field($_); $sorts{$field} = $comparator; } },
    'noheaders'          => sub { $headers = 0; },
    'records|recs'       => \$output_records,
    'sort-all-to-end|sa' => \$all_at_end,
  };

  $this->parse_options($args, $spec);

  if ( %sorts  && $all_at_end ) {
    die "Cannot specify both --sort and --sort-all-to-end\n";
  }

  my $do_vfields = !$vgroup->has_any_group();

  $this->{'XGROUP'} = $xgroup;
  $this->{'YGROUP'} = $ygroup;
  $this->{'VGROUP'} = $vgroup;

  $this->{'PINS_HASH'}       = \%pins;
  $this->{'SORTS'}           = \%sorts;
  $this->{'SORT_ALL_TO_END'} = $all_at_end;
  $this->{'HEADERS'}         = $headers;
  $this->{'DO_VFIELDS'}      = $do_vfields;
  $this->{'OUTPUT_RECORDS'}  = $output_records;
}

sub stream_done {
  my $this = shift;

  my %pins       = %{$this->{'PINS_HASH'}};
  my $headers    = $this->{'HEADERS'};
  my $do_vfields = $this->{'DO_VFIELDS'};

  my $xgroup     = $this->{'XGROUP'};
  my $ygroup     = $this->{'YGROUP'};
  my $vgroup     = $this->{'VGROUP'};

  my $xfields_hash = {};
  my $yfields_hash = {};
  my $vfields_hash = {};

  my $records = $this->get_records();

  my (@xfields, @yfields, @vfields);
  # Prep x and y fields
  foreach my $record (@$records) {
    foreach my $spec ( @{$xgroup->get_keyspecs_for_record($record)} ) {
      if ( !$xfields_hash->{$spec} ) {
        $xfields_hash->{$spec} = 1;
        push @xfields, $spec;
      }
    }
    foreach my $spec ( @{$ygroup->get_keyspecs_for_record($record)} ) {
      if ( !$yfields_hash->{$spec} ) {
        $yfields_hash->{$spec} = 1;
        push @yfields, $spec;
      }
    }
  }

  if ( $this->{'SORT_ALL_TO_END' } ) {
    foreach my $field (@xfields, @yfields) {
      print "creating comp for $field\n";
      my ($comparator, $comp_field) = App::RecordStream::Record::get_comparator_and_field("$field=*");
      $this->{'SORTS'}->{$field} = $comparator;
    }
  }

  # Prep v fields
  if($do_vfields) {
    my %vfields;
    my %used_first_level_keys;

    for my $record (@$records) {
      foreach my $spec (@xfields, @yfields, keys %pins) {
        my $key_list = $record->get_key_list_for_spec($spec);
        if (scalar @$key_list > 0) {
          $used_first_level_keys{$key_list->[0]} = 1;
        }
      }

      foreach my $field (keys(%$record)) {
        if ( !exists($used_first_level_keys{$field}) && 
          !exists($vfields{$field}) ) {

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

    for my $vfield (@vfields) {
      # nothing to see here
      if(!$record->has_key_spec($vfield)) {
        next;
      }

      # if field is pinned, skip other vfields
      if(exists($pins{"FIELD"}) && $pins{"FIELD"} ne $vfield) {
        next;
      }

      my @xv;
      for my $xfield (@xfields) {
        my $v = "";
        if($xfield eq "FIELD") {
          $v = $vfield;
        }
        elsif($record->has_key_spec($xfield)) {
          $v = ${$record->guess_key_from_spec($xfield)};
        }
        push @xv, $v;
      }

      my @yv;
      for my $yfield (@yfields) {
        my $v = "";
        if($yfield eq "FIELD") {
          $v = $vfield;
        }
        elsif($record->has_key_spec($yfield)) {
          $v = ${$record->guess_key_from_spec($yfield)};
        }
        push @yv, $v;
      }

      my $v = "";
      if($record->has_key_spec($vfield)) {
        $v = ${$record->guess_key_from_spec($vfield)};
      }

      _touch_node_recurse($x_values_tree, @xv);
      _touch_node_recurse($y_values_tree, @yv);

      push @r2, [\@xv, \@yv, $v];
    }
  }

  # Start constructing the ASCII table

  # we dump the tree out into all possible x value tuples (saved in
  # @x_value_list) and tag each node in the tree with the index in
  # @x_values_list so we can look it up later
  my @x_values_list;
  $this->_dump_node_recurse($x_values_tree, \@x_values_list, [@xfields], []);

  my @y_values_list;
  $this->_dump_node_recurse($y_values_tree, \@y_values_list, [@yfields], []);

  # Collected the data, if we're only outputing records, stop here.
  if ( $this->{'OUTPUT_RECORDS'} ) {
    $this->output_records(\@xfields, \@yfields, \@r2, \@x_values_list, \@y_values_list);
    return;
  }


  my $width_offset  = scalar @yfields;
  my $height_offset = scalar @xfields;

  if ( $headers ) {
    $width_offset  += 1;
    $height_offset += 1;
  }

  my $w = $width_offset + scalar(@x_values_list);
  my $h = $height_offset + scalar(@y_values_list);
  my @table = map { [map { "" } (1..$w)] } (1..$h);

  if ( $headers ) {
    for(my $i = 0; $i < @xfields; ++$i) {
      $table[$i]->[scalar(@yfields)] = $xfields[$i];
    }

    for(my $i = 0; $i < @yfields; ++$i) {
      $table[scalar(@xfields)]->[$i] = $yfields[$i];
    }
  }

  my @last_xv = map { "" } (1..@xfields);
  for(my $i = 0; $i < @x_values_list; ++$i) {
    my $xv = $x_values_list[$i];
    for(my $j = 0; $j < @xfields; ++$j) {
      if($last_xv[$j] ne $xv->[$j]) {
        $last_xv[$j] = $xv->[$j];
        $table[$j]->[$width_offset + $i] = $xv->[$j];
        for(my $k = $j + 1; $k < @xfields; ++$k) {
          $last_xv[$k] = "";
        }
      }
    }
  }

  my @last_yv = map { "" } (1..@yfields);
  for(my $i = 0; $i < @y_values_list; ++$i) {
    my $yv = $y_values_list[$i];
    for(my $j = 0; $j < @yfields; ++$j) {
      if($last_yv[$j] ne $yv->[$j]) {
        $last_yv[$j] = $yv->[$j];
        $table[$height_offset + $i]->[$j] = $yv->[$j];
        for(my $k = $j + 1; $k < @yfields; ++$k) {
          $last_yv[$k] = "";
        }
      }
    }
  }

  for my $r2 (@r2) {
    my ($xv, $yv, $v) = @$r2;

    # now we have our x value tuple, we need to know where it was in @x_values_list so we can know its x coordinate
    my $i = _find_index_recursive($x_values_tree, @$xv);