#!/usr/bin/perl
## Salonify by Adam Rosi-Kessel Copyright 2002, 2003, 2004, 2005
## Permission granted to modify and redistribute under the terms of the GPL v2.0 or later
 
# You should change this to reflect the name and location of your config file, 
# or invoke with -c config filename

$::config_file = "/etc/salonify";
$::program_title = "make_salonify";
$::program_version = "0.82 (2005/09/15)";

use strict;
use File::Find;
use File::Basename;
use Getopt::Long;
use Pod::Usage;
use Image::Magick;
use POSIX;

use vars qw/$salonify_folders_file $salonify_names_filename $salonify_top_level_directory $salonify_use_rcs $salonify_image_filename_extensions $salonify_titles_filename $salonify_generate_static_archive_file/;

$salonify_folders_file = "folders.txt";
$salonify_names_filename = "names.txt";
$salonify_titles_filename = "title.txt";
$salonify_generate_static_archive_file = 0;

use vars qw/$opt_config $opt_root $opt_help $opt_man $thumb_res $thumb_quality $small_res $small_quality $medium_res $medium_quality $opt_silent $opt_regenerate $opt_version/;

&GetOptions(
             'config:s' => \$opt_config,
             'root:s' => \$opt_root,
             'help' => \$opt_help,
             'man' => \$opt_man,
             'thumbres:s' => \$thumb_res,
             'thumbquality:s' => \$thumb_quality,
             'smallres:s' => \$small_res,
             'smallquality:s' => \$small_quality,
             'mediumres:s' => \$medium_res,
             'mediumquality:s' => \$medium_quality,
             'regenerate' => \$opt_regenerate,
             'silent|quiet' => \$opt_silent,
             'version' => \$opt_version
           );

$::config_file = $opt_config if $opt_config;
do $::config_file || die "Config file $::config_file could not be loaded!\n";

if ($salonify_generate_static_archive_file) {
   require Archive::Zip;
   Archive::Zip->import(qw( :ERROR_CODES :CONSTANTS ));
}

if ($salonify_use_rcs) {
   require Rcs;
   Rcs->import(qw(nonFatal));
   if (-x '/usr/bin/co') {
      Rcs->bindir('/usr/bin');
   } elsif (-x '/usr/local/bin/co') {
      Rcs->bindir('/usr/local/bin');
   } elsif (my $rcs_path = `which co`) {
      $rcs_path =~ s{^(.*)/.*$}{$1};
      Rcs->bindir($rcs_path);
   } else {
     die 'RCS not found in path. Set $salonify_use_rcs to 0 in the configuration, or install RCS.\n';
   }
}

if ($opt_root) {
   unless (-d $opt_root) {
     die "Directory $opt_root does not exist. Please give a valid path for the root photo directory.\n";
   }
} elsif ($salonify_top_level_directory) {
  $opt_root = $salonify_top_level_directory;
} else {
  $opt_root = ".";
}

$thumb_res = "150x100" unless ($thumb_res =~ m/\d+x\d+/);
$thumb_quality = "65" unless ($thumb_quality =~ m/\d+/);
$small_res = "384x288" unless ($small_res =~ m/\d+x\d+/);
$small_quality = "60" unless ($small_quality =~ m/\d+/);
$medium_res = "640x480" unless ($medium_res =~ m/\d+x\d+/);
$medium_quality = "75" unless ($medium_quality =~ m/\d+/);
$salonify_image_filename_extensions = "jpg" unless ($salonify_image_filename_extensions);

$::counter = 0;
%::folders;
%::id;
%::descript;
%::id_wanted;

$::last_length = 0;

my $rcs;

for ($salonify_image_filename_extensions) {
    s/^ *| *$//g;
    s/ /\$\|\\./g;
    s/$/\$/g;
    s/^/\\./g;
}

$| = 1;

# resize: options are input file, output file, target resolution, target quality
sub resize {
  my ($in, $out, $res, $qual) = @_;
  my $p = new Image::Magick;
  print " ." unless ($opt_silent);
  $p->Read($in);
  print " ." unless ($opt_silent);
  $p->Set(quality => $qual);
  print " ." unless ($opt_silent);
  $p->Resize($res);
  print " ." unless ($opt_silent);
  $p->Write($out);
  print ("\b \b" x 8) unless $opt_silent;
}

