#!/usr/bin/perl
#  $Id: sm_wipe 31357 2014-10-13 11:42:07Z atsybulnik $
# -----------------------------------------------------------------------------
#  WIPE - Remove Expired Video 
# -----------------------------------------------------------------------------
#  Author: Alex Titov
#  QA by:  
#  Copyright: videoNEXT LLC
# -----------------------------------------------------------------------------
# usage:       vm_wipe <grp_id>
#
# example:     vm_wipe 1
#
# assumptions: (for REQ see: fogbugz:919, Rally	S432: TA345: 
#              S623:Storage Manager TA925
#              S573: Event Handling TA653 storage retention code
#
# 1. Wipe should be started from sm_keeperl by application/arhive owner (apl)
# 2. Only one volume mark per volume is expected
# 3. Volumes are unique in system
# 4. Active Volumes from Wheels (Online|Degraded|Full) are analyzed, other volumes are ignored 
# 6. Clean arhive only for existen devices. Archive of removed devices are cleaned also as loong
#    as a mark is present in $APL/var/sm/removed
# 7. The time coverage of the chunk is calculated based on name and conf:CHUNK_SIZE
# 8. Wipe any Illegal file in 'hour' directory
# 9. Create .stat file inside each 'hour' directory
#10. 'df' used for space evaluation
#11. Events are stored in Postgres DB on master        (wipe has direct connection)
#12. Volume configuration is taken from local flat files
#13. SIGTERM gratefully terminates process. Current directory cleaning will be completed
#14. SIGHUP  causes process restartig (finish a cleaning, re-read conf and start again)
#15. SIGKILL instantly terminates, directory state may be insconsitent.
#16. SIGKILL is NOT recommended for terminating WIPE process
#17. Block size is 512 (constant for stat(file)[12]
#18. For each 'non-active' directory the .stat is calculated if expired (outdated)
#19. the hour directory has permissions: 
#          - before cleaning 750 
#          - after cleaning  770
#20. < removed >
#21. Chunksize if defined for each camera and never changed during a camera live
#22. Storage policies are preloaded from DB when wipe starts. 
#23. Wipe terminates if cannot preload storage policies
#24. Storage policies must have a default policy (id=1)
#25. If defice has emptpy or unknows storage policies then 'default' is used after warning
#26. Updates var/conf/<DEVID>/stat.wipe with VA_RATE (video accamulation rate)
#27. Calculate TARGET space based on active camera consumption 
#28. If target is not reached then "space-limited" events will start expire 
#...
#31. create task for mover after cleaning an hour if any chunks left protected by event

use strict;
use SKM::DB;
use Data::Dumper;
#use XML::Simple ;
use XML::Simple qw(:strict);
use Time::Local;
use File::Basename qw(dirname);
use lib dirname(__FILE__).'/../lib';              # find  SM::Config here
use SM::Config ':all';
use NextCAM::Conf;
use NextCAM::Init qw(GetAsrv);
use Node::Conf;

