Convert .m4a files to .mp3 format (with tags)

A Perl utility I wrote to convert .m4a files to .mp3 format. It will also pull the tags over from m4a format. If there are no m4a tags, the script will die. (But of course you can just comment that part out.)

Here is the direct link to the script: m4a2mp3.pl

Note: I’ve updated the code to reflect my more current programming style. If I had time to re-do this, I’d have used IPC::Open3 or something else for IPC, instead of the system call used.


#! /usr/bin/perl
#
# name: m4a2mp3.pl
# description: Convert m4a file to mp3 format. Attempts to convert tags.
# developer: Nathan G. Marley
# date: 2011Sep10
# ========================================================================

use strict;
use warnings;
use feature qw(say);
use Carp;
use MP4::Info;
use MP3::Tag;
use Getopt::Long;

if ( !@ARGV ) {
croak("usage: $0 <...>\n");
}

my @m4atags = qw ( YEAR ARTIST GENRE TRACKNUM TIME
TITLE ALBUM ENCODING BITRATE );

sub main {

for my $file ( @ARGV ) {
my $m4atags = get_m4a_tags( $file );
my $mp3file = convert_m4a_2_mp3( $file );
my $rc = tag_mp3_file( $mp3file , $m4atags );
}

}

main();

sub get_m4a_tags {
my $filename = shift;
my $taginfo;

my $tag = get_mp4tag($filename)
or carp("No TAG info");

for my $t ( @m4atags ) {
$taginfo->{ $t } = $tag->{$t};
}

return $taginfo;
}

sub convert_m4a_2_mp3 {
my $m4afile = shift;
my $mp3file;

($mp3file = $m4afile) =~ s/\.m4a$/.mp3/;

if ( -e $mp3file ) {
carp("error: MP3 file '$mp3file' already exists.");
return;
}

my $faad_opts = "-q -o -";
my $lame_opts = "-S -v -V 0";
my $cmd = "faad $faad_opts \"$m4afile\" | lame $lame_opts - \"$mp3file\"";

my $rc = system($cmd) >> 8;
if ( 0 != $rc ) {
croak("error: Couldn't convert m4a file to mp3 format");
}

return $mp3file;
}

sub tag_mp3_file {
my ( $mp3file , $tags ) = (@_)[0,1];

my $mp3 = MP3::Tag->new($mp3file);

# scan file for existing tags
$mp3->get_tags;

if (exists $mp3->{ID3v1}) {
$mp3->{ID3v1}->remove_tag;
$mp3->new_tag("ID3v1");
}

if (exists $mp3->{ID3v2}) {
$mp3->{ID3v2}->remove_tag;
$mp3->new_tag("ID3v2");
}

$mp3->title_set ( $tags->{TITLE} );
$mp3->artist_set( $tags->{ARTIST} );
$mp3->album_set ( $tags->{ALBUM} );
$mp3->year_set ( $tags->{YEAR} );
$mp3->genre_set ( $tags->{GENRE} );
$mp3->track_set ( $tags->{TRACKNUM} );

$mp3->update_tags(); # Commit to file
$mp3->close();

return;
}

spicnspan.pl – “clean up” text files

At times I get tired of editing code with tabs. And by “at times”, I mean every time. I hate tabs in code. I hate trailing spaces in code too (makes it more difficult to navigate using vi/vim). And more than anything, I hate Windows CR/LF (carraige return/line feed) line terminator characters.

So I wrote a script to take care of it. I call it “spicnspan”. To use: spicnspan

Simple enough.

This script:

  • Converts all tab chars in a text file to 4 spaces.
  • Converts Windows-style CR/LF line terminators to UNIX newline chars (0x0a).
  • Removes trailing spaces.

If I were to re-code this, I would allow for multiple filenames on the command-line. I would also make separate smaller functions, one each for:

1. Slurping the file data
2. “Fix” ing (i.e. remove spaces, etc) the file data
3. Writing the file back to disk.

This is done now. The code below has been updated to reflect these changes, as well as the direct link.

Here’s a direct link to the code (save as .pl on your computer, or whatever you want if you have a real OS):

spicnspan


#! /usr/bin/perl
#
# name: spicnspan
# description: Removes tab chars (converts to 4 spaces) & trailing spaces
# from code.
# developer: Nathan G. Marley
# date: 2010Ene19
#
# change history:
# ========================================================================
# description: change description placeholder
# developer: developer name goes here
# date: YYYYMmmDD
# ========================================================================

use strict;
use Data::Dumper;
use File::Basename;
use Carp;

# boilerplate
my $progname = basename($0);
my $usage = "usage: $progname ...";

# main section
foreach my $filename ( @ARGV ) {

# slurp file data
my $indata = &slurp_file( $filename );

# clean file data
my $outdata = &scrub_data( $indata );

# write file data to disk
&write_file( $filename, $outdata );

}

# subroutines...

sub slurp_file() {
my $codefile = shift;
my $data;

if ( ! -f $codefile ) {
print STDERR "error: '$codefile' doesn't exist or not a regular file.\n";
}

open(IN, "< $codefile") or die "Can't open '$codefile': $!"; { local undef $/; $data = ; }
close(IN);

return $data;
}

sub scrub_data() {
my $indata = shift;
my $outdata = $indata;

# strip Windows-style linefeeds
$outdata =~ s%\x0d%%g;

# convert all tabs to 4 space chars
$outdata =~ s%\t% %g;

# remove any trailing spaces
$outdata =~ s% +\n%\n%g;

return $outdata;
}

