So I started with two small scripts as my first goals. One to catalog all the pictures in a folder and build the correct directory structure and links, and the second to monitor a directory for changes.
Here is the script I'm using to test the directory structure.
#!/usr/bin/perl
use strict;
use warnings;
use File::Find;
use Data::Dumper;
use Win32::Hardlink;
use Image::ExifTool qw/ImageInfo/;
my $source = "C:\\Photos";
my $dest = "C:\\Photos_Organized";
my $main = {
Dates => {},
Tags => {},
};
find(\&wanted, $source);
sub wanted {
my $file = $File::Find::name ;
if (-f $file) {
my $date_tag = '';
my $info = ImageInfo($file,['XmpmetaSubject','CreateDate']);
my @keywords = map { $info->{$_} }
grep { /^XmpmetaSubject/ }
keys %$info;
if (defined $info->{CreateDate} && $info->{CreateDate} =~ /^(\d\d\
+d\d):(\d\d):(\d\d)/) {
$date_tag = "$1/$2/$3";
}
add_picture($main, $file, $_, $date_tag, @keywords);
print "$file [", join(",", @keywords), "] [$date_tag] \n";
}
}
sub build_dir {
my $dir = shift;
unless (-d $dir) {
mkdir $dir or die "Failed to create $dir: $!";
}
}
sub link_tag {
my ($base_dir, $src, $file_name, $tags) = @_;
my $base_tag = '';
my @tags = split /\//, $tags;
for (@tags) {
$base_tag .= "$_\\";
build_dir($base_dir . $base_tag);
my $dest = $base_dir . $base_tag . $file_name;
unlink($dest) if -f $dest;
link($src=> $dest);
}
}
sub add_picture {
my ($main, $file, $name, $date, @tags) = @_;
my ($y,$m,$d) = split /\//, $date;
link_tag("$dest\\By Date\\", $file, $name, $date);
link_tag("$dest\\By Tag\\", $file, $name, $_) for @tags;
link_tag("$dest\\By Tag\\", $file, $name, 'All');
}
This actually works well and is fairly fast. I'm not currently happy with the way its continualy checking if directories exist and rebuilding them. I figure my script will probably rebuild the entire folder every night just to make sure it stays in sync, and then use the following script to monitor changes and make them live.
This script monitors the directory and yells about changes (thanks 366446 for the code since Win32::NotifyChanges doesn't actualy tell you what the change is.) So next i'll have to try these scripts together and have the actual changes be put into affect. The problem is figuring out how to update all the links. If a file is deleted i'll no longer know what tags it had in order to find the tags that need removed. I may have to store all the info i need in a database just to know which sym/hard links to go change/remove.
#!/usr/bin/perl
use strict;
use warnings;
use Win32::ChangeNotify;
#thanks to perlmonks node 366446
use Win32::ReadDirectoryChanges;
use Data::Dumper;
$|++;
my $filter =
FILE_NOTIFY_CHANGE_ATTRIBUTES |
FILE_NOTIFY_CHANGE_DIR_NAME |
FILE_NOTIFY_CHANGE_FILE_NAME |
FILE_NOTIFY_CHANGE_LAST_WRITE |
FILE_NOTIFY_CHANGE_SIZE ;
my $path = "C:\\Photos";
my $rdc = Win32::ReadDirectoryChanges->new(path => $path,
subtree => 1,
filter => $filter);
while (1) {
print "Waiting for changes...";
my @results = $rdc->read_changes;
print "changed!\n";
my $old_name;
while (scalar @results) {
my ($action, $filename) = splice(@results, 0, 2);
if ($action == FILE_ACTION_ADDED ) {
print "ADDED $filename\n";
} elsif ($action == FILE_ACTION_REMOVED) {
print "REMOVED $filename\n";
} elsif ($action == FILE_ACTION_MODIFIED) {
print "MODIFIED $filename\n";
} elsif ($action == FILE_ACTION_RENAMED_OLD_NAME) {
$old_name = $filename;
} elsif ($action == FILE_ACTION_RENAMED_NEW_NAME) {
print "RENAMED $old_name TO $filename\n";
$old_name = '';
}
}
}
If anyone has a good ideas about handling this i'd love to hear them! ;) Still to come, GUI, running as a windows service, etc ;)
|