#!/usr/bin/perl
# jpgdir2htm.pl -- 
# J C Nash (C) 1991-2009 
# 
# Find all *.jpg files (NOTE case sensitive -- could do more??)
# then extract comments and display in an html file,
# name this after the current directory (the one we are IN)
# and upload to ncf

use strict;
use Cwd;
use Cwd 'realpath';
use File::Basename; # module that parses filenames into path, name, extension etc.

my ($ii, $jj, $kk, $ifn, $ofn, $tmp, $shortifn, $tpath, $cline);
my ($inpath, $fextn, $fnroot, $emailstring, $cfn, @args, $fulldir);
my (@imfiles, @dirnotlist, @listnotdir, @tfiles, @inlines);
my ($aline, $dfile, $mcount, $numfiles, $CWD, $zfn, $cmd);
my ($USER, $PASSWD, $HOST, $UPDIR);

$HOST="ftp.ncf.ca";
$USER="fh448-1";
# DO NOT ENTER $PASSWD="********"; # !!! Security risk
$UPDIR=""; # put blank to avoid trouble

print "jpgdir2htm.pl -- (C) J C Nash 2020\n";
print "\n";
my $numclargs = @ARGV; # get the number of arguments on the command line
if ($numclargs>0) { die("This program takes no arguments");}

print "This program was written by John C. Nash\n";
print "     18 Spyglass Ridge, Ottawa, Ontario, K2S 1R6\n";
print "       nashjc\@uottawa.ca\n";
print "Creative Commons (CC) Share and share alike non-commercial license\n";
print "\n";
print "Usage:\n";
print "     jpgdir2htm.pl";
print "tries to extract foto captions from current directory into html file\n";
print "\n";

# Get name of directory 
$fulldir = cwd;
# ?? Should check if this is a symlink and sort out -- NOT yet done
$shortifn=basename($fulldir);
$ofn="00$shortifn.htm";
print "The output file is $ofn\n";

$cfn = $ofn;
$cfn =~ s/htm$/txt/;
# ?? can simplify the following -- too much crud from many patches

print "working with directory = $ifn\n";
print "caption file = $cfn\n";
print "continue? ";
$tmp = <STDIN>;

$ifn=realpath($ifn); # expand to full path 
print "full input dirname = $ifn\n";
($fnroot,$inpath,$fextn) = fileparse($ifn);
##?? should check it is a directory !!

# print "Path should now be $tmp =?= $tpath\n";

# $tmp = (-e $ifn);
# print " (-e (dollar)ifn) = $tmp \n";
# $tmp = <STDIN>;

$mcount=0;
if (!(-e $ifn)) {
   die("ERROR -- directory $ifn does not exist");
}

my $currdir=getcwd();

chdir($ifn);
# Now get file names of image files -- only jpg
# for now we'll restrict to jpg -- only lower case
print "Image files\n";
#? @imfiles=();
@tfiles=glob("*.jpg");
#? @imfiles=(@imfiles,@tfiles); # ?? why?
$numfiles=@tfiles;
#? $numfiles=@imfiles;
print "$numfiles total image files\n";	

# sort the files

##@tfiles = sort @imfiles;
@imfiles = sort { lc($a) cmp lc($b) } @tfiles; 

open (CF, '>', $cfn);
$zfn = $cfn;
$zfn =~ s/txt$/zip/;
print "zipfile zfn =$zfn\n";

open (FH, '>', $ofn);

print FH  "<!DOCTYPE html>\n";
print FH  "<html>\n";
print FH  "<head>\n";
print FH  '<meta charset="utf-8" />',"\n";
print FH  "<title>Photo captions in files</title>\n";
print CF  "Photo captions in files in ";
print FH  "</head>\n";
print FH  "<body>\n";
print FH  "<h1>Photo captions from JPEG Comment blocks</h1>\n";
print FH  "<br>\n";
print FH  "<h3>Directory $ifn</h3>\n";
print CF  "$ifn\n";
print CF  "\n";
print FH  "<br>\n";
print FH  "<p>\n";
print FH  "This HTML page created with jpegcap2htm.pl, written by J C Nash\n";
print FH  "(2016). The program uses captions that are embedded WITHIN the jpg\n";
print FH  "image files. Programs such as Irfanview or Mapivi\n";
print FH  "allow such captions/comments\n";
print FH  "to be added and edited. This avoids loss of comments if files are moved\n";
print FH  "or renamed.\n";
print FH  "</p><p>\n";
print FH  "You may Right-click on the images or the file names to save them.\n";
print FH  "A plain text file of captions is available as ";
print FH  "<a href='$cfn' download>$cfn</a><br>\n";
print FH  "A zip archive of all materials in this directory is ";
print FH  "available as <br>\n";
print FH  "<a href='$zfn' download>$zfn</a> and the link at the left should allow download.<br>\n";

