view release on metacpan or  search on metacpan

lib/App/Pfind.pm  view on Meta::CPAN

$Data::Dumper::Terse = 1;  # Don't output variable names.
$Data::Dumper::Sortkeys = 1;  # Sort the content of the hash variables.
$Data::Dumper::Useqq = 1;  # Use double quote for string (better escaping).

{
  # A simple way to make a scalar be read-only.
  package App::Pfind::ReadOnlyVar;
  sub TIESCALAR {
    my ($class, $value) = @_;
    return bless \$value, $class;
  }
  sub FETCH {
    my ($self) = @_;
    return $$self;
  }
  # Does nothing. We could warn_or_die, but it does not play well with the fact
  # that we are inside the safe.
  sub STORE {}
  # Secret hidden methods for our usage only. These methods can't be used
  # through the tie-ed variable, but only through the object returned by the
  # call to tie.
  sub set {
    my ($self, $value) = @_;
    $$self = $value;
  }
}

# These two variables are shared with the user code. They have this name as a
# localized copy is passed to the code.
our ($internal_pfind_dir, $internal_pfind_name);
my $dir_setter = tie $internal_pfind_dir, 'App::Pfind::ReadOnlyVar';
my $name_setter = tie $internal_pfind_name, 'App::Pfind::ReadOnlyVar';

# A Safe object, created in reset_options.
my $safe;

# This hash contains options that are global for the whole program.
my %options;

# Methods that are shared with the safe:

sub prune {
  die "The prune command cannot be used when --depth-first is set.\n" if $options{depth_first};
  $File::Find::prune = 1;
}
# The prototype means that $_ will be used if nothing else is passed.
sub mkdir(_;@) {
  my $err;
  make_path(@_, { error => \$err });
  # make_path sets $! on success (as it test the existance of the file).
  undef $!;
  $! = join(', ', @$err) if @$err;
}
sub rmdir(_;@) {
  for my $d (@_) {
    CORE::rmdir($d);
  }
}
# A safe 'rm' that does not recurse into directories.
sub rm(_;@) {
  for my $f (@_) {
    if (-d $f) {
      CORE::rmdir($f);
      return if $!;
    } else {
      my $err;
      remove_tree($f, { error => \$err });
      undef $!;
      $! = join(', ', @$err) if @$err;
    }
  }
}
sub rmtree(_;@) {
  my $err;
  remove_tree(@_, { error => \$err });
  undef $!;
  $! = join(', ', @$err) if @$err;
}

sub reset_options {
  $safe = Safe->new();
  $safe->deny_only(':ownprocess', ':others', ':dangerous');
  $safe->reval('use File::Spec::Functions qw(:ALL);');
  $safe->reval('use File::Copy qw(cp mv)');
  $safe->share('$internal_pfind_dir', '$internal_pfind_name', 'prune', 'mkdir',
               'rmdir', 'rm', 'rmtree');
  $safe->share_from('main', ['*STDERR']);

  # Whether to process the content of a directory before the directory itself.
  $options{depth_first} = 0;
  # Whether to follow the symlinks.
  $options{follow} = 0;
  # Whether to follow the symlinks using a fast method that may process some files twice.
  $options{follow_fast} = 0;
  # Whether to recurse in directories.
  $options{recurse} = 1;
  # Blocks of code to execute before the main loop
  $options{begin} = [];
  # Blocks of code to execute after the main loop
  $options{end} = [];
  # Blocks of code to execute for each file and directory encountered
  $options{exec} = [];
  # Blocks of code to execute at the beginning of the processing of each directory
  $options{pre} = [];
  # Blocks of code to execute at the end of the processing of each directory
  $options{post} = [];
  # Type of files that are processed. Note that after the reading of the option, this is concatenated in a string.
  $options{type} = [];
  # Whether to chdir in the crawled directories
  $options{chdir} = 1;
  # Whether to catch errors returned in $! in user code
  $options{catch_errors} = 1;  # non-modifiable for now.
  # Add this string after each print statement
  $options{print} = "\n";
  # If true, debug message are printed on STDERR
  $options{verbose} = 0;
}

sub all_options {(
  'help|h' => sub { pod2usage(-exitval => 0, -verbose => 2) },