webize.pl

hello,

The original version of this script was calling _rename_
while recursing with File-Find. I have changed it to
call rename on the elements of the returned AoA.

Since on windows (-e "\L$filename\U") is always true, there
were some unexpected results when forcing to lc.=20

I found that many files were unexpectedly deleted, leaving=20
a single file named, "1" in a given folder.

------------- perl ----------
#!/usr/bin/perl -w
use strict;

# This script will rename recursive the files at a directory structure
# if it is necessary, to much the specified filters. Basically it makes
# the files web friendly . Do not forget to change the variables bellow.
# Tested only at my win 2000 box but I think it will play on a
# unix machine as is without any change.

my @root_directories =3D ('j:\EBooks\CHM\linux');
my @files_to_handle =3D ( '*.chm', '*.xyz' );

our $filter->{'Converse all to lowercase'} =3D 'no'; #force =
if yes
$filter->{'Change non alpanumerics to _'} =3D 'yes';
$filter->{'Change white charecters to _'} =3D 'yes';
$filter->{'Continues _ to only one _'} =3D 'yes';
$filter->{'If renamed file exists add a number'} =3D 'yes';

############################################################ #############=
#######
# =
#
# C o d e b e l l o w . Y o u d o n o t h a v e t o l o o k ! =
! ! #
# =
#
############################################################ #############=
#######

my @ren_arr;
for (@files_to_handle) { s/\./\\\./g; s/\*/\.*/g }
use File::Find;
my $how_to_doit =3D {
wanted =3D> \&webazize_file_names,
bydepth =3D> 0,
follow =3D> 0,
follow_fast =3D> 0,
follow_skip =3D> 1,
no_chdir =3D> 0,
untaint =3D> 0,
untaint_pattern =3D> qr|^([-+@\w./]+)$|,
untaint_skip =3D> 1
};

for my $dir (@root_directories) {
if ( !-d $dir ) { print "Directory \"$dir\" doesn't exist.\n"; next =
}
find( $how_to_doit, $dir );
}

print "count=3D", $#ren_arr, " ", "ref=3D", ref( $ren_arr[0] ), "\n";

my $cntr =3D 0;
my $res =3D 0;
while ( $cntr < scalar(@ren_arr) ) {

#print $ren_arr[$cntr]->[0], " ",$ren_arr[$cntr]->[1], "\n";
$res =3D rename $ren_arr[$cntr]->[0], $ren_arr[$cntr]->[1];
#print $cntr, " ", $res, "\n";
$cntr++;
}

sub webazize_file_names {

next if -d $File::Find::name;
my $bare_file =3D $_;
my $bare_path =3D $File::Find::dir;
my $full_path =3D $File::Find::name;
$bare_path =3D~ s/\\/\//g;
$full_path =3D~ s/\\/\//g;

for my $mask (@files_to_handle) {
my $we_have_a_mask_match =3D 0;

if ( $bare_file =3D~ /$mask/i ) {
$we_have_a_mask_match =3D 1;
$bare_file =3D~ =
s/\s/_/g
if ${$filter}{'Change white charecters to _'} =3D~ /y|1/i;
$bare_file =3D~
s/(.+?)(\.)([^\.]+)\s*$/$1HMM_THIS_IS_A_NEAR_END_DOT$3/;
$bare_file =3D~ =
s/[^\w\-\+]/_/g
if ${$filter}{'Change non alpanumerics to _'} =3D~ /y|1/i;
$bare_file =3D~ s/_+/_/g
if ${$filter}{'Continues _ to only one _'} =3D~ /y|1/i;
$bare_file =3D~ s/_*HMM_THIS_IS_A_NEAR_END_DOT/\./g;

if ( $_ ne $bare_file ) {
if (
$filter->{'If renamed file exists add a number'} =
=3D~ /y|1/i )
{
my $counter =3D 1;
my $body =3D undef;
my $ext =3D undef;
$bare_file =3D~ /\./
? ( ( $body, $ext ) =3D $bare_file =3D~ =
/^(.*)\.([^\.]*)$/ )
: ( $body =3D $bare_file );
while ( -e "$bare_path/$bare_file" ) {

$bare_file =3D "$body\_extra_suffix_" . =
$counter++;
print "\t", "exists ", "$bare_file", "\n";
$bare_file .=3D ".$ext" if defined $ext;
}
}
else {
print "\nSKIP : \"$bare_path/$bare_file\"\n";
next if -e "$bare_path/$bare_file";
}
$bare_file =3D "\L$bare_file\U"
if ${$filter}{'Converse all to lowercase'} =3D~ =
/y|1/i;
print " $bare_path/$bare_file", "\n";
push @ren_arr, [ $full_path, "$bare_path/$bare_file" ];

# never rename inside file-find recursion!!
##rename $full_path ,=20
# "$bare_path/$bare_file" ? ( print "$_ -> =
$bare_file\n" ) :=20
# ( print "FAIL TO RENAME : \"$full_path\"" ) ;

}
elsif ( ${$filter}{'Convert all to lowercase'} =3D~ /y|1/i ) =
{
#print "forcing lc \n";
$bare_file =3D "\L$bare_file\U";
push @ren_arr, [ $full_path, "$bare_path/$bare_file" ];
}
}
last if $we_have_a_mask_match;
}
}
----------------- end perl --------------------

regards,
tlviewer
--=20