#! perl # # Step 1 : pl2bat this file. # Step 2 : add an action for MP3 file types in the explorer # for me, this was located under Folder Options. # I used an action of "De&tail" and set # "Application used to perform action" to # C:\projects\emplalia\emp.bat "%1". # Adjust the filename to something appropriate. # Step 3 : Right click on an mp3 file and select Detail # You can view & alter the Album, Artist, Song # Title and Track Number # use Wx; package MyApp; use MP3::Tag; use File::Copy; use File::Path; use strict; use Win32; use vars qw(@ISA); use Wx qw(wxDefaultSize wxDefaultPosition); @ISA=qw(Wx::App); sub OnInit { my( $this ) = @_; my( $dialog ) = MyDialog->new( "MP3 details",wxDefaultPosition); $this->SetTopWindow($dialog); $dialog->Show(1); 1; } package MyDialog; use strict; use vars qw(@ISA); @ISA=qw(Wx::Dialog); use Wx::Event qw(EVT_CLOSE EVT_BUTTON); use Wx qw(wxDefaultSize wxDefaultValidator wxOK wxICON_INFORMATION wxTE_READONLY); use File::Copy; use File::Path; # # alter these 3 items to create different directories & filenames # my $sortdir="F:/sorted mp3/"; my $pathPattern = '$sortdir$artist/$album/'; my $fnPattern = '$sortdir$artist/$album/$artist - $album - $track - $song'; ($sortdir, $pathPattern, $fnPattern) = loadPatterns(); sub new { my( $class ) = shift; my( $this ) = $class->SUPER::new( undef, -1, $_[0], $_[1], [250, 310] ); my $fieldwidth = 170; # grab the mp3 information my $fn = Win32::GetLongPathName (@ARGV[0]); my $mp3=MP3::Tag->new($fn) || die $!;; my ($song, $track, $artist, $album) = $mp3->autoinfo(); $mp3->close(); $mp3=undef; $song =~s/^\s*//; # leading space trim # done with mp3 info #create the gui controls Wx::StaticText->new ($this,-1,"filename",[10,10],[100,-1]); Wx::StaticText->new ($this,-1,"artist",[10,40],[100,-1]); Wx::StaticText->new ($this,-1,"album",[10,70],[100,-1]); Wx::StaticText->new ($this,-1,"track #",[10,100],[100,-1]); Wx::StaticText->new ($this,-1,"song title",[10,130],[100,-1]); my($fnTXT) = $this->{FILENAME} = Wx::TextCtrl->new( $this, -1, $fn, [60, 10], [$fieldwidth, -1], wxTE_READONLY); my($arTXT) = $this->{ARTIST} = Wx::TextCtrl->new( $this, -1, $artist, [60, 40], [$fieldwidth, -1]); my($alTXT) = $this->{ALBUM} = Wx::TextCtrl->new( $this, -1, $album, [60, 70], [$fieldwidth, -1]); my($trTXT) = $this->{TRACK} = Wx::TextCtrl->new( $this, -1, $track, [60, 100], [$fieldwidth, -1]); my($snTXT) = $this->{SONG} = Wx::TextCtrl->new( $this, -1, $song, [60, 130], [$fieldwidth, -1]); my($okBTN) = Wx::Button->new( $this, -1, 'OK', [5, 160] ); my($llBTN) = Wx::Button->new( $this, -1, 'Load Last', [85, 160] ); my($caBTN) = Wx::Button->new( $this, -1, 'Cancel', [165, 160] ); my($osBTN) = Wx::Button->new( $this, -1, 'OK && Sort', [5, 190] ); EVT_BUTTON( $this, $okBTN, \&okBTN ); EVT_BUTTON( $this, $caBTN, \&OnClose ); EVT_BUTTON ($this, $llBTN, \&loadLast); EVT_BUTTON ($this, $osBTN, \&oksortBTN); EVT_CLOSE( $this, \&OnClose ); return $this; } sub okBTN { #update and save tags, then close my ($this) = @_; updateMP3Tag($this); saveTagData($this); $this->OnClose(); } sub oksortBTN { # update and save tags, move file and close my ($this) = @_; updateMP3Tag ($this); saveTagData ($this); archiveMP3 ($this); $this->OnClose(); } sub updateMP3Tag { # update tags... my ($this) = @_; my $id; my $mpeg=MP3::Tag->new($this->{FILENAME}->GetValue()); $mpeg->get_tags(); my $id; if (exists $mpeg->{ID3v2}){ $id = $mpeg->{ID3v2}; } else { $id = $mpeg->new_tag("ID3v2"); } unless ($id){ # something's seriously funky here. The only time I've seen this scenario is # on a file with an old id3v2 tag. showWarningMessage($this, "Could not create or find tag", "Could not create or find an id3v2 tag for this file for some reason", "The file may have a ID3v2 tag that can't be coped with, or the file may be in use.", "(perl reports $!)"); return; # used to be OnClose, decided to let user have a chance to cope with problem :) } $id->remove_frame ($_) foreach (qw (TIT2 TALB TPE1 TRCK)); $id->add_frame("TIT2", $this->{SONG}->GetValue()); $id->add_frame("TALB", $this->{ALBUM}->GetValue()); $id->add_frame("TPE1", $this->{ARTIST}->GetValue()); $id->add_frame("TRCK", $this->{TRACK}->GetValue()); unless ($id->write_tag()) { showWarningMessage ($this, "Can't update tag","Couldn't write updated tag information", "(Is the file in use by another program?)","(perl reports $!)"); return; # used to be OnClose, decided to let user have a chance to cope with problem :) } } sub saveTagData { # saves tag data to a text file for later loading. my ($this) = @_; my $cfgfn = "emp.cfg"; # configuration file name open FH, ">$cfgfn" || print " no open $!"; print FH join "\n", $this->{SONG}->GetValue(), $this->{ALBUM}->GetValue(), $this->{ARTIST}->GetValue(), $this->{TRACK}->GetValue(); close FH; } sub archiveMP3 { #moves & renames file to user specified info (see loadPatterns) my ($this) = @_; my ($fn, $song, $album, $artist, $track) = ($this->{FILENAME}->GetValue(), $this->{SONG}->GetValue(), $this->{ALBUM}->GetValue(), $this->{ARTIST}->GetValue(), $this->{TRACK}->GetValue()); # clean up the track information if ($track=~m|(\d+)\D+/\D+\d+|){ # deal with n/nn tracks as simply being track "n" $track =$1 } $track =~s |(\d+)/\d+|$1|; $track = sprintf ("%02d",$track); # make sure file path exists/ can be created my $path = eval "\"$pathPattern\""; eval {mkpath ($path)}; if ($@) { # failed to create the new path. This will not occur if the path already exists showWarningMessage($this,"File name too damn long", "Could not create specified path '$sortdir$artist/$album'", "Please deal with this file on your own."); return; # exit early; don't make a file on a path that doesn't exist } # now move the file over my $newfn = eval "\"$fnPattern\""; $newfn .=".mp3"; if (length $newfn >259) { # The maximum length of a path, including drive, directory # and filename is 259 characters. The maximum length of the # filename portion of a path is 255 characters. showWarningMessage($this, "File name too damn long", "resulting filename '$newfn' would be greater that 255 characters.", "Please deal with this file on your own."); return; # no continue; } if (-e $newfn) { # does the file already exist? don't bother copying if it does # TODO : ask user if he wants to delete the file or overwrite target; showWarningMessage($this, "Can't move file","File '$newfn' already exists."); return; } unless (move ($fn, $newfn)) { showWarningMessage($this, "AAAIIEE", "Couldn't move this file.\n(Perl reports $!)"); } } sub loadLast { # load last corrected tag minus track name. # increments track # by one as well my( $this ) = @_; my $cfgfn = "c:/emp.cfg"; open FH, $cfgfn || print $!;; my @lines=; close FH; chomp @lines; print join "\n", @lines; $this->{ALBUM}->SetValue($lines[1]); $this->{ARTIST}->SetValue($lines[2]); if ($lines[3]=~m|(\d+)\D+/\D+(\d+)|) { #attempt to preserve n/nn track numbering my $temp =$1 + 1; $this->{TRACK}->SetValue( "$temp/$2"); } else { $this->{TRACK}->SetValue(++$lines[3]); } $this->{ARTIST}->SetValue($lines[2]); $this->{ALBUM}->SetValue($lines[1]); } sub loadPatterns { my ($sortdir,$pathPattern, $fnPattern); my @defaults = ("F:/sorted mp3/", '$sortdir$artist/$album/', '$sortdir$artist/$album/$artist - $album - $track - $song'); open FH, "emplex.pat" || warn $!; # it's not really a requirement my @temp = ; close FH; chomp @temp; for (0..2) { $temp[$_] = defined $temp[$_] ? $temp[$_] : $defaults[$_]; } return @temp; } sub OnClose { my( $this, $event ) = @_; $this->Destroy(); } sub showWarningMessage { my $this = shift; my $title = shift || "Infomational note"; Wx::MessageBox( join ("\n", @_),$title, wxOK | wxICON_INFORMATION, $this ); } package main; my( $app ) = MyApp->new(); $app->MainLoop();