# CONS =========================================================================
my $WIPE=(split(/\//,$0))[-1];			# the actual name of the prog
my $grp='wheels';                               # only one group is available 
my $MNT="/vasm";		                # mount point
my $SYSVOL="$MNT/store/".SM_VER;                # directory volume
my $DAY=24*60*60;                               # the day size in seconds
my ($tsec,$tmin,$thour,$tday,$tmon,$tyear)=gmtime(time);
my $TODAY=timegm(0,0,$thour,$tday,$tmon,$tyear);# current hour today
my $ENABLE_STAT=1;                              # calculate statistic for dir
my $MIN_TARGET=5;                               # persantage of free space min
my $MAX_TARGET=25;                              # persantage of free space max
my $pid_name="$ENV{APL}/var/sm/pids/$WIPE.pid"; # location and name of PID file
my $BS=512;                                     # blocksize for stat(file)[12]
my $DEVCONF="$ENV{APL}/var/conf";               # device configuration
my $NODEID=UNI;                                 # char22 nodeid in domain
my $CLOUD_TASKS="$ENV{APL_VAR}/sm/cloud";       # incoming/migrated/completed
my $CLOUD_ENABLED=0;                            # Manage cloud tasks if enabled

# --= AF: Adjust minimal free space for one configured in System->Identity =--
my %asrv = GetAsrv();                           # System Identity attributes from DB
$MIN_TARGET = $asrv{SM_FREE_SPACE_LIMIT} || 15; # 15% is default if not set properly
$CLOUD_ENABLED = 1 if $asrv{CLOUD_STORAGE} ne 'none' and $asrv{CLOUD_STORAGE_ENABLED} eq 'yes';

# VARS -----------------------------------------------------------------------
my $dbm;                                        # master db handler
my %dbs;                                        # statements 

# SIGNALS---------------------------------------------------------------------
my ($sigterm,$sighup)=(0,0);
$SIG{TERM}= sub { $sigterm=1 };                 # sigterm is checked in wipe
$SIG{HUP} = sub { $sighup=1  };                 # sighup  is checked in wipe
# PROC -----------------------------------------------------------------------

sub db_master{
 eval { $dbm->disconnect() if $dbm; $dbm=''; }; # disconnect if defined
 for (my $i=1;$i<6;$i++) {
   eval {
     $dbm=DBMaster({PrintError=>1,'RaiseError' => 1});
     $dbs{EXPIRE_EVENT}=$dbm->prepare('update event set lifespan=0 where eventid=?') 
                       or die "Cannot prepare EXPIRE_EVENT";
     $dbs{INSERT_SPREAD}=$dbm->prepare("insert into SM_SPACE_SPREAD(NODEID,ID,OBJID,DAY,SPACE) values('$NODEID',?,?,?,?)") 
                       or die "Cannot prepare INSERT_SPREAD";
     $dbs{DELETE_SPREAD}=$dbm->prepare('delete from SM_SPACE_SPREAD where ID=? and OBJID=? and DAY=?') 
                       or die "Cannot prepare DELETE_SPREAD";
     $dbs{INSERT_SPACE}=$dbm->prepare('insert into SM_SPACE(NODEID,OBJID,SPACE) '
                                     ."select '$NODEID',objid,sum(space) from sm_space_spread "
                                     ."where  NODEID='$NODEID' group by objid") 
                       or die "Cannot prepare INSERT_SPACE";
     $dbs{DELETE_SPACE}=$dbm->prepare("delete from SM_SPACE where NODEID='$NODEID' and SPACE!=0") 
                       or die "Cannot prepare DELETE_SPACE";
     $dbs{DELETE_ZERRO}=$dbm->prepare("delete from SM_SPACE s where NODEID='$NODEID' and SPACE=0 "
                                     ." and  exists (select space from SM_SPACE_SPREAD p  where s.nodeid=p.nodeid and s.objid=p.objid)") 
                       or die "Cannot prepare DELETE_ZERRO";
     SM_LOG->info("All sql statements are prepared");
   };
   if($@) {
     SM_LOG->logdie("Attempt $i (final). Cannot connect to master: $@") if $i>=5;
     SM_LOG->error("Attempt $i. Cannot connect to master: $@");
     SM_LOG->error('Sleep '. $i*30 . ' before next attempt');
     SM_error('',  "Cannot connect to master:$@");
     sleep($i*30);
   } else {
     last;                                   # exit cycle if OK
   }
 }
 $dbm->{FetchHashKeyName} = 'NAME_uc';
 $dbm->{ShowErrorStatement}=1;
 SM_LOG->debug("Connected to master db");
}

#--------------------------------------------------------------------------
#  calc_target
#  Calculate the target for storage group based on space consumption statistics 
#  - Target is 3 * (space consumption by all active retrievers for an hour)
#  - Target should be bigger then MIN_TARGET but less MAX_TARGET
#  - TBD: target should also depend on number of wheels
#--------------------------------------------------------------------------
sub calc_target {
  my $group=shift;
  my $devs=SM_Devices();  
  my @note;
  my $rate=0;
  my $space=space_info($group);
  my $total=int($space->{total}/1024);  # MB
  foreach (keys %$devs) {
     if($devs->{$_}->{_status} eq 'ON' and $devs->{$_}->{stat_VA_RATE}>0) {
        $rate+=$devs->{$_}->{stat_VA_RATE};
        push @note,$devs->{$_}->{stat_VA_RATE};
     }
  }
  return $MIN_TARGET    if  $total==0;  # protection, never return here
  my $creserve=int(3*3600*$rate/1024); 
  my $cprc=int(0.5+100*$creserve/$total);
  my $target=($cprc<$MIN_TARGET)?$MIN_TARGET:$cprc;
  if ($target>$MAX_TARGET) {
     SM_LOG->warn("STORAGE SPACE $total MB  is to low for video stream. SM cannot efectivly manage the space");
     $target=$MAX_TARGET;     
  }
  my $cnote="TARGET=$target. Calculated reserve 3*3600*(".join('+', @note).")=$creserve MB  $cprc% [Total=$total]. min($MIN_TARGET)<$target<max($MAX_TARGET)";
  SM_LOG->info($cnote); 
  return $target;
}
#--------------------------------------------------------------------------
#  get_group returns reference to group/volume info
#  error handling - all error are critical,  handled in MAIN
#  sql statements are raised errors internally and handled in MAIN also
#  TBD: errors from SM_Wheels (unlikely)
#--------------------------------------------------------------------------
sub get_group { 
    my %assigment;
    my $mlist;                       # all mount point in one string
    my $note;
    my $r_vol=SM_Wheels();           # volumes ex:$vol->{$uuid}->{LIMIT_WRITE}    
    foreach (keys %$r_vol) {          # keep only active volumes
      delete($$r_vol{$_}),next if not $$r_vol{$_}->{ost}=~/^(Online|Degraded|Full)$/;
      $note.=' '.shortid($_);       # collect a list
      $mlist.=" $MNT/$_";
    }  
    #print Dumper($r_vol);
    #-------------------------------------------- place info into stucture ---
    die ("GROUP_DEFINITION_ERROR The grop 'wheels' does not have online volumes") if not $mlist;
    %assigment=(NAME=>'wheels',TARGET=>$MIN_TARGET,MLIST=>$mlist,VOLUMES=>$r_vol); 
    SM_LOG->info("ASSIGMENT group: $assigment{NAME} volumes:" . $note);
    $assigment{TARGET}=calc_target(\%assigment);
    #print Dumper \%assigment;
    \%assigment;
}

#--------------------------------------------------------------------------
#  get_storagepolicies  retruns the hash of policies: 
#  Ex: $p->{1}->{STYPE}, $p->{1}->{DAYS_MIN}, etc
#  error handling: all error are critical, handled in MAIN 
#--------------------------------------------------------------------------
sub get_storagepolicies {
 my $policies=$dbm->selectall_hashref(qq{ 
   select storagepolicy as STID, NAME, preservedaysmin as DAYS_MIN,preservedaysmax as DAYS_MAX, frdschedule as SCHEDULE,
     case when storagertntype=1 then 'FIXED' 
          when storagertntype=2 then 'RANGE' 
          when storagertntype=4 then 'FRD4' 
          else 'SPACELIMITED' end            as STYPE
      from storagepolicy},'STID',{Slice=>{}}); 
 #print Dumper $policies;
 die("STORAGE_POLICY_DEFINITION_ERROR") if not defined $policies->{1}->{STYPE}; 
 $policies;
}

#---------------------------
# file size in KB
# 0 if file is not exists
#--------------------------- 
sub file_size {
  my $file=shift;
  return 0 if ! -f $file;
  return (stat($file))[12]*$BS/1024;# get KB-size
}
#--------------------------------------------------------------------------
# rm_days
# find empty dirs (days) and remove then (with records in DB)
# Note: 
#  current day is exclided
#  devid=objid (a106=106)
# sameples
#  /vasm/aa7a2b82-014e-4968-b39b-252ef0f9cdf0/va-2.7.1/a106/110110
#  /vasm/aa7a2b82-014e-4968-b39b-252ef0f9cdf0/va-2.7.1/a106/101219
#
#--------------------------------------------------------------------------
sub rm_days {
   my $mnt=shift;
   open(FIND, "find $mnt -mindepth 3 -maxdepth 3 -type d -empty  2>/dev/null|")
                                     || die "cannot do find in $mnt";
   my @dirs = <FIND>;
   close FIND;
   my ($today)=SM_DateSplit(time); # get today as 110110
   my $count=0;
   foreach(@dirs) {
     chomp;
     next if not m|/vasm/(\w{8}-\w{4}-\w{4}-\w{4}-\w{12})/va-\d\.\d.\d/a*(\d+)/(\d{6})|;
     my ($dir,$uuid,$obj,$day)=($_,$1,$2,$3);
     next if $day>=$today;                     # exclude empty dirs from today
     #TBD: remove from DB
     if($dbs{DELETE_SPREAD}->execute($uuid,$obj,$day)) {
          rmdir($dir);
          unlink("$dir.stat") if -f "$dir.stat";
          SM_LOG->debug("RMDAY obj:$obj remove empty day $dir");
          $count++;
     }else {
        SM_LOG->warn("Cannot remove empty day fron DB ($uuid,$obj,$day)"); 
     }
   }  
   return $count;
}


#--------------------------------------------------------------------------
#  get_wlist retrun the list of dev/date/hour directories for alredy wiped
#            directories. These directories only have event protected files
#  global vars:
#             $TODAY, $DAY
#  example
#    '/vasm/df1f3690-74f8-4fc3-b50b-119190f1954a/va-2.6.3/302/081101/16' => {
#      'MIN' => 1226084399,
#      'TIME'=> 1225555200,
#      'LINK'=> '/vasm/store/va-2.6.3/302/081101/16.0000-01',
#      'DATE'=> '081101',
#      'MAX' => 1226084399,
#      'PATH'=> '/vasm/df1f3690-74f8-4fc3-b50b-119190f1954a/va-2.6.3/302/081101/16.0000-01',
#      'DEV' => 302,
#      'HOUR'=> '16',
#      'IDX' => '/vasm/df1f3690-74f8-4fc3-b50b-119190f1954a/va-2.6.3/302/081101/16.0000-01/.idx',
#      'TRAY'=>'01'
#    }
#  TRAY - the Frame Rate Decimation tray (ex: 01 41,42,43,44  21,22)
# ATTN IDX - old style index .idx for compatibity with old version
#--------------------------------------------------------------------------
sub get_wlist {
  my $mnt=shift;                            # the volume mount point
  my $devcfg=shift;                         # device configurations
  open(FIND, "find $mnt -mindepth 4 -maxdepth 4 -type d -perm 775  2>/dev/null|")
                                     || die "cannot do find in $mnt";
  my @dirs = sort map { "$_" if m|(a?\d+)/(\d{6})/(\d\d(\.\d{4}))-(\d{2})$| } <FIND>; 
  #print Dumper(\@dirs);
  close FIND;
 
  my %wlist;
  my $undef_dev=-1;
  foreach (@dirs) {                         # each hour directory
     next if not m|^(/.+/((a?\d+)/((\d{2})(\d{2})(\d{2}))/(\d{2})(\.\d{4})-(\d{2})))$|;
     my ($dir,$c_path,$c_dev,$c_date,$c_year,$c_month,$c_day,$c_hour,$c_tray)=($1,$2,$3,$4,$5,$6,$7,$8,$10);
     next if $c_dev==$undef_dev;            # exclude UNDEF devices
     if(not exists $devcfg->{$c_dev}) {
       SM_LOG->warn("UNDEFINED device $c_dev on $mnt is ignored");
       $undef_dev=$c_dev;
       next;
     }
     my $g_time;
     eval { $g_time=timegm(0,0,$c_hour,$c_day,$c_month-1,$c_year+100) };
     SM_LOG->warn("WRONG DIRECTORY $dir is ignored: $@"),next  if ($@);
     my %hrecord=(DATE=>$c_date,HOUR=>$c_hour,TIME=>$g_time,PATH=>$dir,
                  IDX=>"$dir/.idx",DEV=>$c_dev,  TRAY=>$c_tray,
                  LINK=>"$SYSVOL/$c_path",MAX=>$TODAY-1,MIN=>$TODAY-1,);
     $wlist{$dir}=\%hrecord;
  }
#  print Dumper(\%wlist);
  \%wlist;
}


sub move_task2completed {
    my ($task,$mark,$reason)=@_;
    my $completed=$task;
    $completed=~s/migrated/completed/;
    open  TASK,">>$task";
    print TASK "INFO: [wipe] $reason\n";
    print TASK "$mark: ".gmtime()."\n";
    close TASK;
    rename $task,$completed;
}

#--------------------------------------------------------------------------
#  get_tmlist retrun the list of dev/date/hour directories from migrated tasks
#  global vars:
#             $TODAY, $DAY
#  example
#    '/vasm/df1f3690-74f8-4fc3-b50b-119190f1954a/va-2.6.3/302/081101/16' => {
#      'MIN' => 1226084399,
#      'TIME'=> 1225555200,
#      'LINK'=> '/vasm/store/va-2.6.3/302/081101/16.0000-01',
#      'DATE'=> '081101',
#      'MAX' => 1226084399,
#      'PATH'=> '/vasm/df1f3690-74f8-4fc3-b50b-119190f1954a/va-2.6.3/302/081101/16.0000-01',
#      'DEV' => 302,
#      'HOUR'=> '16',
#      'IDX' => '/vasm/df1f3690-74f8-4fc3-b50b-119190f1954a/va-2.6.3/302/081101/16.0000-01/.idx',
#      'TRAY'=>'01',
#      'TASK'=>'/var/sarch/sm/cloud/incoming/1382563208_101_081101_01.0000-01,
#      'CHUNKS'=>'131019010300.mjpg,131019010330.mjpg,131019010400.mjpg
#    }
#  TASK & CHUNKS are exist only in tmlist and used for MIGRATED cleaning
#  TRAY - the Frame Rate Decimation tray (ex: 01 41,42,43,44  21,22)
#  ATTN IDX - old style index .idx for compatibity with old version
#--------------------------------------------------------------------------
sub get_tmlist {
  my $mnt=shift;                            # the volume mount point
  my $devcfg=shift;                         # device configurations
  my $path="$CLOUD_TASKS/migrated";
  my %tmlist;
  if(!opendir(DIR, $path)) {
    SM_LOG->warn("Cannot read task list $path, ignored");
    return \%tmlist;                         # empty list
  }
  my @files = sort grep {/^\d+/} readdir(DIR);
  closedir DIR;
  print Dumper(\@files); 
  foreach my $file (@files) {
     if(!open(FILE,"$path/$file")) {
         SM_LOG->warn("Cannot read task file $path/$file, ignored");
         next;
     }
     my @chunks;
     my $src;
     foreach (<FILE>) {
       push(@chunks,$1) if /^(\d{12}\.\w+)/; #chunkname like 131019010330.mjpg
       $src=$1 if m|^SRC=(/.+/((a?\d+)/((\d{2})(\d{2})(\d{2}))/(\d{2})(\.\d{4})-(\d{2})))$|;
     }
     close FILE;
     if(!$src) {
       SM_LOG->warn("TASK $path/$file is ignored since no valid SRC definition");
       move_task2completed("$path/$file",'IGNORED','ignored since no valid SRC definition');
       next;
     }
     if(!@chunks) {                          # no chunks were migrated
         SM_LOG->info("TASK $path/$file has no migraded events, ignored");
         move_task2completed("$path/$file",'COMPLETED','nothing is migrated'); 
         next;
     }
     SM_LOG->info("TASK $path/$file if accepted, $src");
     next if not $src=~m|^(/.+/((a?\d+)/((\d{2})(\d{2})(\d{2}))/(\d{2})(\.\d{4})-(\d{2})))$|; 
     my ($dir,$c_path,$c_dev,$c_date,$c_year,$c_month,$c_day,$c_hour,$c_tray)=($1,$2,$3,$4,$5,$6,$7,$8,$10);
     my $g_time;
     eval { $g_time=timegm(0,0,$c_hour,$c_day,$c_month-1,$c_year+100) };
     SM_LOG->warn("WRONG DIRECTORY $dir is ignored: $@"),next  if ($@);
     my %hrecord=(DATE=>$c_date,HOUR=>$c_hour,TIME=>$g_time,PATH=>$dir,
                  IDX=>"$dir/.idx",DEV=>$c_dev,  TRAY=>$c_tray,
                  LINK=>"$SYSVOL/$c_path",MAX=>$TODAY-1,MIN=>$TODAY-1,
                  TASK=>"$path/$file",CHUNKS=>\@chunks);
     $tmlist{$dir}=\%hrecord;
  }
  print Dumper(\%tmlist);
  \%tmlist;
}
#--------------------------------------------------------------------------
#  get_list  retrun the list of dev/date/hour directories
#             today current hour is excluded
#  global vars:
#             $TODAY, $DAY
#  
#  TBD: FRAMEDECIMATION
#--------------------------------------------------------------------------

sub get_list {                               
   my $mnt=shift;                            # the volume mount point
   my $devcfg=shift;			     # device configurations 
   my $wlist=shift;                          # early wiped directories
   my $policies=shift;                       # storage policies
   open(FIND, "find $mnt -type d -mindepth 4 -maxdepth 4 2>/dev/null|")
                                     || die "cannot do find in $mnt";
   my @dirs = sort {$b cmp $a} map { "$1-$2-$3=$_" if m|(a?\d+)/(\d{6})/(\d\d(\.\d{4})-\d{2})$| } <FIND>;
   close FIND;
   #print Dumper(\@dirs);
   my %list;                                 # collect {dev} date-hours-info
   my $dev=0;                                # the devid from previous cycle
   foreach (@dirs) {                         # each hour directory
     chomp;      # match dirs like /opt/sarch/var/vm/sda7/12/070324/01
     next if not m|=(/.+/((a?\d+)/((\d{2})(\d{2})(\d{2}))/(\d{2})(\.\d{4})-(\d{2})))$|; 
     my ($dir,$c_path,$c_dev,$c_date,$c_year,$c_month,$c_day,$c_hour,$c_tray)=($1,$2,$3,$4,$5,$6,$7,$8,$10);
     SM_LOG->debug("exclude $dir since .wiped") if exists $wlist->{$dir};
     next if exists $wlist->{$dir};          # exclude if .wiped
     my $g_time;
     eval { $g_time=timegm(0,0,$c_hour,$c_day,$c_month-1,$c_year+100) };
     SM_LOG->warn("WRONG DIRECTORY $dir is ignored: $@"),next  if ($@);
     $list{$dev=$c_dev}=[] if $c_dev ne $dev;# make a new record for next device
     if($g_time < $TODAY) {                  # if less then current today hour
   #-----------------------------------------  calculate expiration expectancy 
       my %expiration=('MAX',$TODAY+30*$DAY,'MIN',$g_time); # space limited default
       if(defined $devcfg->{$dev}) {
          my $cfg=$devcfg->{$dev};
          #---        Check storage policy existance. Use default if does not exist
          if((not $cfg->{STORAGE_POLICY}) || (not exists $policies->{$cfg->{STORAGE_POLICY}})) {
            SM_LOG->warn("WRONG STORAGE_POLICY for object:$cfg->{OBJID} [ $cfg->{DEVID} ]. Default will be used");
            SM_warn ('', "WRONG STORAGE_POLICY for object:$cfg->{OBJID} [ $cfg->{DEVID} ]. Default will be used");
            $cfg->{STORAGE_POLICY}=1; 
          }
          my $sp=$policies->{$cfg->{STORAGE_POLICY}}; # device policy
          $expiration{MAX}=$g_time+$DAY*$sp->{DAYS_MIN} if $sp->{STYPE} eq 'FIXED';
          $expiration{MIN}=$g_time+$DAY*$sp->{DAYS_MIN} if $sp->{STYPE} eq 'FIXED';
          $expiration{MAX}=$g_time+$DAY*$sp->{DAYS_MAX} if $sp->{STYPE}=~/^(RANGE|FRD4)$/;
          $expiration{MIN}=$g_time+$DAY*$sp->{DAYS_MIN} if $sp->{STYPE}=~/^(RANGE|FRD4)$/;
          $expiration{MIN}=$expiration{MAX}=$g_time     if $cfg->{OBJID}==-1;#zombie
       } # FRD4 cameras are cleaned in the same way as RANGE devices
   #------------------------------------------ create the record
       my %hrecord=(DATE=>$c_date,HOUR=>$c_hour,TIME=>$g_time,PATH=>$dir,
                    IDX=>"$dir/.idx",TRAY=>$c_tray,
                    LINK=>"$SYSVOL/$c_path",%expiration,
                    MIN2TODAY=>($TODAY-$expiration{MIN})/3600);
       push @{$list{$dev}},\%hrecord;
     }
   }
  #------------------------------------------- remove undefined devices
   foreach (sort keys %list) {
     if(not defined $devcfg->{$_}) {
       SM_LOG->warn("UNDEFINED device $_ on $mnt is ignored");
       SM_warn ('', "UNDEFINED device $_ on $mnt is ignored");
       delete $list{$_};
     }
   }
   # print Dumper(\%list);
   \%list;
}

#--------------------------------------------------------------------------
# cache Events  get events for a entire day for device
# the result will be cashed in %devcfg
# usage:    get_events($dev,$date,\%devconfig);
# ex   :    get_events(1,'070925',\%$devcfg);
# TBD  : evaluate SQL plan
#--------------------------------------------------------------------------
sub cache_events {
      my $cfg=shift;                         # one device configuration     
      my $date=shift;
      $date=~/(\d\d)(\d\d)(\d\d)/;           # split date in year,mon,day
      my $dt=sprintf("%04d-%02d-%02d",$1+2000,$2,$3);
      my $events; 
      for(my $i=1;$i<6;$i++) {
        my $obj=$cfg->{OBJID}+0;             # protect from empty OBJID
        eval {
           $events=$dbm->selectall_arrayref(qq{
           select e.eventid, w.objid,
             case coalesce(s.preserverhours,-1) when -1 then -1 else e.priority end as lifespan,
             eventtype,
             EXTRACT(EPOCH FROM utc_from at time zone 'UTC') as e_begin,
             EXTRACT(EPOCH FROM utc_to   at time zone 'UTC') as e_end
           from eventwitness w
             inner join event e ON e.eventid = w.eventid
             left outer join _obj_attr a on a.obj=e.objid and a.attr='EVENT_POLICY'
             left outer join eventpolicystorage s on s.eventpolicy = cast(a.val as int) and s.eventpriority=e.priority
           where w.objid=$obj
             and e.lifespan!=0
             and (e.utc_from, e.utc_to) OVERLAPS (date '$dt' at time zone 'UTC',interval '1 day')},
           {Slice => {}}
          );
        }; # eval
        last if not $@;                       # exit from cycle if no errors
        die ("DB_MASTER: $@")   if $i>=5;     # only 5 attempts allowed
        SM_LOG->error("Attempt $i. Cannot get events from master: $@");
        db_master();                          # re-connect;
      }
      $cfg->{$date}=[@{$events}];
      #print Dumper($events); 
}

#------------------------------------------------------------------------------
# VA_RATE video accamulation rate
# only calculated for directory when first time .stat is calculated
# NO ERROR handling since optional info
# Path with -00 at the end is not used for VA_RATE calculation
#------------------------------------------------------------------------------
sub update_va_rate {
    my ($cfg,$path,$size,$files)=@_;
    return if $path=~/-00$/;
    return if $files==0 or $cfg->{CHUNK_SIZE}==0; # cannot calculated 
    my $rate=int($size/($files*$cfg->{CHUNK_SIZE}));
    open RESULT,">$DEVCONF/$cfg->{DEVID}/stat.wipe";
    print RESULT  "VA_RATE=$rate  #". scalar(gmtime) . " $path\n";
    close RESULT;
}

#------------------------------------------------------------------------------
# calcuate_hcov calculate coverage summary for an hour
#------------------------------------------------------------------------------
sub calculate_hcov {
 my $dir =shift;
 my $idx ="$dir/.idx.sqlite";      # name of the index database file
 my $hcov="$dir/.hcov";            # name of coverage info
 my $mcov="$dir/.mcov";            # name of coverage info
 my $mmeta="$dir/.mmeta";          # name of coverage meta info
 my $dbh;
 my $dbs_hcov;
 my $dbs_mcov;
 my $dbs_mmeta;
 return if ! -f $idx;              # no index in directory
 return if   -z $idx;              # index is empty
 eval {
   $dbh=DBI->connect("dbi:SQLite:dbname=$idx",'','',{RaiseError=>1}) or die $DBI::errstr;
   $dbs_hcov=$dbh->prepare("select count(1) from (select time_sec from idx group by time_sec)");
   $dbs_mcov=$dbh->prepare("select time_sec - time_sec%60 as minute, count(distinct time_sec) from idx group by minute");
   $dbs_mmeta=$dbh->prepare("select time_sec as time_sec_when, offset as time_sec_from, frame_size as time_sec_to, frame_params from idx where codec=-1");
};
 if($@) {
     SM_LOG->warn(".hcov/.mcov cannot be count for $dir ($@)");
     unlink $hcov if -f $hcov;
     return;
 }
 eval {
     $dbs_hcov->execute()            or die ("Cannot count coverage");
     my $result = $dbs_hcov->fetchall_arrayref;
     die("Cannot count coverage") if @$result!=1;    # we expect exacatly one result
     my $coverage_count=$result->[0][0];
     open(HCOV,">$hcov")             or die("cannot open $hcov");
     print HCOV "$coverage_count\n"  or die("cannot write into $hcov");
     close HCOV;
 };
 if($@) {
     SM_LOG->warn(".hcov cannot be count for $dir");
     unlink $hcov if -f $hcov;
 }
 eval {
     $dbs_mcov->execute()            or die ("Cannot count coverage");
     my $result = $dbs_mcov->fetchall_arrayref;
     my $count=scalar @$result;
     open(MCOV,">$mcov")             or die("cannot open $mcov");
     foreach my $row (@{$result}) {
        print MCOV "$row->[0]|$row->[1]\n"  or die("cannot write into $mcov");
     }
     close MCOV;
 };
 if($@) {
     SM_LOG->warn(".mcov cannot be count for $dir");
     unlink $mcov if -f $mcov;
 }
 eval {
     $dbs_mmeta->execute()            or die ("Cannot count meta coverage");
     my $result = $dbs_mmeta->fetchall_arrayref;
     my $count=scalar @$result;
     open(MCOV,">$mmeta")             or die("cannot open $mcov");
     foreach my $row (@{$result}) {
        print MCOV "$row->[0]|$row->[1]|$row->[2]|$row->[3]"  or die("cannot write into $mmeta");
     }
     close MCOV;
 };
 if($@) {
     SM_LOG->warn(".mmeta cannot be count for $dir");
     unlink $mmeta if -f $mmeta;
 }
}

#------------------------------------------------------------------------------
# keep record about daily usage for device
#
# format:
# SIZE=1234556
# history:
# +310 2011/01/17 20:16:01 stat  /vasm/3f89975f-4643-4582-a4a5-5baecda0ae9f/va-2.7.1/113/110117/19.0000-01
# +10  2011/01/17 20:16:02 stat  /vasm/3f89975f-4643-4582-a4a5-5baecda0ae9f/va-2.7.1/113/110117/19.0000-00
# +340 2011/01/17 21:16:03 stat  /vasm/3f89975f-4643-4582-a4a5-5baecda0ae9f/va-2.7.1/113/110117/20.0000-01
# +11  2011/01/17 21:16:01 stat  /vasm/3f89975f-4643-4582-a4a5-5baecda0ae9f/va-2.7.1/113/110117/20.0000-00
# -11  2011/01/17 21:16:01 clean /vasm/3f89975f-4643-4582-a4a5-5baecda0ae9f/va-2.7.1/113/110117/20.0000-00
#------------------------------------------------------------------------------
sub update_stat4day {
  my $path=shift;               # ex: /vasm/3f89975f-4643-4582-a4a5-5baecda0ae9f/va-2.7.1/113/110117/19.0000-00
  my $change=shift;             # the change in size for hour (KB)
  my $src=shift;                # 'stat|clean';
  return if not $path=~m|^(/vasm/(\w{8}-\w{4}-\w{4}-\w{4}-\w{12})/va-\d\.\d.\d/a*(\d+)/(\d{6}))/\d\d.\d\d\d\d-\d\d$|;
  my ($dir,$uuid,$obj,$day)=($1,$2,$3,$4);
  my $size=0;
  my @hist; 
  if(open(DAY,"$dir.stat")) {     # FILE EXIST: Read SIZE
    $_=<DAY>;
    ($size)=/^SIZE=(\d+)$/;
    $size=0 if not defined $size;
    while(<DAY>) {                # read the rest of file (history)
      push @hist,$_ if /^-*\d+/;  # looks like history
    }
    close DAY;
  }
  push (@hist, "$change\t".time." $src $path\n");
  $size+=$change;
  if(open(DAY,">$dir.stat")) {
     print DAY "SIZE=$size\n";
     print DAY "history:\n";
     print DAY @hist;
     close DAY;
     $dbs{DELETE_SPREAD}->execute($uuid,$obj,$day);
     $dbs{INSERT_SPREAD}->execute($uuid,$obj,$day,$size);
  }else {
     SM_LOG->warn("Cannot create $dir.stat");
  }
}

#------------------------------------------------------------------------------
# collect stat for an hour
#------------------------------------------------------------------------------
sub stat_hour {
   return if ! $ENABLE_STAT;                    # do nothing if disabled 
   my ($cfg,$hour)=@_;
   my $path=$hour->{PATH};
   my $dir_mtime=(stat($path))[9];
   my $stat_mtime=(-f "$path/.stat") ? (stat("$path/.stat"))[9] : 0;
   return if $dir_mtime <= $stat_mtime;         # statistics is valid still
   my $complete_mesage='COMPLETED';
   my $start=time;
   my $stat={DIRECTORY=>{ID=>$cfg->{DEVID},OBJID=>$cfg->{OBJID},HOUR=>$hour->{TIME}},
             RETENTION=>{MIN=>$hour->{MIN},MAX=>$hour->{MAX},TYPE=>$cfg->{VM_CLEAN_TYPE}}};
   SM_LOG->debug("STAT obj:$cfg->{OBJID} $path\n");
   cache_events($cfg,$hour->{DATE}) if not defined $cfg->{$hour->{DATE}};
   eval {
      local $SIG{ALRM}= sub{ die "TIMEOUT $!" }; alarm 30;
      opendir(DIR, $path) || die "can't opendir $path: $!";
      my @files = grep { ! /^\.\.?$/ and ! /^\.stat$/ and ! /^\.idx$/} readdir(DIR);
      closedir DIR;
      my ($dir_size,$dir_files)=(0,0);
      my $policy;                 # policy structure for eventstat collection
      foreach my $file (@files) { #--------------------- check event protection 
        if($file=~/^(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)\./) { # if legal
           my $begin=timegm($6,$5,$4,$3,$2-1,$1+100);    #chunk begin
           my $end=$begin+$cfg->{CHUNK_SIZE};            #chunk end
           my $sz=(stat("$path/$file"))[12]*$BS/1024;    #size KB from blocks 
           $dir_size+=$sz; 
           $dir_files++;
           foreach(@{$cfg->{$hour->{DATE}}}) {           #check overlap with event
               if (($_->{E_BEGIN} < $end) && ($_->{E_END} > $begin)) { 
                 SM_LOG->debug("$file is protected by event $_->{EVENTID} "
                 . scalar(localtime $_->{E_BEGIN}) .'-'. scalar(localtime $_->{E_END}));
                 #---------------------------------------------- event stat calc
                 my ($po,$ty)=($_->{LIFESPAN},$_->{EVENTTYPE}); # short names only
                 if (! (exists $policy->{$po} && exists $policy->{$po}->{TYPE}->{$ty})) {
                    $policy->{$po}->{TYPE}->{$ty}={MIN=>$TODAY+$DAY*5,SIZE=>0};
                 } 
                 $policy->{$po}->{TYPE}->{$ty}->{SIZE}+=$sz;
                 #-------------------------------------------end event stat calc
                 last; 
               } 
            } 
        }
      } # end of foreach
      if($dir_files) {
        update_va_rate($cfg,$path,$dir_size,$dir_files) if not -f "$path/.stat"; # only if stat is not calculated yet
        calculate_hcov($path)                           if not -f "$path/.hcov"; # only if not calculated yet      
        #print "stat:>$path/.stat\n";
        $stat->{DIRECTORY}->{SIZE}=$dir_size;         #total size of directory
        $stat->{RETENTION}->{SIZE}=$dir_size;         #total size of directory
        $stat->{POLICY}=$policy  if $policy;          #add a policy only if present
        open STAT, ">$path/.stat";
        print STAT XMLout($stat,,KeyAttr=>'ID',RootName=>'STAT');
        close STAT;
        update_stat4day($path,$dir_size,'stat');
      }else {                                         # remove empty directory 
        SM_LOG->debug("STAT empty hour $path");
        $complete_mesage='EMPTY';
        open STAT, ">$path/.stat";                    # mark directory with empty file
        close STAT;
#        rm_hour($path,$hour->{LINK});                # directory cannot be removed ! keep empty dirs
      }
   }; #end of eval
   alarm 0;                                         # cleam alarm
   if ($@) {
     SM_LOG->error("STAT object:$cfg->{OBJID} $hour->{PATH} FAIL:$@");
   } else  {
    my $spent=time-$start;
    SM_LOG->info("STAT obj:$cfg->{OBJID} $hour->{PATH} $complete_mesage:"
    ." SIZE=$stat->{DIRECTORY}->{SIZE}K SPENT=$spent".'sec');
   }
    
}      
#------------------------------------------------------------------
# remove_from_idx
#   does nothing if sql errors but pring WARNING
#      potential problem: 
#        The delete opration is slow. 
#      future solution:
#        Instead of delete recreate the index table completely
#   function also re-calculate hour coverage
#------------------------------------------------------------------
sub remove_from_idx { 
 my $dir =shift;
 my $chunksize=shift;  # the size in second, is constant in the hour
 my $list=shift;       # pointer to the array of chunk names ex: 091009192130.mjpg
 my $idx ="$dir/.idx.sqlite";      # name of the index database file
 my $hcov="$dir/.hcov";            # name of coverage info
 my ($dbh,$dbs_delete,$dbs_hcov);
 return if ! -f $idx;              # no index in directory
 return if   -z $idx;              # index is empty
 eval {
   $dbh=DBI->connect("dbi:SQLite:dbname=$idx",'','',{RaiseError=>1}) or die $DBI::errstr;
   $dbs_delete=$dbh->prepare("delete from idx where time_sec between ? and ?");
   $dbs_hcov=$dbh->prepare("select count(1) from (select time_sec from idx group by time_sec)");
 };
 if($@) {
   SM_LOG->warn("index is not updated. ($@)");
   return;
 } 
 eval{
   foreach my $file (@$list) {
     if($file=~/^(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)\./) { # if legal
       my $begin=timegm($6,$5,$4,$3,$2-1,$1+100);    #chunk begin
       my $end=$begin+$chunksize;                    #chunk end
       $dbs_delete->execute($begin,$end-1);
     }
   }
   $dbs_hcov->execute()            or die ("Cannot count coverage");
   my $result = $dbs_hcov->fetchall_arrayref;
   die("Cannot count coverage") if @$result!=1;    # we expect exacatly one result
   my $coverage_count=$result->[0][0];
   open(HCOV,">$hcov")             or die("cannot open $hcov");
   print HCOV "$coverage_count\n"  or die("cannot write into $hcov");
   close HCOV;
 };
 if($@) {
     SM_LOG->warn(".hcov cannot be count for $dir");
     unlink $hcov if -f $hcov;
 }
}

#----------------------------------- 
# remove dir and link
#-----------------------------------
sub rm_hour  {
   my $path=shift;
   my $link=shift;
   unlink "$path/.stat";
   unlink "$path/.idx.sqlite";
   unlink "$path/.idx";
   unlink "$path/.cov";
   unlink "$path/.hcov";
   unlink "$path/.mcov";
   unlink "$path/.mmeta";
   unlink "$path/.wiped";
   rmdir $path || SM_LOG->error("cannot remove $path");
   unlink $link if -l $link;
   unlink $link.'.0000' if -l $link.'.0000';# links from upgrade
   $_=$link; s/\.\d{4}-/-/;
   if( -l $_) {                                    # second link !
      unlink($_) if readlink($_) eq $path;         # rm second link
   }
   ($_)=$link=~/^(\d\d)/;                  # get hh part from hh-mmss-01
   if( -l $_) {                                    # old stile link !
      unlink($_) if readlink($_) eq $path;         # rm old stile link
   }
}


#------------------------------------
# create task for cloud mover 
# hour /vasm/037d3501-b5d5-4c63-8e3c-90386f65e23c/va-3.3.0/a103/131022/15.0000-01
# create a task (empty file) /var/sarch/sm/cloud/incoming/1382039037_101_131005_22.0000-01
#------------------------------------
sub task4mover {
   my $src=shift;
   my $task=$src;
   my $tm=time;
   my $path="$CLOUD_TASKS/incoming";
   $task=~s|/|_|g;
   $task=~s/.+va-\d\.\d.\d_//;
   if(-d $path) {
      SM_LOG->info("creating task for mover ${tm}_$task");
      open(TASK,">$path/${tm}_$task");
      print TASK "SRC=$src\n";
      close TASK;
   }else {
      SM_LOG->warn("dir $path is missing, task $task is not created");
   }
}

#------------------------------------------------------------------------------
# Clean One hour for a device but keep 'event protected' chunks
# actions:
#     1. get file list
#     2. check each file for "event protection"
#     3. remove all files not protected by events
#     4. remove all illegal files
#     5. exclude 'removed' files from <hour>.idx file
#     6. remove  .idx/.cov/.stat if empty
#     6. update '.stat' file
#     7. update '.cov' file
#     8. remove directory & link if directory does not have any chunks
#     9. report statistics in the log
#    10. place  '.wipe' file (the directory was cleaned at least ones) 
#     
# TIMEOUT=300 seconds is set for this function
#------------------------------------------------------------------------------
sub clean_hour {
   my ($phase,$cfg,$hour)=@_;
   my $start=time;
   my $csize=$cfg->{CHUNK_SIZE};                #size of chunk in seconds
   my $path=$hour->{PATH};
   my %auto_events;
   my %info=(DATE=>$TODAY,PHASE=>$phase,FILES=>0,REMOVED=>0,SIZE=>0,WIPED=>0,MIGRATED=>0);
   my $stat={DIRECTORY=>{ID=>$cfg->{DEVID},OBJID=>$cfg->{OBJID},HOUR=>$hour->{TIME}},
             RETENTION=>{MIN=>$hour->{MIN},MAX=>$hour->{MAX},TYPE=>$cfg->{VM_CLEAN_TYPE},SIZE=>0}};
   #print "cleaning $cfg->{DEVID} : $path\n";
   SM_LOG->debug("$phase obj:$cfg->{OBJID} $path\n");
   cache_events($cfg,$hour->{DATE}) if not defined $cfg->{$hour->{DATE}};
   eval {
      local $SIG{ALRM}= sub{ die "TIMEOUT $!" }; alarm 300;
      opendir(DIR, $path) || die "can't opendir $path: $!";
      my @files = grep { ! /^(\.\.?|\.stat|\.idx.sqlite|\.idx|\.cov|\.hcov|\.mcov|\.mmeta|\.wiped)$/} readdir(DIR);
      closedir DIR;

      my %cov;                    #------------------ pre-read coverage info (OLD)
      if (open(COV, "$path/.cov")) {
          foreach (<COV>) {
             $cov{$1}={(OLD=>$2,NEW=>0)} if /^(\d+)\|(\d\d*)/;
          }
          close COV;
      }
     
      my $policy;                 # policy structure for eventstat collection
      my (@keep,%remove);
      my $dir_files;              # number of chunk files;  
      foreach my $file (@files) { #--------------------- check event protection 
        if($file=~/^(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)\./) { # if legal
           my $begin=timegm($6,$5,$4,$3,$2-1,$1+100);    #chunk begin
           my $end=$begin+$csize;                        #chunk end
           my $overlap=0; 
           next if $file=~/\.idx$/;                      #ignore index
           my $idx=(-f "$path/$file.idx")?"$file.idx":'';#index name if file exists
           $dir_files++;
           foreach(@{$cfg->{$hour->{DATE}}}) {           #check overlap with event
               if (($_->{E_BEGIN} < $end) && ($_->{E_END} > $begin)) { 
                 SM_LOG->debug("$file is protected by event $_->{EVENTID} "
                 . scalar(localtime $_->{E_BEGIN}) .'-'. scalar(localtime $_->{E_END}));
                 #---------------------------------------------- event stat calc
                 my ($po,$ty)=($_->{LIFESPAN},$_->{EVENTTYPE}); # short names only
                 if (! (exists $policy->{$po} && exists $policy->{$po}->{TYPE}->{$ty})) {
                    $policy->{$po}->{TYPE}->{$ty}={MIN=>$TODAY+$DAY*5,SIZE=>0};
                 } 
                 $policy->{$po}->{TYPE}->{$ty}->{SIZE}+=(stat("$path/$file"))[12]*$BS/1024;
                 #-------------------------------------------end event stat calc
                 $auto_events{$_->{EVENTID}}=1 if $_->{LIFESPAN}==-1; # -1-Automatic events 
                 $overlap++;last; 
               } 
           }
           if($overlap){
             push(@keep, $file);
             push(@keep, $idx ) if $idx;
           }else{
             $remove{$file}=1;
             $remove{$idx} =1   if $idx;
           } 
           #------------------------------------------------collect coverage info {NEW}
           if ($overlap && %cov)   {
             if( $csize<60) {                         #chunk size 10,20,30
               my $covtime=int($begin/60)*60;
               $cov{$covtime}->{NEW}+=$csize if defined $cov{$covtime};
             } else {                                 #chunk size 60,120,240,300
               for (my $step=0;$step<$csize; $step+=60) {
                 my $covtime=$begin+$step;
                 $cov{$covtime}->{NEW}=60    if defined $cov{$covtime};
               }
             }
           }
        } else {                                      # the filename is illegal
            $remove{$file}=1;
        }
      }  # end of cycle

      foreach (sort keys %remove) { #--------------------------- removing cycle
        my $sz =file_size("$path/$_");         # get KB-size prior unlinking
        if(unlink("$path/$_")) {
          SM_LOG->warn("illegal file $path/$_ is removed") if ! /^\d{12}\./;
          $info{REMOVED}++;                    # count removed file
          $info{WIPED}+=$sz;                   # count wiped space
        } else {
          SM_LOG->warn("cannot remove $path/$_");
          push(@keep,$_);                      # have to keep it
          delete $remove{$_};                  # we cannot remove it
        }
      }  # end of cycle

      if( %remove ) {       # index and coverage have to be updated if any removed
        my @list=sort grep {!/idx$/} keys %remove;
        remove_from_idx($path,$csize,\@list) if @keep; # update index if keeping some chunks
        if (open(IDX, $hour->{IDX})) { #----------------------------------- rewrite index
          my @idx= <IDX>;
          close IDX;
          my @new_idx = grep { not exists $remove{$1} if /\|(\d{12}\.\w+)\|\d+/ } @idx;
          eval {
            if (@new_idx) {
              open( NEW_IDX,">$hour->{IDX}.tmp") || die "Cannot create $hour->{IDX}.tmp";
              print(NEW_IDX @new_idx) || die "Cannot write into $hour->{IDX}.tmp";
              close NEW_IDX;
            }
            unlink($hour->{IDX})      || die "Cannot remove $hour->{IDX}";
            rename("$hour->{IDX}.tmp",$hour->{IDX}) if @new_idx; #error handle isn't needed
          }; # eval
          if ($@) {
             SM_LOG->error( $@);
             unlink("$hour->{IDX}.tmp") if -f "$hour->{IDX}.tmp";
          }
#       } else {          # index file is not exists (not critical)
#              SM_LOG->warn("Cannot open index $hour->{IDX}");
        }
        if (%cov) { #------------------------------------- rewrite .cov if present
          my @new_cov;
          foreach ( sort keys %cov) {
            next if $cov{$_}->{NEW}==0;                # ignore empty coverage
            $cov{$_}->{NEW}=$cov{$_}->{OLD} if $cov{$_}->{OLD}<$cov{$_}->{NEW};
            push @new_cov,"$_|$cov{$_}->{NEW}\n";
          }
          eval {
            if (@new_cov) {
              open( NEW_COV,">$path/.cov.tmp") || die "Cannot create $path/.cov.tmp";
              print(NEW_COV @new_cov) || die "Cannot write into $path/.cov.tmp";
              close NEW_COV;
            }
            unlink("$path/.cov")      || die "Cannot remove $path/.cov";
            rename("$path/.cov.tmp","$path/.cov") if @new_cov; #error handle isn't needed
          }; # eval
          if ($@) {
             SM_LOG->error( $@);
             unlink("$path/.cov.tmp") if -f "$path/.cov.tmp";
          }
        }
      }
      my $migrants;
      $migrants=$hour->{CHUNKS} if $phase eq 'MIGRANTS' and exists $hour->{CHUNKS};
      foreach my $file (@keep) {#--------------------- check MIGRANTS and collect stat 
        $info{FILES}++;
        if($migrants) {
           if(grep {$_ eq $file}  @$migrants) {      # found among migrants
             $info{MIGRATED}+=file_size("$path/$file");
             unlink "$path/$file";
             unlink "$path/$file.idx"  if -f "$path/$file.idx"; 
             open NEW_CHUNK,">$path/$file.s3";       # create empty file
             close NEW_CHUNK;
             next;
           }
        }
        $info{SIZE}+= file_size("$path/$file");      # get KB-size 
      }
      if ( @keep ) { #-------------------------------------------- update .stat 
        if($ENABLE_STAT) { 
          update_va_rate($cfg,$path,$info{SIZE},$dir_files) if not -f "$path/.stat"; # only if stat is not calculated yet
          #print "stat:>$path/.stat\n";
          $stat->{DIRECTORY}->{SIZE}=$info{SIZE};         #total size of directory
          $stat->{POLICY}=$policy;
          open STAT, ">$path/.stat";
          print STAT XMLout($stat,,KeyAttr=>'ID',RootName=>'STAT');
          close STAT;
        } 
        open MARK,">$path/.wiped"; #----------------------- mark dir with .wiped
        close MARK;  
        chmod 0775,$path;          # note wiped dirs have g+w for easy find
        task4mover($hour->{PATH}) if $phase=~/^(UNCONDITIONAL|SPACELIMITED)$/;
      } else {         #----------------------------------- remove dir and link
          rm_hour($path,$hour->{LINK});
      }
   }; # eval
   alarm 0;                                               # clean alarm
   if ($@) {
     SM_LOG->error("$phase object:$cfg->{OBJID} $hour->{PATH} FAIL:$@");
   } else  {
    my $spent=time-$start;
    SM_LOG->info("$phase obj:$cfg->{OBJID} $hour->{PATH} COMPLETED:"
    ." REMOVED=$info{REMOVED} WIPED=$info{WIPED}K MIGRATED=$info{MIGRATED}K LEFT=$info{SIZE}K SPENT=$spent".'sec');
    move_task2completed($hour->{TASK},'COMPLETED',"removed $info{MIGRATED}K") if $phase eq 'MIGRANTS';
    update_stat4day($path,-$info{WIPED},'clean') if $info{WIPED}; # only if wiped
   }
   #sleep 2;
   #------------------------------------------------------- remove auto_events
   foreach(keys %auto_events)  {                            #ATTN! transaction may REQ
     $dbs{EXPIRE_EVENT}->execute($_) or SM_LOG->warn("Cannot exipre event=$_"); 
   }
   return $info{WIPED};                              # wiped KB
}

#------------------------------------------------------------------------------
#  get free_space (MB) on group
#  uses 'df' for getting space results
#  retrun:  free space on grop MB
#------------------------------------------------------------------------------
sub space_info {       # return hash (free,used,total) for a group
   my $group=shift;
   my %space=(free=>0,used=>0,total=>0);
   open(DF, "df -P $group->{MLIST} 2>/dev/null|") || SM_LOG->logdie("Cannot do df $group->{MLIST}");
   my @rows=<DF>;
   close DF;
   foreach(@rows) {
     next if not  /\s(\d+)\s+(\d+)\s+(\d+)\s+\d+%/;
     $space{total}+=$1;
     $space{used}+=$2;
     $space{free}+=$3;
   }
   return \%space;
}

sub free_space {             # free space [ persentage ]
   my $group=shift;
   my $space=space_info($group);
   return 0 if $space->{total}==0;  # actually never retur here, protection only
   return int($space->{free}/$space->{total}*100);
}
#------------------------------------------------------------------------------
#  PID maintanance
#  lite error handling since operation is not critical
#------------------------------------------------------------------------------

sub pid_read {
   my $pid=0;
   if(open PID,"$pid_name") {
     $pid=<PID>;
     close PID;
     chomp $pid
   } 
   $pid;
}

sub pid_write {
   if(open PID,">$pid_name") {
     print PID "$$\n";
     close PID;
   } else {
      SM_LOG->error("Cannot create a PID file $pid_name\n");
   }
}

sub pid_remove { 
    unlink $pid_name if pid_read()==$$;      # remove only own pid
}

sub pid_concurrent_check { 
  my $old_pid=pid_read();
  if($old_pid>1)        {  # check who has that PID
    open PS, "ps -p $old_pid -o comm=|"; # get the name of proc with old_pid
    my $proc=<PS>;
    close PS;
    chomp $proc;
    if ($proc eq $WIPE) {
      SM_LOG->warn("WIPE detects a concurent run, "
                     ."WIPE with $old_pid is already running. Exiting..");
      exit 1;
    } 
  }
  pid_write();
}

#------------------------------------------------------------------------------
# checks if any records in $APL/var/sm/removed
#  if record is present but devcfg does not have it then insert a zombie device
#    in to the devcfg
#  else remove the record from $APL/var/sm/removed (devid is reused)
#------------------------------------------------------------------------------
sub check_removed {
 my $devcfg=shift;                 # access like: $devcfg->{$dev}->{DEVID}
 my $removed=SM_VAR.'/removed';
 if(opendir(DIR,$removed)){
   my @dir= grep{/^a?\d+/} readdir(DIR);
   closedir DIR;
   my @zombie;
   foreach (@dir) {
     my ($dev)=/^(a?\d+)/;         # get id from file name only
     if(exists $devcfg->{$dev})  { # devid was re-used
       unlink "$removed/$_";       # we do not need this file any longer
     }else{                        # create zombie for removal process
       my %zombi=(DEVID=>$dev,OBJID=>-1,STORAGE_POLICY=>0);
       $devcfg->{$dev}=\%zombi;
       push (@zombie,$dev);
     }
   }
   SM_LOG->info("zombies for cleaning:" . join (',',sort @zombie)) if @zombie;
 }else{
    SM_LOG->error("Cannot read $removed");
 } 
}



#------------------------------------------------------------------------------
# expire_events 
# find all "space-limited" events and expire the oldes till target is reached
# the procedeure is called only if target is not reached by wipe
# return the number of removed KB (estimated) or 0 if nothing has been removed
# TBD: fetch small portions
# TBD: evaluate execution plan for a query
# TBD: expire multiple events in one transaction
#------------------------------------------------------------------------------

sub expire_events {
   my $group=shift;
   my $nconf=NodeConf;
   my $events;
   my $start=time;
   eval {                    #--------------- query all space-limited events---
     $events=$dbm->selectall_arrayref(qq{
         select e.eventid, w.objid, s.preserverhours,
           EXTRACT(EPOCH FROM utc_from at time zone 'UTC') as e_begin,
           EXTRACT(EPOCH FROM utc_to   at time zone 'UTC') as e_end
         from eventwitness w
           inner join event e ON e.eventid = w.eventid
           inner join _obj_attr a on a.obj=e.objid and a.attr='EVENT_POLICY'
           inner join eventpolicystorage s on s.eventpolicy = cast(a.val as int) and s.eventpriority=e.priority
         where s.preserverhours = -2 and w.objid in
               (select obj from _objs where node_id=$nconf->{OBJID})
         order by utc_from },
           {Slice => {}}
     );
   }; # eval
   if ($@) {
      SM_LOG->warn("Cannot do :$@");
      print "Cannot do :$@";
      return 0;
   } 
   #print Dumper($events);
                            #--------------- prepare objects-------------------
   my $event_count=scalar @$events; # the number events we have
   my $expired_count=0;
   my $objs=SM_Objects();        # we need for space assesment
   my $policies=get_storagepolicies();
   foreach my $obj (keys %$objs) {       # calculate cutoff moment for each device
      if(defined $objs->{$obj}->{STORAGE_POLICY} and defined $policies->{$objs->{$obj}->{STORAGE_POLICY}}) {
        my $sp=$policies->{$objs->{$obj}->{STORAGE_POLICY}};
        $objs->{$obj}->{cutoff}=$TODAY-$DAY*$sp->{DAYS_MIN}; 
      }else {
        $objs->{$obj}->{cutoff}=$TODAY;
      }
      SM_LOG->debug("obj=$obj; cutoff=$objs->{$obj}->{cutoff} $TODAY");
   }
                            #--------------- prepare space info ---------------
   my $space=space_info($group); # we need for a 'lot' calculation
   my $lot=($group->{TARGET}*$space->{total}/100)-$space->{free}; #KB to be removed
   my $removed=0;                # count KB been removed
   if ($lot<0) {
      SM_LOG->warn("expire_events has nothing to exipre since target is reached (lot=$lot)");
      return 0;
   } 
   if ($event_count==0) {   
      SM_LOG->info("expire_events has no events to expire");
      return 0;
   }
   SM_LOG->info("expire_events has to clean $lot KB, found $event_count events"); 
                            #--------------- expire events from the oldest----
   foreach my $event (@$events) {
     last if $removed>$lot;
     next if $event->{E_END}>$objs->{$event->{OBJID}}->{cutoff}; # cannot expire before content
     my $estimate=($event->{E_END}-$event->{E_BEGIN})*$objs->{$event->{OBJID}}->{stat_VA_RATE};
     eval {
       $dbs{EXPIRE_EVENT}->execute($event->{EVENTID}) or SM_LOG->warn("Cannot exipre event=$event->{EVENTID}"); 
     };
     if($@) {                                 # skeep event if sql fails
       SM_LOG->warn("Cannot expire event $event->{EVENTID} :$@");
       next;
     }
     $removed+=$estimate;
     SM_LOG->debug("$removed ($event->{E_END}-$event->{E_BEGIN})*$objs->{$event->{OBJID}}->{stat_VA_RATE}=$estimate");
     $expired_count++;
   } 
                            #--------------- print completition info---------
   my $mb_removed=int($removed/1024);
   my $spent=time-$start;
   SM_LOG->info("EXPIRE space limited events is COMPLETED:"
    ." EXPIRED=$expired_count events, will be REMOVED=$mb_removed MB SPENT=$spent".'sec');
   return $removed;
}

#------------------------------------------------------------------------------
# THE WIPE - main program logic is here
# 1. Get device configuration
# 2. Get group/volumes information
# 3. Get a list of all 'hour' directories in group
# 4. Do EVENTHOLDERS (already expired but early protected by events)
# 5. Do UNCONDITIONAL cleaning for all expired hours [ FIXED and RANGE ]
# 6. Do SPACELIMITED for SPECELIMITED and RANGE (short excluded)
#------------------------------------------------------------------------------
sub wipe {
 my $group=shift;                              # get the group from argumnets
 my $start=time;                               # start time stamp
 SM_LOG->info("WIPE STARTED");
 db_master;
 my %devcfg = GetCfgs();
 check_removed(\%devcfg);                      # may get additional zombie devices
 #print Dumper(\%devcfg);
 #print Dumper($group);
 my $sp=get_storagepolicies();
 my $tmlist=$CLOUD_ENABLED ? get_tmlist($group->{MLIST},\%devcfg) : {};# migrated
 my $wlist=get_wlist($group->{MLIST},\%devcfg);# early wiped with event protect
 #print Dumper $wlist;
 my $list=get_list($group->{MLIST},\%devcfg,$wlist,$sp);# list of dev/hours in group
 my $wiped=0;
 #----------------------------------------------------------------MIGRANTS
 #print Dumper($list);
 #exit 0;
 foreach my $dir (sort keys %$tmlist) {
      die('SIGTERM')            if $sigterm;   # die if requested
      die('SIGHUP' )            if $sighup;    # restart is requested
      my $hr=$tmlist->{$dir};
      $wiped+=clean_hour('MIGRANTS',$devcfg{$hr->{DEV}},$hr);
      pid_write;                               # keep peed file current
 }
 #----------------------------------------------------------------EVENTHOLDERS
 foreach my $dir (sort keys %$wlist) {
      die('SIGTERM')            if $sigterm;   # die if requested
      die('SIGHUP' )            if $sighup;    # restart is requested
      my $hr=$wlist->{$dir};
      $wiped+=clean_hour('EVENTHOLDERS',$devcfg{$hr->{DEV}},$hr);
      pid_write;                               # keep peed file current
 }
 #----------------------------------------------------------------UNCONDITIONAL
 foreach my $dev (sort keys %$list) {
   for(my $i=$#{$list->{$dev}};$i>=0;$i--) {   # cycle backward
      die('SIGTERM')            if $sigterm;   # die if requested
      die('SIGHUP' )            if $sighup;    # restart is requested
      my $hrec=$list->{$dev}->[$i];
      last if $hrec->{MAX} >= $TODAY;          # nothing for cleaning left
      $wiped+=clean_hour('UNCONDITIONAL',$devcfg{$dev},$hrec);
      pop @{$list->{$dev}};		       # exclude directory if cleaned
      pid_write;                               # keep peed file current
   }
 }
 #print Dumper(\$devcfg{1});
 #------------------------------------------------------------------SPACELIMITED
 my ($target,$free_space)=($group->{TARGET},free_space($group));
 my @mdev=sort {$b <=> $a}                  # sort by age
          map  {my $hr=$list->{$_}->[-1]; $hr->{MIN2TODAY}." $_"}
          grep {my $hr=$list->{$_}->[-1]; $hr->{MIN}<$TODAY }
          grep {scalar @{$list->{$_}} } keys %$list;
 SM_LOG->info("SPACELIMITED spread=".join('| ',@mdev));
 SM_LOG->info("SPACELIMITED is started since $free_space < $target (TARGET)")
                                            if $free_space < $target;
 while (($free_space=free_space($group)) < $target ) {
   my $cleaned=0;                              # the count for cleaned hours
   my ($omin,$odev)=($TODAY,0);                # initial info for oldest content
   foreach my $dev (sort keys %$list) {        # find the oldest day
      die('SIGTERM')            if $sigterm;   # die if requested
      die('SIGHUP' )            if $sighup;    # restart is requested
      next if  ! scalar @{$list->{$dev}};      # if device does not have hours
      my $hrec=$list->{$dev}->[-1];            # get the oldest hour
      next if $hrec->{MIN} >= $TODAY;          # nothing for cleaning
      ($omin,$odev)=($hrec->{MIN},$dev) if $hrec->{MIN}<$omin; # if oldest
   }
   last if not $odev;                          # stop since nothing to clean
   $wiped+=clean_hour('SPACELIMITED',$devcfg{$odev},$list->{$odev}->[-1]);
   pop @{$list->{$odev}};                      # exclude directory if cleaned
   pid_write;                                  # keep peed file current
 }
 #--------------------------------------------------------------------REPORTING
 my $spent=time-$start;
 $wiped=($wiped)? int($wiped/1024).'M are wiped' : 'Nothing to wipe';
 my $result=($free_space>=$target) ? "TARGET is met $free_space > $target"
                                  : "TARGET is not met $free_space < $target";
 SM_LOG->info("WIPE COMPLETED in $spent sec.  $wiped from the GROUP '$group->{NAME}'. $result");
 SM_info('',  "WIPE COMPLETED in $spent sec.  $wiped. $result");
 return if ! $ENABLE_STAT;                     # no further action if disabled 
 #--------------------------------------------------------------------STATISTIC
 SM_LOG->info("STAT collection started:");
 foreach my $dev (sort keys %$list) {
   for(my $i=$#{$list->{$dev}};$i>=0;$i--) {   # cycle backward
      die('SIGTERM')            if $sigterm;   # die if requested
      die('SIGHUP' )            if $sighup;    # restart is requested
      my $hrec=$list->{$dev}->[$i];
      stat_hour($devcfg{$dev},$hrec);
      pop @{$list->{$dev}};                    # exclude directory if cleaned
      pid_write;                               # keep peed file current
   }
 }
 my $stat_spent=time-$start-$spent;
 SM_LOG->info("STAT finished in $stat_spent sec."); 
 #-------------------------------------------------------------------- RMDAYS 
 my $rmdays_start=time;
 my $days=rm_days($group->{MLIST});# remove empty days
 my $rmdays_spent=time-$rmdays_start;
 SM_LOG->info("RMDAYS finished $days empty days are removed in $rmdays_spent sec.");
 #-------------------------------------------------------------------- STAT2DB
 my $stat2db_start=time;
 SM_LOG->debug("STAT2DB execute DELETE_SPACE");
 $dbs{DELETE_SPACE}->execute();
 SM_LOG->debug("STAT2DB execute DELETE_ZERRO");
 $dbs{DELETE_ZERRO}->execute();
 SM_LOG->debug("STAT2DB execute INSERT_SPACE");
 $dbs{INSERT_SPACE}->execute();
 my $stat2db_spent=time-$rmdays_start;
 SM_LOG->info("STAT2DB finished in $stat2db_spent sec.");
}

#------------------------------------------------------------------------------
# WIPER calls wipe and manage exceptions
#
#------------------------------------------------------------------------------
sub wiper {
 my $group=shift;                              # get the group from argumnets
 for (my $i=0;$i<5;$i++ ) {      # 5 attempt to wipe, can be restarted by SIGHUP
   eval { wipe($group); };
   if($@) { #------------------------------------------------SIGNALS and ERRORS
     if (     $@ =~ /^SIGTERM/) {
        SM_LOG->warn("TERMINATED by request. The task is not completed");
        exit 1;
     } elsif ($@ =~ /^SIGHUP/) {
        SM_LOG->warn("SIGHUP. Restarting ...");
        $sighup=0;			      # clean signal flag
        next;                                  # restart WIPE
     } elsif ($@ =~ /^GROUP_DEFINITION_ERROR/) {
        SM_LOG->logdie("TERMINATED. $@");
     } elsif ($@ =~ /^STORAGE_POLICY_DEFINITION_ERROR/) {
        SM_LOG->logdie("TERMINATED. $@");
     } elsif ($@ =~ /^DB_MASTER/) {            # problems with master DB
        SM_LOG->logdie("TERMINATED. $@");
     } else {
        SM_LOG->logdie("TERMINATED. Unknown Error: $@");
     }
   }
   last;
 }
}

# MAIN ========================================================================
pid_concurrent_check(); 
my $group=get_group();     # grop structure
wiper($group);
expire_events($group);     # 
for (my $i=2;$i<2;$i++) {   # run cycle twice since exipre_events is not precise 
  my ($target,$free_space)=($group->{TARGET},free_space($group));
  last if $free_space>=$target;        # target is reached
  last if not expire_events($group);   # if nothing expired
  wiper($group);           # re-run wipe to remove video after event expired
}

# END =========================================================================
END {
  pid_remove;
  $dbm->disconnect() if ($dbm);   #disconnect from databases
} 
