CGI/Perl Guide | Learning Center | Forums | Advertise | Login
Site Search: in

  Main Index MAIN
INDEX
Search Posts SEARCH
POSTS
Who's Online WHO'S
ONLINE
Log in LOG
IN

Home: Perl Programming Help: Regular Expressions:
Track. Title format for audio files

 



jwhit61
Novice

Dec 22, 2008, 10:25 PM

Post #1 of 11 (9338 views)
Track. Title format for audio files Can't Post

Below is the sub routine I use to format audio files for my system. There's has to be a better way. If I send in a song like 01-21 stones.mp3,
I get back 01. 21. Stones.mp3. Another, more annoying example is with a title that may have a date. 01-Up on the roof 10-21-1960.mp3 becomes 01. Up On The Roof 10. 21. 1960.mp3. I guess I'm okay with the idea that if I have a number in the title other than the track, I treat them all the same. It would just be nice if you folks can help me clean this up and maybe just treat the track separate from the title. Also, I set the ID3 tags/Flac tags from the filename. I don't depend on the tags to generate the file name.

Thanks in advance.


Code
sub FixFileName() { 
$oldfile = $file;
# First make the filename all lowercase
$file =~ tr/[A-Z]/[a-z]/;
# Get rid of the underscores and make them spaces
$file =~ s/_/ /g;
# Get rid of double spaces
$file =~ s/ / /g;
# Make sure we have spaces on each side of dash
$file =~ s/-/ - /g;
# Make the first letter Uppercase if Alpha
$file =~ s/^([a-z])/\u$1/;
# Anything that follows the left paran to uppercase
$file =~ s/\(([a-z])/\(\u$1/g;
# Anything that follows the left bracket to uppercase
$file =~ s/\[([a-z])/\[\u$1/g;
# Anything that follows a period to uppercase
$file =~ s/\.([a-z])/\.\u$1/g;
# For every letter following a space make uppercase
$file =~ s/ ([a-z])/ \u$1/g;
# Anything that follows a dash to uppercase
# Commented out - We have a space after a dash
# $file =~ s/\-([a-z])/\-\u$1/g;
# Get rid of double spaces
$file =~ s/ / /g;
# For those files that only have a space between track and title
$file =~ s/([0-9]) ([0-9,A-Z,\(,\[])/$1\. $2/;
# Get back to Track. Title if currently a number-space-dash
$file =~ s/([0-9]) - ([0-9,A-Z,\(,\[])/$1\. $2/;
# We no longer need the space on each side of the dashes we put in
$file =~ s/ - /-/g;
$file =~ s/-\./\./g;
# Need to fix the extension (letter following a period is upper)
$file =~ s/$\.Mp3/$\.mp3/;
$file =~ s/$\.Flac/$\.flac/;
# print $oldfile, " -> ",$file,"\n";
rename ( $oldfile, $file ) unless $oldfile eq $file;
}



KevinR
Veteran


Dec 23, 2008, 8:37 AM

Post #2 of 11 (9327 views)
Re: [jwhit61] Track. Title format for audio files [In reply to] Can't Post

Describe what you would like the audio file names to be formatted to.
-------------------------------------------------


jwhit61
Novice

Dec 23, 2008, 9:10 AM

Post #3 of 11 (9324 views)
Re: [KevinR] Track. Title format for audio files [In reply to] Can't Post

I'm trying to make the file names appear as ##. Title where the number is formatted as two digits with leading zero. The Title will be formatted with uppercase characters for each word following a space, bracket, paran or dash.

For example
01. The Song Name For The Year (It Must Be Good).mp3
02. This Way Too [Remastered].flac
03. Other Way-Off Names 'Encountered' [W/Other Help].mp3

I guess my intent for my original post is to just get better with regular expressions and reduce the lines of code. The function I posted is nearly the first thing I've tried as so its written like reg-ex 101 or intro to regular expressions :-)

Other useless info: My kids rip their discs to a local drive on their machines. I've installed MythTV with MythMusic. All of the media is brought into the single box. Too ensure I don't end up with duplicate files and everything is 'pretty,' I've been using the function to format the files. I could have made everything lower-case or upper-case but I decided to not do that in favor of something more formatted.

Thanks again.


KevinR
Veteran


Dec 23, 2008, 9:33 AM

Post #4 of 11 (9323 views)
Re: [jwhit61] Track. Title format for audio files [In reply to] Can't Post

I will look at your code and post back in a bit.
-------------------------------------------------


(This post was edited by KevinR on Dec 23, 2008, 7:46 PM)


KevinR
Veteran


Dec 23, 2008, 10:18 AM

Post #5 of 11 (9321 views)
Re: [jwhit61] Track. Title format for audio files [In reply to] Can't Post

assuming the names always start with two digits here is some code I came up with. There are also many modules listed on CPAN you may want to look at.


Code
my $file = '01-rolling      stones(paint_it_black).mp3';  
my $new = FixFileName($file);
print $new;

sub FixFileName {
my $file = $_[0] or return "No filename entered. Please enter a filename.";
my $oldfile = $file;
my ($track, $name, $ext);
if ($file =~ /^(\d\d)(.*)(\.\w+)$/) {
($track, $name, $ext) = ($1, $2, $3);
}
else {
print "Format not recognized\n";
exit(0);
}
#replace underscores with a space
$name =~ tr/_/ /;
#collapse multiple spaces
$name =~ tr/ / /s;
#change first alpha to uppercase using the \b anchor as the word boundary
$name =~ s/\b([a-z]+)\b/ucfirst(lc($1))/eg;
unless ($oldfile eq "$track. $name$ext") {
rename ( $oldfile, "$track. $name$ext" ) or die "Can't rename $oldfile to $newfile : $!";
}
return ("$track. $name$ext");
}

-------------------------------------------------


(This post was edited by KevinR on Dec 23, 2008, 7:48 PM)


jwhit61
Novice

Dec 26, 2008, 5:55 AM

Post #6 of 11 (9287 views)
Re: [KevinR] Track. Title format for audio files [In reply to] Can't Post

The season has created some delays on getting back to you. First, thanks for your input. I took the code you provided and below is my current process to 'standardize' my audio system. The structure for my files is: Artist/Album/Track. Title. I ran into some scenarios that were outside my original description. I also decided to run the directory names through the same code to ensure they were more controlled.

Again, you provided me with some pieces (particularly the boundary code) that I had not seen before. Like many things, I'll keep playing around with this as I encounter other situations. This script below is modifying files that are already in place. I've got another script that copies from a source to the destination. The source files are less structured and may need more attention than we are doing here.


Code
#!/usr/bin/perl                                                                             
use Audio::FLAC::Header;
use MP3::Info;
use MP3::Tag;

sub GetArtistAlbum {
$MyPath = `pwd`;
#Get the number of slashes in the pwd
my $I = $MyPath =~ tr /\//\//;
my $J = $I+1;
($Artist,$Album) = split(/\//,`pwd | cut -d/ -f $I,$J`);
chomp($Artist);
chomp($Album);
return ($Artist, $Album);
}

sub GetTrackTitle {
my $file = $_[0] or exit 1;
($Track,$Title) = split(/[\s.-]/,$file,2);
$Title =~ s/^[\s.-]+(.)/$1/;
unless ($Track=~ /^\d+$/) {
$Track=1;
$Title=$file;
}
return ($Track, $Title);
}

sub ProcessFiles {
my @MP3Files = `ls *.mp3 2>/dev/null`;
my @FLACFiles = `ls *.flac 2>/dev/null`;
my $NumMP3Files = @MP3Files;
my $NumFLACFiles = @FLACFiles;
my ($Artist, $Album) = GetArtistAlbum;
if ($NumMP3Files > 0) {
foreach my $MP3File (@MP3Files) {
chomp $MP3File;
if ($MP3File =~ /^(.*)(\.mp3)/) {
($file, $ext) = ($1, $2);
$file = FormatText ($file);
}
my ($Track, $Title) = GetTrackTitle ($file);
my $NewFile = "$Track. $Title$ext";
rename ($MP3File, $NewFile) unless $MP3File eq $NewFile;
remove_mp3tag($NewFile, 'ALL');
$mp3 = MP3::Tag->new($NewFile);
$id3v1 = $mp3->new_tag("ID3v1");
$id3v1->all($Title,$Artist,$Album,"","",$Track,"Rock");
$id3v1->write_tag;

$id3v2 = $mp3->new_tag("ID3v2");
$id3v2->add_frame(TRCK,$Track);
$id3v2->add_frame(TIT2,$Title);
$id3v2->add_frame(TPE1,$Artist);
$id3v2->add_frame(TALB,$Album);
$id3v2->add_frame(TCON,"17");
$id3v2->write_tag;
}
}
if ($NumFLACFiles > 0) {
foreach my $FLACFile (@FLACFiles) {
chomp $FLACFile;
if ($FLACFile =~ /^(.*)(\.flac)/) {
($file, $ext) = ($1, $2);
$file = FormatText ($file);
}
my ($Track, $Title) = GetTrackTitle ($file);
my $NewFile = "$Track. $Title$ext";
rename ($FLACFile, $NewFile) unless $FLACFile eq $NewFile;
my $flac = Audio::FLAC::Header->new($NewFile);
my $tags = $flac->tags();
$tags->{TRACKNUMBER} = $Track;
$tags->{TITLE} = $Title;
$tags->{ARTIST} = $Artist;
$tags->{ALBUM} = $Album;
$flac->write();
}
}
}

sub FormatText {
my $NewText = $_[0] or exit 1;
$NewText =~ tr/[A-Z]/[a-z]/; #Make everything lowercase
$NewText =~ tr/_/ /; #Remove underscores
$NewText =~ tr/ / /s; #Remove unnecessary spaces
$NewText =~ s/\b([a-z]+)\B/ucfirst(lc($1))/eg; #Boundary ends with a Number
$NewText =~ s/\b([a-z]+)\b/ucfirst(lc($1))/eg; #Boundary ends with a Char
$NewText =~ s/([a-z])\.([A-Z])/$1 $2/g; #Remove unnecessary periods
$NewText =~ s/('[A-Z])/lc($1)/eg; #Possesive nouns and others need lc
$NewText =~ s/(\W'\S)/uc($1)/eg; #Some items following ' should be uc
@x = $NewText =~ m/\(/g; #Count open parans
@y = $NewText =~ m/\)/g; #Count closing parans
unless (@x == @y) {
$NewText = $NewText.")";
}
return ($NewText);
}

chdir "/mp3";
my @Artists = `ls -F | grep / 2>/dev/null`;
foreach my $Artist (@Artists) {
chomp $Artist;
$Artist =~ s/(.)\//$1/;
my $NewArtist = FormatText ($Artist);
rename ($Artist, $NewArtist) unless $Artist eq $NewArtist;
# print "New$Artist \n";
chdir $NewArtist or warn "Cannot change to $NewArtist\n";
my @Albums = `ls -F | grep / 2>/dev/null`;
foreach my $Album (@Albums) {
chomp $Album;
$Album =~ s/(.)\//$1/;
my $NewAlbum = FormatText ($Album);
rename ($Album, $NewAlbum) unless $Album eq $NewAlbum;
# print "\t $NewAlbum \n";
chdir $NewAlbum or warn "Cannot change to $NewArtist-$NewAlbum\n";
ProcessFiles;
chdir "..";
}
chdir "..";
# print "\n";
}



KevinR
Veteran


Dec 26, 2008, 6:27 AM

Post #7 of 11 (9285 views)
Re: [jwhit61] Track. Title format for audio files [In reply to] Can't Post

Just a quick look through your code I spotted these lines:


Code
$NewText =~ tr/[A-Z]/[a-z]/; #Make everything lowercase  

$NewText =~ s/\b([a-z]+)\B/ucfirst(lc($1))/eg; #Boundary ends with a Number


In the first line the square brackets are not doing anything. The square brackets do not make a character class when using tr///. tr/// is not a regular expression like s/// and m// are. Leaving them in is not hurting anything but they are being treated as literal characters and not as a character class. But to make everything lower-case, use the lc() function:

$text = lc($text);

In the second line, it looks like you would be better using \d instead of \B as the end of pattern anchor. \d is digits 0-9.
-------------------------------------------------


(This post was edited by KevinR on Dec 26, 2008, 6:29 AM)


KevinR
Veteran


Dec 26, 2008, 6:34 AM

Post #8 of 11 (9282 views)
Re: [jwhit61] Track. Title format for audio files [In reply to] Can't Post

Here you have:

@x = $NewText =~ m/\(/g; #Count open parans
@y = $NewText =~ m/\)/g; #Count closing parans

A more efficient way to count characters in a line or string is using tr///:

$x = $NewText =~ tr/(/(/; #Count open parans
$y = $NewText =~ tr/)/)/; #Count closing parans
if ($x == $y) {
.....
-------------------------------------------------


jwhit61
Novice

Dec 26, 2008, 4:24 PM

Post #9 of 11 (9272 views)
Re: [KevinR] Track. Title format for audio files [In reply to] Can't Post

Thanks for the other tips. I did find one more issue with my code. For items containing characters like ˙, the next letter is uppercase. One example is Queensr˙Che. I'll work on that and see what I can come up with. I'll let you know what I come up with.

Others:
Zz Top / DeqüEllo
Blue ÖYster Cult
MöTley CrüE


jwhit61
Novice

Dec 28, 2008, 7:48 AM

Post #10 of 11 (9246 views)
Re: [jwhit61] Track. Title format for audio files [In reply to] Can't Post

KevinR,

Unless I run into a big problem, I think the script below is the result of your help (I promise to take the blame for errors :-) )

I'm posting the results here in case someone else can learn from it or use it as a start for themselves.


Code
#!/usr/bin/perl                            
use Audio::FLAC::Header;
use MP3::Info;
use MP3::Tag;

sub GetArtistAlbum {
$MyPath = `pwd`;
#Get the number of slashes in the pwd
my $I = $MyPath =~ tr /\//\//;
my $J = $I+1;
($Artist,$Album) = split(/\//,`pwd | cut -d/ -f $I,$J`);
chomp($Artist);
chomp($Album);
return ($Artist, $Album);
}

sub ProcessFiles {
my @MP3Files = `ls *.mp3 2>/dev/null`;
my @FLACFiles = `ls *.flac 2>/dev/null`;
my $NumMP3Files = @MP3Files;
my $NumFLACFiles = @FLACFiles;
my ($Artist, $Album) = GetArtistAlbum;
if ($NumMP3Files > 0) {
foreach my $MP3File (@MP3Files) {
chomp $MP3File;
if ($MP3File =~ /^(\d+[\.\-\ ]+)(.*)(\.\w+)$/) {
($Track, $Title, $Ext) = (int($1), $2, $3);
$Track = sprintf("%02d", $Track);
$Title = FormatText ($Title);
my $NewFile = "$Track. $Title$Ext";
if ($DEBUG) { print "\t$NewFile\n"; }
rename ($MP3File, $NewFile) unless $MP3File eq $NewFile;
remove_mp3tag($NewFile, 'ALL');
$mp3 = MP3::Tag->new($NewFile);
$id3v1 = $mp3->new_tag("ID3v1");
$id3v1->all($Title,$Artist,$Album,"","",$Track,"Rock");
$id3v1->write_tag;
$id3v2 = $mp3->new_tag("ID3v2");
$id3v2->add_frame(TRCK,$Track);
$id3v2->add_frame(TIT2,$Title);
$id3v2->add_frame(TPE1,$Artist);
$id3v2->add_frame(TALB,$Album);
$id3v2->add_frame(TCON,"17");
$id3v2->write_tag;
}
}
}
if ($NumFLACFiles > 0) {
foreach my $FLACFile (@FLACFiles) {
chomp $FLACFile;
if ($FLACFile =~ /^(\d+[\.\-\ ]+)(.*)(\.\w+)$/) {
($Track, $Title, $Ext) = (int($1), $2, $3);
$Track = sprintf("%02d", $Track);
$Title = FormatText ($Title);
my $NewFile = "$Track. $Title$Ext";
if ($DEBUG) { print "\t$NewFile\n"; }
rename ($FLACFile, $NewFile) unless $FLACFile eq $NewFile;
my $flac = Audio::FLAC::Header->new($NewFile);
my $tags = $flac->tags();
$tags->{TRACKNUMBER} = $Track;
$tags->{TITLE} = $Title;
$tags->{ARTIST} = $Artist;
$tags->{ALBUM} = $Album;
$flac->write();
}
}
}
}

sub FormatText {
my $NewText = $_[0] or exit 1;
$NewText = lc($NewText); #Make everything lowercase
$NewText =~ tr/_/ /; #Remove underscores
$NewText =~ s/\[/\(/g;
$NewText =~ s/\]/\)/g;
$NewText =~ tr/ / /s; #Remove unnecessary spaces
$NewText =~ s/\.$//; #Some titles have an extra period - bye
$NewText =~ s/(\d)\./$1/g; #Do not need period after numbers here
@Words = split(/ /,$NewText);
foreach $Word (@Words) {
$Word = ucfirst($Word);
}
$NewText = "@Words";
$NewText =~ s/([(-])([a-z])/$1\u$2/g;
$NewText =~ s/(\W'\S)/uc($1)/eg; #Some items following ' should be uc
$NewText =~ s/(\.)([a-z])/$1\u$2/g; #Letter.Letter.Letter... is uc
$x = $NewText =~ tr/(/(/; #Count open parans
$y = $NewText =~ tr/)/)/; #Count closing parans
if ($x > $y) {
$NewText = $NewText.")";
}
return ($NewText);
}

$DEBUG = 0;
ProcessFiles;
my @Albums = `ls -F | grep / | sort 2>/dev/null`;
foreach my $Album (@Albums) {
chomp $Album;
$Album =~ s/(.)\//$1/;
my $NewAlbum = FormatText ($Album);
rename ($Album, $NewAlbum) unless $Album eq $NewAlbum;
if ($DEBUG) { print "$NewAlbum \n"; }
chdir $NewAlbum or warn "Cannot change to $NewArtist-$NewAlbum\n";
ProcessFiles;
chdir "..";
}



FishMonger
Veteran / Moderator

Dec 28, 2008, 8:50 AM

Post #11 of 11 (9243 views)
Re: [jwhit61] Track. Title format for audio files [In reply to] Can't Post

The script is missing 2 very important items which should be in every Perl script you write and one specifically for your script

Code
use strict; 
use warnings;

use Cwd; # this is a core module


There is no vaild reason to use the backticks to spawn shell commands when there are Perl commands to do the exact same thing, which in this script means all of your backtick commands should go away.

Your GetArtistAlbum sub could be reduced to 1 line and will be more efficient and platform independent.

Code
sub GetArtistAlbum { 
return ( split m!/!, cwd() )[-2,-1];
}


Here are a few docs you should read.
perldoc Cwd
perldoc -f glob
perldoc -f grep
perldoc -f sort
perldoc -q quoting
perldoc perlstyle


(This post was edited by FishMonger on Dec 28, 2008, 8:51 AM)

 
 


Search for (options) Powered by Gossamer Forum v.1.2.0

Web Applications & Managed Hosting Powered by Gossamer Threads
Visit our Mailing List Archives