view release on metacpan or  search on metacpan

lib/App/PTP/Commands.pm  view on Meta::CPAN

      if ($cmd eq 'filter') {
        1;
      } elsif ($cmd eq 'n') {
        $input;
      } elsif ($cmd eq 'mark-line') {
        $markers[$.];
      }
    } else {
      $r;
    }
  } @$content;

  $n_setter->set(undef);
  $m_setter->set(\undef);

  if ($cmd eq 'perl') {
    # Do nothing with the result.
  } elsif ($cmd eq 'n') {
    @$content = @result;
  } elsif ($cmd eq 'filter') {
    for my $i (0 .. $#$content) {
      if (!$result[$i] xor $modes->{inverse_match}) {
        undef $content->[$i];
      }
    }
  } elsif ($cmd eq 'mark-line') {
    @$markers = @result;
  } else {
    die "FATAL: Invalid command received for perl operation ($cmd).\n";
  }

  for my $i (0 .. $#$content) {
    if (not defined $content->[$i]) {
      undef $markers->[$i];
    } elsif (not defined $markers->[$i]) {
      # We don't want undef here, as we will filter on it.
      # Note that the $m and @m variables shared with the environment try to
      # prevent the user from setting undef in them. But we don't trust that
      # Too much.
      $markers->[$i] = '';
    }
  }
  @$content = grep { defined } @$content;
  @$markers = grep { defined } @$markers;
}

sub do_execute {
  my ($content, $markers, $modes, $options, $cmd, $code) = @_;
  $code = prepare_code($code, $modes) if $cmd ne 'M';
  $code = "use $code;" if $cmd eq 'M';
  eval_in_safe_env($code, $options);
  if ($@) {
    chomp($@);
    my $scmd = '-'.($cmd =~ s/^(..)/-$1/r);  # --execute or -M.
    die "FATAL: Perl code failed in ${scmd}: ${@}\n";
  }
}

sub do_load {
  my ($content, $markers, $modes, $options, $file) = @_;
  # do can open relative paths, but in that case it looks them up in the @INC
  # directory, which we want to avoid.
  # We don't use abs_path here to not die (just yet) if the file does not exist.
  my $abs_path = rel2abs($file);
  print "Loading file: '$abs_path'\n" if $options->{debug_mode};
  if (not defined eval_in_safe_env("do '${abs_path}';", $options)) {
    if ($@) {
      die "FATAL: Perl code failed in --load: ${@}\n";
    } elsif ($!) {
      die "FATAL: Cannot load file '$file' for --load: $!\n";
    }
  }
}

# Notes: we are not applying the --sq, --dq, and --ds mode to the code passed
# in the --comparator mode, as that is not a command.
sub do_sort {
  my ($content, $markers, $modes, $options) = @_;
  if (ref($modes->{comparator}) eq 'CODE') {
    # This branch is no longer used.
    @$content = sort { $modes->{comparator}() } @$content;
  } elsif (ref($modes->{comparator}) eq 'SCALAR') {
    if (${$modes->{comparator}} eq 'default') {
      @$content = sort @$content;
    } elsif (${$modes->{comparator}} eq 'numeric') {
      no warnings 'numeric';  ## no critic (ProhibitNoWarnings)
      @$content = sort { $a <=> $b } @$content;
    } elsif (${$modes->{comparator}} eq 'locale') {
      use locale;
      @$content = sort { $a cmp $b } @$content;
    } else {
      die sprintf "INTERNAL ERROR: Invalid comparator (%s)\n", ${$modes->{comparator}};
    }
  } else {
    die sprintf "INTERNAL ERROR: Invalid comparator type (%s)\n", Dumper($modes->{comparator})
        if ref $modes->{comparator};
    my $cmp = $modes->{comparator};
    my $sort = get_code_in_safe_env("sort { $cmp } \@_", $options, 'custom comparator');
    @$content = $sort->(@$content);
  }
  @$markers = (0) x scalar(@$content);
}

sub do_list_op {
  my ($content, $markers, $modes, $options, $sub, $apply_on_markers) = @_;
  if ($apply_on_markers eq 'none') {
    @$content = &$sub(@$content);
    @$markers = (0) x scalar(@$content);
  } elsif ($apply_on_markers eq 'same') {
    @$content = &$sub(@$content);
    @$markers = &$sub(@$markers);
  } elsif ($apply_on_markers eq 'together') {
    &$sub($content, $markers);
  } else {
    die
        "INTERNAL ERROR: Invalid value for \$apply_on_markers passed to do_list_op: $apply_on_markers\n";
  }
}

Readonly::Scalar my $DEFAULT_TAIL_LEN => 10;