Okay, I cut this out of a much longer script. It's a little hackish, but it pretty much folllows the right algorithm (or if it doesn't, I haven't found any errors.) The @exceptions array is for phrases you don't want changed for whatever reason. Also, earlier in my script I do things like this:
next if ( $artist =~ /^Tool$/ && $album =~ /^undertow$/ );
next if ( $artist =~ /^Tori Amos$/ && $album =~ /^Scarlet's Walk$/ );
to skip over problem albums that are capitalized funny.
The rest should be pretty self explanatory. It probably isn't the most optimized code in the world, but it does the job. It also assumes that the titles start out "pretty close" to correct, so starting out with ALL CAPS isn't a good idea, as it will just try to capitalize the first letters (which are already capitalized.)
#!/usr/bin/perl
@articles = ( 'a', 'an', 'the' );
@conjunctions = ( 'and', 'but', 'or', 'nor' );
@prepositions = (
'at', 'by', 'for', 'from', 'in', 'into', 'of', 'off',
'on', 'onto', 'out', 'over', 'to', 'with'
);
@uppers = ( 'also', 'be', 'if', 'that', 'thus', 'when', 'as' );
@lowers = ( 'f\.', 'vs\.', "\'n\'" );
@phrasalverbs = (
'Beat Up', 'Blow Out', 'Break Down', 'Break Into', 'Break Up', 'Bring Up',
'Call Off', 'Call On', 'Call Up', 'Carry On',
'Come Back', 'Come Down', 'Come On', 'Come Out', 'Come Over', 'Do Over',
'Fill In', 'Fill Out', 'Find Out', 'Get Along', 'Get Around',
'Get By', 'Get Over', 'Get Through', 'Get Up', 'Give Back', 'Give Up',
'Go Along', 'Go Away', 'Go On', 'Go Over', 'Hand In', 'Hang Up',
'Hold On', 'Keep On', 'Keep Up', 'Leave Out', 'Let Down', 'Look For',
'Look Into', 'Look Like', 'Look Out', 'Look Over', 'Look Up', 'Make Out',
'Make Up', 'Pack Up', 'Pass Out', 'Pick Out', 'Pick Up', 'Put Away',
'Put Off', 'Put On', 'Put Out', 'Put Up', 'Roll Over', 'Run Into', 'Run Out',
'Run Over', 'Show Up', 'Take After', 'Take Back', 'Take Off', 'Take On',
'Take Up', 'Talk Back', 'Talk Over', 'Throw Away', 'Try On', 'Turn Down',
'Turn In', 'Turn Off', 'Turn On', 'Use Up', 'Wait On'
);
@exceptions = ( );
while ( $title = <>)
{
chop ($title);
$newtitle = capitalizeTitle($title);
print "before: $title\nafter: $newtitle\n";
}
sub substitutions
{
my $word = @_[0];
$word =~ s!^(\()?vs$!$1vs\.!i;
$word =~ s!^(\()ft\.$!$1f\.!i;
$word =~ s!^(\()feat\.$!$1f\.!i;
$word =~ s!^(\()featuring$!$1f\.!i;
return $word;
} # end sub substitutions
sub capitalizeTitle
{
my $string = @_[0];
for ( $i = 0 ; $i < @exceptions ; $i++ ) {
return $string if ( uc($string) eq uc (@exceptions[$i]) );
}
@words = split ( / /, $string );
for ( $i = 0 ; $i < @words ; $i++ )
{
$word = \@words[$i];
if ( $i == 0
|| $i == @words - 1
|| @words[ $i + 1 ] =~ /^\(/
|| @words[ $i - 1 ] eq "-" )
{
$$word =~ s/^(.)/\U$1/;
} # end if ( $i == 0 || $i == ...
else
{
$$word =~ s/^([^A-Za-z0-9]*)(.)/\U$1$2/;
$$word = substitutions($$word);
foreach $a (@articles)
{
if ( $$word =~ /^$a$/i )
{
$$word =~ s/^(.)/\L$1/;
}
} # end foreach $a (@articles)
foreach $a (@conjunctions)
{
if ( $$word =~ /^$a$/i )
{
$$word =~ s/^(.)/\L$1/;
}
} # end foreach $a (@conjunctions)
foreach $a (@prepositions)
{
if ( $$word =~ /^$a$/i )
{
$$word =~ s/^(.)/\L$1/;
}
} # end foreach $a (@prepositions)
foreach $a (@uppers)
{
if ( $$word =~ /^[^A-Za-z0-9]*$a$/i )
{
$$word =~ s/^([^A-Za-z0-9]*)(.)/\U$1$2/;
}
} # end foreach $a (@uppers)
foreach $a (@lowers)
{
if ( $$word =~ /^[^A-Za-z0-9]*$a$/i )
{
$$word =~ s/^([^A-Za-z0-9]*)(.)/\L$1$2/;
}
} # end foreach $a (@lowers)
} # end else[ if ( $i == 0 || $i == ...
} # end for ( $i = 0 ; $i < @words...
$words = join ( ' ', @words );
return $words;
} # end sub capitalizeTitle
.
Previous Topic
Index
