bin/jpeguploads.pl

   1 #!/usr/bin/perl
   2
   3 =head1 NAME
   4
   5 jpeguploads -
   6
   7 =head1 SYNOPSIS
   8
   9 Root runs this from ~ftp/incoming directory in a loop like
  10
  11   while true; do perl ~k/sources/CPAN/andk-cpan-tools/bin/jpeguploads.pl ; sleep 20 ; done
  12
  13 The user looks at the images witha browser under
  14 file:///home/ftp/incoming/today/index.html
  15
  16 =head1 DESCRIPTION
  17
  18 We have a directory in our ftp server where the xxx video server is
  19 allowed to upload images. We make thumbnails of the images and
  20 maintain html pages that let us inspect the thumbnails quickly.
  21
  22 We are always in a hurry and have only that many seconds time to run.
  23 After that we exit. So they(you) must call us repeatedly.
  24
  25 =cut
  26
  27
  28 $ENV{LANG} = "C";
  29
  30 use strict;
  31 use DateTime;
  32 use File::Basename qw(dirname);
  33 use Getopt::Long;
  34 eval {require Time::Duration};
  35 our $HAVE_TIME_DURATION = !$@;
  36
  37 our %Opt;
  38 GetOptions(\%Opt, "timeout=i");
  39
  40 $Opt{timeout} ||= 60;
  41 my $start = time;
  42
  43
  44 # first find out what the most recently uploaded date is
  45 my $dir0 = ".";
  46 opendir my $dh0, $dir0 or die;
  47 my ($m0,$d0,$y0,$iso0);
  48 for my $dirent (readdir $dh0) {
  49     next unless $dirent =~ /(\d+)_(\d+)_(\d+)/;
  50     my($m,$d,$y) = ($1,$2,$3);
  51     my $iso = sprintf "%04d-%02d-%02d", $y, $m, $d;
  52     if (not defined $iso0 or $iso gt $iso0) {
  53         $iso0 = $iso;
  54         $y0 = $y;
  55         $m0 = $m;
  56         $d0 = $d;
  57     }
  58 }
  59
  60 my $dir = sprintf "%d_%d_%d", $m0, $d0, $y0;
  61 opendir my $dh, $dir or die "Could not opendir '$dir': $!";
  62 my @base;
  63 my @tobethumbed;
  64 for my $dirent (readdir $dh) {
  65     next unless $dirent =~ /(.+)\.jpg$/;
  66     my $base = $1;
  67     next if $dirent =~ /\.thumb\.jpg$/;
  68     push @base, $base;
  69     next if -e "$dir/$base.thumb.jpg"; # already converted
  70     warn "base[$base]\n";
  71     push @tobethumbed, $base;
  72 }
  73 @base = sort { $b cmp $a } @base;
  74 if (@tobethumbed or -M "$dir/index.html" > -M $0) {
  75     open my $fh, ">", "$dir/index.html.new" or die;
  76     printf $fh <<EOH, ($y0, $m0, $d0)x2;
  77 <html><head><title>prtz%04d-%02d-%02d</title><meta http-equiv="refresh" content="1800; URL=index.html"></head><body><h3>%04d-%02d-%02d</h3>
  78 EOH
  79     my $L_min;
  80     for my $base (@base) {
  81         my $min = substr($base,0,5);
  82         if (not defined $L_min or $min ne $L_min) {
  83             my $dt = DateTime->new
  84                 (
  85                  year   => $y0,
  86                  month  => $m0,
  87                  day    => $d0,
  88                  hour   => substr($min,0,2),
  89                  minute => substr($min,3),
  90                  second => 0,
  91                  time_zone => 'GMT',
  92                 );
  93             $dt->set_time_zone("Europe/Berlin");
  94             my $berlin_min = sprintf "%02d:%02d", $dt->hour, $dt->minute;
  95             print $fh "<h6>$berlin_min</h6>\n";
  96         }
  97         print $fh <<EOR;
  98 <a href="$base.jpg"><img src="$base.thumb.jpg"/></a>
  99 EOR
 100         $L_min = $min;
 101     }
 102     print $fh "</body></html>\n";
 103     rename "$dir/index.html.new", "$dir/index.html" or die;
 104     my $updir = dirname $dir;
 105     my $symlink = "$updir/today"; # wrong: we're losing the images!
 106     if (-l $symlink) {
 107         my $content = readlink $symlink;
 108         if ($content ne $dir) {
 109             unlink $symlink or die "Could not unlink: $!";
 110             warn "unlinked symlink '$symlink'";
 111         }
 112     }
 113     unless (-e $symlink) {
 114         symlink $dir, $symlink or die "Could not create symlink: $!"
 115     }
 116     for my $base (@tobethumbed) {
 117         if (0 == -s "$dir/$base.jpg") {
 118             warn "Found empty image '$dir/$base.jpg'\n";
 119             local $^T=time;
 120             if (-M "$dir/$base.jpg" > 1) {
 121                 warn "Removing...\n";
 122                 unlink "$dir/$base.jpg" or die "Could not unlink: $!";
 123             } else {
 124                 warn "Skipping\n";
 125             }
 126             next;
 127         }
 128         unless ( 0 == system "convert", "-geometry", "150x150", "-quality", "75", "$dir/$base.jpg", "$dir/$base.thumb.jpg" ) {
 129             warn "died during convert '$dir/$base.jpg' '$dir/$base.thumb.jpg'; sleeping a bit...";
 130             sleep 20;
 131             die "Bye";
 132         }
 133         last if time - $start > $Opt{timeout};
 134     }
 135 }
 136 require Cwd;
 137 my $abs = sprintf "%s/%s/%s.jpg", Cwd::cwd(), $dir, $base[0];
 138 if ($HAVE_TIME_DURATION) {
 139     my @stat = stat $abs;
 140     my $mtime = $stat[9];
 141     warn sprintf "   %s: %s\n", Time::Duration::duration(time - $mtime), $abs;
 142 } else {
 143     warn sprintf "latest: %s\n", $abs;
 144 }
 145 if (not -e "current.jpg" or -M "current.jpg" > -M "$dir/$base[0].jpg") {
 146     unlink "current.jpg";
 147     symlink "$dir/$base[0].jpg", "current.jpg";
 148 }