[Perl] Script sorteren mp3's

[Essence]

Input gevraagd. Kheb een perl script ontwikkeld dat mp3 filenamen zoals je die op het Internet vindt fatsoeneert. Bedoeling is om uiteindelijk een progje te hebben dat je in dosbox kan runnen en dat directories met namen van de artiest aanmaakt en daar de mp3's in kopieert/moved. Nu print ie alleen nog maar opgeschoonde filenamen uit en doet verder niets behalve vinden van deze mp3 in de source tree.
Hieronder is opzetje van het script, vraag: dekt deze fatsoenering de meeste filenaam variaties af?

code:

use File::Copy;
use File::Find;
if (@ARGV !=2) { print "Usage mp3 <source dir> <destination tree>\n"; exit; }
my $name;
my $srcdir = $ARGV[0];
my $dstdir = $ARGV[1];
my $dir;
my $artist;
my $song;
find(\&wanted,$srcdir);

sub wanted {
if (/\.mp3$/) {
    $name = "$File::Find::$_";
    $dir = "$File::Find::dir";
    $name =~ s/_/ /g;   # convert underscores to spaces
    $name =~ s/\s+/ /g;     # delete multiple white space
    $name =~ s/\-+/\-/g;    # delete multiple minus signs 
    if ($name =~ /^\s*(\d+)?\s*(\-)?\s*([^\-]+)\s*\-\s*(.*?)\s*\.mp3$/) {
        ($artist,$song) = ($3,$4);
        $artist =~ s/^\s*(.*?)\s*$/$1/; # trim leading and trailing spaces
        $artist =~ s/\b(\w)/\u$1/g;     # capitalize words
        $artist =~ s/(['`]\we?) /\L$1 /g; # decapitalize single apostrophe words
        $song =~ s/^\s*(.*?)\s*$/$1/;   # trim leading and trailing spaces
        $song =~ s/\b(\w)/\u$1/g;   # capitalize words  
        $song =~ s/(['`]\we?) /\L$1 /g;     # decapitalize single apostrophe words
        print "$artist - $song".".mp3\n";
    }
} 
}

[ Voor 5% gewijzigd door Essence op 02-01-2003 19:12 ]

[Verwijderd]

Misschien is het zinvol om de door jouw bedachte combinaties, waar de regexp voor zou moeten werken, te noemen, zodat mensen nieuwe combinaties kunnen toevoegen en evt. op fouten in je regexp kunnen wijzen. Verder is code ook veel leesbaarder tussen code tags (zie FAQ), zeker met Perl, dat toch al niet bekend zijn om zijn leesbaarheid.

[Essence]

Verwijderd schreef op 02 January 2003 @ 18:26:
Misschien is het zinvol om de door jouw bedachte combinaties, waar de regexp voor zou moeten werken, te noemen, zodat mensen nieuwe combinaties kunnen toevoegen en evt. op fouten in je regexp kunnen wijzen. Verder is code ook veel leesbaarder tussen code tags (zie FAQ), zeker met Perl, dat toch al niet bekend zijn om zijn leesbaarheid.

Ok, code tags toegevoegd, thanx for the tip.

Mijn code gaat uit van het volgende formaat:
<tracknr> - <artiest> - <song>.mp3

Waarbij:
- tracknummer optioneel (wil ik er eigenlijk niet in hebben)
- underscores (if any) worden vervangen door spaties
- zowel woorden in <artiest> als in <song> krijgen een hoofdletter, waarbij rekening gehouden wordt met apostroph constructies die niet verhoofletterd moeten worden
- mulitple spaties en mintekens worden vervangen door 1 spatie/minteken en leading en trailing spaces worden verwijderd

Ideale formaat is voor mij (voorbeeld):
Dire Straits - Money For Nothing.mp3
Origineel had bijvoorbeeld:
01 --- Dire_straits - Money for Nothing .mp3
kunnen heten.

Deze file moet dan uiteindelijk terecht komen in een subdirectory Dire Straits.

[-DarkShadow-]

Soms is het streepje weggelaten, hoe weet jou proje dan wat de titel is en wat de artiest?

[muba]

uhm... je wil ook wel deze:
s/\%20/ /g

[Essence]

MUBA schreef op 02 januari 2003 @ 23:07:
uhm... je wil ook wel deze:
s/\%20/ /g

Bedankt voor de tips sofar. En ja, als er geen minnetje is op de scheiding van artiest en titel, dan wordt het onmogelijk(?) om deze twee altijd goed te scheiden omdat zowel artiest als titel uit meerdere woorden kunnen bestaan.

Inmiddels heb ik het script uitgebreid met aanmaken van van de feitelijke "artist" directories en het copieren van de mp3's naar hun juiste locatie.
Valt dit trouwens qua performance nog te verbeteren? (de hash met "from" en "to" gegevens leek mij de meest logische opslag)
Kortom, hier is de laatste versie:

code:

use strict;
use File::Copy;
use File::Find;
if (@ARGV !=2) { print "Usage mp3 <source dir> <destination tree>\n"; exit; }
my $name;
my ($srcdir,$dstdir) = ($ARGV[0],$ARGV[1]);
my $dir;
my $orig;
my $file;
my $artist;
my $title;
my $item;
my %song;
my $from;
my $to;
find(\&wanted,$srcdir);
foreach $item (sort keys %song) {
    ($from,$to) = ($song{$item},"$dstdir/$item");
    ($dir,$file) = ($to =~ /^(.*)\/(.*?)$/);
    print "Copy $from => $to ...";
    if (copy($from,$to)) {
        print "Ready.\n";
    }
    else {
        if (mkdir($dir,777)) {
            if (copy($from,$to)) {
                print "Ready.\n";
            }
            else { die $!;}
        }
        else { die $!; }
    }
}

sub wanted {
if (/\.mp3$/) {
    $name = "$File::Find::$_";
    $orig = "$File::Find::dir"."/$name";
    $name =~ s/_/ /g;       # convert underscores to spaces
    $name =~ s/\%20/ /g;    # convert escaped spaces to real spaces
    $name =~ s/\s+/ /g;     # delete multiple white space
    $name =~ s/\-+/\-/g;    # delete multiple minus signs 
    if ($name =~ /^\s*(\d+)?\s*(\-)?\s*([^\-]+)\s*\-\s*(.*?)\s*\.mp3$/) {
        ($artist,$title) = ($3,$4);
        $artist =~ s/^\s*(.*?)\s*$/$1/;         # trim leading & trailing spaces
        $artist =~ s/\b(\w)/\u$1/g;             # capitalize words
        $artist =~ s/(['`]\we?) /\L$1 /g;   # decapitalize apostrophe words
        $title =~ s/^\s*(.*?)\s*$/$1/;      # trim leading & trailing spaces
        $title =~ s/\b(\w)/\u$1/g;          # capitalize words  
        $title =~ s/(['`]\we?) /\L$1 /g;    # decapitalize apostrophe words
        $song{"$artist/$artist - $title.mp3"} = $orig; # hash song(to)=from
    }
} 
}

[Verwijderd]

Cool script. Maar misschien kan je beter je code even laten inspringen op sommigen pinten, et zou er een stuk leesbaarder op worden

Edit; hm code is wel ingesprongen alleen Konqueror gaf et niet juist weer :\ (Mozilla ownage )

[ Voor 29% gewijzigd door Verwijderd op 04-01-2003 12:24 ]