Spreadsheet-Edit

 view release on metacpan or  search on metacpan

lib/Spreadsheet/Edit.pm  view on Meta::CPAN

  } ($first_rx..$last_rx);
  oops unless wantarray;
  return( \@indicies, $first_rx, $last_rx );
}

# sort_row_indicies {compare function}
# sort_row_indicies {compare function} $first_rx, $last_rx
#
# Returns [list of row indicies] but does not actually change anything.
# In list context, returns ( [list of row indicies], $first_rx, $last_rx )
sub sort_indicies(&;$$) {
  my $self = &__selfmust;
  my ($indicies, $first_rx, $last_rx) = $self->_internal_sort_indicies(@_);
  if (wantarray) {
    return( $indicies, $first_rx, $last_rx );
  }
  elsif (defined wantarray) {
    return $indicies;
  }
  else { croak __methname, " returns [rx list], first_rx, last_rx"; }
}


# sort_rows {compare function}
# sort_rows {compare function} $first_rx, $last_rx
sub sort_rows(&;$$) {
  my $self = &__selfmust;
  my ($indicies, $first_rx, $last_rx) = $self->_internal_sort_indicies(@_);

  my ($rows, $linenums) = @$$self{qw/rows linenums/};
  @$rows[$first_rx..$#$rows] = @$rows[@$indicies];
  @$linenums[$first_rx..$#$rows] = @$linenums[@$indicies];

  __validate_not_scalar_context(0..$first_rx-1, @$indicies, $last_rx+1..$#$rows)
}

lib/Spreadsheet/Edit.pm  view on Meta::CPAN

  }
  $$self->{num_cols} = scalar(@cxlist);
  $self->_adjust_colx(\@cxlist);
  $self
}

# obj->join_cols separator_or_coderef, colspecs...
# If coderef:
#   $_ is bound to the first-named column, and is the destination
#   @_ is bound to all named columns, in the order named.
sub join_cols(&@) {
  my $self = &__selfmust;
  my ($separator, @sources) = @_;
  my $hash = $$self;

  my ($num_cols, $rows) = @$hash{qw/num_cols rows/};

  my @source_cxs = map { scalar $self->_spec2cx($_) } @sources;
  $self->_logmethifv(\"'$separator' ",
                \join(" ",map{"$source_cxs[$_]\[$_\]"} 0..$#source_cxs));

lib/Spreadsheet/Edit.pm  view on Meta::CPAN

  }
  $self->_rebuild_colx();
  $self
}

# apply {code}, colspec*
#   @_ are bound to the columns in the order specified (if any)
#   $_ is bound to the first such column
#   Only visit rows bounded by first_data_rx and/or last_data_rx,
#   starting with title_rx+1 if a title row is defined.
sub apply(&;@) {
  my $self = &__selfmust;
  my ($code, @cols) = @_;
  my $hash = $$self;
  my @cxs = map { scalar $self->_spec2cx($_) } @cols;

  my $first_rx = max(($hash->{title_rx} // -1)+1, $hash->{first_data_rx}//0);

  @_ = ($self, $code, \@cxs, undef, $first_rx, $hash->{last_data_rx});
  goto &_apply_to_rows
}

# apply_all {code}, colspec*
#  Like apply, but ALL rows are visited, inluding the title row if any
sub apply_all(&;@) {
  my $self = &__selfmust;
  my ($code, @cols) = @_;
  my $hash = $$self;
  my @cxs = map { scalar $self->_spec2cx($_) } @cols;
  log_methcall $self, [\"rx 0..",$#{$hash->{rows}},
                       @cxs > 0 ? \(" cxs=".avis(@cxs)) : ()]
    if $$self->{verbose};
  @_ = ($self, $code, \@cxs);
  goto &_apply_to_rows
}

lib/Spreadsheet/Edit.pm  view on Meta::CPAN

  my $result = ref($_) eq 'ARRAY' ? $_ : [ $_ ];
  croak "Invalid argument ",vis($_)," (expecting [array ref] or single value)\n"
    unless @$result > 0 && !grep{ref($_) || $_ eq ""} @$result;
  $result
}

# apply_torx {code} rx,        colspec*
# apply_torx {code} [rx list], colspec*
# Only the specified row(s) are visited
# first/last_data_rx are ignored.
sub apply_torx(&$;@) {
  my $self = &__selfmust;
  my ($code, $rxlist_arg, @cols) = @_;
  croak "Missing rx (or [list of rx]) argument\n" unless defined $rxlist_arg;
  my $rxlist = __arrify_checknotempty($rxlist_arg);
  my @cxs = map { scalar $self->_spec2cx($_) } @cols;
  log_methcall $self, [\vis($rxlist_arg),
                       @cxs > 0 ? \(" cxs=".avis(@cxs)) : ()]
    if $$self->{verbose};
  @_ = ($self, $code, \@cxs, $rxlist);
  goto &_apply_to_rows
}

# apply_exceptrx {code} [rx list], colspec*
# All rows EXCEPT the specified rows are visited
sub apply_exceptrx(&$;@) {
  my $self = &__selfmust;
  my ($code, $exrxlist_arg, @cols) = @_;
  croak "Missing rx (or [list of rx]) argument\n" unless defined $exrxlist_arg;
  my $exrxlist = __arrify_checknotempty($exrxlist_arg);
  my @cxs = map { scalar $self->_spec2cx($_) } @cols;
  log_methcall $self, [\vis($exrxlist_arg),
                       @cxs > 0 ? \(" cxs=".avis(@cxs)) : ()]
    if $$self->{verbose};
  my $hash = $$self;
  my $max_rx = $#{ $hash->{rows} };

lib/Spreadsheet/Edit.pm  view on Meta::CPAN

  my %exrxlist = map{ $_ => 1 } @$exrxlist;
  my $rxlist = [ grep{ ! exists $exrxlist{$_} } 0..$max_rx ];
  @_ = ($self, $code, \@cxs, $rxlist);
  goto &_apply_to_rows
}

# split_col {code} oldcol, newcol_start_position, new titles...
#  {code} is called for each row with $_ bound to <oldcol>
#         and @_ bound to the new column(s).
# The old column is left as-is (not deleted).
sub split_col(&$$$@) {
  my $self = &__selfmust;
  my ($code, $oldcol_posn, $newcols_posn, @new_titles) = @_;

  my $num_insert_cols = @new_titles;
  my $old_cx = $self->_spec2cx($oldcol_posn);
  my $newcols_first_cx = $self->_relspec2cx($newcols_posn);

  log_methcall $self, [\"... $oldcol_posn\[$old_cx] -> [$newcols_first_cx]",
                       avis(@new_titles)]
    if $$self->{verbose};

t/90_Log.t  view on Meta::CPAN

sub doeval           { my $self=shift; $self->{inner}->doeval(@_) }
sub xxxtest           { my $self=shift; $self->{inner}->xxxtest(@_) }

package main;
use Spreadsheet::Edit::Log qw/nearest_call abbrev_call_fn_ln_subname/;
my $myFILE_basename = basename(__FILE__);

my $obj = Outer->new("red");
my $obj2 = Outer->new("blue");

sub checklog(&$;$$) {
  my ($code, $exptail, $test_label, $nohead) = @_;
  my ($file, $lno) = (caller(0))[1,2];
  $file = basename($file);
  my $exphead = $nohead ? "" : ">[${file}:${lno}] ";
  my $exp = ref($exptail) ? qr/\A\Q$exphead\E$exptail\n\z/
                          : $exphead.$exptail."\n";
  chomp( $test_label ||= $exp );
  my ($out, $err) = my_capture { $code->() };
  @_ = ($err, $exp, $test_label);
  unless ($out eq "") {

t/t_TestCommon.pm  view on Meta::CPAN

  close STDOUT;
  open(STDOUT, ">", \$inmem_stdOUT) or die "redir STDOUT: $!";
  binmode(STDOUT); binmode(STDOUT, ":utf8");

  my @ERR_layers = grep{ $_ ne "unix" } PerlIO::get_layers(*STDERR, output=>1);
  open($orig_stdERR, ">&", \*STDERR) or die "dup STDERR: $!";
  close STDERR;
  open(STDERR, ">", \$inmem_stdERR) or die "redir STDERR: $!";
  binmode(STDERR); binmode(STDERR, ":utf8");
}
sub silent(&) {
  my $wantarray = wantarray;
  my $code = shift;
  _start_silent();
  my @result = do{
    if (defined $wantarray) {
      return( $wantarray ? $code->() : scalar($code->()) );
    }
    $code->();
    my $dummy_result; # so previous call has null context
  };

t/t_TestCommon.pm  view on Meta::CPAN

  dprint "Got expected err: $ex\n";
}

sub insert_loc_in_evalstr($) {
  my $orig = shift;
  my ($fn, $lno) = (caller(0))[1,2];
#use Data::Dumper::Interp; say dvis '###insert_loc_in_evalstr $fn $lno';
  "# line $lno \"$fn\"\n".$orig
}

sub timed_run(&$@) {
  my ($code, $maxcpusecs, @codeargs) = @_;

  my $getcpu = eval {do{
    require Time::HiRes;
    () = (&Time::HiRes::clock());
    \&Time::HiRes::clock;
  }} // sub{ my @t = times; $t[0]+$t[1] };
  dprint("Note: $@") if $@;
  $@ = ""; # avoid triggering "Eval error" in mycheck();

t/t_TestCommon.pm  view on Meta::CPAN

sub clean_capture_output($) {
  my $str = shift;
  # For some reason I can not track down, tests on Windows in VirtualBox sometimes emit
  # this message.  I think (unproven) that this occurs because the current directory
  # is a VBox host-shared directory mounted read-only.   But nobody should be writing
  # to the cwd!
  $str =~ s/The media is write protected\S*\R//gs;
  $str
}

sub my_capture(&) {
  my ($out, $err, @results) = &capture($_[0]);
  return( clean_capture_output($out), clean_capture_output($err), @results );
}
sub my_capture_merged(&) {
  my ($merged, @results) = &capture_merged($_[0]);
  return( clean_capture_output($merged), @results );
}
sub my_tee_merged(&) {
  my ($merged, @results) = &tee_merged($_[0]);
  return( clean_capture_output($merged), @results );
}

1;