###############################################################################
#
# itunes_update_location.pl
#
# This script will allow a user to move tracks between file paths.  This is 
# especially handy for users that have imported external libraries into their
# iTunes library but later want to move those files to a new location.
#
# This script can filter the list of files to move to those whose file path 
# matches a user-supplied pattern (regex).	 Each unique path is printed and 
# the user then may select one of the unique paths to move.  Unique paths are 
# any paths that are different from more than the last 2 subdirectories.  This 
# may not work for all sources since it assumes the file structure resembles
# artist / album / song.
#
# written by: Michael Stovenour (http://www.stovenour.net)
# Copyright (C) 2009 Michael Stovenour
#
# Based on itunes_find_by_location.pl
# written by: Robert Jacobson (http://mysite.verizon.net/teridon/itunesscripts)
# Original Copyright (C) 2007	Robert Jacobson
#
# This script is GPL v2.	see http://www.gnu.org/copyleft/gpl.html
#
###############################################################################

use File::Basename;
use File::Spec;
use File::Copy;
use File::Path;
my $PROGNAME = basename($0);
my $VERSION = "1.0";
my $AUTHOR = "Michael Stovenour";
my $HOMEPAGE = "http://www.stovenour.net";
my $YEAR = 2009;
my $GNU_URL = "http://www.gnu.org/copyleft/gpl.html";

{
	print
	"**************************************************************\n" .
	"$PROGNAME version $VERSION, Copyright (C) $YEAR $AUTHOR\n" .
	"Visit $HOMEPAGE for updates\n" . 
	"$PROGNAME comes with ABSOLUTELY NO WARRANTY;\n".
	"This is free software, and you are welcome\n" .
	"to redistribute it under certain conditions\n" .
	"for details see $GNU_URL.\n" .
	"**************************************************************\n" .
	"\n"
	;
}

use strict;
use Win32::OLE;

# Create a signal handler to destroy the iTunes object
# in case our program quits before the end
use sigtrap 'handler', \&quit, 'normal-signals';

## Create the OLE Object
my $iTunes = Win32::OLE->new('iTunes.Application') or die Win32::OLE->LastError();

print "Enter regular expression pattern to search for ( . for all): ";
chomp (my $pattern = <STDIN>);
print "\n";

# For the main library source list each unique path assuming the last 
# three items are non-unique (e.g. artist\album\song.ext)
my %paths;
my $playlist = $iTunes->LibraryPlaylist();
my $playlist_name = $playlist->Name();
my $tracks = $playlist->Tracks;
my $num_tracks = $tracks->Count();
print "Selected $playlist_name with $num_tracks tracks\n";
# Get all the tracks in the primary playlist
print "Please wait; building a list of matching tracks for this source\n";
for (my $k = 1 ; $k <= $tracks->Count ; $k++ ) {
    my $track = $tracks->Item($k);
    my $track_kind = $track->Kind();
    
    if ($track_kind == 1) { # File
        my $songname = $track->Name();
        my $artist = $track->Artist();
        my $path = $track->Location();
		if ($path =~ /$pattern/) {
#            print "Matched ->\t";
#            print $artist . "::" . "$songname\n";
#            print "$path\n";
            my @dirs = File::Spec->splitdir( $path );
            my @trackBasePath;
            for (my $i = 0 ; $i <= scalar(@dirs)-4 ; $i++ ) {
                push(@trackBasePath, $dirs[$i]);
            }
            #print join('^',@trackBasePath) . "\n";
            my $trackBasePath = File::Spec->catdir( @trackBasePath);
            $paths{$trackBasePath}++;
        }
    }
}
print "\n\n";
print "Found " . scalar(keys(%paths)) . " unique paths for tracks.\n";
if( scalar(keys(%paths)) == 0) {
    print "No matching files were found\n";
    quit();
}

print "Number\tTracks\tTrack Path\n";
my @paths;
my $n = 1;
foreach my $trackPath (sort(keys(%paths))) {
	print "$n\t". $paths{$trackPath} . " -\t" . $trackPath . "\n";
	$paths[$n] = $trackPath;
	$n++;
}


print "Enter path number to update: ";
chomp (my $pathNum = <STDIN>);
my $pathOld = $paths[$pathNum];

print "Enter the new location path: ";
chomp (my $pathNew = <STDIN>);

print "Should the tracks be copied, moved, or neither (C, M, N): ";
chomp (my $pathAction = <STDIN>);

print "\nI am about to update iTunes using the following information\n";
print "--Replace path:\n" . $pathOld . "\n";
print "--With new path:\n" . $pathNew . "\n";
if( uc($pathAction) eq 'C') {
    print "--Copying files from the old location to the new location\n";
} elsif( uc($pathAction) eq 'M') {
    print "--Moving files from the old location to the new location\n";
} else {
    $pathAction = 'N';  #Force default Neither
    print "--Do not update tracks that are not found in the new location\n";
}
print "\n";
print "Are you sure you want to continue? (Y/N): ";
chomp (my $YN = <STDIN>);
quit() if( uc($YN) ne 'Y');



print "Please wait; changing the location of matching tracks\n";
my $success;
for (my $k = 1 ; $k <= $tracks->Count ; $k++ ) {
    my $track = $tracks->Item($k);
    my $track_kind = $track->Kind();
    
    if ($track_kind == 1) { # File
        my $songname = $track->Name();
        my $artist = $track->Artist();
        my $path = $track->Location();
        if ($path =~ /$pattern/) {
#            print "Matched ->\t";
#            print $artist . "::" . "$songname\n";
#            print "$path\n";
            
            if( substr($path, 0, length($pathOld)) eq $pathOld) {
                my $pathRelative = substr($path,length($pathOld));
#                print "Updating: \n";
#                print "     pathOld: $pathOld\n";
#                print "     pathNew: $pathNew\n";
#                print "pathRelative: $pathRelative\n";
                print "\n";
                print "    Original: " . $path . "\n";
                print " Replacement: " . $pathNew . $pathRelative . "\n";
                
                $success = 1;
                if( ! -e $pathNew . $pathRelative) {
                    if( $pathAction eq 'N') {
                        #Fail the update
                        $success = 0;
                        print "Error!!  File does not exist.  It will not be updated.\n";
                    } else {
                        
                        #Need to create the entire directory tree
                        my @dirs = File::Spec->splitdir( $pathNew . $pathRelative);
                        my $pathSoFar;
                        for (my $i = 0 ; $i <= scalar(@dirs)-2; $i++ ) {
                            $pathSoFar = File::Spec->catdir(@dirs[0..$i]);
                            if( ! -d $pathSoFar) {
                                $success = mkdir $pathSoFar;
                                if(!$success) {
                                    print "mkdir error: " . $! . "\n";
                                    last;
                                }
                            }
                        }
                        
                        
                        if( $success and $pathAction eq 'C') {
                            #Copy the file from the old location
                            $success = copy($path, $pathNew . $pathRelative);
                            print "copy error: " . $! . "\n" if(!$success);
                        } elsif( $success and $pathAction eq 'M') {
                            #Move the file from the old location
                            $success = move($path, $pathNew . $pathRelative);
                            print "move error: " . $! . "\n" if(!$success);
                        }
                    }
                }
                
                #ok now actually update the track...   I can't watch.....
                if( $success) {
                    $track->{'Location'} = $pathNew . $pathRelative;
                }
            }
        }
    }
}


# Destroy the object.	 Otherwise zombie object will come back
# to haunt you
quit();

sub quit 
{
	# This destroys the object
	undef $iTunes;
	exit;
}