#!/usr/bin/perl
#  $Id: cam_patrol.pl 33576 2016-02-03 19:27:46Z atsybulnik $
# -----------------------------------------------------------------------------
#  Patrol everything related to devices
# -----------------------------------------------------------------------------
#  Author: Alex Titov
#  Edited by: Dmitriy Astaltsev, Andriy Fomenko
#  QA by:  Christopher C Gettings
#  Copyright: videoNEXT LLC
# -----------------------------------------------------------------------------

use strict;
use Symbol 'gensym';
use Fcntl;
use IPC::Open3;
use POSIX ":sys_wait_h";
use Image::Magick;
use NextCAM::Conf qw(GetCfgs);
use Master::Conf;
use Node::Conf;
use SKM::Common qw(WritePid UpdatePid);
#use Data::Dumper;
use Log::Log4perl "get_logger";

require "$ENV{APL}/common/bin/logger.patrol";
my $log = get_logger('NEXTCAM::CAM::CAM_PATROL');
my $log_db = get_logger('PATROL::CAM::CAM_PATROL');

$log->logdie('Variables APL/APL_CONF must be set') if !$ENV{APL} || !$ENV{APL_CONF};

#CONSTANTS
my $APL         = "$ENV{APL}";
my $CONFDIR     = "$ENV{APL_CONF}";
my $AVCONFDIR   = "$CONFDIR/av";
my $AVCONF_DEL  = "$CONFDIR/av/deleted";
my $LIVEPATH    = "/tmp";
my $STILLPATH   = "$CONFDIR/still";
my $VARPATH     = "$ENV{APL}/var";
my $REMOVED     = "$ENV{APL}/var/sm/removed"; #list of removed devices
my $MAIN_LOOP_SLEEP = 2;      # sleeps between iterations of heartbeat loop
my $COUNT4FAULTED =5;         # how many times camera should fail to be condidered faulted
my $DELAY4FAULTED=60;         # what is deleay before trying to start a retriever for faulted camera
my $START_TIME_LIMIT=20;      # let 20 seconds for device starting
my $STOP_TIME_LIMIT=3;        # let 3  seconds for device stopping

