slitaz-dev-tools annotate baba-scripts/renup.pl @ rev 291

Add: slitaz-release (A hellper script to release SliTaz stable :-)
author Christophe Lincoln <pankso@slitaz.org>
date Sun Mar 19 03:23:21 2017 +0100 (2017-03-19)
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 }