slitaz-dev-tools diff baba-scripts/renup.pl @ rev 251
tazwikiss/wkp_Calc.sh: fix double quote escape
author | Pascal Bellard <pascal.bellard@slitaz.org> |
---|---|
date | Sat Dec 19 12:30:53 2015 +0100 (2015-12-19) |
parents | |
children |
line diff
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 1.2 +++ b/baba-scripts/renup.pl Sat Dec 19 12:30:53 2015 +0100 1.3 @@ -0,0 +1,59 @@ 1.4 +#! /usr/bin/perl -w 1.5 +chomp (my $scriptname = `basename "$0"`); 1.6 +chomp (my $workdir = `pwd`); 1.7 +my $help = <<HELP; 1.8 +Usage : $scriptname -h 1.9 + $scriptname [-t] [work-directory] 1.10 +HELP 1.11 +my $testmode = 0; 1.12 +my $prefix = ""; 1.13 +#check dependencies 1.14 +die "Execution error: rename.pl needed but not found\n" if (`which rename.pl` eq ''); 1.15 +#check parameters 1.16 +die $help if ($ARGV[0] eq '-h' or $ARGV[0] eq '--help'); 1.17 +foreach my $a (@ARGV) 1.18 +{ 1.19 + if ($a eq '-t') { $testmode = 1; } 1.20 + else 1.21 + { 1.22 + $a = $workdir.'/'.$a if ($a !~ /^\//); 1.23 + if(-d $a and -r $a) { $workdir = $a; } 1.24 + else { die "Syntax error: $a is not a valid directory\n$help"; } 1.25 + } 1.26 +} 1.27 +#asks a pattern for rename.pl if unknown 1.28 +if ($prefix eq '') 1.29 +{ 1.30 + print "*** CAUTION: no prefix specified in substitution pattern for rename.pl\n"; 1.31 + print "*** Please fill in a prefix once for the whole process\n"; 1.32 + print "*** (press ENTER key to validate) : "; 1.33 + chomp ($prefix = <STDIN>); 1.34 +} 1.35 +#look for subdirectories in $workdir 1.36 +print "Scanning subdirectories in $workdir...\n"; 1.37 +chdir $workdir; 1.38 +foreach $f (<*>) 1.39 +{ 1.40 + my $path = $workdir.'/'.$f; 1.41 + if (-d $path) 1.42 + { 1.43 + chdir $path; 1.44 + my @all = <*>; 1.45 + my @regularfiles = grep { -f } @all; 1.46 + printf "\n> %s : %d files\n", $f, scalar @regularfiles; 1.47 + next if (scalar @regularfiles == 0); #skip if empty 1.48 + #parse numeric part of $path to use in rename.pl's pattern 1.49 + $path =~ /(\d+)/; 1.50 + my $num = $1; 1.51 + system 'rename.pl '.($testmode == 1? '-t ':'').'"s/^/'.$prefix.$num.'_/" *'; #call rename.pl 1.52 + #update files data (changed because of renaming) 1.53 + @all = <*>; 1.54 + @regularfiles = grep { -f } @all; 1.55 + #~ print join ("\n", @regularfiles), "\n"; 1.56 + map { rename $_, $workdir.'/'.$_ } @regularfiles unless ($testmode); #move files one level up 1.57 + #check for subdirectory inside 1.58 + if (scalar (grep { -d } @all) > 0) { warn "Caution: subdirectory found in $f => not deleted\n"; next; } 1.59 + chdir $workdir; 1.60 + unless ($testmode) { rmdir $path or die "$!\n"; } 1.61 + } 1.62 +}