sub RcsOpen {
   return unless $salonify_use_rcs;
   $< = $>;
   $( = $);
   my $filename = shift;
   $rcs = Rcs->new;
   $rcs->rcsdir(dirname($filename) . "/RCS");
   $rcs->workdir(dirname($filename));
   $rcs->file(basename($filename));
   unless (-d dirname($filename) . "/RCS") {
     die "Unable to create directory" . dirname($filename) . "/RCS! Check permissions on directories or make the salonify script setuid.\n" unless mkdir dirname($filename) . "/RCS";
   }
   unless (-e dirname($filename) . "/RCS/" . basename($filename) . ",v") {
     die "Unable to perform initial check-in on file $filename with RCS! Check permissions on data files or make the salonify script setuid.\n" unless $rcs->ci('-u','-t-none');  # initial checkin
   }
   if (! $rcs->co('-l')) {
      print "File $filename is apparently already checked out.\n\nThis may have occurred because:\n\n(1) salonify failed in the middle of a past run\n(2) another process is using it\n(3) you manually edited the file without checking it back in.\n\n";
      print "Do you want to break the lock and overwrite the file with the last checked-in version?\n(will wait one minute for a response) (y/N) ";
      fcntl(STDIN, F_SETFL(), O_NONBLOCK());
      my $x = time;
      until (sysread STDIN, $_, 1) { last if (time - $x) > 60; }
      print "\n" unless $_;
      print "\n";
      if (/y/i) {
         if (! $rcs->co('-l','-f')) {
            die "Unable to override lock on $filename with RCS! Check permissions on data files.\n";
         } else {
           print "Successfully unlocked $filename.\n";
         }
      } else {
        die "Unable to check out and lock $filename with RCS! Check permissions on data files.\n";
      }
   }
}

sub RcsClose {
   $< = $>;
   $( = $);
   $rcs->ci('-u','-mnone') if ($salonify_use_rcs);
}

