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 ;)


___________
Eric Hodges

In reply to Re: Virtual folders for 'Microsoft Live Photo Gallery' (Progress) by eric256
in thread Virtual folders for 'Microsoft Live Photo Gallery' by eric256

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.