File Coverage

blib/lib/App/RegexFileUtils.pm

Criterion	Covered	Total	%
statement	89	120	74.1
branch	39	62	62.9
condition	10	15	66.6
subroutine	8	8	100.0
pod	1	1	100.0
total	147	206	71.3

package App::RegexFileUtils;

use strict;
use warnings;
use File::Spec;
use File::ShareDir::Dist qw( dist_share );
use File::Which qw( which );

# ABSTRACT: use regexes with file utils like rm, cp, mv, ln
our $VERSION = '0.08'; # VERSION


sub main {
  my $class = shift;
  my $mode = shift;
  my $appname = $mode;
  $mode =~ s!^.*/!!;
  my @args = @_;

  my @options = ();
  my $verbose = 0;
  my $do_hidden = 0;
  my $re;
  my $sub;
  my $modifiers;
  my $modifiers_match = '';
  my $tr;
  my $static_dest = 0;

  while(defined($args[0]) && $args[0] =~ /^-/) {
    my $arg = shift @args;

    if($arg =~ /^--recmd$/) {
      $mode = shift @args;
      $mode =~ s!^.*/!!;
    } elsif($arg =~ /^--reverbose$/) {
      $verbose = 1;
    } elsif($arg =~ /^--reall$/) {
      $do_hidden = 1;
    } else {
      push @options, $arg;
    }
  }

  my $dest = pop @args;

  unless(defined $dest) {
    print STDERR "usage: $appname [options] [source files] /pattern/[substitution/]\n";
    print STDERR "       $appname [options] /pattern/ /path/to/destination\n";
    print STDERR "\n";
    print STDERR "--recmd [command]      change the behavior of the tool\n";
    print STDERR "--verbose              print commands before they are executed\n";
    print STDERR "--reall                include hidden (so called `dot') files\n";
    print STDERR "\n";
    print STDERR "all other arguments are passed to the system tool\n";
    exit;
  }

  my $orig_mode = $mode;
  $mode =~ s/^re//;

  my %modes = (
    'mv'    => 'mv',
    'move'    => 'mv',
    'rename'  => 'mv',
    'cp'    => 'cp',
    'copy'    => 'cp',
    'ln'    => 'ln',
    'link'    => 'ln',
    'symlink'  => 'ln',
    'rm'    => 'rm',
    'remove'  => 'rm',
    'unlink'  => 'rm',
    'touch'    => 'touch',
  );

  unshift @options, '-s' if $mode eq 'symlink';

  $mode = $modes{$mode};
  unless(defined $mode) {
    print STDERR "unknown mode $orig_mode\n";
    exit;
  }

  my $no_dest = 0;
  if($mode eq 'touch' || $mode eq 'rm') {
    $no_dest = 1;
  }

  if($dest =~ m!^(s|)/(.*)/(.*)/([ig]*)$!) {
    $re = $2;
    $sub = $3;
    $modifiers = $4;
    $modifiers_match = 'i' if $modifiers =~ /i/;

    if($no_dest) {
      print STDERR "substitution `$mode' doesn't make sense\n";
      exit;
    }

  }

  elsif($dest =~ m!tr/(.*)/(.*)/$!) {
    $tr = $1;
    $sub = $2;

    if($no_dest) {
      print STDERR "translation `$mode' doesn't make sense\n";
    }
  }

  elsif($dest =~ m!^(m|)/(.*)/([i]*)$!) {
    $re = $2;
    $modifiers = $3;
    $modifiers_match = $3;
  }

  elsif(-d $dest) {
    my $src = pop @args;
    if($src =~ m!^(m|)/(.*)/([i]*)$!) {
      $static_dest = 1;
      $re = $2;
      $modifiers = $3;
      $modifiers_match = $3;
    } else {
      die "source is not a regex";
    }
  }

  else {
    die "destination is not a directory or a regex";
  }

  my @files = @args;

  if(@files ==0) {
    opendir(DIR, '.') || die "unable to opendir `.' $!";
    @files = readdir(DIR);
    closedir DIR;
  }

  for(@files) {
    next if /^\./ && !$do_hidden;
    next unless eval "/$re/$modifiers_match" || defined $tr;
    my $old = $_;
    my $new = $old;

    my @cmd = ($mode, @options, $old);

    if(defined $tr) {
      eval "\$new =~ tr/$tr/$sub/";
    } elsif(defined $sub) {
      eval "\$new =~ s/$re/$sub/$modifiers";
    } elsif($static_dest) {
      $new = $dest;
    } else {
      if($no_dest) {
        $new = '';
      } else {
        $new = '.';
      }
    }

    push @cmd, $new unless $no_dest;
    print "% @cmd\n" if $verbose;

    __PACKAGE__->_fix_path(\@cmd);

    system @cmd;

    if ($? == -1) {
      print STDERR "failed to execute: $!\n";
      exit 2;
    } elsif ($? & 127) {
      print STDERR "child died with signal ", $? & 127, "\n";
    } elsif($? >> 8) {
      print "child exited with value ", $? >> 8, "\n";
    }
  }
}

use constant _share_dir => do {
  my $path;
  $path = dist_share('App-RegexFileUtils');
  die 'can not find share directory' unless $path && -d "$path/ppt";
  $path;
};

sub _fix_path
{
  my($class, $cmd) = @_;

  return unless $^O eq 'MSWin32';

  return if which($cmd->[0]);

  $cmd->[0] = File::Spec->catfile(
    App::RegexFileUtils->_share_dir,
    'ppt', $cmd->[0] . '.pl',
  );
  unshift @$cmd, $^X;
}

1;

__END__