perl文件名过滤工具

eddik

　　有时候客户给的文件文件名里面有很多空格，在网页解析的时候会把这些空格变成只保留一个，所以得去掉这些空格。通过重命名是一种方法。这里我是对文件名进行批量过滤。



1 #!/usr/bin/perl -w
2 use strict;
3 use warnings;
4 use File::Find ();
5 use File::Basename ;
6
7 #文件名过滤工具（批量改文件名，去掉文件名中的全部/或多余空格）
8 #暂不支持目录重命名
9 use vars qw/*name *dir *prune/ ;
10 *name = *File::Find::name ;
11 *dir = *File::Find::dir  ;
12 *prune = *File::Find::prune ;
13
14 our $space = 0 ; #默认留1个空格，$space = 0 时去除所有空格
15
16 #回调函数
17 sub wanted
18 {
19     if( /\.jpg/s )
20     {
21         my @file_array = split /\n/, $name ;
22         foreach my $file ( @file_array )
23         {
24             my ($nameName,$path,$suffix) = fileparse($file,".jpg");
25             print "name:$nameName$suffix\t path:$path\n"
26         }
27     }
28 }
29
30 sub renamer;
31 sub folderTraverse
32 {
33     my $dir = shift ;
34     #File::Find::find({wanted=>\&renamer},$dir);
35     File::Find::find({wanted=>\&singleFile_renamer},$dir);
36 }
37 sub renamer
38 {
39     my @file_array = split /\n/, $name ;
40     my %dir_array ;#为了判断元素是否重复，用hash表
41     #先对文件进行重命名
42     foreach my $file ( @file_array )
43     {
44         my ($fileName,$path,$suffix) = fileparse($file,".jpg");
45         
46         $dir_array{$path} = 1 if(!exists( $dir_array{$path} )) ;
47         
48         my $newFile = $fileName ;
49         ( $space ) ? ( $newFile =~ s#\s{2,}# #g ) : ( $newFile =~ s#\s{2,}##g )  ;
50         if( -e $newFile ){}
51         else{
52             if( rename $file => $newFile ){}
53             else{warn "rename $file error!";}
54         }
55     }
56     #再对目录进行重命名      !!!!!!!这涉及到一个递归的问题！如果上一级目录先重名于下一级，这样就没法找到下一级目录！
57     foreach my $dir ( %dir_array )
58     {
59         my $newDir = $dir =~ s#\s{2,}# #gr ;
60         rename $dir => $newDir ;
61     }
62 }
63
64 sub singleFile_renamer
65 {
66     my @file_array = split /\n/, $name ;
67     foreach my $file ( @file_array )
68     {
69         my ($fileName,$path,$suffix) = fileparse($file,".jpg");
70         
71         my $newFile = $fileName ;
72         ( $space ) ? ( $newFile =~ s#\s{2,}# #g ) : ( $newFile =~ s#\s+##g )  ;
73         if( -e $path.$newFile.$suffix ){}
74         else{
75             if( rename $file => $path.$newFile.$suffix ){
76                 print "替换文件：$fileName 为 $newFile \n";
77         }
78             else{warn "rename $file error!";}
79         }
80     }
81 }
82
83
84 sub main
85 {
86     my $dir = 'C:\Users\Administrator\Desktop\products' ;
87     folderTraverse($dir);
88 }
89 main();