RockBox iPod Organization

These are a few of the more interesting scripts I use to organize my RockBox iPod. They're all located on the iPod, too, so it makes use of Perl's cross-platform aspects. In terms of actual use, these are some of my most-successful scripts.

split.pl

This script splits a large playlist into smaller parts, named after the artist of the tracks in the playlist. Due to some of my collection having corrupt tags, it output a lot of errors when actually running, but redirecting stdout preserved the useful lines (if I recall correctly).

#!/usr/bin/perl -w
use strict;
use utf8;
use MP3::Tag;
use Ogg::Vorbis::Header::PurePerl;
use Audio::FLAC::Header;
scalar @ARGV >= 2 || die "Usage: $0 source.m3u rootdir/\n";

my %artists;
my ($infile, $rootdir) = (shift @ARGV, shift @ARGV);
open(FILE, "<$infile");
my @lines = <FILE>;
chop(@lines);
close(FILE);
foreach my $file (@lines) {
my %data;
if($file =~ /\.ogg$/i) {
%data = ogginfo("$rootdir/$file");
$data{filename} = $file;
}
elsif($file =~ /\.mp3/i) {
%data = mp3info("$rootdir/$file");
$data{filename} = $file;
}
elsif($file =~ /\.flac/i) {
%data = flacinfo("$rootdir/$file");
$data{filename} = $file;
}
else {
print "Unknown file type: $file\n";
}
if(!$data{artist}) {
defined $artists{uncategorized} and push(@{$artists{uncategorized}}, $file) or ($artists{uncategorized} = [ $file ]);
}
else {
defined $artists{$data{artist}} and push(@{$artists{$data{artist}}}, $file) or ($artists{$data{artist}} = [ $file ]);
}
}
mkdir('Artists');
foreach my $artist (keys %artists) {
open(FILE, ">Artists/$artist.m3u");
print FILE "$_\n" foreach(@{$artists{$artist}});
close(FILE);
}








sub mp3info {
my $mp3file = shift;
my $mp3 = MP3::Tag->new($mp3file);
my %data;
defined $mp3 || return %data;
$mp3->get_tags();
if(defined $mp3) {
if(exists $mp3->{ID3v2}) {
$data{filename} = $mp3file;
$data{artist} = $mp3->{ID3v2}->artist;
$data{title} = $mp3->{ID3v2}->title;
$data{album} = $mp3->{ID3v2}->album;
$data{genre} = $mp3->{ID3v2}->genre;
}
elsif(exists $mp3->{ID3v1}) {
$data{filename} = $mp3file;
$data{artist} = $mp3->{ID3v1}->artist;
$data{title} = $mp3->{ID3v1}->title;
$data{album} = $mp3->{ID3v1}->album;
$data{genre} = $mp3->{ID3v1}->genre;
}
}
return %data;
}
sub flacinfo {
my $flacfile = shift;
my %data;
my $flac = Audio::FLAC::Header->new($flacfile);

my %tags = %{$flac->tags()};
if(scalar %tags) {
$data{filename} = $flacfile;
$data{artist} = $tags{ARTIST};
$data{title} = $tags{TITLE};
$data{album} = $tags{ALBUM};
$data{genre} = $tags{GENRE};
}
return %data;
}
sub ogginfo {
my $oggfile = shift;
my $ogg = Ogg::Vorbis::Header::PurePerl->new($oggfile);
my %data;
if(defined $ogg) {
$data{filename} = $oggfile;
$data{artist} = '';
$data{title} = '';
$data{album} = '';
$data{genre} = '';
foreach my $t($ogg->comment("ARTIST")) {
$data{artist} = $t;
}
foreach my $t($ogg->comment("TITLE")) {
$data{title} = $t;
}
foreach my $t($ogg->comment("ALBUM")) {
$data{album} = $t;
}
foreach my $t($ogg->comment("GENRE")) {
$data{genre} = $t;
}
}
return %data;
}

sort-multi.pl

The multi-album version of my playlist-sorting script. The original sort script isn't very interesting.