my $PROCCTL_NAME   ="$ENV{APL}/pm/bin/procctl.pl";
my $PROCCTL        ="$PROCCTL_NAME >/dev/null 2>/dev/null &";
my $PROCCFG = "$ENV{APL}/pm/bin/proccfg.pl  >/dev/null 2>/dev/null &";
my $PTZSERVER="$ENV{APL}/ptz/bin/PTZ_server.pl";       # used only to find and send a signal
my $MRETR          = 'cam_mretr';
my $IP_RETRIEVER   = "$ENV{APL}/mgears/bin/$MRETR";
my $NODE2AVATAR        = "$ENV{APL}/av/bin/node2avatar";             # send information about camera update to avatar
my $NODE2AVATAR_TIMEOUT = 30; # wait for node2avatar process to complete
my $KOWTOW         = "$ENV{APL}/conf/bin/conf_kowtow >/dev/null 2>&1 &"; # handshake with master
my $CMD_RESET      = "$ENV{APL}/conf/bin/cmd_reset";           # reset and program encoder, run in bg
my $SETUP	   = "$ENV{APL}/conf/bin/conf_setup >/dev/null 2>&1 &";
my $SYNC_VAE_DIRS  = "$ENV{APL}/conf/bin/conf_sync_vae_dirs.pl";
my ($VERSION)      = `$ENV{APL}/vpatch/bin/vpatch level`=~/(version.+)/;
#$ENV{LD_LIBRARY_PATH}="$ENV{APL}/imp/lib:$ENV{APL}/mgears/bin:$ENV{APL}/mgears/lib";# for binary retreiver
$ENV{PATH}.=":$ENV{APL}/imp/bin";                                  # Darwin: postgres
my ($PATROL)       = reverse(split(/\//, $0)); #name of the program

#VARS
my %conf;                           #conf of all devs;example $conf{$dev}->{DEVID}
my @difference;                     # after diff this array show the actual difference
my %faulted;     # list of faulted cameras $faulted{$id}->{since},$faulted{$id}->{last},$faulted{$id}->{count}

my %mretr_pids;

my %node2avatar; # node2avatar processes tracking

# node2avatar process statuses
my $N2A_STAT_STARTED = 0;
my $N2A_STAT_DONE = 1;
my $N2A_STAT_FAILED = 2;
my $N2A_STAT_HANG = 3;

my $N2A_MAX_RETRIES = 50; # Max node2avatar restarts after failures (return code != 0)

# Map camera status to dot color
my %stat2clr = (
    'ON'        => '#42d327', # green
    'OFF'       => '#8c8b6d', # grey
    'ON-DEMAND' => '#00ccff', # blue
    'BROKEN'    => '#d72948', # red
    'DOWN'      => '#d72948', # red
    'other'     => '#cecb19'  # yellow
);

#SIGNALS
$SIG{INT} = \&softdie;
$SIG{TERM} = \&softdie;
$SIG{HUP} = sub {};                 # empty sub instead of 'IGNORE' bug a140
setpgrp(0, 0); # create own proc group

sub softdie { ##################################################################
    local $SIG{TERM} = 'IGNORE';
    `killall $MRETR &`;
    `rm -f $CONFDIR/*/pid; rm -f $CONFDIR/*/pids/$MRETR.*`;
    die 'SIGTERM';
}

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

sub CalculateMaxCameraDelay { #### MAXIMUM DELAY ACCEPTABLE FOR CAMERA BEFORE RedX #####
    my $dev = shift;
    return 31 if not defined $conf{$dev}->{FRAMERATE} or $conf{$dev}->{FRAMERATE}==0;
    my $max_delay = 2.1 / $conf{$dev}->{FRAMERATE};
    $max_delay = ($max_delay < 4) ? 4 : $max_delay;
    $max_delay = 31 if $conf{$dev}->{MEDIA_FORMAT} ne 'mjpg'; # only have few jpeg in minute from mpeg stream
    $log->debug('CalculateMaxCameraDelay: FPS=', $conf{$dev}->{FRAMERATE}, ' MAX_DELAY=', $max_delay);
    return $max_delay;
}
#-------------------------------------
# return 1 if reseting
#-------------------------------------
my $RESET_TIMEOUT=360; # 6 minutes hard-coded
sub is_resetting {
  my $id=shift;
  my $rfile="$CONFDIR/$id/conf.reset";
  return 0 if ! -f $rfile;
  my $mtime=get_mtime($rfile);
  $log->info("present $CONFDIR/$id/conf.reset time=$mtime status=$conf{$id}->{_STATUS}");
  $conf{$id}->{_STATUS}='RESETTING';
  my %info;
  if(open(RFILE,$rfile)) {
     %info=map{/(^\w+)=(.+)/} grep {/^\w+=.+/} <RFILE>;
     close RFILE;
     if(exists $info{RESULT}) {
       $log->info("get a result $info{RESULT} from $CONFDIR/$id/conf.reset");
       unlink $rfile;
       $conf{$id}->{_STATUS}=($info{RESULT} eq 'FAIL')?'RESET-FAILURE':'OFF';
       $log->info("new status=$conf{$id}->{_STATUS}");
     }
  }
  if(not exists $info{RESULT}) {
    $log->info("not result yet in $CONFDIR/$id/conf.reset");
    if($mtime>$RESET_TIMEOUT) {
       unlink $rfile;
       # TBD Kill if pid
       $conf{$id}->{_STATUS}='RESET-FAILURE';
    }
  }
  return 1;
}

#-------------------------------------
# return 1 if command is pending
#-------------------------------------
sub is_cmd {
  my $id=shift;
  return 0 if ! -f "$CONFDIR/$id/cmd_reset";
  return 1;
}

#-------------------------------------
# run program if requested
sub exec_cmd {
  my ($id,$reason)=@_;
  unlink "$CONFDIR/$id/cmd_reset" if -f "$CONFDIR/$id/cmd_reset";
  $log->info("RESET DEVID=$id, reason=$reason");
  system("$CMD_RESET $id >/dev/null 2>&1 &"); # runs in background
}
#-------------------------------------
# return 1 if device is faulted
#-------------------------------------
sub is_faulted {
  my $id=shift;
  return 0 if not defined $faulted{$id};
  return 0 if $faulted{$id}->{count} < $COUNT4FAULTED;
  return 1;
}

#-------------------------------------
# return 1 if falted device needs to be tried (every DELAY4FAULTED sec)
# return 1 for if defice is not faulted
#-------------------------------------
sub need_try_faulted {
  my $id=shift;
  return 1 if not defined $faulted{$id};
  return 1 if time()-$faulted{$id}->{last}>=$DELAY4FAULTED;
  return 0;
}

sub last_tried_faulted {
  my $id=shift;
  return time()  if not defined $faulted{$id};
  $faulted{$id}->{last};
}

#-------------------------------------
# count how many times device fails
#-------------------------------------
sub count_faulted {
  my $id=shift;
  if(not defined $faulted{$id}) {
    my %fail=(last=>time(),since=>time(),count=>0);
    $faulted{$id}=\%fail;
  }else {
    $faulted{$id}->{count}++;
    $faulted{$id}->{last}=time();
  }
  if ($faulted{$id}->{count} == $COUNT4FAULTED) {
    my $msg="Camera (DEVID=$conf{$id}->{OBJID}) is considered as faulted since it failed $COUNT4FAULTED times";
    $conf{$id}->{_STATUS}='BROKEN';
    $log->info($msg);
    $log_db->warn($msg);
  }
}

#-------------------------------------
# exclude from faulted
#-------------------------------------
sub reset_faulted {
  my $id=shift;
  $faulted{$id}->{count}=0;
#  delete $faulted{$id};
}

#-------------------------------------
# next time faulted camera will be tried
# ignore not faulted cameras
#-------------------------------------
sub force_try_faulted {
  my $id=shift;
  return if not defined $faulted{$id};
  $faulted{$id}->{last}-=$DELAY4FAULTED;
}

#------------------------------------------------------------------------
# check the age of pictures
#------------------------------------------------------------------------
sub check_pics { ### check old pictures; if picture old - scratch the picture ###
    foreach my $dev (keys %conf) {
        next if $conf{$dev}->{DEVICETYPE} !~ /CAMERA/i;
        next if $conf{$dev}->{PROXYCAMERA} =~ /yes/i;	# Don't scratch PROXYCAMERAs
        #next if $conf{$dev}->{ARCHSTATE} =~ /off/i;	# Don't scratch turned off cameras
        next if $conf{$dev}->{ROUTINE} !~ /[AV]/;       # Don't scratch inactive cameras
        next if $conf{$dev}->{_STATUS} =~ /^RESETTING$/;    # Don't scratch RESET
        next if defined $conf{$dev}->{_START_TIME} and time-$conf{$dev}->{_START_TIME}<$START_TIME_LIMIT;
        my $ss = get_mtime(-f "$LIVEPATH/$dev.jpg" ? "$LIVEPATH/$dev.jpg" : "$LIVEPATH/${dev}_0.jpg");
        my $dterm=($ss>10000)?'unknown long time': "$ss seconds";
        $log->debug("check_pic: on $dev ss=$ss") if $log->is_debug();
        my $max_delay = CalculateMaxCameraDelay($dev);
#        $log->info(Dumper(\%faulted));
        if (is_faulted($dev) ){         # remove camera from faulted list if it produces at least one frame
           if(time()-last_tried_faulted($dev)>$ss) {
             reset_faulted($dev);
             $log->info   ("Camera (ID:$conf{$dev}->{OBJID}) has a new picture; 'faulted' attribute is removed");
             $log_db->info("Camera (ID:$conf{$dev}->{OBJID}) has a new picture; 'faulted' attribute is removed");
           }
        }
        $conf{$dev}->{_STATUS}='ON' if $ss <= $max_delay;   # we have a fresh picture, so the camera is on
        if ($ss > $max_delay) { #  RED X
            if (not -f "$LIVEPATH/dead.$dev.jpg") {{ # just died few seconds ago
                if ($conf{$dev}{AVATARID}) { # check Status propagation interval for avatar cameras
                    my $av = $conf{ $conf{$dev}{AVATARID} };
                    last if not $av;
                    my $prop_int = $av->{STATUS_PROPOGATION_INTERVAL};
                    if ($ss < $prop_int) {
                        $log->warn('Set ON-DEMAND status on DEVID=', $dev, '! (Frozen for ', $dterm, ', propagation interval=', $prop_int, ')');
                        $conf{$dev}->{_STATUS} = 'ON-DEMAND'; # Special state for avatar cameras using 'on-demand' policy
                        last;
                    }
                }
                my $ref="$LIVEPATH/$dev.jpg";
                $ref='/tmp' if not -f "$LIVEPATH/$dev.jpg"; #if reference file is missing
                $log->warn('CPT-0007 Draw RED X on DEVID=', $dev, '! (Dead for ', $dterm, ', max_delay=', $max_delay, ')');
                $log_db->warn("Draw RED X on camera '$conf{$dev}->{NAME}' (ID:$conf{$dev}->{OBJID}). (Dead for $dterm )");
                system("touch -r $ref $LIVEPATH/dead.$dev.jpg"); # create empy image, RED-X will be drawn later
                if($conf{$dev}->{_STATUS} ne 'RESET-FAILURE') {  # do not mess with RESET-FAILURE
                  my $pidState = $conf{$dev}->{stat_STATUS};
                  if( ( !defined $pidState ) || !$pidState || ( $pidState eq 'OK' ) ) {
                      $conf{$dev}->{_STATUS}='DOWN';             # picture is old, so the camera is down
                      $log->info("DEVID=$dev is marked as DOWN");
                  } else {
                      $conf{$dev}->{_STATUS}=$pidState;
                  }
                }
            }}
        }
        elsif (-f "$LIVEPATH/dead.$dev.jpg") { # move out body if dead
            unlink "$LIVEPATH/dead.$dev.jpg";
            system("touch -r $APL $STILLPATH/still.$dev.jpg");
            $log->info('Remove RED X on DEVID=', $dev, '! (Dead for ', $dterm, ', max_delay=', $max_delay, ')');
            my $msg = "Camera '$conf{$dev}->{NAME}' (ID:$conf{$dev}->{OBJID}) response received. Remove 'Red X' mark.";
            $log_db->warn($msg);
            $conf{$dev}->{_STATUS}='ON' if  $conf{$dev}->{_STATUS} eq 'DOWN';
        }
    }
}

#------------------------------------------------------------------------
# Annotate camera low-res snapshots with dots according to camera status
# Place resulting image near live one
#  ex: /tmp/102_0_status.jpg
#------------------------------------------------------------------------

sub mk_snapshots {
    foreach my $dev (keys %conf) {
        next unless $dev =~ /^\d+$/; # Skip non-camera devices
        my $cfg = $conf{$dev};
        my $st = $cfg->{_STATUS};
        if (not $st) {
            if ($cfg->{ARCHSTATE} eq 'off') {
                $st = 'OFF';
            } else {
                $st = 'DOWN';
            }
        }
        my $oldst = $cfg->{_old_STATUS};
        my $stat = "$LIVEPATH/${dev}_0_status.jpg";
        my $live = "$LIVEPATH/${dev}_0.jpg";
        next if not -f $live;
        my $mtime = -f $stat ? get_mtime($stat) : time;
        next if $mtime < 60 and defined $oldst and $oldst eq $st; # Skip cameras with no state changes
        # Draw dot using Image::Magick
        my $color = exists $stat2clr{$st} ? $stat2clr{$st} : $stat2clr{other};
        draw_dot($live, $stat, $color);
    }
}

sub draw_dot {
    my ($src, $dst, $dot) = @_;
    
    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');
        my $rad = ($width > $height ? $height : $width) / 16; # circle radius
        my $points=int($width - $rad - 3). ",". int($rad + 3). ", ". int($width - 3). ",". int($rad + 3);
        
        $_=$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')
        
        $_ = $image->Write($dst);
        die($_) if $_;
  }; # end eval
  if($@) {
    my $err = $@;
    $log->warn("Error creating status image for $src: $err");
  }
}

sub killakid { # !!! TBD err handle; TBD parents check
#---------------------------------------------------------------------
# ex: /opt/sarch/var/conf/30/pids/cam_mretr.15035
#     KIDS=21935,21937
# killakid will read the file. then kill proc if pid and ppid are correct
#---------------------------------------------------------------------
  my $fpid=shift;
  my $dadpid;
  $dadpid = $1 if $fpid =~ /.+\.(\d+)$/; # last number is a pid of retriever itself
  $log->info("killing leftover processes after retriever pid=$fpid");
  if (open (PID,"$fpid")) {
     my %info=map{/(^\w+)=(.+)/} grep {/^\w+=.+/} <PID>;
     close PID;
     if(exists $info{KIDS}) { # we have string KIDS=21935,21937
        $log->info("processes to be killed: $info{KIDS}");
        my @kids=split(',',$info{KIDS});
        foreach my $kidpid (@kids) {
           next if not $kidpid=~/^\d+$/;           # skip empty elements
           if(open(PS,"ps -o pid,ppid,command $kidpid|")) { # need to check that ppid is correct!
              while(<PS>) {
                 if(/^\s*\d+\s+(\d+)\s+/) {        # foreach row with 2 number on front
                    if($1==$dadpid || $1==1)  {    # because in case of cam_mretr death PPID its descendants becomes equal 1
                       $log->info("killing an analytic process: $_");
                       kill 9,$kidpid;
                    }
                 }
              }
              close PS;
           }
        }
     }
  }
}


sub kill_retriever    {      # kill retriever, unlink pid (only for cam_mretr)
  my ($sig,$id,$pid)=@_;     # usage kill_retriever(9,1,23123);

  if(defined $pid) {         # kill explicitly defined retriever
    kill ($sig,$pid);
    if($sig==9) {            # only for SIGKILL we clean the mess
      $log->info("cleaning after retriever DEVID=$id");
      killakid("$CONFDIR/$id/pids/$MRETR.$pid");
      unlink "$CONFDIR/$id/pids/$MRETR.$pid";
    }
  }else            {         # kill implicitly defined retriever (no pid)
  #     $log->info("implicitly kill [$id] sig $sig, checking dir $CONFDIR/$id/pids for files $MRETR");
        if(opendir(CFDIR, "$CONFDIR/$id/pids")) {
          my @pids=grep {/$MRETR\.\d+/} readdir(CFDIR);
          closedir CFDIR;
          foreach (@pids) {
              my ($implpid)=/$MRETR\.(\d+)/; #implicit pid
              kill ($sig,$implpid);
              if($sig==9) { # only for SIGKILL we clean the mess
                $log->info("cleaning after retriever DEVID=$id since found $_");
                killakid("$CONFDIR/$id/pids/$MRETR.$implpid");
                unlink "$CONFDIR/$id/pids/$MRETR.$implpid";
              }
          }
        }
  }
}

#------------------------------------------------------------------------
# check result from a ping demon.
# return UNKNOWN if result is old (200 seconds) or does not exist
#------------------------------------------------------------------------
sub get_ping_result    {
   my $dev=shift;
   my $stat="$CONFDIR/$dev/stat.network";
   return 'UNKNOWN' if get_mtime($stat) >200;
   if(open STAT,"$CONFDIR/$dev/stat.network") {
     $_=<STAT>;
     chomp;
     s/PING=//;
     return $_;
   }else{
     return 'UNKNOWN';
   }
}

sub verify_retriever { #### check alive devices, if device dead then restart it! #####
    my $msg;
    #----------------------------- prepare hash for each working retreiver based on `ps`
    open(PS,"ps -au$> -o pid,ppid,command|")  or $log->error("Cannot get ps -au$> -o pid,command");
    my @plist=<PS>;         # we need that list for debug only;
    close PS;
    %mretr_pids = ();
    my %mretr; #-------------------- build the hash: $mretr{$camid}->[PID,PPID]
    foreach(@plist) {
      if (/^\s*(\d+)\s+(\d+)\s+.*(\Q$IP_RETRIEVER\E)\s+(a?\d+)/){ # if it is a retriever
        if(defined $mretr{$4}) {        # What the FORK are they doing here?
           $log->debug("verify_retriever: Looks like FORK. Checking DEVID=$4;"); # See ps list:\n@plist");
           if($mretr{$4}->[0]==$2) {    # we already have a parent in hash
             $log->debug("verify_retriever: we have found a parent and the child");
             next;
           }elsif($mretr{$4}->[1]==$1) {# we laredy have a child but the perent is found. Swap-em!
             $log->debug("verify_retriever: we have found a child and the parent, let's swap'em");
           }else{
             $log->info("verify_retriever: killing extra retreiver DEVID=$4");
             kill_retriever(9,$4,$1);               # unlikely we ever do this kill
           }
        }
        $mretr{$4}=[$1,$2];
        $mretr_pids{$4}=$1;
      }
    }#--------------------------- %mretr is prepared; usage $mretr{$camid}->[0]=PID

    foreach my $id (keys %conf) {
        next if $conf{$id}->{DEVICETYPE} eq 'AVATAR';
        pid2stat($id,(exists $mretr{$id})?$mretr{$id}->[0]:'');  # collect stat information from pid (one in 30 seconds)
        next if is_resetting($id);                               # skip device if resetting in progress
        next if $conf{$id}->{_STATUS}=~/^RESET/; # RESETTING,RESET-FAILURE
        if ($conf{$id}->{DEVICETYPE} eq 'CAMERA') { # device - camera
            $log->debug('verify_retriever: on ', $id, ' [routine=', $conf{$id}->{ROUTINE}, ']') if $log->is_debug();
            next if $conf{$id}->{PROXYCAMERA} eq 'yes';         # fully ignore PROXY cameras
            next if exists  $conf{$id}->{AVATARID} and $conf{$id}->{AVATARID} ne '';   # ignore AVATAR cameras
            if($conf{$id}->{CAMERAMODEL} ne 'URL') {
              next if $conf{$id}->{DEVIP} eq '0.0.0.0';# do not touch cameras with empty IP (only IP cams here)
            }
            if(defined $conf{$id}->{_START_TIME} and time-$conf{$id}->{_START_TIME}<$START_TIME_LIMIT) {
              $log->info("Skipping retriver check for $id since started less then $START_TIME_LIMIT ago");
              next;
            }
            if(defined $conf{$id}->{_STOP_TIME}) { # -- we let retriver stop itself in STOP_TIME_LIMIT seconds
              if(exists $mretr{$id}) {             # retriever is alive still
                 if(time-$conf{$id}->{_STOP_TIME}<$STOP_TIME_LIMIT) {
                    $log->info("Skipping retriver check for $id since stopped less then $STOP_TIME_LIMIT ago");
                    next;
                 }else {
                    $log->warn("Retriver ($id,$mretr{$id}->[0]) did not stop in $STOP_TIME_LIMIT seconds. Terminating ..");
                    kill_retriever(9,$id,$mretr{$id}->[0]);
                    delete  $mretr{$id};   # remove info about proccess
                 }
              } else {                             # retreiver is dead
                    kill_retriever(9,$id);
              }
            }
            do{$conf{$id}->{_STATUS}='OFF'; next} if not $conf{$id}->{ROUTINE} =~ /[AV]/;
            if( exists $conf{$id}->{stat_STATUS} && $conf{$id}->{stat_STATUS} && ($conf{$id}->{stat_STATUS} ne 'OK') ) {
                $conf{$id}->{_STATUS}=$conf{$id}->{stat_STATUS};
            }
            if (is_faulted($id)) {
               next if not need_try_faulted($id);  # do not restart faulted devices
               my $ping_result=get_ping_result($id);
               if($ping_result=~/^FAIL/) {
                  $log->warn("CPT-OOOO Network connection to camera DEVID=$id ($conf{$id}->{DEVIP}) is lost. Check that the camera is ON and connected to the network");
                  count_faulted($id);
                  next;
               }
            }
            my $object="$CONFDIR/$id/pids/$MRETR.";                    # TBD, analyze this!
            $object.= $mretr{$id}->[0] if defined $mretr{$id};
            my $ss = get_mtime($object);	    # how old is a pid file
            my $maxdelay = 2 * CalculateMaxCameraDelay($id);           # for fast cameras it will be 8 seconds here
            $maxdelay=15 if $conf{$id}->{MEDIA_FORMAT}=~/(mpeg4|h264)/; # special case for mpeg4 and h264
            if (($ss >= $maxdelay) or not defined $mretr{$id}) { # picture was lost(RedX) or mretr is dead
                if (not defined $mretr{$id}) {
                   $log->info("CPT-0001 Retriever for camera DEVID=$id is absent in memory, will be restarted");
                   kill_retriever(9,$id);                              # because it is need to kill all retriever childs
                   `rm -f $CONFDIR/$id/pid $CONFDIR/$id/pids/$MRETR.*`;# cleanup pid file for dead retriever if any
                }
                else {
		   $log->info("CPT-0002 kill retriever on camera DEVID=$id reason: no pictures more then $ss seconds, trigger=$maxdelay seconds");
                   kill_retriever(9,$id,$mretr{$id}->[0]);   # SIGKILL is only way here
		}
                count_faulted($id);              # count faulted unconditionally even for first start
                $conf{$id}->{_STATUS}='STARTING' if ! is_faulted($id);  # one failted stays faulted
                $conf{$id}->{_START_TIME}=time;  # mark the time when retreiver started
                delete $conf{$id}->{_STOP_TIME} if defined $conf{$id}->{_STOP_TIME}; # if retriver was ever stopped
                `$IP_RETRIEVER $id >/dev/null 2>/dev/null &`;
                $log->info("CPT-0003 Retriever $MRETR for DEVID=$id has been started");
                $msg = "Camera '$conf{$id}->{NAME}' (ID:$conf{$id}->{OBJID}) retriever restarted.";
                # $log_db->info($msg); # AT???? commented out due to high DB poluuting - 25 records per minute
            }
        }elsif ($conf{$id}->{DEVICETYPE} eq 'AUDIO') { # device - audio
            $log->debug('verify_retriever(audio): on ', $id, ' [routine=', $conf{$id}->{ROUTINE}, ']') if $log->is_debug();
            # ignore non-HTTP. if RTSP then de-mux from video stream
            # except panasonic BL-C210A
            next if     $conf{$id}->{PROTO} ne 'HTTP' and $conf{$id}->{CAMERAMODEL} ne 'panasonic' || $conf{$id}->{MODELID} ne 'BL-C210A';
            next if     $conf{$id}->{CAMERAMODEL} eq 'iStream';              # ignore iStream devices. They send audio multiplexed
            next if not $conf{$id}->{ROUTINE} =~ /[AV]/;
            next if is_faulted($id) && not need_try_faulted($id);   # do not restart faulted devices
            my $ss = get_mtime("$LIVEPATH/$id.aac");
            my $maxdelay = 5;                                       # initially 5 sec constant
            if (($ss >= $maxdelay) or not defined $mretr{$id}) {    # the sound is lost or audio retreiver is down
                if (not defined $mretr{$id}) {
                    $log->info("CPT-0001 Retriever for audio DEVID=$id is absent in memory, will be restarted");
                   `rm -f $CONFDIR/$id/pid $CONFDIR/$id/pids/$MRETR.*`;# cleanup pid file for dead retriever if any
                }else {
                    $log->info("CPT-0002 kill audio retriever on camera DEVID=$id reason: no audio stream more then $ss seconds, trigger=$maxdelay seconds");
                     kill_retriever(9,$id,$mretr{$id}->[0]);        # SIGKILL is only way here
                }
                count_faulted($id);            # count faulted unconditionally even for first start
                delete $conf{$id}->{_STOP_TIME} if defined $conf{$id}->{_STOP_TIME}; # if retriver was ever stopped
                `touch $LIVEPATH/$id.aac; $IP_RETRIEVER $id >/dev/null 2>/dev/null &`;  # restart retreiver
                # have to touch dev.jpg - otherwise retreiver may be killed even before it made any image
                $log->info("CPT-0003 Retriever $MRETR for DEVID=$id has been started");
            }
        }

    } # end foreach camera loop
}



sub diff { ########## compare file1 and file2 and return 1 if diff --brief #####
    my ($f1, $f2) = @_;
    @difference=();
    return 2 if not -f $f1;
    return 2 if not -f $f2;
    open DIFF, "diff $f1 $f2 2>/dev/null|";
    @difference= grep {/^[<>]\s/} <DIFF>;
    close DIFF;
    $log->debug("diff: diff $f1 $f2 => '@difference'") if $log->is_debug();
    return 1 if @difference;
    return 0;
}


sub stop_retr { ############## Stop retriever ##################################
    my $dev = shift;
    $log->info('CPT-0004 Stop retriever on DEVID=', $dev);
    $conf{$dev}->{_STOP_TIME}=time;           # mark the time when the stop begin
    kill_retriever(15,$dev);                  # send kill TERM (may take some time to terminate)
    my $msg = "Camera '$conf{$dev}->{NAME}' (ID:$conf{$dev}->{OBJID}) retriever stopped.";
    $log_db->info($msg);
}

sub send_sighup { ############## Send sighup to retriever#######################
    my ($dev,$usr) = @_;
    my $signame = $usr?"SIGUSR1":"SIGHUP";
    $log->info("$signame will be sent to retriever on DEVID=$dev");
    kill_retriever($usr?10:1,$dev);
    my $msg = "Camera '$conf{$dev}->{NAME}' (ID:$conf{$dev}->{OBJID}); $signame is sent to retriever.";
    $log_db->info($msg);
}

sub send_signal { ####### Send signal to all process by procname /pathto/prog###
		  # note, only procs from own user are analyzed
    my $procname=shift;
    my $sig=shift;
    $log->info("signal $sig will be sent to '$procname'");
    $log->error("send_signal:  Wrong arguments signal=$sig proc='$procname'") if($sig<1 or $sig>32 or !$procname);
    system("ps -au$> -o pid,command |grep $procname | grep -v grep | cut -c1-6 | xargs kill $sig 2>/dev/null");
}

sub remove_dev { ### clean space after delete camera from the system ###########
    my $dev = shift;
    my $migrate = shift;
    if (not $migrate) {
        if(exists $conf{$dev}->{AVATARID} and $conf{$dev}->{AVATARID} ne '') { #------------- Avatar's device
            av_cmd($dev, "delete", lc($conf{$dev}->{DEVICETYPE}));
        }
    }
    my $text = $migrate ? "migrated" : "deleted";
    $log->info("Remove ".$text." DEVID=", $dev);
#    TIME EXPENSIVE      stop_retr($dev);        # give a chance to stop
#          !!!           sleep 1;                # TBD: the sleep exceptionly set
    kill_retriever(9,$dev); # SIGKILL
    my $msg = "Device '$conf{$dev}->{NAME}' (ID:$conf{$dev}->{OBJID}) $text, cleaning up from storage.";
    $log_db->info($msg);
    $log->info($msg);
    `rm -rf $VARPATH/dev/$dev` if -e "$VARPATH/dev/$dev";
    `rm -rf $LIVEPATH/$dev.jpg $LIVEPATH/${dev}_*.jpg $LIVEPATH/dead.$dev.jpg`; # delete frame from live
    rename "$CONFDIR/$dev/conf","$REMOVED/$dev";         # schedule request for removig storage
    `rm -rf $CONFDIR/$dev`     if -e "$CONFDIR/$dev";    # Delete from $CONFDIR
    unlink("$CONFDIR/conf/$dev.conf") if -e "$CONFDIR/conf/$dev.conf";   # special case for NEW & DELETED
    $log->error("Cannot remove: rm -rf $CONFDIR/$dev \n".`ls -la $CONFDIR/$dev $CONFDIR/conf`) if $?;
    delete $conf{$dev} if exists $conf{$dev};
    $log->info("Device '$dev' has been $text");
}

sub remove_avatar {
    my $objid = shift;
    system("/bin/rm -rf $AVCONFDIR/$objid &>/dev/null");
    $log->info("AVATAR configuration for ObjId=$objid was deleted");
    #av_cmd($objid, "delete", "avatar");
}

#------------------------------------------------------------------------------
# set routines for cameras based on conf (used to be depend on simple-schedule)
#
# routine = [ A,AM,AMD,V, X ]
#  A   - archiving only
#  AM  - archiving and motion detection
#  AN  - archiving and analytics
#  V   - view only                                                      [ X ]
#  s912 extension:
#  Am  - archiving + MD report events to eventlog store video for MD and extenal events
#  Aw  - archiving + MD do not report event into e-log but store only motion and extenal events
#  Ae  - archiving but store video only if extenal events
#  Attn!! STORAGE_POLICY=5 & STORAGE_POLICY=6 are hardcoded (initially)
#------------------------------------------------------------------------------
sub set_routine {

    foreach my $devid (keys %conf) {
        next if $conf{$devid}->{DEVICETYPE} !~ /(CAMERA|AUDIO)/;
        my $routine;
        my %cfg = %{ $conf{$devid} };
        # calculate routine based on config
            if( $cfg{ARCHSTATE} eq 'on' ) {
                if( $cfg{STORAGE_POLICY} != -7 ) {
                    $routine  = 'A';
                } else {
                    $routine  = 'V';
                }
            }
            $routine .= 'M' if $cfg{VAE_MOTION_ACTIVE} eq 'yes';
            $routine .= 'N' if $cfg{VAE_ACTIVE} eq 'yes';
        # s912 extension: --------
        if($routine=~/A/){                   # only if camera archinging
              if($cfg{STORAGE_POLICY} == -5) {
                if($routine=~/M/) {
                  $routine=~s/M/m/;          # archive only MD+events. report MD events to elog
                }else {
                  $routine.='w';             # archive only MD+events. do not report MD events to elog
                }
              }elsif($cfg{STORAGE_POLICY} == -6) {
                if($routine=~/M/) {
                  $routine=~s/M/e/;          # archive only if events
                }else {
                  $routine.='e';             # archive only if events
                }
              }
        }
        #-------------------------
        # clean routine for audio device if AUDIO=off
        $routine ='' if $conf{$devid}->{DEVICETYPE} eq 'AUDIO' and $conf{$devid}->{AUDIO} eq 'off';
        open ROUTINE, "$CONFDIR/$cfg{DEVID}/routine"; # read current routine
        $_ = <ROUTINE>;
        close ROUTINE;
        s/\s//g;

        if ($routine ne $_) {
            $log->info("Set routine for ID=$cfg{DEVID}: [$routine], previous:[$_]");
            open ROUTINE, ">$CONFDIR/$cfg{DEVID}/routine"; # place routine info into file
            print ROUTINE "$routine\n";
            close ROUTINE;
            #$log->debug('ROUTINE');
            $conf{$cfg{DEVID}}->{ROUTINE} = $routine;
            stop_retr($cfg{DEVID});
        }
        $conf{$cfg{DEVID}}->{ROUTINE} = $routine;
#       $log->info("DEV: $cfg{DEVID}  routing assigned as  [$routine]");
    }
}

sub write_stat {
#-------------------------------------------------------------
# write stat info for retrievers if status or stat info is changed
#-------------------------------------------------------------
     my $dev=shift;
     my $current=$conf{$dev};
     next if not exists $current->{_STATUS};
     $current->{_old_STATUS}='n/a'  if not exists $current->{_old_STATUS};
     $current->{_old_stat_UPTIME_SEC}=0 if not exists $current->{_old_stat_UPTIME_SEC};
     next if  $current->{_STATUS}         eq $current->{_old_STATUS}          # the same status, nothing to write
          and $current->{stat_UPTIME_SEC} eq $current->{_old_stat_UPTIME_SEC};# the same uptime
     if( not  exists $current->{stat_VL_RATE_LAST}) {              # have to read from old stat file
       open(OLDSTAT,"$CONFDIR/$dev/stat");
       my %info=map{/(^\w+)=(.+)/} grep {/^\w+=.+/} <OLDSTAT>;
       close OLDSTAT;
       $current->{stat_VL_RATE_LAST}=$info{STAT_VL_RATE_LAST};
     }
     if(open  STAT,">$CONFDIR/$dev/stat.tmp") {
        print STAT "STATUS=$current->{_STATUS}\n";
        foreach my $attr ( grep {/^stat_/} keys %$current) {
            print STAT uc($attr)."=$current->{$attr}\n";
        }
        close STAT;
        unlink("$CONFDIR/$dev/stat") if -f "$CONFDIR/$dev/stat";
        rename "$CONFDIR/$dev/stat.tmp","$CONFDIR/$dev/stat";
     }
     $conf{$dev}->{_old_STATUS}         =$conf{$dev}->{_STATUS};   # for future comparation
     $conf{$dev}->{_old_stat_UPTIME_SEC}=$conf{$dev}->{stat_UPTIME_SEC};
}

sub pid2stat {
#--------------------------------------------------------------
# load stat information from pid file
# do not make check if last check happen less then 30 seconds ago
#--------------------------------------------------------------
   my $dev=shift;
   my $pid=shift;# later will use (defined $conf{$dev}->{_pid})?$conf{$dev}->{_pid}:0;
   return if exists $conf{$dev}->{_CHECK_TIME} and time-$conf{$dev}->{_CHECK_TIME}<30;
   $log->debug("pid2stat: dev=$dev pid=$pid");
   $conf{$dev}->{_CHECK_TIME}=time;
   my %stat=(UPTIME=>0,OUTPUT=>0,FRAMES=>0);
   my %info;
   if($pid and open(PID,"$CONFDIR/$dev/pids/cam_mretr.$pid")) {
      %info=map{/(^\w+)=(.+)/} grep {/^\w+=.+/} <PID>;
      close PID;
   }
   $conf{$dev}->{stat_METADATA_RECEIVING} = $info{METADATA_RECEIVING} if exists $info{METADATA_RECEIVING};
   my @parts = gmtime($info{UPTIME}); # 7-days 2-hours 1-minutes 0-secs
   my $uptime='none';
   if(    $parts[7]) { $uptime = sprintf ("%d days %02d hours",@parts[7,2]);
   }elsif($parts[2]) { $uptime = sprintf ("%2d:%02d hours",    @parts[2,1]);
   }elsif($parts[1]) { $uptime = sprintf ("%2d:%02d minutes",  @parts[1,0]);
   }elsif($parts[0]) { $uptime = "$parts[0] seconds";
   }
   $conf{$dev}->{stat_UPTIME}=$uptime; # human-readable format
   if($info{UPTIME}) {                 # retreiver is working
     $conf{$dev}->{stat_UPTIME_SEC}=$info{UPTIME};
     my $liveTime = $info{UPTIME} - $info{WAITTIME};
     if( $liveTime ) {
        $conf{$dev}->{stat_FPS}=sprintf("%2.1f",$info{FRAMES}/$liveTime);
        $conf{$dev}->{stat_VL_RATE}=int($info{OUTPUT}/$liveTime);
     } else {
        $conf{$dev}->{stat_FPS}=0;
        $conf{$dev}->{stat_VL_RATE}=0;
     }
     $conf{$dev}->{stat_VL_RATE_LAST}=$conf{$dev}->{stat_VL_RATE}; # last known value
     $conf{$dev}->{stat_WAITTIME_SEC}=$info{WAITTIME};
     $conf{$dev}->{stat_STATUS}=$info{STATUS};
   }else {                            # retriver is not working or stat is not collected
     $conf{$dev}->{stat_UPTIME_SEC}=0;
     $conf{$dev}->{stat_FPS}=0;
     $conf{$dev}->{stat_VL_RATE}=0;
     # do not update $conf{$dev}->{stat_VL_RATE_LAST} since it shows tha last known rate
   }
   write_stat($dev);
}
#--------------------------------------------------------------
sub touch_conf  { ################# update time for conf_upd for indication of configuration change
  if (not -f "$CONFDIR/conf_upd") {
    if(open (UPD,">$CONFDIR/conf_upd")) {
      print UPD "modification time of this file indicates change in some of camera configuration";
      close UPD;
    } else { $log->error("Cannot create $CONFDIR/conf_upd"); }
  } else {
     utime undef, undef, "$CONFDIR/conf_upd"
  }
}
#--------------------------------------------------------------
sub load_newconf {
    my $dev=shift;
    my %conf;
    if(open(NEWCONF,"$CONFDIR/conf/$dev.conf")) {
      %conf=map{/(^\w+)=(.+)/} grep {/^\w+=.+/} <NEWCONF>;
      close NEWCONF;
    }
    return \%conf;
}

sub read_av_cmd {
    my $cmd_file = shift;
    
    if (open FH, $cmd_file) {
        my %cmd = map {/(\w+)=(.*)/} grep {/^\w+=.*$/} <FH>;
        close FH;
        return \%cmd;
    }
    else {
        $log->error("Error opening file $cmd_file: $!");
        return;
    }
}

sub av_cmd {
    return if not -e $NODE2AVATAR;
    
    my ($dev, $action, $devtype, $avatarid, $objid, $exists);
    my $cmd_file;
    if (@_ == 1) { # Single argument - av_cmd file path
        $cmd_file = @_[0];
        my $cmd = read_av_cmd($cmd_file);
        if (not $cmd) {
            unlink $cmd_file;
            return;
        }
        $exists = 1;
        ($dev, $action, $devtype, $avatarid) = ($cmd->{DEVID}, $cmd->{ACTION}, $cmd->{TYPE}, $cmd->{AVATARID});
        $objid = $cmd->{OBJID};
        $objid = $1 if not $objid and $dev=~/^\D?(\d+)$/;
    }
    else { # Several args - list of cmd parameters
        ($dev, $action, $devtype, $avatarid, $exists) = @_;
        ($objid) = $dev=~/^\D?(\d+)$/;
        $cmd_file = $devtype eq 'avatar' ? "$AVCONFDIR/$objid/av_cmd" : "$CONFDIR/$dev/av_cmd";
        $cmd_file = "$AVCONF_DEL/$dev" if $action eq 'delete';
    }
    
    if (not $avatarid) {
        $avatarid = $devtype eq 'avatar' ? $objid : $conf{$dev}{AVATARID};
    }
    
    # Special case: 
    # if device was already removed, do not accept any action except 'delete'
    if (not $conf{$dev} and $action ne 'delete') {
        $log->warn("'$action' action is forbidden for deleted device (DEVID=$dev)");
        return;
    }
    
    my $args = "-o $objid -a $action -t $devtype";
    $args .= " -v $avatarid" if $action eq 'delete';
    my $cmd_wait_file = "${cmd_file}.wait";
    my $cmd = "DEVID=$dev\nOBJID=$objid\nAVATARID=$avatarid\nTYPE=$devtype\nACTION=$action";
    
    $log->info("Inform Avatar: DEVID=$dev AVATARID=$avatarid ACTION=$action DEVICETYPE=$devtype");
    
    if (-f $cmd_file and not $exists) { # Process already running, create/replace 'wait' file
        unlink $cmd_wait_file if -f $cmd_wait_file;
        if ($action ne 'delete') { # Do not queue delete commands
            open (FH, '>', $cmd_wait_file);
            print FH $cmd;
            close FH or die "Error closing $cmd_wait_file: $!\n";
        }
        return 1;
    }
    
    # Special case:
    # If update command already running but 'delete' came
    # Terminate existing process
    if ($action eq 'delete' and exists $node2avatar{$dev} and $node2avatar{$dev}{ACTION} ne 'delete') {
        my $pid = $node2avatar{$dev}{PID};
        kill 'KILL', $pid;
        waitpid($pid, 0);
        $log->info("node2avatar terminated for DEVID=$dev caused by 'delete' action arrived");
        unlink $node2avatar{$dev}{FILE};
        delete $node2avatar{$dev};
    }

    my ($in, $out, $err);
    my $pid = 0;
    eval {
        # Write params to $cmd_file if not called for already existing file
        if (not $exists) {
            unlink $cmd_file if -f $cmd_file;
            open (FH, '>', $cmd_file) or die "Error creating $cmd_file: $!\n";
            print FH $cmd;
            close FH or die "Error closing $cmd_file: $!\n";
        }
        $err = gensym; 
        $out = $err;
        $pid = open3($in = gensym, $out, $err, "$NODE2AVATAR $args");
        close($in);

        my $flags = fcntl($err, F_GETFL, 0);
        fcntl($err, F_SETFL, $flags | O_NONBLOCK) or die "Couldn't set flags: $!\n";
    };
    if ($@) {
        chomp $@;
        $log->error("av_cmd() for DEVID=$dev failed: $@");
    }

    if (exists $node2avatar{$dev}) { # Update element
        my $proc = $node2avatar{$dev};
        
        $proc->{ACTION} = $action;
        $proc->{RTIME} = time;
        $proc->{PID} = $pid;
        $proc->{STDERR} = $err;
        $proc->{FILE} = $cmd_file;
        $proc->{ATTEMPT}++;
        $proc->{STATUS} = $N2A_STAT_STARTED;
        $proc->{RESTART} = 0;
    }
    else {
        my $proc = {
            DEVID    => $dev,
            OBJID    => $objid,
            AVATARID => $avatarid,
            TYPE     => $devtype,
            ACTION   => $action,
            RTIME    => time,
            PID      => $pid,
            STDERR   => $err,
            FILE     => $cmd_file,
            ATTEMPT  => 1,
            STATUS   => $N2A_STAT_STARTED,
            RESTART  => 0
        };

        $node2avatar{$dev} = $proc;
    }
}

#--------------------------------------------------------------
sub handle_avatar {
    my ($dev, $conf) = @_;
    my $confpath = "$CONFDIR/conf/$dev.conf";
    my $objid = $conf->{OBJID};
    # create dedicated area for avatar devices if doesn't exist
    mkdir $AVCONFDIR if not -d $AVCONFDIR;
    mkdir $AVCONF_DEL if not -d $AVCONF_DEL;
    my $avdir = "$AVCONFDIR/$objid";
    # If devices is moved to garbage, delete corresponding dir
    if ($conf->{LOCATION} eq '@garbage') {
	remove_avatar($objid);
	unlink $confpath;
	return;
    }
    # Read device conf from flat file and compare with the one from db
    my $is_new_device = -d $avdir ? 0 : 1;
    # Create avatar object dir
    mkdir $avdir, 0755;
    my $diff_result=diff $confpath, "$avdir/conf";
    unlink $confpath, return unless $diff_result;
    if(!$is_new_device) {
	$log->info("AVATAR [ID=$objid] => Configuration is different: ", $diff_result, "\n", @difference);
    } else {
	$log->info("AVATAR [ID=$objid] => This is a new device");
    }
    # Put avatar configuration into its conf dir
    rename $confpath, "$avdir/conf" or 
        $log->error("CPT-0005 Cannot rename $confpath -> $avdir/conf DEVID=$dev");
    %conf = (%conf, GetCfgs(('OBJID' => "$objid")));      # this is the SECOND place where global conf is udated
    # Sync with Avatar
    av_cmd($objid, $is_new_device ? "create" : "update", "avatar");
}

sub av_manager {
    # iterate over existing 'node2avatar' processes and check 'exit code'
    while (my ($dev, $val) = each %node2avatar) {
        if (waitpid($val->{PID}, WNOHANG) > 0) {
            my $exit_code = $? >> 8;
            if ($exit_code == 0) {
                # Remove av_cmd file
                $val->{STATUS} = $N2A_STAT_DONE;
                unlink $val->{FILE};
                $log->info("STRATUS successfully pushed AVATAR device ID:$dev configuration update into AVATAR");
            } else { # read stderr
                my $buf = undef; 
                read($val->{STDERR}, $buf, 1024);
                $log->error("STRATUS was not able to push AVATAR device ID:$dev configuration update into AVATAR");
                $log->error("node2avatar exited with error: AVATARID=$val->{AVATARID} ".
                    "ACTION=$val->{ACTION} DEVTYPE=$val->{TYPE} ATTEMPT=$val->{ATTEMPT}; Output: $buf");
                $val->{STATUS} = $N2A_STAT_FAILED;
                $val->{RESTART} = $val->{ATTEMPT} >= 7 ? time + 120 : time + 2 ** $val->{ATTEMPT};
            }
        }
        elsif (not $val->{RESTART} and time - $val->{RTIME} > $NODE2AVATAR_TIMEOUT ) { # hangs
            $val->{STATUS} = $N2A_STAT_HANG;
            kill 'KILL', $val->{PID};
            waitpid($val->{PID}, 0);
            $log->error("STRATUS was not able to push AVATAR device DEVID=$dev configuration update into avatar");
            $log->error("node2avatar terminated by timeout: AVATARID=$val->{AVATARID} ".
                "ACTION=$val->{ACTION} DEVTYPE=$val->{TYPE} ATTEMPT=$val->{ATTEMPT}");
            $val->{RESTART} = $val->{ATTEMPT} >= 7 ? time + 120 : time + 2 ** $val->{ATTEMPT};
        }
    }
    
    # Restart failed processes
    while (my ($dev, $val) = each %node2avatar) {
        next if $val->{STATUS} == $N2A_STAT_STARTED; # Skip running processes
        delete $node2avatar{$dev},next if $val->{STATUS} == $N2A_STAT_DONE; # remove completed
        if ($val->{TYPE} ne 'avatar' and !-f "$AVCONFDIR/$val->{AVATARID}/conf") {
            # Parent avatar object was already deleted, stop sending commands to it
            $log->info("Stop restarting node2avatar for DEVID=$val->{DEVID} ".
                        "because parent avatar ID=$val->{AVATARID} was deleted");
            unlink $val->{FILE};
            delete $node2avatar{$dev};
            next;
        }
        # Remove failed tasks if limit was reached
        if ($val->{STATUS} == $N2A_STAT_FAILED and $val->{ATTEMPT} >= $N2A_MAX_RETRIES) {
            $log->info("Stop restarting node2avatar for DEVID=$val->{DEVID} after $val->{ATTEMPT} failures");
            unlink $val->{FILE};
            delete $node2avatar{$dev};
            next;
        }
        # TP6748
        # For failed and hanged tasks
        # Do not restart them if another command waiting in queue, run most recent command
        my $cmd_wait = $val->{FILE}. ".wait";
        if (-f $cmd_wait) {
            my $cmd_new = $val->{FILE};
            rename $cmd_wait, $cmd_new;
            $log->info("Stop restarting hanged/failed commands for DEVID=$val->{DEVID} - new command waiting in queue");
            delete $node2avatar{$dev};
            av_cmd($cmd_new);
            next;
        }
        if (time >= $val->{RESTART}) {
            $log->info("Restart node2avatar for DEVID=$val->{DEVID} after failure");
            av_cmd($dev, $val->{ACTION}, $val->{TYPE}, $val->{AVATARID}, 1);
        }
    }
    
    # Scan directories for av_cmd files
    # Look for cmd files for deleted objects
    opendir(DEL, $AVCONF_DEL);
    my %del = map {$_=>1} grep {/^\D?\d+$/} readdir DEL;
    closedir DEL;
    
    my %devs = (%conf, %del);
    foreach my $dev (sort keys %devs) {
        my $av_cmd;
        if ($del{$dev}) {
            $av_cmd = "$AVCONF_DEL/$dev";
        }
        else {
            $av_cmd = $conf{$dev}{DEVICETYPE} eq 'AVATAR' ? "$AVCONFDIR/$dev/av_cmd" : "$CONFDIR/$dev/av_cmd";
        }
        my $av_cmd_wait = "${av_cmd}.wait";
        if (-f $av_cmd) {
            if (not $node2avatar{$dev}) {
                $log->warn("Got av_cmd file for DEVID=$dev and no process is running");
                av_cmd($av_cmd); # Restart process
            }
        }
        elsif (-f $av_cmd_wait) { # av_cmd was removed but another command waiting
            if (not $node2avatar{$dev}) {
                $log->info("Got command in queue for DEVID=$dev. Run it");
                rename $av_cmd_wait, $av_cmd;
                av_cmd($av_cmd);
            }
            else {
                $log->error("No av_cmd for DEVID=$dev but process still running");
                rename $av_cmd_wait, $av_cmd;
            }
        }
        else { # Both av_cmd and av_cmd.wait are missing
            $log->error("No av_cmd for DEVID=$dev but process still running") if $node2avatar{$dev};
        }
    }
}

#--------------------------------------------------------------
sub change_conf { #### check conf dir, mv conf/dev.conf to dev/conf and stop device engine if runing ####
    $log->debug("change_conf:........$CONFDIR/conf") if $log->is_debug();
    opendir(DIR, "$CONFDIR/conf") or die "Cannot open $CONFDIR/conf: $!";

    foreach (readdir DIR) {
            next if not /^(\w?\d+)\.conf/;
            my $dev = $1;
            $log->info('Configuration changed: ', $_);
            my $newconf=load_newconf($dev);
            if (defined $newconf->{DEVICETYPE} and $newconf->{DEVICETYPE} eq 'AVATAR') { # Special processing for Avatars
                handle_avatar($dev, $newconf);
                next;
            }
            remove_dev($dev),next if $newconf->{LOCATION} eq '@garbage'; # REMOVE if deleted
            force_try_faulted($dev);
            my $ThisIsNewDevice=(-d "$CONFDIR/$dev")?0:1;
            my $diff_result=diff "$CONFDIR/conf/$_", "$CONFDIR/$dev/conf";
            $log->info('Configuration is different: ', $diff_result,"\n",@difference);
            if(!$diff_result) {
              unlink "$CONFDIR/conf/$_";       # remove since conf is the same
              next;
            }
            # Check if device was migrated
            if (scalar(grep {/NODEID/} @difference)) {
                my $nodeconf = NodeConf;
                if ($newconf->{NODEID} and $nodeconf->{OBJID} ne $newconf->{NODEID}) {
                    remove_dev($dev, 1);
                    next;
                }
            }
            unlink "$CONFDIR/$dev/geometry"; # Remove geometry file so it'll be recreated!
            mkdir("$CONFDIR/$dev", 0775) if not -d "$CONFDIR/$dev";
            mkdir("$VARPATH/dev/$dev", 0755) if not -d "$VARPATH/dev/$dev";
            rename("$CONFDIR/conf/$_", "$CONFDIR/$dev/conf")
                   || $log->error("CPT-0005 Cannot rename $CONFDIR/conf/$_ -> $CONFDIR/$dev/conf DEVID=$dev");
            #-------
            %conf = (%conf, GetCfgs(('DEVID' => "$dev")));      # this is the FIRST place where global conf is udated
            my $current=$conf{$dev};
            touch_conf                  if  $current->{DEVICETYPE} eq 'CAMERA';
            if ($current->{DEVICETYPE} eq 'CAMERA' and $ThisIsNewDevice) {
        	# Call script synchronously, because VAE directory structure should exist when retriever is started
        	my @out = `$SYNC_VAE_DIRS $dev 2>&1`;
        	chomp foreach @out;
        	if ($?) {
        	    $log->error("Sync VAE dirs FAILED: ".join(';',@out));
        	} else {
        	    $log->info("Sync VAE dirs: ".join(';',@out));
        	}
            }
            #------- remove GEO from diff (ignore geo changes)
            @difference=grep {!/^[<>]\s*CAM_GEO_/} @difference;
            next if ! @difference and ! $ThisIsNewDevice;      # exit if only GEO in difference
            my $id_changed = scalar grep {/OBJID/} @difference;
            if(exists $conf{$dev}->{AVATARID} and $conf{$dev}->{AVATARID} ne '') { #------------- Avatar's device
              $log->info("Avatar update for $conf{$dev}->{OBJID} on $conf{$dev}->{AVATARID} ");
              my $devicetype=lc($conf{$dev}->{DEVICETYPE});
              my $action="";
              if($conf{$dev}->{LOCATION} eq '@garbage') {         #---- remove device from avatar see remove_dev()
                   $action="delete";
              }elsif($ThisIsNewDevice){                                         #---- create device on avatar
                   $action="create";
              }else{                                              #---- update device on avatar
                   $action="update";
              }
              if(-e $NODE2AVATAR) {
                   av_cmd($dev, $action, $devicetype);
              }

              if ($id_changed || $ThisIsNewDevice) { # let's re-read PTZ conf
                send_signal($PTZSERVER,1);
              }
              system($PROCCFG);

              next if not $conf{$dev}->{LOCATION} eq '@garbage'; # no other cation nedded if update/create
            }                                                                      #------------- End Avatar's device
            unlink("$REMOVED/$dev") if -e "$REMOVED/$dev";       # if we restore backup and have deleted device previously
            if($current->{DEVICETYPE} eq 'CAMERA' && $current->{LOCATION} ne '@garbage') {
               my $difflist=join ",", map {/^<\s*(\w+)=/} @difference;
               my $restart1=scalar grep {/(CAMERAMODEL|DEVICETYPE|ARCHSTATE|RC_|IMAGESIZE|CAMERA|AUDIO|MEDIA_FORMAT|IFRAMES_MAXBITRATE|VAE_MOTION_|METADATA_PORT|ONVIF_)/} @difference;
               my $restart2=scalar grep {/(CHANNEL|MEDIA_FORMAT|FRAMERATE|QVALUE|CAMCOMPRESSION|IMAGESIZE|GOP|RC_|VAE_EDVA_CONFIG|VAE_EDVA_SCHEDULER)/}  @difference;
               my $sigusr=scalar(grep {/VAE_\w+/} @difference)==scalar(grep {!/UPDATE_TIME/} @difference);
               my $restart=$restart1+$restart2;            # restart1:restart needed by retriever   restart2: restart needed for encoder reprogramming
               if($restart) {
                  $log->info('Essential configuration change. Have to restart retreiver');
                  stop_retr($dev);

                  #---------------------------------------------------- TBD: should be moved to Axis cartrige ----------
		  if($current->{CAMERAMODEL} eq 'Axis') {
		    if($current->{ARCHSTATE} ne 'on') {
			$log->info("Turn MD off at AXIS devid=[$dev]");
			print `$APL/cam/bin/provision_md_axis.pl devid=$dev md=off`;
		    }
		    elsif(scalar grep {/VAE_MOTION_ACTIVE/} @difference) {
			if($current->{VAE_MOTION_ACTIVE} eq 'external') {
			    $log->info("Turn MD on at AXIS devid=[$dev]");
			    print `$APL/cam/bin/provision_md_axis.pl devid=$dev md=on`;
			}
			else {
			    $log->info("Turn MD off at AXIS devid=[$dev]");
			    print `$APL/cam/bin/provision_md_axis.pl devid=$dev md=off`;
			}
		    }
		  } #-------------------------------------------------- TBD: END should be moved to Axis cartrige -------
                  exec_cmd($dev,'change') if exists $current->{ENCODER_SETTING_OVERRIDE} and $current->{ENCODER_SETTING_OVERRIDE} eq 'yes' and $current->{ARCHSTATE} ne 'off';
               }else {
                  send_sighup($dev,$sigusr);
                  $log->debug("change_conf:\t\t DEVICETYPE=$current->{DEVICETYPE}; send ".($sigusr?"SIGUSR":"SIGHUP"));
               }
            }
            elsif($dev=~/^[se]\d+/) {
        	if($current->{DEVICETYPE} eq 'SENSOR' && $current->{HW_MODEL} ne 'MODBUS') {
        	    my $restart=scalar grep {/(NAME|LOCATION|HW_MODEL|IP|PASSWD|USRNAME|HW_PORT|ASSOCIATE|TIME_ZONE)/} @difference;
        	    if($ThisIsNewDevice || $current->{LOCATION} eq '@garbage' || $restart) {
        	        # temporary fix: kill all possible sensor daemons
        	        $log->info("Restarting sensor daemons");
        		system("ps -au apl -o pid,cmd|grep $APL/xio/bin/axisd.pl|cut -c 1-6|xargs kill 2>/dev/null");
        		system("ps -au apl -o pid,cmd|grep $APL/xio/bin/actid.pl|cut -c 1-6|xargs kill 2>/dev/null");
        		system("ps -au apl -o pid,cmd|grep $APL/xio/bin/sonyd.pl|cut -c 1-6|xargs kill 2>/dev/null");
        	    }
        	}
        	elsif($current->{HW_MODEL} eq 'MODBUS') {
        	    system("ps ax|grep modbusd|grep -v grep|cut -c 1-6|xargs kill -1 2>/dev/null");
        	    $log->info("Send HUP to MODBUS");
        	}
    	    }
            else { # non camera or fake camera or removed device then stop retriever unconditionally
               stop_retr($dev);
            }
	    if ($id_changed || $ThisIsNewDevice) # let's re-read PTZ conf
			{
				send_signal($PTZSERVER,1);
			}
            @difference=();                                     # clen array, we do not need it now
            remove_dev($dev) if $current->{LOCATION} eq '@garbage';
            $log->debug("change_conf:\t\t DEVICETYPE = $current->{DEVICETYPE}") if $log->is_debug();

            system($PROCCFG);
    }
}


#   AT: check_axis was moved from MAIN code
sub check_axis {
    my %cf = GetCfgs( ('DEVICETYPE' => 'CAMERA') );
    foreach my $dev (sort keys %cf) {
	if($cf{$dev}->{CAMERAMODEL} eq 'Axis') {
	    if($cf{$dev}->{ARCHSTATE} ne 'on') {
		$log->info("Turn MD off at AXIS devid=[$dev]");
		print `$APL/cam/bin/provision_md_axis.pl devid=$dev md=off`;
	    }
	    else {
		if($cf{$dev}->{VAE_MOTION_ACTIVE} eq 'external') {
		    $log->info("Turn MD on at AXIS devid=[$dev]");
		    print `$APL/cam/bin/provision_md_axis.pl devid=$dev md=on`;
		}
		else {
		    $log->info("Turn MD off at AXIS devid=[$dev]");
		    print `$APL/cam/bin/provision_md_axis.pl devid=$dev md=off`;
		}
	    }
	}
    }
}


sub check_procctl {                               # restart PROCCTL if it dies
 system("ps ax | grep -v grep |grep -q $PROCCTL_NAME");
 system("$PROCCTL") if $?;
}
#-----------------------------------------------------------------------------
# expect special command from GUI
#-----------------------------------------------------------------------------
sub check_cmd {
  foreach my $dev (sort keys %conf) {
    if( is_cmd($dev)) {
       stop_retr($dev);
       exec_cmd($dev,'command');
    }
  }
}


###############################################################################
############ MAIN #############################################################
###############################################################################
system("rm -f $APL/var/pids/* &>/dev/null"); # Cleanup old pids if any
system("/opt/vae-*/bin/refresh_license &>/dev/null"); # #6315: execute 'refresh_license' if exist after patrol restart 
WritePid($PATROL);
#--------------------------------------------- pre-start activity
$log_db->info("Starting CAMERA PATROL $VERSION");
system($SETUP);

$log->info("======= CAMERA PATROL $VERSION =====");
#--------------------------------------------- run PROC MANAGER
system($PROCCTL);
sleep 15;               # delay for other 'patrols' to start functioning
#send_signal($PTZSERVER,1);# initiate PTZ conf reread
system($PROCCFG);       # reevaluate dynamic engines configs - for just in case :)

%conf = GetCfgs();                     # load conf files for devs
change_conf();                         # initially put all config in place
touch_conf();                          # initially declare the change in conf

#------------ wait for store ------------------
for(;;) {    # we should not start retrievers till storage avaiable
  last if $ENV{APL_MOD} eq 'CIRRUS';   # do not wait store for cirrus
  last if $ENV{APL_MOD} eq 'SKMHA';    # do not wait store for HA
 `df /vasm/store | grep -q /vasm/store`;
  last if $?==0;                       # last if /vasm/store is mounted
  $log->info('/vasm/store is not mounted yet. Waiting ..');
  sleep 1;
}
#------------ big loop ------------------------
my $is_first_loop = 1;
my $last_time_check_procctl=time;
$log->info('Entering patroling loop...');

for (;;) {
    eval {
        local $SIG{ALRM} = sub { die "TIMEOUT $!" };
        alarm 300;
	check_axis() if $is_first_loop;	    # cam_patrol should switch on/off Axis-based-MD before starting cam_mretr based on conf:MOTION
					    # cam_patrol should switch off Axis-based-MD for all cameras with conf:ARCHSTATE!=on when starting
        change_conf();    #
        check_cmd();                        # check if command is set
        av_manager();
        set_routine();                      # set routine based on schedule
        verify_retriever();                 # check cameras & restart
        sleep 1;                            # sleep here to allow retrievers started to create first picture
        check_pics() if !$is_first_loop;    # drwas red X if video is dead and it's not first loop
        mk_snapshots() if !$is_first_loop;
    };
    if ($@) {
        $log->error("LOOP ERROR: $@");
        die if $@=~/^SIGTERM/;              # sigterm is caugth
    }

    $is_first_loop = 0;
    foreach my $dev (keys %conf) {write_stat($dev)} # write new camera stat if any
    UpdatePid($PATROL);
    sleep $MAIN_LOOP_SLEEP;
    if(time-$last_time_check_procctl>30) {  # every 30 seconds
      check_procctl;                        # check if procctl still alive
      $last_time_check_procctl=time;
    }
}

#------------ end big loop --------------------
