#!/usr/bin/perl
#
# $Id: cam_snapshot 26714 2012-09-05 14:52:33Z teetov $
#
# Purpose:
#     Create Snap-shot images from Live 
#     Note: 
#      1. if dead picture[X] is present then snap-shorts will be generated from dead picture
#      2. if no picture is present then empty picture will be published as snap-shot
#      3. cam_snapshots is working as a demon and started from procctl
#      4. cam_snapshots renews pictures every 170+10 seconds
#      5. if CPU load_avg>5 then renews pictures every 200+170+10 seconds;
#      6. if new dead picture is present then snapshort is generated out of turn
#      7. if dead picture is disapears then snapshort is generatted out of turn
#      8. if routine for camera is changed snapshort is generated out of turn
#      9. cam_snapshots re-read camera configuration every 5 second
#     10. Create DEAD X if ( -z dead). use live for a picture
#     11. Writes conf/$dev/geometry
#
#     prepare a test set: perl -e ' for($i=1;$i<51;$i++) { `cp b.jjj $i.jpg` }'

use Image::Magick;
use File::Copy;
use NextCAM::Init;
use strict;
use Data::Dumper;
use Log::Log4perl "get_logger";
require "$ENV{APL}/common/bin/logger.patrol";

# CONS ================================================================

my $log = get_logger('NEXTCAM::CAM::CAM_SNAPSHOT');

my %matrix_sizes = (
    "1x1" => "165x165", 
    "3x3" => "240x180",
    "5x5" => "160x120",
    "7x7" => "273x205");

my $SRC         ="$ENV{APL}/var/conf/live";
#my $SRC        ="/home/apl/live";
#my $DST         ="$ENV{APL}/www/tmp";
my $DST         ="$ENV{APL}/var/conf/still";
my $CONF        ="$ENV{APL}/var/conf";
my $NOIMAGE     ="$ENV{APL}/sdi/html/admin/img/noimage";
my $EXPIRATION  =170;  # expiration time
my $THRESH	=5; # Max calls to 'mk_snapshots' per turn


# VARS ===============================================================
my %conf;
my %routines;	  # device routines
my %dead_list;	  # a list of dead is needed for detecting resuraction
my $reported_CPU; # last time CPU average reported to log
my $snapscnt; 	  # number of calls to 'mk_snapshots'

# PLATFORM-SPECIFIC
my $cpu_loadavg_default;# = $^O =~ /linux/i ? 10 : 5;
my $font;
if($^O =~ /darwin/i) {
    $cpu_loadavg_default = 5;
    $font = '/Library/Fonts/Arial.ttf';
}
else {
    $cpu_loadavg_default = 10;
    $font = 'AvantGarde-Book';
}

# PROC ===============================================================

sub CPU_load     { # indicate a current CPU load
    if(open(AVG,"/proc/loadavg")) {
      my $avg=<AVG>;
      close AVG;
      return 0+$avg;
    } else {
      return $cpu_loadavg_default;
    }
}

sub X_polygon    { # generate a X
    my  ($width,$height)=@_;
    my $w_x = sprintf("%.0f", 0.125 * $width);
    my $w_y = sprintf("%.0f", 0.125 * $height);
    my $X_shape = "0,$w_y $w_x,0 " . sprintf("%.0f", $width / 2) . "," . sprintf("%.0f", $height / 2 - $w_y) . " ";
    $X_shape .= ($width - $w_x) . ",0 $width,$w_y " . sprintf("%.0f", $width / 2 + $w_x) . "," . sprintf("%.0f", $height / 2) . " ";
    $X_shape .= "$width," . ($height - $w_y) . " " . ($width - $w_x) . ",$height " . sprintf("%.0f", $width / 2) . "," . sprintf("%.0f", $height / 2 + $w_y) . " ";
    $X_shape .= "$w_x,$height 0," . ($height - $w_y) . " " . sprintf("%.0f", $width / 2 - $w_x) . "," . sprintf("%.0f", $height / 2);
    $X_shape;
}

sub mk_snapshots { # makes shapshort for one device
  my ($dev,$src,$dot,$dead_mark)=@_;
  my $image = Image::Magick->new;
  eval {
    $_=$image->Read($src);
    die($_) if $_ and $_!~/^Exception 325/i;	# Ignore exception 325: "Corrupt JPEG data"
    die("Empty image") if -z $src; # precaution imagemagic may die
    my ($width,$height)=$image->Get('columns','height');
#    if(open(GEOMETRY,">$CONF/$dev/geometry")) { # rewrite a geomentry file
#      print GEOMETRY "${width}x${height}";
#      close GEOMETRY;
#    }
    if($dead_mark) {        # DEAD-X image needs to be created
      $_=$image->Draw(primitive=>'polygon',stroke=>$dot,fill=>$dot,points=>X_polygon($width,$height));
      die($_) if $_ and $_!~/Exception 395/i; # Workaround for Darwin (unable to access configure file `colors.xml')
      $_ = $image->Write("$SRC/dead.$dev.tmp.jpg");
      die($_) if $_;
      system("touch -r $SRC/dead.$dev.jpg $SRC/dead.$dev.tmp.jpg; rm $SRC/dead.$dev.jpg; mv $SRC/dead.$dev.tmp.jpg $SRC/dead.$dev.jpg");
    }
    
    foreach my $mx (sort keys %matrix_sizes) { # cycle for different resolutions
      my $clone=$image->Clone();
      my $size=$matrix_sizes{$mx};
      sample_annotate($clone,geometry=>$size,dot=>$dot);
      $_ = $clone->Write("$DST/still.$dev.$size.jpg");
      die("camera $dev: $_") if $_;
    }
    # Process original image
    sample_annotate($image,geometry=>"${width}x${height}",dot=>$dot);
    $_ = $image->Write("$DST/still.$dev.jpg");
    die($_) if $_;
  }; # end eval
  if($@) {
    my $err = $@;
    $log->error($err);
    print "ERROR: $err\n";
  }
  else {
    $snapscnt++;
  }
}

