Web-Jukebox mit Perl und Apache::MP3

Das Modul Apache::MP3 baut eine komfortable Web-Jukebox um lose MP3-Sammlungen. Ein zusätzliches Perl-Skript macht die Songauswahl für den Musikliebhaber noch komfortabler.

Während der letzten Monate habe ich meine Drohung aus[2] wahr gemacht und meine CDs zu MP3s gerippt, um sie auf einer nagelneuen Riesen-Festplatte (120 GByte) zu speichern. Dann stöpselte ich ein Kabel in die Soundkarte, verband es mit der Stereoanalage und knipste mit dem Browser fortan fröhlich in tausenden Titeln herum. Erstaunlich, was ich bislang zwar besessen aber nicht wahrgenommen hatte! Als der erste Rausch vorbei war, begann ich Perl-Skripte zu schreiben, um den Wahnsinn noch etwas weiter zu treiben.

Es war natürlich schon eine Heidenarbeit, 200 CDs einzulesen. Wer den hohen Aufwand scheut, der möge sich ein paar Fragen stellen: Schon mal daran gedacht, innerhalb von Sekunden einfach irgendeinen Song anzuknipsen, der gerade im Kopf herumgeistert? Oder Songs per Stichwort zu suchen und sofort abzuspielen? Playlists zu erstellen, zu verwalten und bei Bedarf abzuhören? Den Musikserver übers Ethernet von mehreren Servern/Stereoanlagen in der gesamten Wohnung zu nutzen? Oder Songs nach Schmuse-Faktor zu kategorisieren und dem Anlass entsprechend einfach ein Dutzend auszuwählen? Und das alles völlig legal?

Wer sich erst mal daran gewöhnt hat, nicht mehr mit Silberscheiben zu hantieren, und die erweiterten Such- und Sortiermechanismen schätzt, der kann sich kaum mehr vorstellen, welch absurde Tätigkeiten in der Steinzeit der CD-Technologie noch notwendig waren, um Musik zu hören.

Der Ripper schlägt zu

Zum Rippen nutzte ich das Perl-Skript »crip«, das es unter[3] als freie Software gibt. Einfach eine CD ins Laufwerk einlegen – schon kontaktiert »crip« die CDDB-Datenbank, um Interpreten, Album- und Titelinformationen einzuholen. Die legt es es dann bei jedem Song zusammen mit der Musik in einer MP3-Datei ab. Zuerst wollte ich ja auf Ogg Vorbis umsteigen, was »crip« neuerdings ausschließlich unterstützt (MP3 nur bis Version 1.0), musste aber diesen Plan streichen, da der tragbare MP3-Player meiner Frau das Format nicht unterstützt. C\’est la vie!

MP3-Partitionen

Um die gigantische Datenmenge besser partitionieren zu können (immerhin 25 GByte), verteilen sich die MP3s auf so genannte Pods, also dreistellig durchnummerierte Unterverzeichnisse (001, 002 …) mit jeweils 700 MByte Daten. Woher der Wert? Passt bequem auf eine CD-ROM, um die mühevolle Ripp-Arbeit zu sichern. Um zum Beispiel Pod »027« zu sichern, muss ich nur einen Rohling einlegen und

cdr 027

tippen, schon springt der Brenner an. »cdr« ist ein einfaches Shellskript, das nur die Zeile

mkisofs -R $* | cdrecord -v speed=4 
dev=0,0 -

enthält. Wenn das nicht ausreicht, zeigt[8] ein paar nützliche Tricks, um handelsübliche CD-Brenner unter Linux anzusprechen.

In ein Pod passen etwa 150 bis 200 MP3-Dateien, 33 Pod-Verzeichnisse legte ich insgesamt an: 001 bis 033.

Symbolisch verlinkt

