SliTaz Repositories

     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/baba-scripts/renup.pl	Tue Mar 13 09:22:05 2012 +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 +}