#!/usr/local/bin/perl -w
# $Id: pmv,v 1.6 2003/12/12 06:30:10 ianb Exp $
# ianb@nessie.mcc.ac.uk 20011126
# Rewrite, first version is on an inaccessible computer down south somewhere
# 20031106: cleaned up and documented for mp3-archive-tools

use strict;
use Cwd;

my $me=($0=~/(?:.*\/)?(.*)/)[0];
my $verbose=0;
my $dryrun=0;
my $mkdir=0;
my $rmdir=0;
my $doneopts=0;
my $donesomething=0;
my $begin=undef;
my $end=undef;

while(($#ARGV>=0) && ($ARGV[0]=~/^\-/) && (!$doneopts))
{
	my $arg=shift(@ARGV);
	if($arg=~/^\-v/)     { $verbose=1;  }
	elsif($arg=~/^\-q/)  { $verbose=0;  }
	elsif($arg=~/^\-d/)  { $dryrun=1;   }
	elsif($arg=~/^\-m/)  { $mkdir=1;    }
	elsif($arg=~/^\-r/)  { $rmdir=1;    }
	elsif($arg=~/^\-M/)  { $mkdir=1; $rmdir=1; }
	elsif($arg=~/^\-b/)  { usage() unless($#ARGV>=0); $begin=shift(@ARGV); }
	elsif($arg=~/^\-e/)  { usage() unless($#ARGV>=0); $end  =shift(@ARGV); }
	elsif($arg=~/^\-\-/) { $doneopts=1; }
	elsif($arg=~/^\-h/)  { usage();     }
}

my $code=shift;

usage() unless(defined($code));

if(defined($begin))
{
	$donesomething=1;
	no strict;
	eval($begin);
	use strict;
	die("$me: error in -b code: $@\n") if $@;
}

while($#ARGV>-1)
{
	$donesomething=1;
	my $oldfile=shift;
	$_=$oldfile;
	
	unless(-e $oldfile)
	{
		warn("$me: $oldfile: file not found\n");
		next;
	}

	my $file=$oldfile;
	my($path,$name)=splitpath($file);

	my $oldpath=$path;
	my $oldname=$name;
	
	no strict;
	eval($code);
	use strict;
	die("$me: error in perl code: $@\n") if $@;

	if($file ne $oldfile)
	{
		$_=$file;
	}
	elsif(($path ne $oldpath) || ($name ne $oldname))
	{
		$_="$path/$name";
	}
	# else we use $_

	($path,$name)=splitpath($_);

	# allow for $_ sprouting full path
	if(($oldfile eq $_) ||
	   (($oldpath eq $path) && ($oldname eq $name)))
	{
		print "$me: $_: filename not changed - skipping\n" if($verbose||$dryrun);
		next;
	}

	if($mkdir && !$dryrun)
	{
		my($path,$name)=splitpath($_);
		if($path ne $oldpath)
		{
			next unless(mkdirs($path));
		}
	}
	
	if(-f $_)
	{
		warn("$me: $_: not renaming: file exists\n");
		next;
	}
	
	print "$oldfile -> $_\n" if($verbose || $dryrun);
	unless($dryrun)
	{
		rename($oldfile,$_) or warn("$me: could not rename $oldfile to $_: $!\n");
	}

	if($rmdir && !$dryrun)
	{
		if($path ne $oldpath)
		{
			rmdirs($oldpath);
		}
	}
}

if(defined($end))
{
	$donesomething=1;
	no strict;
	eval($end);
	use strict;
	die("$me: error in -e code: $@\n") if $@;
}

usage() unless($donesomething);

# canonicalises path and returns (pathpart,filename)
sub splitpath
{
	my $file=shift;
	my($path,$name);
	if($file=~/(.*)\/(.*)/)
	{
		$path=Cwd::abs_path($1);
		$name=$2;
	}
	else
	{
		$path=getcwd;
		$name=$file;
	}
	return($path,$name);
}

# makes any necessary directories
sub mkdirs
{
	my @dirs=split(/\//,$_[0]);
	my $path="";
	if($dirs[0] eq "") { shift(@dirs); } # caused by leading /

	# loop, adding a component each time
	while(my $dir=shift(@dirs))
	{
		$path .= "/$dir";
		if(-f $path)
		{
			warn("$me: cannot mkdir $path: is a file\n");
			return 0;
		}
		elsif(!-d $path)
		{
			print "$me: mkdir $path\n" if($verbose||$dryrun);
			
			unless(mkdir($path))
			{
				warn("$me: cannot mkdir $path: $!\n");
				return 0;
			}
		}
	}
	return 1;
}

sub rmdirs
{
	my @dirs=split(/\//,$_[0]);

	# easiest way: try and rmdir everything and ignore errors
	do
	{
		my $path = join("/",@dirs);
		rmdir($path);
	} while(pop(@dirs));
}

sub usage
{
	die("Usage: $me [-vqdmMr] [-b startcode] [-e endcode] 'perl that modifies \$_' files...\n".
		"Renames files according to perl code, analogous to 'perl -pe'\n".
		" -v\t\tVerbose.\n".
		" -q\t\tQuiet (default).\n".
		" -d\t\tDry run (just show what it would do).\n".
		" -m\t\tMake directories if necessary.\n".
		" -r\t\tRemove empty directories.\n".
		" -M\t\tSame as -m -r.\n".
		" -b startcode\tPerl code to run before processing files.\n".
		" -e endcode\tPerl code to run after processing files.\n".
		" -h\t\tThis help.\n".
		" --\t\tEnd of options.\n");
}

__DATA__

=head1 NAME

pmv - rename files according to perl code

=head1 SYNOPSIS

B<pmv> [I<-vqdmMrh>] [I<-b startcode>] [I<-e endcode>] [I<-->] I<'perl code'> I<E<lt>files...E<gt>>

=head1 DESCRIPTION

pmv allows you to manipulate filenames based on arbitrary perl
code. Think of it like B<perl -pe> but operating on the filename
instead of the file contents. It is useful for renaming large numbers
of files according to arbitrary criteria.

In the code you write, B<$_> is set to the current filename, and you
should change B<$_> to what you want the new filename to be.
This enables you to write quick oneliners like:

	pmv 's/$/.bak/;' *

If you want more control, there are three variables defined:

=over 4

=item B<$file>

Same as B<$_>, the filename passed in on the command line.

=item B<$path>

The full pathname, without the filename.

=item B<$name>

The filename, without any path components.

=back	

You can alter any of these variables to get the same effect as
altering B<$_>. Which to use is determined as follows:

=over 4

=item B<1:>

If B<$file> has been altered, that is used.

=item B<2:>

If B<$path> or B<$name> has been altered, they are joined together
then used.

=item B<3:>

Otherwise, B<$_> is used.

=back

The file F<pmv-examples.sh> contains useful example bourne shell
functions that use pmv. This is available in the source distribution,
and will probably be installed under F</usr/share/doc/mp3-archive-tools/>.

This file can be sourced by (using B<source> or B<.>) or included in
one of your startup files (eg F</etc/profile> or
F<$HOME/.bash_profile> for L<bash(1)> users.

=head1 OPTIONS

=over 4

=item B<-v>

Verbose. 

=item B<-q>

Quiet (no output). This is the default.

=item B<-d>

Dry run. Shows how it would rename files without actually doing it.

=item B<-b> I<startcode>

Specifies perl code to run once before processing files. Useful for
I<use>ing modules and doing one-time initialisation.

=item B<-e> I<endcode>

Specifies perl code to run once after processing files. Useful for
summarising data gathered from filenames.

=item B<-m>

If the pathname has been altered, create any necessary directories.

=item B<-r>

If a file is moved out of a directory, remove any empty directories.

=item B<-M>

Same as B<-m -r>.

=item B<-h>

Show a brief usage summary.

=item B<-->

End of options.

=back

=head1 AVAILABLE FUNCTIONS

If you have sourced F<pmv-examples.sh> (see above>,
the following functions are available:

=over 4

=item B<pmv-stdswap>

Swaps round fields in filenames delimited by " - ".

=item B<pmv-space2_>

converts all spaces in filename to underscores.

=item B<pmv-_2space>

Converts all underscores in filename to spaces.

=item B<pmv-fixcaps>

Crude attempt at capitalising filenames.

=item B<pmv-fixcase>

Much better attempt at capitalising filenames. This requires the
B<Text::Autoformat> module from CPAN (www.cpan.org).

=item B<pmv-number>

Numbers filenames sequentially.

=item B<pmv-deepen>

Converts directoriess from "artist - album" to "artist/album"

=item B<pmv-flatten>

Converts directoriess from "artist/album" to "artist - album"

=item B<pmv-datestamp>

Insert a datestamp in the form YYYYMMDD at the start of the
filename. See below for more details.

=back

=head1 EXAMPLES

=over 4

=item B<Convert all whitespace in all mp3 filenames to underscores>

 pmv 's/\s/_/g;' *.mp3

=item B<Convert the spelling of Color to Colour in all filenames>

 pmv 's/Color/Colour/gi;' *	

=item B<Swap round fields in mp3 filenames>

 pmv '$name=~s/(.*) - (.*) - (.*) - (.*)(\..*)/$3 - $1 - $2 - $4$5/;' *.mp3

This would convert eg:

 Primal Scream - Screamadelica - 04 - Higher Than The Sun.mp3

to:

 04 - Primal Scream - Screamadelica - Higher Than The Sun.mp3	

=item B<Crudely capitalise every word in all filenames>

 pmv  '$name=join(" ",map({ucfirst(lc($_));} split(/\s+/,$name)));' *

See B<pmv-fixcase> in F<pmv-examples.sh> for a better way to
capitalise filenames.

=item B<Add a datestamp to the start of all filenames>

 pmv -b '$d=`date +%Y%d%m`;chomp($d);' '$name = "$d.$name";' *

This adds a datestamp in the form I<YYYYMMDD> (eg 20031214) to the
start of a filename. Files with datestamps in this form will sort in
date order, which is useful for (e.g.) logfiles.

The B<-b> code to get the date is run only once, before the files are
processed.

If you wanted to make this into a shell function, callable by typing
C<pmv-datestamp files>, you would insert the following into your
startup files:

 function pmv-datestamp
 {
     pmv -b '$d=`date +%Y%d%m`;chomp($d);' '$name = "$d.$name";' "$@"
 }

=back

=head1 BUGS

Rather similar (I recently discovered) to rename(1), which ships with
perl. However, pmv provides several features that rename does not have,
and the pmv- shell functions in F<pmv-examples.sh> are useful, so I
decided to add it to the L<mp3-archive-tools(1)> package anyway.

=head1 SEE ALSO    

L<perl(1)>, L<mp3-archive-tools(1)>, L<mp3lint(1)>

=head1 AUTHOR

Ian Beckwith <ianb@nessie.mcc.ac.uk>

=head1 AVAILABILITY

pmv is part of the mp3-archive-tools package.

The latest version can be found at:

B<http://nessie.mcc.ac.uk/~ianb/projects/mp3-archive-tools/>

=head1 COPYRIGHT

Copyright 2003 Ian Beckwith <ianb@nessie.mcc.ac.uk>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at
your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

=cut