Die Pods können auf verschiedenen Partitionen einer oder mehrerer Festplatten liegen und von einer zentralen Dateistruktur aus mittels symbolischer Links zu den einzelnen MP3-Dateien weisen. Damit können mehrere Ansichten der CD-Sammlung koexistieren: nach Album sortiert, nach Interpret, nach Musikrichtung, nach Schmusigkeit – und alles, ohne die zentnerschweren MP3-Dateien herumkopieren zu müsssen. Die bleiben ewig im gleichen Pod.

Von einem temporären Verzeichnis, in dem »crip« die CD rippt, schiebt das Skript »topod« die entstandenen MP3-Dateien ins nächste verfügbare Pod. Es benutzt das Modul Algorithm::Bucketizer vom CPAN, um die verschiedenen Eimer der Pod-Kette jeweils bis zur 700-MByte-Grenze zu füllen und, falls nötig, noch einen neuen Eimer hinten anzuhängen. Es hält sich außerdem einen Hash »%seen«, um bestehende Duplikate in der Sammlung aufzuspüren und neue Dubletten gar nicht erst entstehen zu lassen.

Zeile 18 in »topod« (Listing 1) initialisiert ein »Algorithm::Bucketizer«-Objekt mit 700000000 Bytes Eimergröße. Es benutzt den »simple«-Algorithmus, füllt also stur nur den letzten Eimer auf, bevor es einen neuen anlegt. So ist sichergestellt, dass sich außer dem letzten Pod keiner mehr ändert, sodass sich alle anderen bei Bedarf getrost auf CD-ROMs sichern lassen.

Falls das Skript feststellt, dass schon Pods auf der Platte existieren, muss es diese zunächst in virtuelle Eimer umwandeln und dem »Algorithm::Bucketizer«-Objekt mit der »prefill_bucket«-Methode in Zeile 33 unterjubeln.

Abbildung 1: Die Jukebox bietet alle Songs der CD “Shenanigans” von “Green Day” zum Streamen an.

Abbildung 2: Die Jukebox zeigt alle CDs an, die ich von “Green Day” besitze.

Alles im Eimer

So präpariert kann Algorithm ::Bucketizer in der While-Schleife ab Zeile 38 (immer noch Listing 1) mit Hilfe der »add_item«-Methode neue MP3s entgegennehmen und in den letzten bestehenden Eimer schütten oder einen neuen anlegen. Entsprechend legt es in der realen Welt neue Unterverzeichnisse an (Zeile 52) und schiebt neue MP3s hinein (Zeile 57).

Algorithm::Bucketizer nummeriert die Eimer von 0 an aufsteigend durch, die Unterverzeichnisse in der realen Welt heißen 001, 002 und so weiter. Die »add_item()«-Methode in Zeile 46 nimmt jeweils den Namen der MP3-Datei und deren Größe entgegen. Letztere wird mit dem Datei-Testoperator »-s« ermittelt. »add_item« gibt das glückliche Eimer-Objekt zurück, das die MP3-Datei in Empfang nahm. Dessen »serial()«-Methode liefert die Indexnummer des Eimers (0, 1, 2 …). Addiert man 1 dazu und formatiert die Nummer mit führenden Nullen (etwa 007) erhält man das zugehörige Pod-Verzeichnis.

Ansichten

Um Songs auszuwählen, will ich aber nicht im Durcheinander der Pods herumwühlen. Vielmehr möchte ich drei Hierarchiestufen einführen: ein Top-Verzeichnis mit allen Interpreten, darunter jeweils deren Alben, darunter wiederum jeweils die Songs eines Albums in der richtigen Reihenfolge.

»crip« hat schon dafür gesorgt, dass die einzelnen MP3-Dateien die korrekten Tag-Informationen enthalten. Außerdem zeigen auch die Dateinamen an, woher der Wind weht, zum Beispiel:

The_Strokes_-_ITI02_The_Modern_Age.mp3

Vor dem Querstrich steht der Interpret (»The_Strokes«), dahinter die ersten Buchstaben der Wörter des Albumtitels (»ITI« heißt “Is This It”), gefolgt von der Tracknummer (»02«), gefolgt vom Songtitel (»The_Modern_Age«).

