Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
=pod =head1 NAME iPod-backup: reclaim tracks orphaned on an iPod =head1 SYNOPSIS perl ipod-backup.pl -do MODE -out DIR -mnt DRIVE [-top DIR] -out Output directory for any reclaimed files -mnt iPod mount path or drive -top iTunes top-level directory -do perform one of the following operations: stat print iPod vs iTunes statistics (default) sync reclaimed tracks not in iTunes bak backup full iPod =head1 DISCUSSION Man, dont even get me started on a rant about Apple software... When disk files are lost, iTunes helpfully does nothing then silently removes them from your iPod next time you plug it in. While the latter + can be avoided by disabling automatic sync'ing, there is no way to import tracks on the iPod back into iTunes...ho hum This script checks your iPod's database against iTune's and imports an +y tracks not available in iTunes back onto the harddisk. It can also do a full backup of the iPod in a human friendly manner, i +e: /Artist/Album/Track rather than Apple's quirky /F<DIGITS>/<ARBITRARY TRUNCATED FILENAME> =head1 BUGS & CAVEATS This is quick and dirty programming...use at your own risk. In particular, the iPod database is a binary format. Rather than caref +ully reverse engineer by hand, I just weild the Swiss Army Chainsaw and hac +k off what I dont need. Your mileage may vary, as they say. Only tested on Windows XP. Linux requires 2.6 kernel or a FAT32 format +ted iPod. You would probably be better off looking at Gnupod for that. =cut use strict; use utf8; usage() if @ARGV % 2; my %ARGS = @ARGV; my @KEYS = (undef, "Name", "Path", "Album", "Artist", "Genre", "Kind" +, undef, "Comments"); my $TYPE = qr/\.(?:mp3|aux)/i; my @STAT = ("sync'd","iPod","iTunes"); my $IPOD = 1; my $SYNC = 0; my $DISK = -1; my $mode = $ARGS{-do} || "stat"; my $ipod_temp = $ARGS{-out} || "./ipod-temp"; my $ipod_mount = $ARGS{-mnt} || usage(); my $itunes_root = $ARGS{-top}; my $ipod_itunesdb = "$ipod_mount/iPod_Control/iTunes/iTunesDB"; my $ipod_sysinfo = "$ipod_mount/iPod_Control/Device/SysInfo"; my $ipod_music = "$ipod_mount/iPod_Control/Music"; my $itunes_lib = "$itunes_root/iTunes Music Library.xml"; my $itunes_music = "$itunes_root/iTunes Music"; die "'$ipod_itunesdb' does not exist\n" unless -f $ipod_itunesdb; die "'$itunes_root' is not a directory\n" unless !$itunes_root || -d + $itunes_root; die "'$itunes_lib' does not exist\n" unless !$itunes_root || -f + $itunes_lib; if($mode eq "stat"){ stat_ipod($ipod_itunesdb, $itunes_lib); } elsif($mode eq "bak"){ import_ipod($ipod_temp, $ipod_itunesdb); } elsif($mode eq "sync"){ import_ipod($ipod_temp, $ipod_itunesdb, $itunes_lib); } else{ usage(); } # # # sub usage { my $src = fslurp( fopen($0) ); print "\n", $1,"\n\n",$2,"\n\n" if $src =~ /=head1 NAME\s*?(.*?)\s*?=head1 SYNOPSIS\s*?(.*?)\s +*?=head1 DISCUSSION/s; exit 0; } # # Print shared and unique tracks on iPod and iTunes # sub stat_ipod { my $ipod = shift || die "Error: No path to iTunesDB\n"; my $local = shift || die "Error: No path to XML library\n"; my $dup = {}; my ($disk, $pod, $syn); $ipod = parse_itunesdb($ipod); $local = parse_itunes_library($local); $dup->{ $_->{Artist}." - ".$_->{Album}." - ".$_->{Name} }++ foreac +h @$ipod; $dup->{ $_->{Artist}." - ".$_->{Album}." - ".$_->{Name} }-- foreac +h @$local; foreach(sort keys %$dup){ my $s = $dup->{$_}; printf "%-70s %-6s\n", (length $_ < 70) ? $_ : substr($_,0,67) +."...", $STAT[$s]; ($s == $DISK) ? $disk : ($s == $IPOD) ? $pod : $syn += 1; } my $format = "%-6s: %5d / %-5d\n"; print "\n\n"; printf $format, "iPod", $pod, scalar(@$ipod); printf $format, "iTunes",$disk, scalar(@$local); printf $format, "Sync'd",$syn, scalar(@$ipod)+scalar(@$local); } # # Import tracks on an iPod # If $local is provided, only imports those not currently in iTunes # else, imports the lot for backup # sub import_ipod { my $dir = shift || "./ipod-temp"; my $ipod = shift || die "Error: No path to iTunesDB\n"; my $local = shift; my $dup = {}; my @err = (); my $prog = 0; my $totl = 0; $ipod = parse_itunesdb($ipod); $local = parse_itunes_library($local) if $local; $local = [] unless $local; print "(ipod) scanned tracks: ",scalar(@$ipod),"\n"; print "(local) scanned tracks: ",scalar(@$local),"\n"; $dup->{ $_->{Artist}."/".$_->{Album}."/".$_->{Name} } = $_ fore +ach @$ipod; $dup->{ $_->{Artist}."/".$_->{Album}."/".$_->{Name} } = undef fore +ach @$local; (defined $dup->{$_}) ? $totl++ : delete $dup->{$_} foreach(keys %$ +dup); mkdir($dir) unless -d $dir; $|++; foreach(sort keys %$dup) { my $track = $dup->{$_} or next; my $path = $track->{Path}; my $ext = $1 if $track->{Path} =~ /\.(\S+)$/; my $in = "$ipod_mount$track->{Path}"; my $d1 = "$dir/$track->{Artist}"; my $d2 = "$d1/$track->{Album}"; my $out = "$d2/$track->{Name}.$ext"; my $ui = $track->{Artist}." - ".$track->{Album}." - ".$trac +k->{Name}; mkdir($d1) unless -d $d1; mkdir($d2) unless -d $d2; printf "%-11s %-65s", ++$prog."/".$totl, (length($ui) < 60) ? $ui : substr($ui,0,60)."..."; $@ =''; eval{ fcopy($in, $out) unless( -f $out && (stat($in))[7] == (sta +t($out))[7] ); print "ok\n"; }; if($@) { push @err, "$out: $@"; print "--\n"; } } print STDERR "\nErrors:\n"; print @err ? join('\n', @err) : "none", "\n"; } # # BRRRRRRRR!-BRRRRRRR! # sub parse_itunesdb { my $f = fopen(shift); my $s = fslurp($f); my $fields; my @records = (); my $record = {}; foreach( split(/mhod/, $s) ) { my ($eor, $t, $k); next unless length $_; s/\000\000+/ /sgo; s/\000//sgo; # this doesnt work...??? # s/^(..(.).(.).....)//; # $c = escape($1); # $l = chr($2); # $t = $K[ord($3)]; $t = substr($_, 0, 10); $t = $KEYS[ord(substr($t, 4, 5))]; $_ = substr($_, 10, length $_); next if !$t; if($t eq "Path") { $eor++; $_ = $1 if m/^(.*?$TYPE)/; $_ =~ s/:/\//sg; } # TODO: Some final checks for non-printable pathnames... $record->{$t} = $_ ; if($eor) { $record->{Artist} = "Unknown" unless defined $record->{Ar +tist}; $record->{Album} = "Unknown" unless defined $record->{Al +bum}; push @records, $record if defined $record->{Na +me}; $record = {}; } } return \@records; } # # YAHRXP... # sub parse_itunes_library { my $lib = fopen(shift); my $ok = 0; my @records = (); my $record = {}; while(<$lib>) { chomp; last if m/^\s*?<key>Playlists<\/key>/; $ok++ if m/^\s*?<key>Tracks<\/key>/; next unless $ok; if(m/^\s*?<key>(.*?)<\/key><(\S+)>(.*?)<\/\2>/) { $record->{$1} = xml_decode($3) ; } elsif(m/^\s*?<key>(\d+)<\/key>/) { $record->{Artist} = "Unknown" unless defined $record->{Ar +tist}; $record->{Album} = "Unknown" unless defined $record->{Al +bum}; push @records, $record if defined $record->{Na +me}; $record = {}; } } return \@records; } # # decode filename urls in XML # sub url_decode { my $str = shift; $str =~ tr/+/ /; $str =~ s/%(..)/pack("C",hex($1))/eg; return $str; } # # TODO: decode XML-entities in fields # sub xml_decode { my $str = shift; $str =~ s/\&\#(\d+)\;/chr($1)/esg; return $str; } # # # sub fcopy { my $in = shift; my $out = shift; my $buf = shift || 1024; my $fin = fopen($in); my $fout = fopen(">".$out); my ($b, $r, $w); while($r = sysread($fin, $b, $buf)) { $w = syswrite($fout, $b, $r); last if $r < $buf; } } # # # sub fopen { my $path = shift or die "fopen: no path\n"; my $f; open $f,$path or die "$path: $!"; binmode $f; return $f; } # # # sub fslurp { my $f = shift; local $/ = undef; return <$f>; }

In reply to ipod-backup by Ctrl-z

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Domain Nodelet?
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this?Last hourOther CB clients
    Other Users?
    Others chanting in the Monastery: (4)
    As of 2024-07-23 23:32 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      No recent polls found

      Notices?
      erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.