OK I went ahead and fixed the file renamimg scheme for repeated files:
file.txt
file_1.txt
file_2.txt
[tt]------------------------------------------------------------
Pragmas (perl 5.8.8) used :
[ul]
[li]strict - Perl pragma to restrict unsafe constructs[/li]
[li]warnings - Perl pragma to control optional warnings[/li]
[li]warnings - Perl pragma to control optional warnings[/li]
[/ul]
Core (perl 5.8.8) Modules used :
[ul]
[li]CGI::Carp - CGI routines for writing to the HTTPD (or other) error log[/li]
[li]File::Copy - Copy files or filehandles[/li]
[li]File:
ath - create or remove directory trees[/li]
[/ul]
[/tt]
------------------------------------------
- Kevin, perl coder unexceptional!![[wiggle] [wiggle] [wiggle]](/data/assets/smilies/wiggle.gif)
file.txt
file_1.txt
file_2.txt
Code:
[gray]#!/usr/bin/perl[/gray]
[url=http://perldoc.perl.org/functions/use.html][black][b]use[/b][/black][/url] [green]strict[/green][red];[/red]
[black][b]use[/b][/black] [green]warnings[/green][red];[/red]
[black][b]use[/b][/black] [green]File::Path[/green][red];[/red]
[black][b]use[/b][/black] [green]File::Copy[/green][red];[/red]
[black][b]use[/b][/black] [green]CGI::Carp[/green] [red]qw/[/red][purple]fatalsToBrowser[/purple][red]/[/red][red];[/red]
[blue]$|[/blue]=[fuchsia]1[/fuchsia][red];[/red]
[url=http://perldoc.perl.org/functions/print.html][black][b]print[/b][/black][/url] [red]"[/red][purple]Content-type: text/html[purple][b]\n[/b][/purple][purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]
[black][b]print[/b][/black] [red]'[/red][purple]<plaintext>[/purple][red]'[/red][red];[/red]
[gray][i]# uncomment next line for debugging and sanity checks[/i][/gray]
[gray][i]#use Data::Dumper;[/i][/gray]
[gray][i]# the start directory[/i][/gray]
[url=http://perldoc.perl.org/functions/my.html][black][b]my[/b][/black][/url] [blue]$dir[/blue] = [red]'[/red][purple]/home/e-pixsco/public_html/dump[/purple][red]'[/red][red];[/red]
[gray][i]# a hash to store the filesnames[/i][/gray]
[gray][i]# the keys are the MIME type or file extenstion.[/i][/gray]
[gray][i]# NOEXT is for file with no extension[/i][/gray]
[gray][i]# SUSPECT is for file extensions with non-word characters in them. Could be[/i][/gray]
[gray][i]# potentitally dangerous so just move these files into the SUSPECT folder.[/i][/gray]
[black][b]my[/b][/black] [blue]%types[/blue] = [red]([/red] [purple]NOEXT[/purple] => [red][[/red][red]][/red], [purple]SUSPECT[/purple] => [red][[/red][red]][/red] [red])[/red][red];[/red]
[url=http://perldoc.perl.org/functions/opendir.html][black][b]opendir[/b][/black][/url][red]([/red]DIR, [blue]$dir[/blue][red])[/red] or [url=http://perldoc.perl.org/functions/die.html][black][b]die[/b][/black][/url] [red]"[/red][purple][blue]$![/blue][/purple][red]"[/red][red];[/red]
[olive][b]while[/b][/olive] [red]([/red][black][b]my[/b][/black] [blue]$t[/blue] = [url=http://perldoc.perl.org/functions/readdir.html][black][b]readdir[/b][/black][/url] DIR[red])[/red] [red]{[/red]
[gray][i]# we only want files[/i][/gray]
[olive][b]next[/b][/olive] [olive][b]unless[/b][/olive] [red]([/red][url=http://perldoc.perl.org/functions/-X.html][black][b]-f[/b][/black][/url] [red]"[/red][purple][blue]$dir[/blue]/[blue]$t[/blue][/purple][red]"[/red][red])[/red][red];[/red]
[gray][i]# get the file extension[/i][/gray]
[olive][b]if[/b][/olive] [red]([/red] [blue]$t[/blue] =~ [red]/[/red][purple][purple][b]\.[/b][/purple]([^.]+)$[/purple][red]/[/red] [red])[/red] [red]{[/red]
[black][b]my[/b][/black] [blue]$f[/blue] = [blue]$1[/blue][red];[/red]
[gray][i]# check it for suspicious characters[/i][/gray]
[olive][b]if[/b][/olive] [red]([/red][blue]$f[/blue] =~ [red]/[/red][purple]^[a-zA-Z0-9_-]+$[/purple][red]/[/red][red])[/red] [red]{[/red]
[gray][i]# its OK[/i][/gray]
[url=http://perldoc.perl.org/functions/push.html][black][b]push[/b][/black][/url] [blue]@[/blue][red]{[/red][blue]$types[/blue][red]{[/red][blue]$f[/blue][red]}[/red][red]}[/red], [blue]$t[/blue][red];[/red]
[red]}[/red]
[olive][b]else[/b][/olive] [red]{[/red]
[gray][i]# it's suspicious[/i][/gray]
[black][b]push[/b][/black] [blue]@[/blue][red]{[/red][blue]$types[/blue][red]{[/red][purple]SUSPECT[/purple][red]}[/red][red]}[/red], [blue]$t[/blue][red];[/red]
[red]}[/red]
[red]}[/red]
[olive][b]else[/b][/olive] [red]{[/red]
[gray][i]# no file extension[/i][/gray]
[black][b]push[/b][/black] [blue]@[/blue][red]{[/red][blue]$types[/blue][red]{[/red][purple]NOEXT[/purple][red]}[/red][red]}[/red], [blue]$t[/blue][red];[/red]
[red]}[/red]
[red]}[/red]
[gray][i]# uncomment next line for sanity checks[/i][/gray]
[gray][i]#print Dumper \%types;[/i][/gray]
[gray][i]# make the folders and fill them with files.[/i][/gray]
[maroon]MAINLOOP[/maroon][maroon]:[/maroon] [olive][b]foreach[/b][/olive] [black][b]my[/b][/black] [blue]$type[/blue] [red]([/red] [url=http://perldoc.perl.org/functions/keys.html][black][b]keys[/b][/black][/url] [blue]%types[/blue] [red])[/red] [red]{[/red]
[gray][i]# make a folder[/i][/gray]
[maroon]mkpath[/maroon][red]([/red] [red]"[/red][purple][blue]$dir[/blue]/[blue]$type[/blue][/purple][red]"[/red], [red]{[/red][purple]verbose[/purple] => [fuchsia]1[/fuchsia][red]}[/red] [red])[/red] or
[black][b]print[/b][/black] [red]"[/red][purple]Could not create '[blue]$type[/blue]'. Might already exist.[purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]
[gray][i]# loop through hash[/i][/gray]
[olive][b]foreach[/b][/olive] [black][b]my[/b][/black] [blue]$file[/blue] [red]([/red] [blue]@[/blue][red]{[/red][blue]$types[/blue][red]{[/red][blue]$type[/blue][red]}[/red][red]}[/red] [red])[/red] [red]{[/red]
[gray][i]# check that file does not already exists[/i][/gray]
[olive][b]unless[/b][/olive] [red]([/red] [url=http://perldoc.perl.org/functions/-X.html][black][b]-e[/b][/black][/url] [red]"[/red][purple][blue]$dir[/blue]/[blue]$type[/blue]/[blue]$file[/blue][/purple][red]"[/red] [red])[/red] [red]{[/red]
[maroon]move[/maroon][red]([/red][red]"[/red][purple][blue]$dir[/blue]/[blue]$file[/blue][/purple][red]"[/red], [red]"[/red][purple][blue]$dir[/blue]/[blue]$type[/blue]/[blue]$file[/blue][/purple][red]"[/red][red])[/red] or
[black][b]print[/b][/black] [red]"[/red][purple]move failed [[blue]$dir[/blue]/[blue]$file[/blue], [blue]$dir[/blue]/[blue]$type[/blue]/[blue]$file[/blue]] : [blue]$![/blue][/purple][red]"[/red][red];[/red]
[red]}[/red]
[gray][i]# the file does exist so now we need to add the '_n'[/i][/gray]
[gray][i]# to the end of the filename. So that means we have to check[/i][/gray]
[gray][i]# for files already with '_n' appended to them.[/i][/gray]
[olive][b]else[/b][/olive] [red]{[/red]
[olive][b]next[/b][/olive] MAINLOOP [olive][b]if[/b][/olive] [red]([/red][blue]$type[/blue] eq [red]'[/red][purple]NOEXT[/purple][red]'[/red][red])[/red][red];[/red]
[black][b]my[/b][/black] [blue]$n[/blue] = [fuchsia]1[/fuchsia][red];[/red]
[black][b]my[/b][/black] [blue]$newfile[/blue][red];[/red]
[maroon]LOOP[/maroon][maroon]:[/maroon] [red]{[/red]
[blue]$newfile[/blue] = [maroon]filename_new[/maroon][red]([/red][blue]$file[/blue],[blue]$n[/blue][red])[/red][red];[/red]
[olive][b]if[/b][/olive] [red]([/red] [black][b]-e[/b][/black] [red]"[/red][purple][blue]$dir[/blue]/[blue]$type[/blue]/[blue]$newfile[/blue][/purple][red]"[/red] [red])[/red] [red]{[/red]
[blue]$n[/blue]++[red];[/red]
[olive][b]redo[/b][/olive] LOOP[red];[/red]
[red]}[/red]
[olive][b]else[/b][/olive] [red]{[/red]
[maroon]move[/maroon][red]([/red][red]"[/red][purple][blue]$dir[/blue]/[blue]$file[/blue][/purple][red]"[/red], [red]"[/red][purple][blue]$dir[/blue]/[blue]$type[/blue]/[blue]$newfile[/blue][/purple][red]"[/red][red])[/red] or
[black][b]print[/b][/black] [red]"[/red][purple]move failed [[blue]$dir[/blue]/[blue]$file[/blue], [blue]$dir[/blue]/[blue]$type[/blue]/[blue]$newfile[/blue]] : [blue]$![/blue][/purple][red]"[/red][red];[/red]
[red]}[/red]
[red]}[/red]
[red]}[/red]
[red]}[/red]
[red]}[/red]
[black][b]print[/b][/black] [red]"[/red][purple]Finished processing files[/purple][red]"[/red][red];[/red]
[url=http://perldoc.perl.org/functions/sub.html][black][b]sub[/b][/black][/url] [maroon]filename_new[/maroon] [red]{[/red]
[url=http://perldoc.perl.org/functions/no.html][black][b]no[/b][/black][/url] [green]warnings[/green][red];[/red]
[black][b]my[/b][/black] [blue]$t[/blue] = [url=http://perldoc.perl.org/functions/shift.html][black][b]shift[/b][/black][/url] or [url=http://perldoc.perl.org/functions/return.html][black][b]return[/b][/black][/url] [fuchsia]0[/fuchsia][red];[/red]
[black][b]my[/b][/black] [blue]$n[/blue] = [black][b]shift[/b][/black] or [black][b]return[/b][/black] [fuchsia]0[/fuchsia][red];[/red]
[black][b]my[/b][/black] [red]([/red][blue]$name[/blue], [blue]$ext[/blue][red])[/red] = [blue]$t[/blue] =~ [red]/[/red][purple](.+)[purple][b]\.[/b][/purple]([^.]+)$[/purple][red]/[/red][red];[/red]
[black][b]return[/b][/black][red]([/red][red]"[/red][purple][blue]$[/blue]{name}_[blue]$n[/blue].[blue]$ext[/blue][/purple][red]"[/red][red])[/red][red];[/red]
[red]}[/red]
Pragmas (perl 5.8.8) used :
[ul]
[li]strict - Perl pragma to restrict unsafe constructs[/li]
[li]warnings - Perl pragma to control optional warnings[/li]
[li]warnings - Perl pragma to control optional warnings[/li]
[/ul]
Core (perl 5.8.8) Modules used :
[ul]
[li]CGI::Carp - CGI routines for writing to the HTTPD (or other) error log[/li]
[li]File::Copy - Copy files or filehandles[/li]
[li]File:
[/ul]
[/tt]
------------------------------------------
- Kevin, perl coder unexceptional!
![[wiggle] [wiggle] [wiggle]](/data/assets/smilies/wiggle.gif)