In der von mir geforderten »by_artist«-Hierarchie soll dieser Song wie folgt landen:

by_artist
   Strokes,_The
        Is This_It
            01 ..................
            02_The_Modern_Age.mp3
            03 ..................

Listing 2 iteriert hierzu durch alle Pods, liest mit dem Modul MP3::Info die eingebetteten Info-Tags der dort liegenden MP3-Dateien, erzeugt die notwendigen Unterverzeichnisse im »by_artist«-Baum (»Strokes,_The/Is_This_It«) und legt, da der Song “The Modern Age” in Pod 018 liegt, anschließend folgenden symbolischen Link an:

ln -s /.../pods/018/The_Strokes_-_ 
ITI02_The_Modern_Age.mp3 
by_artist/Strokes,_The/Is_This_It/ 
02_The_Modern_Age.mp3

Bei den frei auf [freedb.org] erhältlichen CD-Daten spielt freilich auch der menschliche Faktor eine Rolle: Da vertippt sich schon mal ein begeisterter Fan, vergisst das zweite z in Eros Ramazzotti – und schon steht\’s falsch in der Datenbank. Oder es steht “Tom Waits” drin, während man in einem alphabetischen Listing doch lieber “Waits, Tom” hätte.

Gehirnschmalz zur Rettung

Allerdings lässt sich das schwer automatisieren: Wo ist der Unterschied zwischen “John Cale”, den wir lieber als “Cale, John” in der Sammlung hätten, und der famosen Gruppe “Judas Priest”, die in genau dieser Weise eingetragen sein soll? Menschliche Intelligenz einschalten! »mktree« (Listing 2) macht zu jedem neu gefundenen Interpreten ein paar sinnvolle Vorschläge und lässt den Benutzer entscheiden:

[1] Judas Priest
[2] Priest, Judas
[1]>

Für den ersten Vorschlag drückt er einfach auf [Enter], tippt er eine Zahl ein, dann wählt »mktree« den entsprechend nummerierten Eintrag. Liegen alle Vorschläge daneben, nimmt »mktree« an dieser Stelle auch gern einen Wort-Text entgegen. Einmal bestätigte Entscheidungen speichert es persistent bis zum nächsten Aufruf in einem GDBM-Datenbänklein.

»mktree« definiert ab Zeile 9 zunächst eine Reihe von installationsabhängigen Parametern: Unter »$POD_ROOT« liegen die Pod-Verzeichnisse mit den MP3-Dateien, unter »$TREE_ROOT« ist der richtige Platz für Interpreten, Alben und Songs, und zwar in dieser Reihenfolge. In dem persistenten Hash »%ARTIST _MAP« steht, wie der Interpretenname aus der öffentlichen CDDB-Datenbank zu korrigieren ist.

Spaß mit der Minidatenbank

Zeile 16 holt das Modul GDBM_File herein, das der »tie()«-Befehl in Zeile 29 nutzt, um den Hash »%ARTIST_MAP« persistent abzuspeichern. Zeile 24 initialisiert »Log::Log4perl«, das aus alter Gewohnheit drinblieb, um »mktree« kurzfristig mehr oder weniger gesprächig zu machen. »%m%n« gibt nur die Log-Nachricht und ein Newline-Zeichen aus. »mktree« versteht dank Zeile 27 auch die Optionen »-d« (Dump) und »-u« (Undump), die es nur den Inhalt der permanenten »%ARTIST_MAP« ausgeben oder setzen lassen. Die Anweisung

mktree -d >data

legt in der Datei »data« die Interpreten-Tabelle wie in

The Beatles => Beatles, The
Salt 'N' Pepa => Salt 'N' Pepa
Zucchero Sugar Fornaciari => Zucchero

ab. Bringt man mit einem Texteditor manuelle Korrekturen in »data« an, lädt

mktree -u <data

die ganze Chose anschließend wieder in die binäre GDBM-Datei und »mktree« ist beim nächsten Aufruf repariert. Sehr praktisch, falls man sich mal vertippt.