print FH  "</p><p>\n";
print FH  "It is almost certain that some of the captions are incorrect. They are a best guess.\n";
print FH  "Please communicate corrections, preferably with the reason for the correction by\n";
print FH  'email to <a href="mailto:nashjc@ncf.ca">nashjc@ncf.ca</a>';
print FH  "\n";



print FH  "<br>\n";
print FH  "<hr>\n";

# Main processing
  $kk=0;
  while ($kk<$numfiles) { # loop over the files
	$dfile=$imfiles[$kk];
        print "Checking file $dfile\n";
	($fnroot,$inpath,$fextn) = fileparse($dfile);
	if ((uc($fextn) != 'JPG') && (uc($fextn) != 'JPEG')) {
		print "File: $dfile, Cannot caption other than jpg at moment\n";
        } else {
		$aline=`rdjpgcom $dfile`;
        print FH "<p>";
        print FH "<a href='$dfile' download>\n";
        print FH "<img src='$dfile' width=800><br>File: <b>$dfile</b></a></p>\n";
        print FH "</a>\n <p>\n";
		$aline=trim($aline);
		if (length($aline) > 0) { # CAPTION!
                     print "File $dfile has caption: $aline\n";
                }
#        $tmp = <STDIN>; 
        my @cap = split "\n", $aline;
        print "AT cap:";
        print @cap;
        print "\n";
        print CF "$dfile: ";
        print CF @cap;
        print CF "\n\n";
#        $tmp = <STDIN>;
        for $jj (@cap) {
           if (length($jj) < 1) {
              print FH "</p><p>\n";
           } else {
              # accents?
              if ($jj =~ /é/) {
                  print "accent in:$jj\n";
#                  $tmp = <STDIN>;
                  $jj =~ s/é/\&eacute;/;
              }
              if ($jj =~ /\\351/) {
                  print "numaccent in:$jj\n";
#                  $tmp = <STDIN>;
                  $jj =~ s/\\351/\&eacute;/;
          }
              print FH "$jj\n"
           }
        }
        } 
        $kk++; # increment counter
        print FH "</p>\n";
        print FH "<hr>\n";
  } # end loop over captioned files

print FH  "</body>\n";
print FH  "</html>\n";

close FH;
close CF;

# ??fix zip -- and do NOT recurse
$CWD=$shortifn;
$jj=getcwd(); # ?? watch for symlinks!
print "Changed dir to $jj\n";
print "continue? ";
$tmp = <STDIN>;
#system("zip -r $zfn .");
system("zip -u $zfn *");
# $CWD="..";


print "continue and try upload, else ctrl-C to stop here? ";
$tmp = <STDIN>;
# print "Host is ",$HOST,"\n";
# print "User is ",$USER,"\n";

$cmd="gftp";
system($cmd);

# print "Now get information from val and process\n";
# $tmp = <STDIN>;

# $cmd="wput -v --disable-tls ".$shortifn."/* ftp://".$USER.":".$PASSWD."@".$HOST."/MossNash/";
# print "cmd=",$cmd,"\n";
# print "current directory=",cwd,"\n";
# system($cmd);

chdir "..";
print "\n";
print "Done\n";
#===============================================
# Perl trim function to remove whitespace from the start and end of the string
sub trim {
	my $string = shift;
	$string =~ s/^\s+//;
	$string =~ s/\s+$//;
	return $string;
}
# Left trim function to remove leading whitespace
sub ltrim {
	my $string = shift;
	$string =~ s/^\s+//;
	return $string;
}
# Right trim function to remove trailing whitespace
sub rtrim {
	my $string = shift;
	$string =~ s/\s+$//;
	return $string;
}
#===============================================