#!/usr/bin/perl -w
use strict;
use utf8;
use File::Basename;

my $sortmode = 'normal';

scalar @ARGV || die "Usage: $0 [ sortmode ] playlist\n";
my $pls;
if(scalar @ARGV > 1) {
($sortmode, $pls) = @ARGV;
$sortmode eq 'normal' || $sortmode eq 'collated' || ($sortmode = 'normal');
}
else {
$pls = shift @ARGV;
}
-e $pls || die "No such file: $pls\n";

open(FILE, "<$pls") || die "Unable to open file\n";
my @lines = <FILE>;
chop(@lines);
close(FILE);
my %sorted;
foreach my $line(@lines) {
my $file = basename($line);
my $album = basename(dirname($line));
($sorted{$album} = { }) if(!$sorted{$album});
$file =~ /^([0-9]+) -/;
${$sorted{$album}}{$1} = $line;
}
open(FILE, ">$pls") || die "Unable to open file";
if($sortmode eq 'normal') {
foreach(sort keys %sorted) {
my $rsubsorted = $sorted{$_};
if($rsubsorted) {
my %subsorted = %{$rsubsorted};
foreach my $key(sort keys %subsorted) {
print FILE "$subsorted{$key}\n" || die "Unable to write to file\n";
}
}
}
}
elsif($sortmode eq 'collated') {
my $maxlen = 0;
foreach(keys %sorted) {
my $rsubsorted = $sorted{$_};
if($rsubsorted) {
my $len = scalar keys(%{$rsubsorted});
$len > $maxlen && ($maxlen = $len);
}
}
for(my $i = 1; $i <= $maxlen; $i++) {
foreach(keys %sorted) {
my $rsubsorted = $sorted{$_};
if($rsubsorted) {
my %subsorted = %{$rsubsorted};
my $str = sprintf('%02d', $i);
$subsorted{$str} && (print FILE "$subsorted{$str}\n" || die "Unable to write to file\n");
}
}
}
}
close(FILE);

check-repair.pl

A script to check the existence of each file in the playlist, then suggest fixes based on similar album tracks. The plain checking script isn't very interesting, either.

#!/usr/bin/perl
use strict;
scalar @ARGV|| die "Usage: $0 m3ufile\n";
my $pls = shift @ARGV;
open(FILE, "<$pls");
my @files = <FILE>;
close(FILE);
chomp(@files);
my $len = scalar @files;
for(my $q = 0; $q < $len; $q++) {
my $file = $files[$q];
my $realfile = "/mnt/ipod/$file";
if(!-e "$realfile") {
print "NOT FOUND: $realfile\n";
if($file =~ /^(\/Music\/[^\/]+)\/([0-9]+)[ -]+(.*)\.(flac|ogg)/) {
my ($realdir, $track, $title, $ext) = ("/mnt/ipod/$1", $2, $3, $4);
if(-e "$realdir") {
my @found;
if($realdir =~ /\s/) {
@found = <"$realdir"/$track*>;
}
else {
@found = <$realdir/$track*>;
}
if(scalar @found) {
print "Closes matches are:\n";
my $slen = scalar @found;
for(my $i = 1; $i <= $slen; $i++) {
print "\t$i: " . $found[$i - 1] . "\n";
}
my $good = 0;
my $ans = 1;
do {
$good = 0;
print "Invalid number\n" if($ans > $slen);
print 'Replace with # (0 to skip):';
my $ans = <>;
$good = 1 if($ans > 0);
} while($ans > $slen);
if($good) {
my $foo = $found[$ans - 1];
$foo =~ s/^\/mnt\/ipod\///;
$files[$q] = $foo;
}
else {
print "Skipping\n";
}
}
else {
print "No matches found; skipping\n";
}
}
else {
print "No such directory: $realdir\n";
}
}
else {
print "Unable to repair\n";
}
}
}
open(FILE, ">$pls");
print FILE "$_\n" foreach(@files);
close(FILE);