MP3-Tags rausfieseln

Das Modul MP3::Info hilft beim Lesen der Tag-Informationen in MP3-Dateien. Die daraus exportierte Funktion »get _mp3tag()« nimmt den Namen einer MP3-Datei entgegen und gibt eine Referenz auf einen Hash zurück, der den CD-Daten entsprechend Einträge zu den Schlüsseln »ARTIST«, »ALBUM«, »TITLE« und »COMMENT« enthält.

Die ab Zeile 55 definierte Funktion »mklink()« in »mktree« nimmt den vollständigen Pfad zu einer MP3-Datei in einem Pod entgegen, extrahiert daraus mittels MP3::Info die zugehörigen CD-Daten und ermittelt den Titel des Albums und den normalisierten Interpretennamen – unter Umständen mit Hilfe des Benutzers. »link_path()« legt dann mit »symlink« einen symbolischen Link an, der von »by_artist/interpret/album /song.mp3« zur wirklichen MP3-Datei im Pod zeigt. Bei wirren oder fehlenden MP3-Tag-Daten landet der Link im »lost+found«-Verzeichnis.

Die Tracknummer extrahiert das Skript mit einem regulären Ausdruck aus dem MP3-eigenen Feld »COMMENT«, in dem etwas wie »track11« steht. Leerzeichen und in Unix-Dateinamen unerlaubte Schrägstriche ersetzt der Map-Befehl in Zeile 94 durch simple Unterstriche. Da »s/[s/]/_/g;« nicht etwa den Ergebnisstring, sondern die Anzahl der Ersetzungen zurückgibt, muss noch ein »$_;« hinterherkommen, damit der »map«-Befehl die Einzelkomponenten an »catfile« weitergeben kann. Diese aus der File::Spec-Sammlung stammende Funktion schustert alles zu einem Pfadnamen zusammen.

»warp_artist()« ab Zeile 123 versucht, mehr oder minder schlaue Vorschläge aus einem ihr übergebenen Interpretennamen zu generieren. Mit “The Red Hot Chili Peppers” aufgerufen, wird es “Red Hot Chili Peppers, The” und “The Red Hot Chili Peppers” generieren und beides zur Wahl stellen. Von “Rory Galagher” wird es “Rory Galagher” und “Galagher, Rory” ableiten.

»pick« schließlich nimmt (ab Zeile 146) eine Liste von Vorschlägen entgegen und bietet dem Benutzer alle Strings jeweils unter einer Nummer zur Auswahl an. Wählt er eine der vorgeschlagenen Nummern aus, liefert »pick()« den zugehörigen String zurück. Frei definierte neue Strings übernimmt »pick« und reicht sie auch an den Aufrufer zurück.

Installation

Nach dem Anpassen der Konfigurationszeilen an die lokalen Gegebenheiten werden »topod« und »mktree« einfach von der Kommandozeile aus aufgerufen. »topod« findet gerade gerippte MP3-Dateien im gegenwärtigen Verzeichnis, »mktree« kann irgendwo laufen, selbst als Cronjob. Hat es einmal die »by_artist«-Hierarchie eingerichtet, ist nur noch ein Apache-Webserver in diese Richtung einzunorden. Er muss allerdings »mod _perl«-tauglich sein. (Anleitung unter[5] oder[6]).

Die lokale Perl-Installation braucht das Modul Apache::MP3 vom CPAN. Meine Installation lief mit dem Apache 1.3.37 – mittlerweile soll »mod_perl« aber auch zuverlässig mit dem 2.0er funktionieren. Folgende Einträge in »httpd.conf« aktivieren anschließend den Musikserver:

<Location /songs>
  SetHandler perl-script
  PerlHandler Apache::MP3::Sorted
  PerlSetVar SortFields Artist,Album,comment
</Location>

Das Verzeichnis »/songs« unter »htdocs« des Apache muss dabei zumindest symbolisch auf das oben mit »mktree« angelegte »by_artist«-Verzeichnis zeigen. Damit der Apache dem Link nachgeht, muss in der Konfiguration etwas wie

