####################################################
#                  FILE SORTER                     #
####################################################
#
# Some days I find that I have a lot of... 
# ehh hemmm... files laying around on my computer
# that need sorting... yes, sorting... and this 
# file helps me sort them so that they aren't
# laying around on my computer for certain people 
# to find... certain people who don't understand 
# that there is nothing wrong with someone who
# like to ummmm look at files because they are nice
# you see... nice, and that in no way means that the
# person doesn't love the other person and is VERY 
# glad that they are spending the rest of their 
# lives together.
# 
# Takes the files in the directory called from and
# sorts them into sub directories.
#
# For instance a file named shirakawa-minami-001.jpg
# would be moved to 
# /a/shirakawa/shirakawa-minami-001.jpg

use strict;
use warnings;
use File::Copy;
use Cwd;

# Common file extension groups
my @picture_extensions = ('jpg', 'jpeg', 'gif', 'png');
my @movie_extensions   = ('mov', 'mpg', 'mpeg', 'avi', 'ra');
my @audio_extensions   = ('mp3', 'ra', 'wmf', 'wav');

# Folder Regexs
my $two_chars        = '(..)';
my $one_letter        = '[a-zA-Z]';
my $one_name        = "($one_letter)($one_letter+)";
my $two_name        = '(' . $one_letter . '+)[_\-\s]([' . $one_letter 
+. '+)';

# Returns the first letter of the file if it is a letter
# otherwise "__".
sub get_folder_name
{
    my $file_name = shift;
    my $r = "__";
    if ($file_name =~ m/^($one_letter)/) {
        $r = $1;
    }
    return $r;
} # getFolderName

# Returns the first few full words on the file name,
# i.e. "aoki_yuko001.jpg" returns "aoki_yuko".
sub get_subfolder_name
{
    my $file_name = shift;
    $file_name =~ m/^$two_chars/;
    my $r = $1;
    if ($file_name =~ m/^$two_name/) {
        $r = $1 . "_" . $2;
    } elsif($file_name =~ m/^$one_name/) {
        $r = $1 . $2;
    }
    return $r;
} # getFolderName

# Dumn test to make sure that the thing is getting the
# right folder names.
sub test_me
{
    my @test_names = (
        "sps_ai_kato_2044.jpg", 
        "aoki_yuko001.jpg", 
        "shirakawa-minami-001.jpg", 
        "otoha001.jpg", 
        "c02_m_ohno_bs08.jpg", 
        "1234.jpg");
    foreach my $first (@test_names) {
        print get_folder_name($first), "\n";
        print get_subfolder_name($first), "\n";
    }

} # testMe 

################################
# LET'S GET READY TO RUMBLE!!! #
################################

# Open the directory that the script is called from.
my $dir = getcwd();
opendir(SOURCE, $dir) or die "DOHH, Bad SOURCE directory!";


# Loops through each file in the directory and sort it
# if it matches the right extensions.
while ( defined (my $file = readdir SOURCE)) {
    # make sure that it's not . or double dot
    next if $file =~ /^\.\.?$/;
    
    # make sure that the file matches one of the specified extensions
    my $no_match = 1;
    foreach my $ex (@picture_extensions) {
        if ($file =~ m/\.$ex/i  ) {
            $no_match = 0;
        }
    }
    if ($no_match) {
        next;
    }

    my $folder = get_folder_name($file);
    my $sub_folder = get_subfolder_name($file);
    
    my $full_file_from    = "$dir/$file";
    my $full_file_to    = "$dir/$folder/$sub_folder/$file";
    
    print "Moving $dir/$file to $dir/$folder/$sub_folder/$file\n";

    mkdir ("$dir/$folder");
    mkdir ("$dir/$folder/$sub_folder");
    
    move($full_file_from, $full_file_to) 
        or die "BAD MOVE $full_file_from to $full_file_to\n$!";
}

print "\n\ndone!\n";
[download]