[Ifp-driver-common] Syncronizing PERL script -- Have fun

[David O. <da...@od...>]

This script syncronizes an XMMS playlist (or a file containing a list of
iles for that matter..) and your IRiver device.

Comments & suggestions are welcome--

-----------------------------CUT-HERE----------------------------------
#!/usr/bin/perl -w
#
# Synchronizes an XMMS playlist with an IRiver device
#
# Usage: sync_iriver.pl [playlist.m3u [heading dir]]
# 
# Distributed under the GNU GPL <http://www.gnu.org/copyleft/gpl.html>
#             by David Obadia <da...@ob...>
# 
# WARNING: This program *WILL DELETE EVERYTHING* from your IRiver device
# that is not listed in your playlist. I recommend backing up what's on
# there in case you don't have a copy.
# 
# Point $playlist to your playlist file and $heading_dirs should be the
# number of "heading directories" that you want to exclude.
# 
# So if you have /home/user/mp3/genre/album/artist/tune.mp3 and you only
# want to see album/artist/tune.mp3 on the IRiver device, you should
# set $heading_dirs to 4 (1 home, 2 user, 3 mp3, 4 genre)
# 
# Have fun synchronizing!
# 
# DISPLAIMER: NO WARRANTY ... BLABLA ... DELETE FILES ... BLABLA ... NOT
#   RESPONSIBLE ... BLABLA ... CUT YOUR LEG ... BLABLA ... DON'T COME
#   CRYING TO ME.

use strict;
use FileHandle;

STDOUT->autoflush(1);

my $playlist = (shift or ($ENV{'HOME'} . '/.xmms/iriver.m3u'));
my $heading_dirs = (shift or 4);    # 1 home 2 david 3 mp3 4 [genre]

die if system('ifp', 'battery');
my $files = list_local_files();
cleanup_dir($files, '');
upload_dir($files,  '');

# What do we need to keep/upload
sub list_local_files
{
   my $files = {};
   my $fh = new FileHandle $playlist or die $!;
   while (my $file = <$fh>)
   {
      chomp $file;
      next if $file =~ /^\#/;
      my @tree = split ("/", $file);
      for (my $i = 0; $i <= $heading_dirs; $i++)
      {
         shift @tree;
      }
      my $cursor = $files;
      while (my $next = shift @tree)
      {
         $next =~ s/:/,/;
         if (scalar @tree > 0)
         {
            unless (defined($cursor->{$next}))
            {
               $cursor->{$next} = {};
            }
            $cursor = $cursor->{$next};
         }
         else
         {
            $cursor->{$next} = $file;
         }
      }
   }
   return $files;
}

# Delete what we don't want to keep
sub cleanup_dir
{
   my $cursor  = shift;
   my $dir     = shift;
   my $content = ifp_ls($dir);

   print "Cleaning up '$dir'\n";
   foreach my $element (sort keys %$content)
   {
      my $name = $dir . '/' . $element;
      $name =~ s/:/,/g;
      next if $name eq '/RECORD' or $name eq '/VOICE';

      if (defined($cursor->{$element}))
      {
         if ($content->{$element} eq 'd')
         {
            cleanup_dir($cursor->{$element}, $dir . '/' . $element);
            $cursor->{$element}->{'NO_MKDIR'} = 1;
         }
         else
         {
            delete $cursor->{$element};
         }
      }
      else
      {
         if ($content->{$element} eq 'd')
         {

            print "Deleting $name/\n";
            system('ifp', 'rm', '-r', $name) and die;
         }
         else
         {
            print "Deleting $name\n";
            system('ifp', 'rm', $name) and die;
         }
      }
   }
}

# upload what we want
sub upload_dir
{
   my $cursor = shift;
   my $dir    = shift;

   print "Syncronizing '$dir'\n";
   foreach my $element (sort keys %$cursor)
   {
      my $name = $dir . '/' . $element;
      $name =~ s/:/,/g;
      if (ref $cursor->{$element})
      {
         if ($cursor->{$element}->{'NO_MKDIR'})
         {
            delete $cursor->{$element}->{'NO_MKDIR'};
         }
         else
         {
            print "Creating directory: $name\n";
            system('ifp', 'mkdir', $name) and die;
         }
         upload_dir($cursor->{$element}, $dir . '/' . $element);
      }
      else
      {
         print "Uploading: '$name'\n";
         system('ifp', 'upload', $cursor->{$element}, $name) and die;
      }
   }
}

# returns a hash name->type withinn directory $dir
sub ifp_ls
{
   my $dir = shift;
   $dir =~ s/\'/\\\'/g;
   my $fh      = new FileHandle "ifp ls '$dir' |";
   my %content = ();
   while (my $line = <$fh>)
   {
      chomp $line;
      $line =~ s/^(.)\s+//;
      my $type = $1;
      $line =~ s/\s+\(size \d+\)$//;
      $content{$line} = $type;
   }
   return \%content;
}
-----------------------------CUT-HERE----------------------------------

-- 
David Obadia
da...@od...