<Directory />
    Options FollowSymLinks
    AllowOverride None
</Directory>

stehen. Wer dann nach einem Neustart den Browser nach

http://localhost/songs

dirigiert, kann nach Herzenslust in der Sammlung herumstreunen. Wird ein Stream-Link neben einem Song aktiviert, springt der Linux-MP3-Spieler »xmms«[7] an und spielt einen oder mehrere Songs, der Reihe nach oder zufällig, ganz nach Belieben. Und das ist erst der Anfang einer wunderbaren neuen Freundschaft. (uwo)

Listing 1: »topod«
01 #!/usr/bin/perl 02 ########################################### 03 # topod 04 # Mike Schilli, 2003 (m@perlmeister.com) 05 ########################################### 06 use warnings; 07 use strict; 08 09 my $POD_DIR = "/ms1/SONGS/pods"; 10 11 use File::Basename; 12 use Algorithm::Bucketizer; 13 use File::Copy; 14 15 my %seen = (); 16 17 # Init buckets 18 my $b = Algorithm::Bucketizer->new( 19 bucketsize => 700_000_000, 20 algorithm => 'simple', 21 ); 22 23 # Prefill buckets with existing Pods 24 while(<$POD_DIR/>) { 25 my($idx) = /(d{3})/; 26 27 while(<$POD_DIR/$idx/.mp3>) { 28 my $base = basename($_); 29 if(exists $seen{$base}) { 30 print "Dupe detected: $_n"; 31 } 32 $seen{$base}++; 33 $b->prefill_bucket($idx - 1, 34 $_, -s $_); 35 } 36 } 37 38 while(<*.mp3>) { 39 if(exists $seen{$_}) { 40 print "Not adding dupe: $_n"; 41 next; 42 } 43 44 $seen{$_}++; 45 46 my $bucket = $b->add_item($_, -s $_); 47 48 my $path = sprintf "$POD_DIR/%03d/$_", 49 $bucket->serial(); 50 51 unless(-d dirname($path)) { 52 mkdir dirname($path) or 53 die "Cannot mkdir " . 54 dirname($path); 55 } 56 57 move($_, $path) or 58 die "Cannot move $_ to $path"; 59 }

Listing 1:
»topod«