# CheckForImages: this subroutine is run for each file (this is the find "wanted" function)
sub CheckForImages {
   my $dir = $File::Find::dir;
   my $relative_dir = $dir;
   my $folder = $dir;
   my $title_file = $dir . "/" . $salonify_titles_filename;
   my $name_file = $dir . "/" . $salonify_names_filename;
   my $file = $_;
   my ($new_name,$cur_id);

# don't need to index any rcs directories
   $dir =~ m</RCS> and return 1;

# path is relative; remove top level path
   $relative_dir =~ s/$salonify_top_level_directory//g;

# folder is just the actual sub-directory name; becomes default description if none given
   $folder =~ s{^.*/}{}g;

# the folders hash is a boolean that tells us whether there are any images in the folder 
   defined $::folders{$relative_dir} or $::folders{$relative_dir} = 0;

# the description hash is a string that is the description of this directory--defaults to dir name
   if ($::descript{$relative_dir} eq $folder or not defined $::descript{$relative_dir}) {
# if the salonify_titles_filename exists in the directory, and no other description is known, use that      
   if (-e $title_file) {
         open TITLE, $title_file || die "Could not open title file $title_file, check permissions!\n";
         while (<TITLE>) {
# pick the first line that is not a comment for the description
           last if (($cur_id,$::descript{$relative_dir}) = /^([^#][^\t]*)\t(.*)$/);
         }
         close TITLE;
      }
# use default description (folder name) if no other description was found
      $::descript{$relative_dir} = $folder unless ($::descript{$relative_dir});
# search array here to see if ID is already taken -- if not, assign ID from title file
      if (grep {/^$cur_id$/} values %::id) {
        my %rev_id = reverse %::id;
        $::id_wanted{$relative_dir} = { id => $cur_id, folder => $rev_id{$cur_id} }
      } else {
        $::id{$relative_dir} = $cur_id unless defined $::id{$relative_dir};
      }
   }

# if we don't already have an ID number for this directory, pick the next one available
   unless (defined $::id{$relative_dir}) {
# find the highest used ID number; then increase by one
      $::counter = ((sort { $a <=> $b} (values %::id))[-1])+1;
      $::id{$relative_dir} = $::counter;
   }

   umask 002;

# save found description and selected ID number to the directory's "title" file
   open TITLE, ">$title_file" || die "Could not write to title file $title_file, check permissions!\n";
   print TITLE <<EOF
# The following line contains the title/description of this folder for salonify
# you can edit this file, but it will be automatically regenerated the next time
# make_salonify is run.
$::id{$relative_dir}\t$::descript{$relative_dir}
EOF
;
   close TITLE;

# create a title to hold captions in each directory, and do an initial RCS check-in
   unless (-e $name_file) {
     open NAMES, ">$name_file" || die "Could not create file $name_file, check permissions!\n";
     close NAMES;
     RcsOpen($name_file);
     RcsClose;
   }

# check to see if there are any images in the current directory
   if ($file !~ /^\./ and $file =~ /$salonify_image_filename_extensions/i) {
      print "\b \b" x ($::last_length + 26) unless $opt_silent or not $::last_length;
      print "Generating image files for $file" unless $opt_silent;
      $::last_length = length $file;
      $::folders{$relative_dir} = 1;

      $new_name = $dir . "/.tn" . basename($file);
      print " (thumbnail)" unless $opt_silent;
      resize($file, $new_name, $thumb_res, $thumb_quality) unless (-f $new_name and not $opt_regenerate); 

      $new_name = $dir . "/.li" . basename($file);
      print (("\b \b" x 11) . "(small)") unless $opt_silent; 
      resize($file, $new_name, $small_res, $small_quality) unless (-f $new_name and not $opt_regenerate); 
      
      $new_name = $dir . "/.me" . basename($file);
      print (("\b \b" x 7) . "(medium)") unless $opt_silent; 
      resize($file, $new_name, $medium_res, $medium_quality) unless (-f $new_name and not $opt_regenerate); 
      print ("\b \b" x 10) unless $opt_silent;
   }
   1;
}

sub ReadExistingTree {
   my ($counter, $path, $contents, $description);
   open IN, "$salonify_folders_file" || die "Tree file $salonify_folders_file exists but I could not open it--check file permissions!\n";
   while (<IN>) {
      ($counter, $path, $contents, $description) = /^(.*)\t(.*)\t(.*)\t(.*)$/;
      $::id{$path} = $counter;
      $::descript{$path} = $description;
   }
   close IN;

   my @ids = sort { $a <=> $b } values %::id;
   $::counter = ($ids[$#ids] + 1);

   1;
}

sub MakeZipBase {
   $_ = shift @_;
   s{/*$}{};
   s{^/*}{};
   s{^.*/}{};
   return "/${_}_";
}

sub GenerateStaticArchive {
   my ($path) = @_;
   my $zip_base = MakeZipBase($path);
   $path =~ s{//*}{/}g;
   my $dirname = $path;
   $dirname =~ s{/*$}{}g;
   $dirname =~ s{^.*/}{}g;
   my $zip;

   my $target = $zip_base . "full.zip";

   unless (-e $path . $target || $opt_regenerate) {
     unlink $path . $target  if -e $target;
     $zip = Archive::Zip->new();
     print "Generating (large) archive for $path...";
     while (<$path/*>) {
        next unless (-f and /$salonify_image_filename_extensions/i);
        my $file = basename($_);
        $zip->addFile( $_ , $dirname . "/" . $file);
     }
     foreach my $member ($zip->members()) {
        $member->desiredCompressionMethod( 0 );
     }
     $zip->writeToFileNamed( $path . $target ) if $zip->members();
     print "\b \b" x (length "Generating (large) archive for $path...");
   }

   $target = $zip_base . "medium.zip";

   unless (-e $path . $target || $opt_regenerate) {
     unlink $path . $target if -e $path . $target;
     $zip = Archive::Zip->new();
     print "Generating (medium) archive for $path...";
     while (<$path/.*>) {
        next unless (-f and /$salonify_image_filename_extensions/i);
        my $file = basename($_);
        next unless $file =~ m/^.me/;
        $file =~ s/^.me//g;
        $zip->addFile( $_ , $dirname . "/" . $file);
     }
     foreach my $member ($zip->members()) {
        $member->desiredCompressionMethod( 0 );
     }
     $zip->writeToFileNamed( $path . $target ) if $zip->members();
     print "\b \b" x (length "Generating (medium) archive for $path...");
   }
 
   $target = $zip_base . "small.zip";

   unless (-e $path . $target || $opt_regenerate) {
     unlink $path . $target if -e $path . $target;
     $zip = Archive::Zip->new();
     print "Generating (small) archive for $path...";
     while (<$path/.*>) {
        next unless (-f and /$salonify_image_filename_extensions/i);
        my $file = basename($_);
        next unless $file =~ m/^.li/;
        $file =~ s/^.li//g;
        $zip->addFile( $_ , $dirname . "/" . $file);
     }
     foreach my $member ($zip->members()) {
        $member->desiredCompressionMethod( 0 );
     }
     $zip->writeToFileNamed( $path . $target ) if $zip->members();
     print "\b \b" x (length "Generating (small) archive for $path...");
   }

}

print $::program_title . " " . $::program_version . "\n" unless $opt_silent;

exit(0) if $opt_version;
pod2usage(1) if $opt_help;
pod2usage(-exitstatus => 0, -verbose => 2) if $opt_man;

(-e $salonify_folders_file) and &ReadExistingTree;

find ( { wanted => \&CheckForImages, 
         follow_fast => 1, 
         follow_skip => 2 
       }, $opt_root);

print "\b \b" x ($::last_length + 26) unless $opt_silent;

umask 002;

unless (-e $salonify_folders_file) {
   open OUT, ">$salonify_folders_file" || die "Could not create file $salonify_folders_file, check permissions!\n";
   close OUT;
}
RcsOpen($salonify_folders_file);
open OUT, ">$salonify_folders_file" or die "Couldn't open output $salonify_folders_file!\n";

print OUT <<EOF
# Salonify Folder Index
# Format for this file:
# ID NUMBER <tab> PATH <tab> CONTAINS IMAGES? (1=yes, 0=no) <tab> Description <newline>
# If you edit this file with a text editor, make sure the tabs don't get converted into spaces,
# or the program won't work! Comments can be inserted with #'s, but they won't be preserved
# when the file is regenerated.
EOF
;

delete($::folders{""});     # assume we don't want the top level directory in the index
delete($::folders{"."});    # sometimes appears as "."

# create archive files if so configured
if ($salonify_generate_static_archive_file) {
   foreach my $relative_dir (keys %::folders) {
      &GenerateStaticArchive($salonify_top_level_directory . "/" . $relative_dir);
   }
}

# for every apparent "already taken" ID number, go back and see if they corresponded to real
# folders; if not assign the ID number from the "title" file in the respective directories
# this enables folders to be renamed and to keep the same URL as they had before
foreach my $relative_dir (keys %::id_wanted) {
   my $my_id = $::id_wanted{$relative_dir}{'id'};
   my $folder = $::id_wanted{$relative_dir}{'folder'};
   $::id{$relative_dir} = $my_id unless defined $::folders{$folder};
   my $title_file = $salonify_top_level_directory . "/" . $relative_dir . "/" . $salonify_titles_filename;
   open TITLE, ">$title_file" || die "Could not write to title file $title_file, check permissions!\n";
   print TITLE <<EOF
# The following line contains the title/description of this folder for salonify
# you can edit this file, but it will be automatically regenerated the next time
# make_salonify is run.
$::id{$relative_dir}\t$::descript{$relative_dir}
EOF
;
   close TITLE;
   
}

print "Done.\n";

# create the new folders file now that the hashes are complete
foreach (sort keys %::folders) {
  print OUT $::id{$_}, "\t", $_, "\t",  $::folders{$_}, "\t", $::descript{$_}, "\n"; 
}

close OUT;

&RcsClose();

__END__

=head1 NAME

make_salonify - generate thumbnails and index files for salonify image gallery

=head1 SYNOPSIS

make_salonify [options] 

 Options:
   --help                            brief help message
   --silent                          don't show status information
   --version                         display version and exit
   --config [filename]               use [filename] as configuration file
                                     (default /etc/salonify)
   --root [directory]                use [directory] as top-level directory for images
                                     (default current directory or as specified in config file)
   --thumbres [x-size] x [y-size]    resolution for thumbnails (default 150x100)
   --thumbquality [value]            JPEG quality for thumbnails (default 65)
   --smallres [x-size] x [y-size]    resolution for small images (default 384x288)
   --smallquality [value]            JPEG quality for small images (default 60)
   --mediumres [x-size] x [y-size]   resolution for medium images (default 640x480)
   --mediumquality [value]           JPEG quality for medium images (default 75)
   --regenerate                      regenerate thumbnails and images even if they already exist

=head1 DESCRIPTION

Generates thumbnails, reduced images, and directory tree for salonify image gallery. When run with no options, will regenerate all necessary files based on configuration.

=head1 COPYRIGHT

Copyright (c) 2003-2005 Adam Rosi-Kessel.
This is free software; see the source for copying conditions.  There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE, to the extent permitted by law.

=head1 AUTHOR

Adam Rosi-Kessel, L<ajkessel@debian.org|mailto:ajkessel@debian.org>

=cut