sub sample_annotate { # resize image, draw dot and text on it
    my ($image, %params) = @_;
    my ($size,$dot)=@params{'geometry','dot'};
    my ($width,$height)=split('x',$size);
    my $pointsize=int($height/4);
    my $points=int($width*18/640). ",". int($height*18/480). ", ". 
	       int($width*10/640). ",". int($height*10/480);
    
    $_ = $image->Sample(geometry=>$size);  # fast
    die($_) if $_;
    
    $_=$image->Draw(primitive=>'circle',stroke=>$dot,fill=>$dot,points=>$points);
    die($_) if $_ and $_!~/Exception 395/i; # Workaround for Darwin (unable to access configure file `colors.xml')
      
    if($dot eq 'grey') {      # write RED OFF in left-upper coner
	$_=$image->Annotate(font=>$font,text=>'OFF',stretch=>'UltraExpanded',stroke=>'red',
			    fill=>'red',gravity=>'NorthEast',pointsize=>$pointsize,strokewidth=>4);
        die($_) if $_;
    } 
}

sub get_mtime { ####################### GET THE AGE OF THE FILE ################
    my @ss = stat(shift);
    return time - $ss[9];
}

sub load_conf { # read camera configs and check routine changes
    %conf=GetCfgs('DEVICETYPE' => 'CAMERA');
    $routines{diff} = {};
    foreach my $dev (keys %conf) {
	my $routine='';
	if(open(ROUTINE,"$CONF/$dev/routine")) {
	    $routine=<ROUTINE>;
    	    close ROUTINE;
	}
	$routines{diff}{$dev}=1 if defined $routines{$dev} and $routines{$dev} ne $routine;
	$routines{$dev}=$routine;
    }
}

sub check_and_make { # check if snapshot has to be created and find a sourser

  my ($dev,$urg)=@_;
  my $live="$SRC/$dev.jpg";        # last known live image, always present
  my $dead="$SRC/dead.$dev.jpg";   # dead picture (has a RED X), could be absent
  my $snap="$DST/still.$dev.jpg";  # master snapshot ( the same resolution as live)
  my $live_age=get_mtime($live);   # file age in seconds
  my $dead_age=get_mtime($dead);
  my $snap_age=get_mtime($snap);
  my $src=$live;                   # the live is a usual sourse for snapshots
  my $dead_mark;                   # force RED X creation
  
  if(! -f $live || -z $live ) {    # we do not have any image yet, use noimage
    return if -f $snap and not $urg;		   # nothing to do
#   print "DEBUG: live.$dev is missing, uses noimage\n";
    copy("$NOIMAGE/noimage.jpg","$DST/still.$dev.jpg");
    foreach my $mx (sort keys %matrix_sizes) { # cycle for different resolutions
      my $size=$matrix_sizes{$mx};
      copy("$NOIMAGE/noimage.$size.jpg","$DST/still.$dev.$size.jpg");
    }
    return;
  }                                # since this point we a sure about live image

  if(-f $dead) {                   # if image marked as a dead
    $log->info("Creating snapshots from dead.$dev.jpg") if exists $dead_list{$dev};
    $dead_list{$dev}='X';          # remember the dead
    if(! -z $dead) {               # real dead image with RED-X present
      return if -f $snap && $snap_age<=$dead_age && !$urg;# snapshot still actual, nothing todo
      $src=$dead;
    } else {
      $src=$live;
      $dead_mark='X';              # need a dead-X-image creation
    }
  } else {                         # image is LIVE
    if(exists $dead_list{$dev}) {
       delete($dead_list{$dev});   # remove live from dead list!
       $log->info("$dev is resurected. Create snapshot from live $dev.jpg")
    }
  }
                                   # since this point $src is fully defined
  my $routine=$routines{$dev};     # calculate the color of dot based on routine
  my $dot='grey';
  $dot='green' if $routine=~/V/;
  $dot='red'   if $routine=~/A/;
  
  mk_snapshots($dev,$src,$dot,$dead_mark); 
}

sub main_cycle {
  load_conf;

  foreach ( sort keys %dead_list) { #-------------- check resurection
    check_and_make($_) if not -f "$SRC/dead.$_.jpg"; # make live snapshots
  }

  foreach ( sort keys %conf) {      #-------------- check new dead
    next if defined $dead_list{$_};               # already dead, do nothing
    check_and_make($_) if -f "$SRC/dead.$_.jpg";# just died, make X-snapshots
  }

  #--------
  # TBD: check_and_make if routine is changed
  #--------

  my $delta=0;
  my $cpu_load=CPU_load;
  $snapscnt=0;
  if($cpu_load > 5) {
    $delta=200;
    if(time-$reported_CPU > $delta) {         # do not report to often !
      $log->info("CPU average load $cpu_load>5; snapshot creation will be posponded for 200 sec");
      $reported_CPU=time;
    }
  }
  foreach my $dev (sort keys %conf) {        #-------------- check everyone
    check_and_make($dev,1),next if $routines{diff}{$dev};	# routine is changed
    next if defined $dead_list{$dev};        #               skip dead
    check_and_make($dev,1) if not -f    "$DST/still.$dev.jpg";
    check_and_make($dev) if get_mtime("$DST/still.$dev.jpg") > $delta+$EXPIRATION+$dev%10 and $snapscnt < $THRESH;
  }
}


# MAIN ==================
$log->info("cam_snapshot is started");
for(;;) {
    main_cycle();
    sleep 5;
}

