slitaz-dev-tools annotate baba-scripts/renup.pl @ rev 253
Tiny edits
author | Aleksej Bobylev <al.bobylev@gmail.com> |
---|---|
date | Wed Mar 30 01:31:12 2016 +0300 (2016-03-30) |
parents | |
children |
rev | line source |
---|---|
postmaster@96 | 1 #! /usr/bin/perl -w |
postmaster@96 | 2 chomp (my $scriptname = `basename "$0"`); |
postmaster@96 | 3 chomp (my $workdir = `pwd`); |
postmaster@96 | 4 my $help = <<HELP; |
postmaster@96 | 5 Usage : $scriptname -h |
postmaster@96 | 6 $scriptname [-t] [work-directory] |
postmaster@96 | 7 HELP |
postmaster@96 | 8 my $testmode = 0; |
postmaster@96 | 9 my $prefix = ""; |
postmaster@96 | 10 #check dependencies |
postmaster@96 | 11 die "Execution error: rename.pl needed but not found\n" if (`which rename.pl` eq ''); |
postmaster@96 | 12 #check parameters |
postmaster@96 | 13 die $help if ($ARGV[0] eq '-h' or $ARGV[0] eq '--help'); |
postmaster@96 | 14 foreach my $a (@ARGV) |
postmaster@96 | 15 { |
postmaster@96 | 16 if ($a eq '-t') { $testmode = 1; } |
postmaster@96 | 17 else |
postmaster@96 | 18 { |
postmaster@96 | 19 $a = $workdir.'/'.$a if ($a !~ /^\//); |
postmaster@96 | 20 if(-d $a and -r $a) { $workdir = $a; } |
postmaster@96 | 21 else { die "Syntax error: $a is not a valid directory\n$help"; } |
postmaster@96 | 22 } |
postmaster@96 | 23 } |
postmaster@96 | 24 #asks a pattern for rename.pl if unknown |
postmaster@96 | 25 if ($prefix eq '') |
postmaster@96 | 26 { |
postmaster@96 | 27 print "*** CAUTION: no prefix specified in substitution pattern for rename.pl\n"; |
postmaster@96 | 28 print "*** Please fill in a prefix once for the whole process\n"; |
postmaster@96 | 29 print "*** (press ENTER key to validate) : "; |
postmaster@96 | 30 chomp ($prefix = <STDIN>); |
postmaster@96 | 31 } |
postmaster@96 | 32 #look for subdirectories in $workdir |
postmaster@96 | 33 print "Scanning subdirectories in $workdir...\n"; |
postmaster@96 | 34 chdir $workdir; |
postmaster@96 | 35 foreach $f (<*>) |
postmaster@96 | 36 { |
postmaster@96 | 37 my $path = $workdir.'/'.$f; |
postmaster@96 | 38 if (-d $path) |
postmaster@96 | 39 { |
postmaster@96 | 40 chdir $path; |
postmaster@96 | 41 my @all = <*>; |
postmaster@96 | 42 my @regularfiles = grep { -f } @all; |
postmaster@96 | 43 printf "\n> %s : %d files\n", $f, scalar @regularfiles; |
postmaster@96 | 44 next if (scalar @regularfiles == 0); #skip if empty |
postmaster@96 | 45 #parse numeric part of $path to use in rename.pl's pattern |
postmaster@96 | 46 $path =~ /(\d+)/; |
postmaster@96 | 47 my $num = $1; |
postmaster@96 | 48 system 'rename.pl '.($testmode == 1? '-t ':'').'"s/^/'.$prefix.$num.'_/" *'; #call rename.pl |
postmaster@96 | 49 #update files data (changed because of renaming) |
postmaster@96 | 50 @all = <*>; |
postmaster@96 | 51 @regularfiles = grep { -f } @all; |
postmaster@96 | 52 #~ print join ("\n", @regularfiles), "\n"; |
postmaster@96 | 53 map { rename $_, $workdir.'/'.$_ } @regularfiles unless ($testmode); #move files one level up |
postmaster@96 | 54 #check for subdirectory inside |
postmaster@96 | 55 if (scalar (grep { -d } @all) > 0) { warn "Caution: subdirectory found in $f => not deleted\n"; next; } |
postmaster@96 | 56 chdir $workdir; |
postmaster@96 | 57 unless ($testmode) { rmdir $path or die "$!\n"; } |
postmaster@96 | 58 } |
postmaster@96 | 59 } |