#!/usr/bin/perl ########################################### # mktree # Mike Schilli, 2003 (m@perlmeister.com) ########################################### use warnings; use strict; my $POD_ROOT = "/ms1/SONGS/pods"; my $TREE_ROOT = "/ms1/SONGS/by_artist"; my $MP3_PATTERN = qr/\.mp3$/; my %ARTIST_MAP = (); my $ARTIST_FILE = "artistmap.gdbm"; use Log::Log4perl qw(:easy); use GDBM_File; use File::Find; use MP3::Info; use File::Basename; use File::Path; use File::Spec; use Getopt::Std; Log::Log4perl->easy_init( { level => $INFO, layout => '%m%n'}); getopts("du", \my %opts); tie %ARTIST_MAP, 'GDBM_File', $ARTIST_FILE, &GDBM_WRCREAT, 0640 or die "Cannot tie $ARTIST_FILE"; if($opts{d}) { # Dump artist map for(sort keys %ARTIST_MAP) { print "$_ => $ARTIST_MAP{$_}\n"; } } elsif($opts{u}) { # Undump artist map %ARTIST_MAP = (); while(<>) { chomp; my($k, $v) = split / => /, $_, 2; $ARTIST_MAP{$k} = $v; } } else { # Link hierarchy entry to pod entry find(sub { mklink($File::Find::name) if /$MP3_PATTERN/; }, $POD_ROOT); } ########################################### sub mklink { ########################################### my($file) = @_; my $tag = get_mp3tag($file); if(!$tag) { warn "No TAG info in $file"; link_path($file, "Lost+Found/" . basename($file)); return; } for(qw(ARTIST ALBUM TITLE COMMENT)) { unless($tag->{$_} =~ /\S/) { warn "No $_ TAG in $file"; link_path($file, "Lost+Found/" . basename($file)); return; } } my ($track_no) = ($tag->{COMMENT} =~ /(\d+)$/); $track_no = "XX" unless defined $track_no; my $artist = $tag->{ARTIST}; unless(exists $ARTIST_MAP{$artist}) { $ARTIST_MAP{$artist} = warp_artist($artist); } $artist = $ARTIST_MAP{$artist}; my $relpath = File::Spec->catfile( map { s/[\s\/]/_/g; $_; } $artist, $tag->{ALBUM}, "${track_no}_$tag->{TITLE}.mp3"); link_path($file, $relpath); } ########################################### sub link_path { ########################################### my($file, $relpath) = @_; my $path = File::Spec->rel2abs( $relpath, $TREE_ROOT); my $dir = dirname($path); unless(-d dirname($path)) { INFO("mkdir $dir"); mkpath $dir or die "Cannot mkpath $dir"; } unless(-l $path) { INFO("Linking $file to $path"); symlink($file, $path) or die "Cannot symlink $file"; } } ########################################### sub warp_artist { ########################################### my($artist) = @_; my @choices = (); my @c = split ' ', $artist; if(@c == 1) { @choices = (); } elsif($c[0] =~ /^the$/i) { my $the = shift @c; @choices = ("@c, $the"); } elsif(@c == 2) { @choices = ("$c[1], $c[0]"); } elsif(@c == 3) { @choices = ("$c[2], $c[0] $c[1]"); } return pick($artist, @choices); } ########################################### sub pick { ########################################### my(@options) = @_; my $counter = 1; for(@options) { print "[", $counter++, "] $_\n"; } $| = 1; print "[1]>"; chomp(my $input = ); $input = 1 unless $input; if($input =~ /^\d+$/) { return $options[$input-1]; } else { return $input; } }