############################################################################### # # 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 = ); 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 = ); my $pathOld = $paths[$pathNum]; print "Enter the new location path: "; chomp (my $pathNew = ); print "Should the tracks be copied, moved, or neither (C, M, N): "; chomp (my $pathAction = ); 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 = ); 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; }