Hallo, Am Fri, 18 Jan 2013, Sebastian Reinhardt schrieb:
Ups, die ist wohl zwei mal raus gegangen.
Egal, ich habe gerade das Script noch mal auf einigen Verzeichnisse angewendet und ein Problem bemerkt: Es sollten nicht mehrere Punkte im Dateinamen vorkommen. Da der Player sowieso nur MP3's will, habe ich das einfach "umgangen", indem die Dateinamenserweiterung fest auf "MP3" gesetzt wird:
Es gibt noch mehrere andere Probleme ;)
#!/usr/bin/perl -w use strict; use POSIX;
Ok ;) use File::Basename; ## s.u.
my @dirlist; my $directory; my $outputfile; my $cd_dir; if ($ARGV[0] !~ /-h/) { $cd_dir=$ARGV[0]; } else { &printhelp; ^ sollte man nie verwenden. }
Würde ich umdrehen und ne Schleife über die Argumente: if($ARGV[0] ~ /^-h$/) { printhelp; exit(0); } my $dirinfo = "!dirinfo.txt"; my $ext_re = qr/\.(?:mp3|ogg|wav|aiff)/i; foreach my $dir (@ARGV) {
opendir($directory,$cd_dir) or die ('unable to open directory '.$cd_dir.'!');;
if( ! -d $dir ) { print STDERR "Not a directory: $dir\n"; next; } opendir(my $dir_handle, $dir) or die "cannot opendir '$dir': $!\n";
@dirlist = readdir $directory; close($directory); @dirlist = sort { lc($a) cmp lc($b) } @dirlist;
my @dirlist = sort { lc($a) cmp lc($b) } grep { -f "$dir/$_" && $ext_re; } readdir($dir_handle); closedir($dir_handle);
my $output_file=$cd_dir.'/dirinfo.txt';
open($outputfile,'>'.$cd_dir.'/!dirinfo.txt') or die ('unable to open file'.$cd_dir.'/!dirinfo.txt');
my $outfile = $dir . "/", $dirinfo; open($out_handle, ">", $outfile) or die "cannot open file '$outfile': $!\n";
foreach ( @dirlist) { if( $_ ne '.' && $_ ne '..' && $_ !~ 'dirinfo') { print $outputfile substr((split(/\./,uc($_)))[0],0,6)."~1.MP3:".$_."\r\n"; } }
my %generated_names; foreach(@dirlist) { # Behandlung von ., .. und !dirinfo.txt siehe das 'grep' oben # beim readdir. my $new; ### Dateinamen zerlegen und auf 8.3 testen my ($name,$path,$suffix) = fileparse($_, $ext_re); if( length($name) > 8 || $suffix > 3 ) { my ($n, $i) = (6, 1); do { $new = sprintf("%s~%i.%s", substr($name, 0, $n), $i, substr($suffix, 1, 3)); $i++; if($n == 6 && $i > 9) { $n--; } if($n == 5 && $i > 99) { die "ran out of shortnames\n"; } } until( ! defined( $generated_names{$new} ) ); $generated_names{$new}++; } else { $new = $_; } printf $out_handle "%s:%s\n", uc($new), $_; }
close($outputfile); exit 0;
close($out_handle) or die "$!\n"; } Die Hilfe würd ich eher oben hinpacken. Das ganze wg. Übersicht nochmal am Stück: ==== #!/usr/bin/perl -w use strict; use POSIX; use File::Basename; sub printhelp { print "Usage: \n"; } if( $ARGV[0] =~ /^-h$/) { printhelp; exit(0); } my $dirinfo = "!dirinfo.txt"; my $ext_re = qr/\.(?:mp3|ogg|wav|aiff)/i; ### Endungen ggfs. ergänzen foreach my $dir (@ARGV) { if( ! -d $dir ) { print STDERR "Not a directory: $dir\n"; next; } opendir(my $dir_handle, $dir) or die "cannot opendir '$dir': $!\n"; my @dirlist = sort { lc($a) cmp lc($b) } grep { -f "${dir}/${_}" && /$ext_re$/; } readdir($dir_handle); closedir($dir_handle); my $outfile = "${dir}/${dirinfo}"; open(my $out_handle, ">", $outfile) or die "cannot open file '$outfile': $!\n"; my %generated_names; foreach(@dirlist) { # Behandlung von ., .. und !dirinfo.txt siehe das 'grep' oben # beim readdir. my $new; ### Dateinamen zerlegen und auf 8.3 testen my ($name,$path,$suffix) = fileparse($_, $ext_re); if( length($name) > 8 || length($suffix) > 4 ) { my ($n, $i) = (6, 1); do { $new = sprintf("%s~%i.%s", substr($name, 0, $n), $i, substr($suffix, 1, 3)); $i++; if($n == 6 && $i > 9) { $n--; } if($n == 5 && $i > 99) { die "ran out of shortnames\n"; } } until( ! defined( $generated_names{$new} ) ); $generated_names{$new}++; } else { $new = $_; } printf $out_handle "%s:%s\n", uc($new), $_; } close($out_handle) or die "$!\n"; } exit 0; ==== Kurz getestet in nem Verzeichnis mit Konflikten bei den generierten Dateinamen sowie ner Datei mit kurzem Namen der unverändert bleiben kann. Wie gesagt, das mit dem 8.3 ist nicht ganz trivial ;) HTH, -dnh -- I'm too busy to insult you, but your humiliation is important. Please hold. -- Um die Liste abzubestellen, schicken Sie eine Mail an: opensuse-de+unsubscribe@opensuse.org Um den Listen Administrator zu erreichen, schicken Sie eine Mail an: opensuse-de+owner@opensuse.org