#!/usr/bin/perl ## ## Author: David McKeon <@bonzoli.com> ## URL: http://bonzoli.com ## Program: sort_wmas ## Creation Date: Date: 2007/01/31 17:41:35 GMT ## Last Revision: $Date$ ## Version: v. ## ############################################################################# # David McKeon <@bonzoli.com> http://bonzoli.com # # # # Copyright (C) 2007-2007 David McKeon. All rights reserved. # # # # 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: # # # # Free Software Foundation, Inc. # # 59 Temple Place - Suite 330 # # Boston, MA 02111-1307, USA. # # # # Or you can find the full GNU GPL online at: http://www.gnu.org # # # ############################################################################# ## Category: Perl ## ## ## ## ## # $| = 1; use Getopt::Long; use File::Basename; use File::Find; # Find files and run a process against them use File::Path; # create paths/dirs use Audio::WMA; # Read MS wma tags my $USAGE="Usage: sort_wma [-l target_wma_directory] NOTE: *.wma works \n"; my $file,$wmadir,$debug; if (! $ARGV[0]) { print "$USAGE\n"; exit; } # -d has to be first in command line. if ($ARGV[0] eq '-l') { shift(@ARGV); $wmadir=$ARGV[0]; shift(@ARGV); } else{ $wmadir='.'; } #--------------------------------------------------------------------------- Getopt::Long::Configure("no_ignore_case"); GetOptions( "h|help" => \$help, "V|version" => \$vers, #----------------------- ); #--------------------------------------------------------------------------- if($help){ exec("perldoc $0"); } if($vers){ version(); } #--------------------------------------------------------------------------- #--------------------------------------------------------------------------- sub version { my($date) = "\$Date$_"; my($rvsn) = "\$Revision$_"; my($rcsd) = "\$Id$_"; $date =~ s/(.*: +)(.*?)(\s*$)/$2/g; $rvsn =~ s/(.*: +)(.*?)(\s*$)/$2/g; $rcsd =~ s/(.*: +)(.*?)(\s*$)/$2/g; print < URL: http://bonzoli.com Creation Date: 2007/01/31 17:41:35 PST Last Revision: $date PST Version: v Copyright (C) 2007-2007 David McKeon. All rights reserved. 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: Free Software Foundation, Inc. 59 Temple Place - Suite 330 Boston, MA 02111-1307, USA. Or you can find the full GNU GPL online at: http://www.gnu.org EOF exit; } sub move_to_new_dir { ########################################################################## # FUNCTION DEFINITIONS #------------------------------------------------------------------------- # FUNCTION move_to_new_dir # RECEIVES ($NEWDIR, $NEWFILE, $OLDFILE); # RETURNS new file with path # EXPECTS ($NEWDIR, $NEWFILE, $OLDFILE); # SETS creates new directory when needed, then renames file to that dir # DOES We will make directory and move file to it, if' directory doesn't exist. my $NEWDIR=shift; my $NEWFILE=shift; my $OLDFILE=shift; eval { mkpath("$NEWDIR", 1, 0755) }; if ($@) { print "Couldn\'t create $NEWDIR: $@"; } else { # Create directory worked, moving file now. #print "Moving: mv $OLDFILE $NEWFILE\n"; if (!rename "$OLDFILE", "$NEWFILE"){ print "ERROR: Failed to move $OLDFILE to $NEWFILE!!!!\n"; } else { # if' it worked then return the new file return $NEWFILE; } } # We return old file if we didn't make a good directory return $OLDFILE; } sub shellify_string { ########################################################################## # FUNCTION DEFINITIONS #------------------------------------------------------------------------- # FUNCTION shellify_string # RECEIVES $string # RETURNS $string # DOES Going to make this line readable by shell, so mv's and copies work. # add a backslash before unusual characters my ( $file ); # shouldn't just shift work here? $file = shift @_; #print "my file is $file \n"; #If its not one of these characters put a \ in front of it. $file =~ s|[^-a-zA-Z0-9_.,/]|\\$&|g; # backslash newline gets ignored by sh, so we have to use quotes. $file =~ s|\\\n|'\n'|g; # make sure name doesn't have a leading - $file =~ s|^-|./-|; # null name is unprintable, make it '.' if ($file eq '') { $file = "."; } return $file; } sub sanitize_string { ########################################################################## # FUNCTION DEFINITIONS #------------------------------------------------------------------------- # FUNCTION sanitize_string # RECEIVES string # RETURNS sanitized string # DOES sanitize artist name (or filename fragment) for use as a dir name my $string = shift; return 'unsorted' unless $string; $string = lc($string); $string =~ s/\bthe\b//; $string =~ s/_/ /g; $string =~ s/^ +//; $string =~ s/ +$//; $string =~ s/ +/ /g; $string =~ s/\// /g; $string =~ s/[,(){}\[\]]//g; return $string; } ##### Main ###### foreach $_ (@ARGV) { my $file=$_; my $wmafile=$file; my ($artist, $album, $tag); my ($name,$path,$suffix) = fileparse($file,''); print "\nMY FILE=*$file*\n" if ($debug == 1); my $wma = Audio::WMA->new($file); my $info = $wma->info(); my $tag_wma = $wma->tags(); #print "ALBUMTITLE: $tag_wma->{'ALBUMTITLE'}\n"; #print "YEAR: $tag_wma->{'YEAR'}\n"; #print "TRACK: $tag_wma->{'TRACK'}\n"; #print "RATING: $tag_wma->{'RATING'}\n"; #print "GENRE: $tag_wma->{'GENRE'}\n"; #print "TRACKNUMBER: $tag_wma->{'TRACKNUMBER'}\n"; #print "COPYRIGHT: $tag_wma->{'COPYRIGHT'}\n"; #print "LYRICS: $tag_wma->{'LYRICS'}\n"; #print "COMPOSER: $tag_wma->{'COMPOSER'}\n"; #print "ALBUMARTIST: $tag_wma->{'ALBUMARTIST'}\n"; #print "VBR: $tag_wma->{'VBR'}\n"; #print "AUTHOR: $tag_wma->{'AUTHOR'}\n"; # MS taggers think this is the performer/artist #print "TITLE: $tag_wma->{'TITLE'}\n"; #print "DESCRIPTION: $tag_wma->{'DESCRIPTION'}\n"; # this is the wma fingerprint for a file, like TRM for wma #print "MCDI: $tag_wma->{'MCDI'}\n"; if ($tag_wma->{'ALBUMTITLE'}) { $artist = $tag_wma->{'AUTHOR'}; $album = $tag_wma->{'ALBUMTITLE'}; } else { $artist = "misc"; } if (! $artist) { print "--> NO ID information thats usable, skipping\n"; next; } #Could make this a function call since each media type will use it. dave print "PATH IS: $artist/$album\n" if ($debug == 1); # fall back to scanning filename. we're assuming artist name # is everything up to the first hyphen # unless ( $tag_wma && $artist !~ /^\s*$/ && $artist ne 'artist' ) { ($artist) = /^([^-]+?)-.+$/; $artist ||= 'unsorted'; } else { $artist = $artist; } $album = $album || ""; if ( $album =~ /^\s*$/ || $album eq 'title' ) { $album = 'misc' } $artist = sanitize_string( $artist ) unless $artist eq 'unsorted'; $album = sanitize_string( $album ) unless $album eq 'misc'; print "==>ALBUM=>$artist/$album\n" if ($debug == 1); my $NEWDIR="$wmadir/$artist/$album"; my $NEWFILE="$NEWDIR/$name"; my $OLDFILE=$wmafile; if ( $NEWFILE ne $OLDFILE) { $wmafile=move_to_new_dir($NEWDIR, $NEWFILE, $OLDFILE); } else{ print "This file *$OLDFILE* already exists, I can't move it.\n" if ($debug == 1); } } ######## End Main ####### #--------------------------------------------------------------------------- ## ## Use "perldoc sort_wmas" to read the man page below. # __END__ =head1 NAME B - Sorts directory of wma's into an organized set of directories. =head1 SYNOPSIS B S<[ B<-hv> ]> S<[ I ]> =head1 DESCRIPTION B sorts your cluster of wma's that are all in 1 directory into an organized set of directories. artist->album this information is pulled from the wma/MS tags. You can tell the program what the destination top directory is by using -l /dir/path. If you do not supply a directory to move to, it assumes the current directory, and creates the artists there. If you specify a destination directory that does not exist, this directory will be made along with any paths. =head1 QUICK START The most common usage is as follows: B [-l target_wma_directory] I NOTE: *.wma works =head1 STANDARD OPTIONS B<-h --help> Prints this information. B<-v --version> Prints version information. =head1 OPTIONS =head1 EXAMPLE The example below B B<-l target_wma_directory> I<*.wma> =head1 BUGS None. =head1 SEE ALSO sort_flacs, sort_wmas, sort_oggs, sort_wmas =head1 AUTHOR AND COPYRIGHT David McKeon <@bonzoli.com> http://bonzoli.com Copyright (C) 2007-2007 David McKeon. All rights reserved. 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: Free Software Foundation, Inc. 59 Temple Place - Suite 330 Boston, MA 02111-1307, USA. Or you can find the full GNU GPL online at: http://www.gnu.org =head1 VERSION Current Revision: $Revision$ Last Modification: $Date$ =pod SCRIPT CATEGORIES UNIX/System_administration =pod OSNAMES Any