sub write_file( $codefile, $outdata ) {
my ( $codefile , $outdata ) = (@_)[0,1];
open(OUT, "> $codefile") or die "Can't open '$codefile' for writing: $!";
print OUT $outdata;
close(OUT);
}

CPAN changing permissions on OSX

some Perl code
some Perl code

If you are looking for a Perl module to interface with Amazon’s S3 hosting service, do not use the Net::Amazon::S3 module. It has an unrealistically huge list of modules on which it’s dependent (one of which is more like a framework — a pain in itself) and you’ll likely never get it installed. The Amazon::S3 module by Timothy Appnel installs without a hitch, and it was based on an earlier version of the Net::Amazon::S3 module.

So apparently something in CPAN on OSX 10.6 (Perl version 5.10.0) causes it to change permissions of the /usr/bin/cpan script, not only removing the executable bit for all, but also setting the write bit (not good).

This results in the common “permission denied” message when someone trys to run CPAN to install some Perl modules:


[root@lorien ~]# cpan
-bash: /usr/bin/cpan: Permission denied

For the uninitiated, this permission change will render your CPAN installation completely vulnerable to anyone who logs in (or breaks in) to the system, even standard “normal” user accounts.

You can run this find statement to show all files in a directory (including subdirectories) that are world-writeable:
find . -perm -o+w

In the example below, I’ve paired this with the “exec” argument using ‘ls’ to show the permissions and inode number of each file.


[root@lorien bin]# find . -perm -o+w -exec ls -ldi {} \;
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./c2ph
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./corelist
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./cpan
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./cpan2dist
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./cpanp
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./cpanp-run-perl
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./dprofpp
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./enc2xs
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./find2perl
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./h2ph
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./h2xs
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./libnetcfg
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./perlbug
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./perlcc
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./perldoc
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./perlivp
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./perlthanks
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./piconv
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./pl2pm
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./pod2html
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./pod2latex
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./pod2man
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./pod2text
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./pod2usage
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./podchecker
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./podselect
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./psed
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./pstruct
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./ptar
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./ptardiff
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./s2p
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./shasum
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./splain
2491453 -rw-rw-rw- 34 root wheel 807 2009-06-24 02:42 ./xsubpp

As you can see from the output, there are a lot of files that were affected, but you can also see from the inode number that they are all hard links to the same file (good in this case). So, we fix the permissions on one file and we fix them all.


[root@lorien bin]# chmod 0755 cpan
[root@lorien bin]# ls -ld cpan
-rwxr-xr-x 34 root wheel 807 2009-06-24 02:42 cpan
[root@lorien bin]# find . -perm -o+w -exec ls -ldi {} \;
[root@lorien bin]#

Life is good again. (Note: this will fix the problems, but not the root cause. I’m too lazy to start looking into CPAN itself to find the root cause, so… I’ll leave it to the smart guys who actually write the code for CPAN to figure that one out.)

And in case you are wondering, yes, my computer’s name is Lorien. What can I say? I’m a LotR nerd. Not too unusual for us techie types.

basic Perl log function

I believe any good Perl utility should have a log to which pertinent information should be written. I’m not even going to go over the merits of having a log file, but all good scripts should have one.

Setup – Define the Function and Log Filename

Here’s the log function which I use in my Perl scripts. This could easily be exported to a log module. Yes, I realize there are probably a lot of good logging modules out there already, I’m just offering this for the lazy sods who don’t currently log anything in their Perl scripts, but realize that it’s a good idea to start.

my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$mon  += 1; $wday += 1; $year += 1900;
my @months = qw { Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec };
unshift @months , '';


my $date = sprintf "%04d%03s%02d" , $year , $months[$mon] , $mday ;
my $logfile = "/tmp/$progname.$date.log";

open( LOGFILE , ">> $logfile" )
    or die "Can't open file '$logfile'. $!\n";
select((select(LOGFILE), $| = 1)[0]); # autoflush LOGFILE

sub logh() {
    my $msg = shift(@_);
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
    $mon  += 1; $wday += 1; $year += 1900;

    my @months = qw { Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec };
    my $dts;
    $dts = sprintf("%04d%3s%02d %02d:%02d:%02d",
                   $year,$months[$mon],$mday,$hour,$min,$sec);
    my $pid = $$;
    printf LOGFILE ("$dts:$pid: $msg\n" , @_);
}

I’ve actually included a bit more than just the log function – a few more lines to show how I set up the log filename. I like to create a daily log and assume the script I’m writing will eventually be run from a cron job or something.

Logging Strings – Calls to the logh() subroutine

This is the reason for all the setup — the actual log strings. Because of the way the arguments to the logh() function are utilized,
printf-style strings & arguments can be sent to the function. Here are some example calls to the logh function (pulled directly from a live production script):

I generally start out with the first line in the examples below (I always have a script global called “$progname”).

&logh("$progname started");
&logh("site '$store_nbr' not found in DB. adding site.");
&logh("all data matches for site '$store_nbr': nothing to do.");
&logh("adding site $store_nbr to db");
&logh("updating '$k' to '$v' for store $store_nbr in db");

Close It Out

Though it’s not really necessary these days, it’s good practice to actually close the file at the end of your script. I like to include the block below to close out the log file.

&logh("$progname ended");
my $line = '='x72;
&logh("$line");
close( LOGFILE );