01 #!/usr/bin/perl
02 ###########################################
03 # topod
04 # Mike Schilli, 2003 (m@perlmeister.com)
05 ###########################################
06 use warnings;
07 use strict;
08 
09 my $POD_DIR = "/ms1/SONGS/pods";
10 
11 use File::Basename;
12 use Algorithm::Bucketizer;
13 use File::Copy;
14 
15 my %seen = ();
16 
17     # Init buckets
18 my $b = Algorithm::Bucketizer->new(
19     bucketsize => 700_000_000,
20     algorithm  => 'simple',
21 );
22 
23     # Prefill buckets with existing Pods
24 while(<$POD_DIR/*>) {
25     my($idx) = /(d{3})/;
26 
27     while(<$POD_DIR/$idx/*.mp3>) {
28         my $base = basename($_);
29         if(exists $seen{$base}) {
30             print "Dupe detected: $_n";
31         }
32         $seen{$base}++;
33         $b->prefill_bucket($idx - 1,
34                            $_, -s $_);
35     }
36 }
37 
38 while(<*.mp3>) {
39     if(exists $seen{$_}) {
40         print "Not adding dupe: $_n";
41         next;
42     }
43 
44     $seen{$_}++;
45 
46     my $bucket = $b->add_item($_, -s $_);
47 
48     my $path = sprintf "$POD_DIR/%03d/$_",
49                       $bucket->serial();
50 
51     unless(-d dirname($path)) {
52         mkdir dirname($path) or
53             die "Cannot mkdir " .
54                 dirname($path);
55     }
56 
57     move($_, $path) or
58         die "Cannot move $_ to $path";
59 }

Listing 2: »mktree«
001 #!/usr/bin/perl 002 ########################################### 003 # mktree 004 # Mike Schilli, 2003 (m@perlmeister.com) 005 ########################################### 006 use warnings; 007 use strict; 008 009 my $POD_ROOT = "/ms1/SONGS/pods"; 010 my $TREE_ROOT = "/ms1/SONGS/by_artist"; 011 my $MP3_PATTERN = qr/.mp3$/; 012 my %ARTIST_MAP = (); 013 my $ARTIST_FILE = "artistmap.gdbm"; 014 015 use Log::Log4perl qw(:easy); 016 use GDBM_File; 017 use File::Find; 018 use MP3::Info; 019 use File::Basename; 020 use File::Path; 021 use File::Spec; 022 use Getopt::Std; 023 024 Log::Log4perl->easy_init( 025 { level => $INFO, layout => '%m%n'}); 026 027 getopts("du", my %opts); 028 029 tie %ARTIST_MAP, 'GDBM_File', $ARTIST_FILE, 030 &GDBM_WRCREAT, 0640 or 031 die "Cannot tie $ARTIST_FILE"; 032 033 if($opts{d}) { 034 # Dump artist map 035 for(sort keys %ARTIST_MAP) { 036 print "$_ => $ARTIST_MAP{$_}n"; 037 } 038 } elsif($opts{u}) { 039 # Undump artist map 040 %ARTIST_MAP = (); 041 while(<>) { 042 chomp; 043 my($k, $v) = split / => /, $_, 2; 044 $ARTIST_MAP{$k} = $v; 045 } 046 } else { 047 # Link hierarchy entry to pod entry 048 find(sub { 049 mklink($File::Find::name) 050 if /$MP3_PATTERN/; 051 }, $POD_ROOT); 052 } 053 054 ########################################### 055 sub mklink { 056 ########################################### 057 my($file) = @_; 058 059 my $tag = get_mp3tag($file); 060 061 if(!$tag) { 062 warn "No TAG info in $file"; 063 link_path($file, 064 "Lost+Found/" . basename($file)); 065 return; 066 } 067 068 for(qw(ARTIST ALBUM TITLE COMMENT)) { 069 unless($tag->{$_} =~ /S/) { 070 warn "No $_ TAG in $file"; 071 link_path($file, 072 "Lost+Found/" . 073 basename($file)); 074 return; 075 } 076 } 077 078 my ($track_no) = 079 ($tag->{COMMENT} =~ /(d+)$/); 080 081 $track_no = "XX" unless 082 defined $track_no; 083 084 my $artist = $tag->{ARTIST}; 085 086 unless(exists $ARTIST_MAP{$artist}) { 087 $ARTIST_MAP{$artist} = 088 warp_artist($artist); 089 } 090 091 $artist = $ARTIST_MAP{$artist}; 092 093 my $relpath = File::Spec->catfile( 094 map { s/[s/]/_/g; $_; 095 } $artist, $tag->{ALBUM}, 096 "${track_no}_$tag->{TITLE}.mp3"); 097 098 link_path($file, $relpath); 099 } 100 101 ########################################### 102 sub link_path { 103 ########################################### 104 my($file, $relpath) = @_; 105 106 my $path = File::Spec->rel2abs( 107 $relpath, $TREE_ROOT); 108 109 my $dir = dirname($path); 110 unless(-d dirname($path)) { 111 INFO("mkdir $dir"); 112 mkpath $dir or 113 die "Cannot mkpath $dir"; 114 } 115 unless(-l $path) { 116 INFO("Linking $file to $path"); 117 symlink($file, $path) or 118 die "Cannot symlink $file"; 119 } 120 } 121 122 ########################################### 123 sub warp_artist { 124 ########################################### 125 my($artist) = @_; 126 127 my @choices = (); 128 129 my @c = split ' ', $artist; 130 131 if(@c == 1) { 132 @choices = (); 133 } elsif($c[0] =~ /^the$/i) { 134 my $the = shift @c; 135 @choices = ("@c, $the"); 136 } elsif(@c == 2) { 137 @choices = ("$c[1], $c[0]"); 138 } elsif(@c == 3) { 139 @choices = ("$c[2], $c[0] $c[1]"); 140 } 141 142 return pick($artist, @choices); 143 } 144 145 ########################################### 146 sub pick { 147 ########################################### 148 my(@options) = @_; 149 150 my $counter = 1; 151 152 for(@options) { 153 print "[", $counter++, "] $_n"; 154 } 155 156 $\| = 1; 157 print "[1]>"; 158 159 chomp(my $input = <STDIN>); 160 $input = 1 unless $input; 161 162 if($input =~ /^d+$/) { 163 return $options[$input-1]; 164 } else { 165 return $input; 166 } 167 }

Listing 2:
»mktree«

001 #!/usr/bin/perl
002 ###########################################
003 # mktree
004 # Mike Schilli, 2003 (m@perlmeister.com)
005 ###########################################
006 use warnings;
007 use strict;
008 
009 my $POD_ROOT    = "/ms1/SONGS/pods";
010 my $TREE_ROOT   = "/ms1/SONGS/by_artist";
011 my $MP3_PATTERN = qr/.mp3$/;
012 my %ARTIST_MAP  = ();
013 my $ARTIST_FILE = "artistmap.gdbm";
014 
015 use Log::Log4perl qw(:easy);
016 use GDBM_File;
017 use File::Find;
018 use MP3::Info;
019 use File::Basename;
020 use File::Path;
021 use File::Spec;
022 use Getopt::Std;
023 
024 Log::Log4perl->easy_init(
025      { level  => $INFO, layout => '%m%n'});
026 
027 getopts("du", my %opts);
028 
029 tie %ARTIST_MAP, 'GDBM_File', $ARTIST_FILE,
030     &GDBM_WRCREAT, 0640 or
031         die "Cannot tie $ARTIST_FILE";
032 
033 if($opts{d}) {
034         # Dump artist map
035     for(sort keys %ARTIST_MAP) {
036         print "$_ => $ARTIST_MAP{$_}n";
037     }
038 } elsif($opts{u}) {
039         # Undump artist map
040     %ARTIST_MAP = ();
041     while(<>) {
042         chomp;
043         my($k, $v) = split / => /, $_, 2;
044         $ARTIST_MAP{$k} = $v;
045     }
046 } else {
047         # Link hierarchy entry to pod entry
048     find(sub {
049         mklink($File::Find::name)
050                          if /$MP3_PATTERN/;
051     }, $POD_ROOT);
052 }
053 
054 ###########################################
055 sub mklink {
056 ###########################################
057     my($file) = @_;
058 
059     my $tag = get_mp3tag($file);
060 
061     if(!$tag) {
062         warn "No TAG info in $file";
063         link_path($file,
064           "Lost+Found/" . basename($file));
065         return;
066     }
067 
068     for(qw(ARTIST ALBUM TITLE COMMENT)) {
069         unless($tag->{$_} =~ /S/) {
070             warn "No $_ TAG in $file";
071             link_path($file,
072                       "Lost+Found/" .
073                       basename($file));
074             return;
075         }
076     }
077 
078     my ($track_no) =
079              ($tag->{COMMENT} =~ /(d+)$/);
080 
081     $track_no = "XX" unless
082                          defined $track_no;
083 
084     my $artist = $tag->{ARTIST};
085 
086     unless(exists $ARTIST_MAP{$artist}) {
087         $ARTIST_MAP{$artist} =
088                       warp_artist($artist);
089     }
090 
091     $artist = $ARTIST_MAP{$artist};
092 
093     my $relpath = File::Spec->catfile(
094         map { s/[s/]/_/g; $_;
095             } $artist, $tag->{ALBUM},
096           "${track_no}_$tag->{TITLE}.mp3");
097 
098     link_path($file, $relpath);
099 }
100 
101 ###########################################
102 sub link_path {
103 ###########################################
104     my($file, $relpath) = @_;
105 
106     my $path = File::Spec->rel2abs(
107                      $relpath, $TREE_ROOT);
108 
109     my $dir = dirname($path);
110     unless(-d dirname($path)) {
111         INFO("mkdir $dir");
112         mkpath $dir or
113             die "Cannot mkpath $dir";
114     }
115     unless(-l $path) {
116         INFO("Linking $file to $path");
117         symlink($file, $path) or
118             die "Cannot symlink $file";
119     }
120 }
121 
122 ###########################################
123 sub warp_artist {
124 ###########################################
125     my($artist) = @_;
126 
127     my @choices = ();
128 
129     my @c = split ' ', $artist;
130 
131     if(@c == 1) {
132         @choices = ();
133     } elsif($c[0] =~ /^the$/i) {
134         my $the = shift @c;
135         @choices = ("@c, $the");
136     } elsif(@c == 2) {
137         @choices = ("$c[1], $c[0]");
138     } elsif(@c == 3) {
139         @choices = ("$c[2], $c[0] $c[1]");
140     }
141 
142     return pick($artist, @choices);
143 }
144 
145 ###########################################
146 sub pick {
147 ###########################################
148     my(@options) = @_;
149 
150     my $counter = 1;
151 
152     for(@options) {
153         print "[", $counter++, "] $_n";
154     }
155 
156     $| = 1;
157     print "[1]>";
158 
159     chomp(my $input = <STDIN>);
160     $input = 1 unless $input;
161 
162     if($input =~ /^d+$/) {
163         return $options[$input-1];
164     } else {
165         return $input;
166     }
167 }

Infos
[1] Listings zu diesem Artikel: [ftp://www.linux-magazin.de/pub/listings/magazin/2003/08/Perl] [2] Michael Schilli, “Musik aus dem Keller”, Linux-Magazin 3/03: [https://www.linux-magazin.de/Artikel/ausgabe/2003/03/perl/perl.html] [3] Crip-Homepage, [bach.dynet.com/crip/] [4] Apache::MP3: [namp.sourceforge.net], CPAN [5] Homepage Apache mod_perl: [http://perl.apache.org] [6] Michael Schilli, “Hacker mögen Sport”, Linux-Magazin 2/01: [https://www.linux-magazin.de/Artikel/ausgabe/2001/02/Perl/perl.html] [7] Fix für XMMS auf Red Hat: [http://www.gurulabs.com/downloads.html] [8] Steve Litt, “Installing Your ATAPI CDRW Drive in Linux”: [http://www.troubleshooters.com/linux/cdrw.htm]

Infos

[1] Listings zu diesem Artikel: [ftp://www.linux-magazin.de/pub/listings/magazin/2003/08/Perl]

[2] Michael Schilli, “Musik aus dem Keller”, Linux-Magazin 3/03: [https://www.linux-magazin.de/Artikel/ausgabe/2003/03/perl/perl.html]

[3] Crip-Homepage, [bach.dynet.com/crip/]

[4] Apache::MP3: [namp.sourceforge.net], CPAN

[5] Homepage Apache mod_perl: [http://perl.apache.org]

[6] Michael Schilli, “Hacker mögen Sport”, Linux-Magazin 2/01: [https://www.linux-magazin.de/Artikel/ausgabe/2001/02/Perl/perl.html]

[7] Fix für XMMS auf Red Hat: [http://www.gurulabs.com/downloads.html]

[8] Steve Litt, “Installing Your ATAPI CDRW Drive in Linux”: [http://www.troubleshooters.com/linux/cdrw.htm]

Der Autor
Michael Schilli arbeitet als Web-Engineer für AOL/Netscape in Mountain View, Kalifornien. Er hat “Goto Perl 5” (deutsch) und “Perl Power” (englisch) für Addison-Wesley geschrieben und ist unter [mschilli@perlmeister.com] zu erreichen. Seine Homepage ist [http://perlmeister.com]