2005-12-16 18:05:29 +08:00
#!/usr/bin/perl -wT
#
# ==========================================================================
#
# ZoneMinder Event Filter Script, $Date$, $Revision$
2008-07-25 17:48:16 +08:00
# Copyright (C) 2001-2008 Philip Coombes
2005-12-16 18:05:29 +08:00
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
# ==========================================================================
#
# This script continuously monitors the recorded events for the given
# monitor and applies any filters which would delete and/or upload
# matching events
#
use strict ;
use bytes ;
# ==========================================================================
#
# These are the elements you can edit to suit your installation
#
# ==========================================================================
2005-12-16 21:16:37 +08:00
use constant START_DELAY = > 5 ; # How long to wait before starting
2005-12-16 18:36:22 +08:00
# ==========================================================================
#
# You shouldn't need to change anything from here downwards
#
# ==========================================================================
2009-06-08 17:11:56 +08:00
@ EXTRA_PERL_LIB @
2005-12-16 18:36:22 +08:00
use ZoneMinder ;
use DBI ;
use POSIX ;
use Time::HiRes qw/gettimeofday/ ;
use Date::Manip ;
use Getopt::Long ;
2007-09-04 22:52:26 +08:00
use Data::Dumper ;
2005-12-16 18:36:22 +08:00
2010-03-01 06:03:27 +08:00
use constant EVENT_PATH = > ( ZM_DIR_EVENTS =~ m | /|)?ZM_DIR_EVENTS:(ZM_PATH_WEB.'/ ' . ZM_DIR_EVENTS ) ;
2005-12-16 18:36:22 +08:00
2011-06-21 17:19:10 +08:00
logInit ( ) ;
logSetSignal ( ) ;
2005-12-21 01:03:33 +08:00
2005-12-16 18:05:29 +08:00
if ( ZM_OPT_UPLOAD )
{
2007-09-04 22:52:26 +08:00
# Comment these out if you don't have them and don't want to upload
# or don't want to use that format
if ( ZM_UPLOAD_ARCH_FORMAT eq "zip" )
{
require Archive::Zip ;
import Archive:: Zip qw( :ERROR_CODES :CONSTANTS ) ;
}
else
{
require Archive::Tar ;
}
require Net::FTP ;
2005-12-16 18:05:29 +08:00
}
if ( ZM_OPT_EMAIL )
{
2007-09-04 22:52:26 +08:00
if ( ZM_NEW_MAIL_MODULES )
{
require MIME::Lite ;
require Net::SMTP ;
}
else
{
require MIME::Entity ;
}
2005-12-16 18:05:29 +08:00
}
if ( ZM_OPT_MESSAGE )
{
2007-09-04 22:52:26 +08:00
if ( ZM_NEW_MAIL_MODULES )
{
require MIME::Lite ;
require Net::SMTP ;
}
else
{
require MIME::Entity ;
}
2005-12-16 18:05:29 +08:00
}
$| = 1 ;
$ ENV { PATH } = '/bin:/usr/bin' ;
$ ENV { SHELL } = '/bin/sh' if exists $ ENV { SHELL } ;
delete @ ENV { qw( IFS CDPATH ENV BASH_ENV ) } ;
my $ delay = ZM_FILTER_EXECUTE_INTERVAL ;
my $ event_id = 0 ;
2006-10-23 23:32:22 +08:00
my $ filter_parm = "" ;
2005-12-16 18:05:29 +08:00
sub Usage
{
2007-09-04 22:52:26 +08:00
print ( "
2006-10-23 23:32:22 +08:00
Usage: zmfilter . pl [ - f < filter name > , - - filter = < filter name > ]
2005-12-16 18:05:29 +08:00
Parameters are : -
2006-10-23 23:32:22 +08:00
- f < filter name > , - - filter = < filter name > - The name of a specific filter to run
2005-12-16 18:05:29 +08:00
" ) ;
2007-09-04 22:52:26 +08:00
exit ( - 1 ) ;
2005-12-16 18:05:29 +08:00
}
#
# More or less replicates the equivalent PHP function
#
sub strtotime
{
2007-09-04 22:52:26 +08:00
my $ dt_str = shift ;
return ( UnixDate ( $ dt_str , '%s' ) ) ;
2005-12-16 18:05:29 +08:00
}
#
# More or less replicates the equivalent PHP function
#
sub str_repeat
{
2007-09-04 22:52:26 +08:00
my $ string = shift ;
my $ count = shift ;
return ( $ { string } x $ { count } ) ;
2005-12-16 18:05:29 +08:00
}
# Formats a date into MySQL format
sub DateTimeToSQL
{
2007-09-04 22:52:26 +08:00
my $ dt_str = shift ;
my $ dt_val = strtotime ( $ dt_str ) ;
if ( ! $ dt_val )
{
Error ( "Unable to parse date string '$dt_str'\n" ) ;
return ( undef ) ;
}
return ( strftime ( "%Y-%m-%d %H:%M:%S" , localtime ( $ dt_val ) ) ) ;
2005-12-16 18:05:29 +08:00
}
2006-10-23 23:32:22 +08:00
if ( ! GetOptions ( 'filter=s' = > \ $ filter_parm ) )
2005-12-16 18:05:29 +08:00
{
2007-09-04 22:52:26 +08:00
Usage ( ) ;
2005-12-16 18:05:29 +08:00
}
chdir ( EVENT_PATH ) ;
2007-09-07 23:39:44 +08:00
my $ dbh = zmDbConnect ( ) ;
2005-12-16 18:05:29 +08:00
2006-10-23 23:32:22 +08:00
if ( $ filter_parm )
{
Info ( "Scanning for events using filter '$filter_parm'\n" ) ;
}
else
{
Info ( "Scanning for events\n" ) ;
}
2005-12-16 18:05:29 +08:00
2006-10-23 23:32:22 +08:00
if ( ! $ filter_parm )
{
sleep ( START_DELAY ) ;
}
2005-12-16 18:05:29 +08:00
2006-10-23 23:32:22 +08:00
my $ filters ;
2005-12-16 18:05:29 +08:00
my $ last_action = 0 ;
while ( 1 )
{
2007-09-04 22:52:26 +08:00
if ( ( time ( ) - $ last_action ) > ZM_FILTER_RELOAD_DELAY )
{
Debug ( "Reloading filters\n" ) ;
$ last_action = time ( ) ;
$ filters = getFilters ( $ filter_parm ) ;
}
foreach my $ filter ( @$ filters )
{
checkFilter ( $ filter ) ;
}
2005-12-16 18:05:29 +08:00
2006-10-23 23:32:22 +08:00
last if ( $ filter_parm ) ;
2007-09-04 22:52:26 +08:00
Debug ( "Sleeping for $delay seconds\n" ) ;
sleep ( $ delay ) ;
2005-12-16 18:05:29 +08:00
}
sub getDiskPercent
{
2007-09-04 22:52:26 +08:00
my $ command = "df ." ;
my $ df = qx( $command ) ;
my $ space = - 1 ;
if ( $ df =~ /\s(\d+)%/ms )
{
$ space = $ 1 ;
}
return ( $ space ) ;
2005-12-16 18:05:29 +08:00
}
sub getDiskBlocks
{
2007-09-04 22:52:26 +08:00
my $ command = "df ." ;
my $ df = qx( $command ) ;
my $ space = - 1 ;
if ( $ df =~ /\s(\d+)\s+\d+\s+\d+%/ms )
{
$ space = $ 1 ;
}
return ( $ space ) ;
2005-12-16 18:05:29 +08:00
}
2007-09-06 17:34:44 +08:00
sub getLoad
{
my $ command = "uptime ." ;
my $ uptime = qx( $command ) ;
my $ load = - 1 ;
if ( $ uptime =~ /load average:\s+([\d.]+)/ms )
{
$ load = $ 1 ;
Info ( "Load: $load" ) ;
}
return ( $ load ) ;
}
2005-12-16 18:05:29 +08:00
sub getFilters
{
2006-10-23 23:32:22 +08:00
my $ filter_name = shift ;
2007-09-04 22:52:26 +08:00
my @ filters ;
my $ sql = "select * from Filters where" ;
2006-10-23 23:32:22 +08:00
if ( $ filter_name )
{
$ sql . = " Name = ? and" ;
}
else
{
$ sql . = " Background = 1 and" ;
}
$ sql . = " (AutoArchive = 1 or AutoVideo = 1 or AutoUpload = 1 or AutoEmail = 1 or AutoMessage = 1 or AutoExecute = 1 or AutoDelete = 1) order by Name" ;
2007-09-04 22:52:26 +08:00
my $ sth = $ dbh - > prepare_cached ( $ sql ) or Fatal ( "Can't prepare '$sql': " . $ dbh - > errstr ( ) ) ;
my $ res ;
2006-10-23 23:32:22 +08:00
if ( $ filter_name )
{
$ res = $ sth - > execute ( $ filter_name ) or Fatal ( "Can't execute '$sql': " . $ sth - > errstr ( ) ) ;
}
else
{
$ res = $ sth - > execute ( ) or Fatal ( "Can't execute '$sql': " . $ sth - > errstr ( ) ) ;
}
2007-09-04 22:52:26 +08:00
FILTER: while ( my $ db_filter = $ sth - > fetchrow_hashref ( ) )
{
Debug ( "Found filter '$db_filter->{Name}'\n" ) ;
2011-05-24 00:18:18 +08:00
my $ filter_expr = jsonDecode ( $ db_filter - > { Query } ) ;
2007-09-04 22:52:26 +08:00
my $ sql = "select E.Id,E.MonitorId,M.Name as MonitorName,M.DefaultRate,M.DefaultScale,E.Name,E.Cause,E.Notes,E.StartTime,unix_timestamp(E.StartTime) as Time,E.Length,E.Frames,E.AlarmFrames,E.TotScore,E.AvgScore,E.MaxScore,E.Archived,E.Videoed,E.Uploaded,E.Emailed,E.Messaged,E.Executed from Events as E inner join Monitors as M on M.Id = E.MonitorId where not isnull(E.EndTime)" ;
2010-03-01 03:16:40 +08:00
$ db_filter - > { Sql } = '' ;
2007-09-04 22:52:26 +08:00
if ( @ { $ filter_expr - > { terms } } )
{
for ( my $ i = 0 ; $ i < @ { $ filter_expr - > { terms } } ; $ i + + )
{
if ( exists ( $ filter_expr - > { terms } [ $ i ] - > { cnj } ) )
{
$ db_filter - > { Sql } . = " " . $ filter_expr - > { terms } [ $ i ] - > { cnj } . " " ;
}
if ( exists ( $ filter_expr - > { terms } [ $ i ] - > { obr } ) )
{
$ db_filter - > { Sql } . = " " . str_repeat ( "(" , $ filter_expr - > { terms } [ $ i ] - > { obr } ) . " " ;
}
my $ value = $ filter_expr - > { terms } [ $ i ] - > { val } ;
my @ value_list ;
if ( $ filter_expr - > { terms } [ $ i ] - > { attr } )
{
if ( $ filter_expr - > { terms } [ $ i ] - > { attr } =~ /^Monitor/ )
{
my ( $ temp_attr_name ) = $ filter_expr - > { terms } [ $ i ] - > { attr } =~ /^Monitor(.+)$/ ;
$ db_filter - > { Sql } . = "M." . $ temp_attr_name ;
}
elsif ( $ filter_expr - > { terms } [ $ i ] - > { attr } eq 'DateTime' )
{
$ db_filter - > { Sql } . = "E.StartTime" ;
}
elsif ( $ filter_expr - > { terms } [ $ i ] - > { attr } eq 'Date' )
{
$ db_filter - > { Sql } . = "to_days( E.StartTime )" ;
}
elsif ( $ filter_expr - > { terms } [ $ i ] - > { attr } eq 'Time' )
{
$ db_filter - > { Sql } . = "extract( hour_second from E.StartTime )" ;
}
elsif ( $ filter_expr - > { terms } [ $ i ] - > { attr } eq 'Weekday' )
{
$ db_filter - > { Sql } . = "weekday( E.StartTime )" ;
}
elsif ( $ filter_expr - > { terms } [ $ i ] - > { attr } eq 'DiskPercent' )
{
$ db_filter - > { Sql } . = "zmDiskPercent" ;
$ db_filter - > { HasDiskPercent } = ! undef ;
}
elsif ( $ filter_expr - > { terms } [ $ i ] - > { attr } eq 'DiskBlocks' )
{
$ db_filter - > { Sql } . = "zmDiskBlocks" ;
$ db_filter - > { HasDiskBlocks } = ! undef ;
}
2007-09-06 17:34:44 +08:00
elsif ( $ filter_expr - > { terms } [ $ i ] - > { attr } eq 'SystemLoad' )
{
$ db_filter - > { Sql } . = "zmSystemLoad" ;
$ db_filter - > { HasSystemLoad } = ! undef ;
}
2007-09-04 22:52:26 +08:00
else
{
$ db_filter - > { Sql } . = "E." . $ filter_expr - > { terms } [ $ i ] - > { attr } ;
}
( my $ stripped_value = $ value ) =~ s/^["\']+?(.+)["\']+?$/$1/ ;
foreach my $ temp_value ( split ( '/["\'\s]*?,["\'\s]*?/' , $ stripped_value ) )
{
if ( $ filter_expr - > { terms } [ $ i ] - > { attr } =~ /^Monitor/ )
{
$ value = "'$temp_value'" ;
}
2007-12-22 00:46:48 +08:00
elsif ( $ filter_expr - > { terms } [ $ i ] - > { attr } eq 'Name' || $ filter_expr - > { terms } [ $ i ] - > { attr } eq 'Cause' || $ filter_expr - > { terms } [ $ i ] - > { attr } eq 'Notes' )
2007-09-04 22:52:26 +08:00
{
$ value = "'$temp_value'" ;
}
elsif ( $ filter_expr - > { terms } [ $ i ] - > { attr } eq 'DateTime' )
{
$ value = DateTimeToSQL ( $ temp_value ) ;
if ( ! $ value )
{
Error ( "Error parsing date/time '$temp_value', skipping filter '$db_filter->{Name}'\n" ) ;
next FILTER ;
}
$ value = "'$value'" ;
}
elsif ( $ filter_expr - > { terms } [ $ i ] - > { attr } eq 'Date' )
{
$ value = DateTimeToSQL ( $ temp_value ) ;
if ( ! $ value )
{
Error ( "Error parsing date/time '$temp_value', skipping filter '$db_filter->{Name}'\n" ) ;
next FILTER ;
}
$ value = "to_days( '$value' )" ;
}
elsif ( $ filter_expr - > { terms } [ $ i ] - > { attr } eq 'Time' )
{
$ value = DateTimeToSQL ( $ temp_value ) ;
if ( ! $ value )
{
Error ( "Error parsing date/time '$temp_value', skipping filter '$db_filter->{Name}'\n" ) ;
next FILTER ;
}
$ value = "extract( hour_second from '$value' )" ;
}
else
{
$ value = $ temp_value ;
}
push ( @ value_list , $ value ) ;
}
}
if ( $ filter_expr - > { terms } [ $ i ] - > { op } )
{
if ( $ filter_expr - > { terms } [ $ i ] - > { op } eq '=~' )
2006-07-04 18:33:11 +08:00
{
2007-09-04 22:52:26 +08:00
$ db_filter - > { Sql } . = " regexp $value" ;
2006-07-04 18:33:11 +08:00
}
2007-09-04 22:52:26 +08:00
elsif ( $ filter_expr - > { terms } [ $ i ] - > { op } eq '!~' )
{
$ db_filter - > { Sql } . = " not regexp $value" ;
}
elsif ( $ filter_expr - > { terms } [ $ i ] - > { op } eq '=[]' )
{
$ db_filter - > { Sql } . = " in (" . join ( "," , @ value_list ) . ")" ;
}
elsif ( $ filter_expr - > { terms } [ $ i ] - > { op } eq '!~' )
{
$ db_filter - > { Sql } . = " not in (" . join ( "," , @ value_list ) . ")" ;
}
else
{
$ db_filter - > { Sql } . = " " . $ filter_expr - > { terms } [ $ i ] - > { op } . " $value" ;
}
}
if ( exists ( $ filter_expr - > { terms } [ $ i ] - > { cbr } ) )
{
$ db_filter - > { Sql } . = " " . str_repeat ( ")" , $ filter_expr - > { terms } [ $ i ] - > { cbr } ) . " " ;
}
}
}
if ( $ db_filter - > { Sql } )
{
$ sql . = " and ( " . $ db_filter - > { Sql } . " )" ;
}
my @ auto_terms ;
if ( $ db_filter - > { AutoArchive } )
{
push ( @ auto_terms , "E.Archived = 0" )
}
if ( $ db_filter - > { AutoVideo } )
{
push ( @ auto_terms , "E.Videoed = 0" )
}
if ( $ db_filter - > { AutoUpload } )
{
push ( @ auto_terms , "E.Uploaded = 0" )
}
if ( $ db_filter - > { AutoEmail } )
{
push ( @ auto_terms , "E.Emailed = 0" )
}
if ( $ db_filter - > { AutoMessage } )
{
push ( @ auto_terms , "E.Messaged = 0" )
}
if ( $ db_filter - > { AutoExecute } )
{
push ( @ auto_terms , "E.Executed = 0" )
}
if ( @ auto_terms )
{
$ sql . = " and ( " . join ( " or " , @ auto_terms ) . " )" ;
}
if ( ! $ filter_expr - > { sort_field } )
{
$ filter_expr - > { sort_field } = 'StartTime' ;
$ filter_expr - > { sort_asc } = 0 ;
}
my $ sort_column = '' ;
if ( $ filter_expr - > { sort_field } eq 'Id' )
{
2005-12-16 18:05:29 +08:00
$ sort_column = "E.Id" ;
2007-09-04 22:52:26 +08:00
}
elsif ( $ filter_expr - > { sort_field } eq 'MonitorName' )
{
2005-12-16 18:05:29 +08:00
$ sort_column = "M.Name" ;
2007-09-04 22:52:26 +08:00
}
elsif ( $ filter_expr - > { sort_field } eq 'Name' )
{
2005-12-16 18:05:29 +08:00
$ sort_column = "E.Name" ;
2007-09-04 22:52:26 +08:00
}
elsif ( $ filter_expr - > { sort_field } eq 'StartTime' )
{
2005-12-16 18:05:29 +08:00
$ sort_column = "E.StartTime" ;
2007-09-04 22:52:26 +08:00
}
elsif ( $ filter_expr - > { sort_field } eq 'Secs' )
{
2005-12-16 18:05:29 +08:00
$ sort_column = "E.Length" ;
2007-09-04 22:52:26 +08:00
}
elsif ( $ filter_expr - > { sort_field } eq 'Frames' )
{
2005-12-16 18:05:29 +08:00
$ sort_column = "E.Frames" ;
2007-09-04 22:52:26 +08:00
}
elsif ( $ filter_expr - > { sort_field } eq 'AlarmFrames' )
{
2005-12-16 18:05:29 +08:00
$ sort_column = "E.AlarmFrames" ;
2007-09-04 22:52:26 +08:00
}
elsif ( $ filter_expr - > { sort_field } eq 'TotScore' )
{
2005-12-16 18:05:29 +08:00
$ sort_column = "E.TotScore" ;
2007-09-04 22:52:26 +08:00
}
elsif ( $ filter_expr - > { sort_field } eq 'AvgScore' )
{
2005-12-16 18:05:29 +08:00
$ sort_column = "E.AvgScore" ;
2007-09-04 22:52:26 +08:00
}
elsif ( $ filter_expr - > { sort_field } eq 'MaxScore' )
{
2005-12-16 18:05:29 +08:00
$ sort_column = "E.MaxScore" ;
2007-09-04 22:52:26 +08:00
}
else
{
2005-12-16 18:05:29 +08:00
$ sort_column = "E.StartTime" ;
2007-09-04 22:52:26 +08:00
}
my $ sort_order = $ filter_expr - > { sort_asc } ? "asc" : "desc" ;
$ sql . = " order by " . $ sort_column . " " . $ sort_order ;
if ( $ filter_expr - > { limit } )
{
$ sql . = " limit 0," . $ filter_expr - > { limit } ;
}
Debug ( "SQL:$sql\n" ) ;
$ db_filter - > { Sql } = $ sql ;
if ( $ db_filter - > { AutoExecute } )
{
my $ script = $ db_filter - > { AutoExecuteCmd } ;
$ script =~ s/\s.*$// ;
if ( ! - e $ script )
{
Error ( "Auto execute script '$script' not found, skipping filter '$db_filter->{Name}'\n" ) ;
next FILTER ;
}
elsif ( ! - x $ script )
{
Error ( "Auto execute script '$script' not executable, skipping filter '$db_filter->{Name}'\n" ) ;
next FILTER ;
}
}
push ( @ filters , $ db_filter ) ;
}
$ sth - > finish ( ) ;
return ( \ @ filters ) ;
2005-12-16 18:05:29 +08:00
}
sub checkFilter
{
2007-09-04 22:52:26 +08:00
my $ filter = shift ;
Debug ( "Checking filter '$filter->{Name}'" .
( $ filter - > { AutoDelete } ? ", delete" : "" ) .
( $ filter - > { AutoArchive } ? ", archive" : "" ) .
( $ filter - > { AutoVideo } ? ", video" : "" ) .
( $ filter - > { AutoUpload } ? ", upload" : "" ) .
( $ filter - > { AutoEmail } ? ", email" : "" ) .
( $ filter - > { AutoMessage } ? ", message" : "" ) .
( $ filter - > { AutoExecute } ? ", execute" : "" ) .
"\n"
) ;
my $ sql = $ filter - > { Sql } ;
if ( $ filter - > { HasDiskPercent } )
{
my $ disk_percent = getDiskPercent ( ) ;
$ sql =~ s/zmDiskPercent/$disk_percent/g ;
}
if ( $ filter - > { HasDiskBlocks } )
{
my $ disk_blocks = getDiskBlocks ( ) ;
$ sql =~ s/zmDiskBlocks/$disk_blocks/g ;
}
2007-09-06 17:34:44 +08:00
if ( $ filter - > { HasSystemLoad } )
{
my $ load = getLoad ( ) ;
$ sql =~ s/zmSystemLoad/$load/g ;
}
2007-09-04 22:52:26 +08:00
my $ sth = $ dbh - > prepare_cached ( $ sql ) or Fatal ( "Can't prepare '$sql': " . $ dbh - > errstr ( ) ) ;
my $ res = $ sth - > execute ( ) ;
if ( ! $ res )
{
Error ( "Can't execute filter '$sql', ignoring: " . $ sth - > errstr ( ) ) ;
return ;
}
while ( my $ event = $ sth - > fetchrow_hashref ( ) )
{
Debug ( "Checking event $event->{Id}\n" ) ;
my $ delete_ok = ! undef ;
if ( $ filter - > { AutoArchive } )
{
Info ( "Archiving event $event->{Id}\n" ) ;
# Do it individually to avoid locking up the table for new events
my $ sql = "update Events set Archived = 1 where Id = ?" ;
my $ sth = $ dbh - > prepare_cached ( $ sql ) or Fatal ( "Can't prepare '$sql': " . $ dbh - > errstr ( ) ) ;
my $ res = $ sth - > execute ( $ event - > { Id } ) or Fatal ( "Can't execute '$sql': " . $ sth - > errstr ( ) ) ;
}
2008-07-14 23:56:52 +08:00
if ( ZM_OPT_FFMPEG && $ filter - > { AutoVideo } )
2007-09-04 22:52:26 +08:00
{
if ( ! $ event - > { Videoed } )
{
$ delete_ok = undef if ( ! generateVideo ( $ filter , $ event ) ) ;
}
}
if ( ZM_OPT_EMAIL && $ filter - > { AutoEmail } )
{
if ( ! $ event - > { Emailed } )
{
$ delete_ok = undef if ( ! sendEmail ( $ filter , $ event ) ) ;
}
}
if ( ZM_OPT_MESSAGE && $ filter - > { AutoMessage } )
{
if ( ! $ event - > { Messaged } )
{
$ delete_ok = undef if ( ! sendMessage ( $ filter , $ event ) ) ;
}
}
if ( ZM_OPT_UPLOAD && $ filter - > { AutoUpload } )
{
if ( ! $ event - > { Uploaded } )
{
$ delete_ok = undef if ( ! uploadArchFile ( $ filter , $ event ) ) ;
}
}
if ( $ filter - > { AutoExecute } )
{
if ( ! $ event - > { Execute } )
{
$ delete_ok = undef if ( ! executeCommand ( $ filter , $ event ) ) ;
}
}
if ( $ filter - > { AutoDelete } )
{
if ( $ delete_ok )
{
Info ( "Deleting event $event->{Id}\n" ) ;
# Do it individually to avoid locking up the table for new events
my $ sql = "delete from Events where Id = ?" ;
my $ sth = $ dbh - > prepare_cached ( $ sql ) or Fatal ( "Can't prepare '$sql': " . $ dbh - > errstr ( ) ) ;
my $ res = $ sth - > execute ( $ event - > { Id } ) or Fatal ( "Can't execute '$sql': " . $ sth - > errstr ( ) ) ;
if ( ! ZM_OPT_FAST_DELETE )
{
my $ sql = "delete from Frames where EventId = ?" ;
my $ sth = $ dbh - > prepare_cached ( $ sql ) or Fatal ( "Can't prepare '$sql': " . $ dbh - > errstr ( ) ) ;
my $ res = $ sth - > execute ( $ event - > { Id } ) or Fatal ( "Can't execute '$sql': " . $ sth - > errstr ( ) ) ;
$ sql = "delete from Stats where EventId = ?" ;
$ sth = $ dbh - > prepare_cached ( $ sql ) or Fatal ( "Can't prepare '$sql': " . $ dbh - > errstr ( ) ) ;
$ res = $ sth - > execute ( $ event - > { Id } ) or Fatal ( "Can't execute '$sql': " . $ sth - > errstr ( ) ) ;
2007-09-05 00:08:55 +08:00
deleteEventFiles ( $ event - > { Id } , $ event - > { MonitorId } ) ;
2007-09-04 22:52:26 +08:00
}
}
else
{
Error ( "Unable to delete event $event->{Id} as previous operations failed\n" ) ;
}
}
}
$ sth - > finish ( ) ;
2005-12-16 18:05:29 +08:00
}
sub generateVideo
{
2007-09-04 22:52:26 +08:00
my $ filter = shift ;
my $ event = shift ;
my $ phone = shift ;
my $ rate = $ event - > { DefaultRate } / 100 ;
my $ scale = $ event - > { DefaultScale } / 100 ;
my $ format ;
my @ ffmpeg_formats = split ( /\s+/ , ZM_FFMPEG_FORMATS ) ;
my $ default_video_format ;
my $ default_phone_format ;
foreach my $ ffmpeg_format ( @ ffmpeg_formats )
{
if ( $ ffmpeg_format =~ /^(.+)\*\*$/ )
{
$ default_phone_format = $ 1 ;
}
elsif ( $ ffmpeg_format =~ /^(.+)\*$/ )
{
$ default_video_format = $ 1 ;
}
}
if ( $ phone && $ default_phone_format )
{
$ format = $ default_phone_format ;
}
elsif ( $ default_video_format )
{
$ format = $ default_video_format ;
}
else
{
$ format = $ ffmpeg_formats [ 0 ] ;
}
my $ command = ZM_PATH_BIN . "/zmvideo.pl -e " . $ event - > { Id } . " -r " . $ rate . " -s " . $ scale . " -f " . $ format ;
my $ output = qx( $command ) ;
chomp ( $ output ) ;
my $ status = $? >> 8 ;
2011-06-21 17:19:10 +08:00
if ( $ status || logDebugging ( ) )
2007-09-04 22:52:26 +08:00
{
Debug ( "Output: $output\n" ) ;
}
if ( $ status )
{
Error ( "Video generation '$command' failed with status: $status\n" ) ;
if ( wantarray ( ) )
{
return ( undef , undef ) ;
}
return ( 0 ) ;
}
else
{
my $ sql = "update Events set Videoed = 1 where Id = ?" ;
my $ sth = $ dbh - > prepare_cached ( $ sql ) or Fatal ( "Can't prepare '$sql': " . $ dbh - > errstr ( ) ) ;
my $ res = $ sth - > execute ( $ event - > { Id } ) or Fatal ( "Can't execute '$sql': " . $ sth - > errstr ( ) ) ;
if ( wantarray ( ) )
{
2008-10-09 17:17:07 +08:00
return ( $ format , sprintf ( "%s/%s" , getEventPath ( $ event ) , $ output ) ) ;
2007-09-04 22:52:26 +08:00
}
}
return ( 1 ) ;
2005-12-16 18:05:29 +08:00
}
sub uploadArchFile
{
2007-09-04 22:52:26 +08:00
my $ filter = shift ;
my $ event = shift ;
2009-03-04 01:51:27 +08:00
if ( ! ZM_UPLOAD_FTP_HOST )
{
Error ( "Cannot upload archive as no FTP host defined" ) ;
return ( 0 ) ;
}
2007-09-04 22:52:26 +08:00
my $ arch_file = ZM_UPLOAD_FTP_LOC_DIR . '/' . $ event - > { MonitorName } . '-' . $ event - > { Id } ;
2008-02-14 06:41:17 +08:00
my $ arch_image_path = getEventPath ( $ event ) . "/" . ( ( ZM_UPLOAD_ARCH_ANALYSE ) ? '{*analyse,*capture}' : '*capture' ) . ".jpg" ;
2009-03-04 01:51:27 +08:00
my @ arch_image_files = glob ( $ arch_image_path ) ;
2007-09-04 22:52:26 +08:00
2010-03-01 03:16:40 +08:00
my $ arch_error = 0 ;
2007-09-04 22:52:26 +08:00
if ( ZM_UPLOAD_ARCH_FORMAT eq "zip" )
{
$ arch_file . = '.zip' ;
my $ zip = Archive::Zip - > new ( ) ;
2009-03-04 01:51:27 +08:00
Info ( "Creating upload file '$arch_file', " . int ( @ arch_image_files ) . " files\n" ) ;
2007-09-04 22:52:26 +08:00
my $ status = & AZ_OK ;
2009-03-04 01:51:27 +08:00
foreach my $ image_file ( @ arch_image_files )
2007-09-04 22:52:26 +08:00
{
2010-03-01 03:16:40 +08:00
Debug ( "Adding $image_file\n" ) ;
2007-09-04 22:52:26 +08:00
my $ member = $ zip - > addFile ( $ image_file ) ;
2010-03-01 03:16:40 +08:00
if ( ! $ member )
{
Error ( "Unable to add image file $image_file to zip archive $arch_file" ) ;
$ arch_error = 1 ;
last ;
}
2007-09-04 22:52:26 +08:00
$ member - > desiredCompressionMethod ( ( ZM_UPLOAD_ARCH_COMPRESS ) ? & COMPRESSION_DEFLATED: & COMPRESSION_STORED ) ;
}
2010-03-01 03:16:40 +08:00
if ( ! $ arch_error )
{
$ status = $ zip - > writeToFileNamed ( $ arch_file ) ;
2007-09-04 22:52:26 +08:00
2010-03-01 03:16:40 +08:00
if ( $ arch_error = ( $ status != & AZ_OK ) )
{
Error ( "Zip error: $status\n " ) ;
}
}
else
2007-09-04 22:52:26 +08:00
{
2010-03-01 03:16:40 +08:00
Error ( "Error adding images to zip archive $arch_file, not writing" ) ;
2007-09-04 22:52:26 +08:00
}
}
elsif ( ZM_UPLOAD_ARCH_FORMAT eq "tar" )
{
if ( ZM_UPLOAD_ARCH_COMPRESS )
{
$ arch_file . = '.tar.gz' ;
}
else
{
$ arch_file . = '.tar' ;
}
2009-03-04 01:51:27 +08:00
Info ( "Creating upload file '$arch_file', " . int ( @ arch_image_files ) . " files\n" ) ;
2007-09-04 22:52:26 +08:00
2009-03-04 01:51:27 +08:00
if ( $ arch_error = ! Archive::Tar - > create_archive ( $ arch_file , ZM_UPLOAD_ARCH_COMPRESS , @ arch_image_files ) )
2007-09-04 22:52:26 +08:00
{
Error ( "Tar error: " . Archive::Tar - > error ( ) . "\n " ) ;
}
}
if ( $ arch_error )
{
return ( 0 ) ;
}
else
{
Info ( "Uploading to " . ZM_UPLOAD_FTP_HOST . "\n" ) ;
my $ ftp = Net::FTP - > new ( ZM_UPLOAD_FTP_HOST , Timeout = > ZM_UPLOAD_FTP_TIMEOUT , Passive = > ZM_UPLOAD_FTP_PASSIVE , Debug = > ZM_UPLOAD_FTP_DEBUG ) ;
if ( ! $ ftp )
{
warn ( "Can't create ftp connection: $@" ) ;
return ( 0 ) ;
}
$ ftp - > login ( ZM_UPLOAD_FTP_USER , ZM_UPLOAD_FTP_PASS ) or warn ( "FTP - Can't login" ) ;
$ ftp - > binary ( ) or warn ( "FTP - Can't go binary" ) ;
$ ftp - > cwd ( ZM_UPLOAD_FTP_REM_DIR ) or warn ( "FTP - Can't cwd" ) ;
$ ftp - > put ( $ arch_file ) or warn ( "FTP - Can't upload '$arch_file'" ) ;
$ ftp - > quit ( ) or warn ( "FTP - Can't quit" ) ;
unlink ( $ arch_file ) ;
my $ sql = "update Events set Uploaded = 1 where Id = ?" ;
my $ sth = $ dbh - > prepare_cached ( $ sql ) or Fatal ( "Can't prepare '$sql': " . $ dbh - > errstr ( ) ) ;
my $ res = $ sth - > execute ( $ event - > { Id } ) or Fatal ( "Can't execute '$sql': " . $ sth - > errstr ( ) ) ;
}
return ( 1 ) ;
2005-12-16 18:05:29 +08:00
}
sub substituteTags
{
2007-09-04 22:52:26 +08:00
my $ text = shift ;
my $ filter = shift ;
my $ event = shift ;
my $ attachments_ref = shift ;
# First we'd better check what we need to get
# We have a filter and an event, do we need any more
# monitor information?
my $ need_monitor = $ text =~ /%(?:MET|MEH|MED|MEW|MEN|MEA)%/ ;
my $ monitor = { } ;
if ( $ need_monitor )
{
my $ db_now = strftime ( "%Y-%m-%d %H:%M:%S" , localtime ( ) ) ;
my $ sql = "select M.Id, count(E.Id) as EventCount, count(if(E.Archived,1,NULL)) as ArchEventCount, count(if(E.StartTime>'$db_now' - INTERVAL 1 HOUR && E.Archived = 0,1,NULL)) as HourEventCount, count(if(E.StartTime>'$db_now' - INTERVAL 1 DAY && E.Archived = 0,1,NULL)) as DayEventCount, count(if(E.StartTime>'$db_now' - INTERVAL 7 DAY && E.Archived = 0,1,NULL)) as WeekEventCount, count(if(E.StartTime>'$db_now' - INTERVAL 1 MONTH && E.Archived = 0,1,NULL)) as MonthEventCount from Monitors as M left join Events as E on E.MonitorId = M.Id where MonitorId = ? group by E.MonitorId order by Id" ;
my $ sth = $ dbh - > prepare_cached ( $ sql ) or Fatal ( "Can't prepare '$sql': " . $ dbh - > errstr ( ) ) ;
my $ res = $ sth - > execute ( $ event - > { MonitorId } ) or Fatal ( "Can't execute '$sql': " . $ sth - > errstr ( ) ) ;
$ monitor = $ sth - > fetchrow_hashref ( ) ;
$ sth - > finish ( ) ;
return ( ) if ( ! $ monitor ) ;
}
# Do we need the image information too?
my $ need_images = $ text =~ /%(?:EPI1|EPIM|EI1|EIM)%/ ;
my $ first_alarm_frame ;
my $ max_alarm_frame ;
my $ max_alarm_score = 0 ;
if ( $ need_images )
{
my $ sql = "select * from Frames where EventId = ? and Type = 'Alarm' order by FrameId" ;
my $ sth = $ dbh - > prepare_cached ( $ sql ) or Fatal ( "Can't prepare '$sql': " . $ dbh - > errstr ( ) ) ;
my $ res = $ sth - > execute ( $ event - > { Id } ) or Fatal ( "Can't execute '$sql': " . $ sth - > errstr ( ) ) ;
while ( my $ frame = $ sth - > fetchrow_hashref ( ) )
{
if ( ! $ first_alarm_frame )
{
$ first_alarm_frame = $ frame ;
}
if ( $ frame - > { Score } > $ max_alarm_score )
{
$ max_alarm_frame = $ frame ;
$ max_alarm_score = $ frame - > { Score } ;
}
}
$ sth - > finish ( ) ;
}
my $ url = ZM_URL ;
$ text =~ s/%ZP%/$url/g ;
$ text =~ s/%MN%/$event->{MonitorName}/g ;
$ text =~ s/%MET%/$monitor->{EventCount}/g ;
$ text =~ s/%MEH%/$monitor->{HourEventCount}/g ;
$ text =~ s/%MED%/$monitor->{DayEventCount}/g ;
$ text =~ s/%MEW%/$monitor->{WeekEventCount}/g ;
$ text =~ s/%MEM%/$monitor->{MonthEventCount}/g ;
$ text =~ s/%MEA%/$monitor->{ArchEventCount}/g ;
$ text =~ s/%MP%/$url?view=watch&mid=$event->{MonitorId}/g ;
$ text =~ s/%MPS%/$url?view=watchfeed&mid=$event->{MonitorId}&mode=stream/g ;
$ text =~ s/%MPI%/$url?view=watchfeed&mid=$event->{MonitorId}&mode=still/g ;
$ text =~ s/%EP%/$url?view=event&mid=$event->{MonitorId}&eid=$event->{Id}/g ;
$ text =~ s/%EPS%/$url?view=event&mode=stream&mid=$event->{MonitorId}&eid=$event->{Id}/g ;
$ text =~ s/%EPI%/$url?view=event&mode=still&mid=$event->{MonitorId}&eid=$event->{Id}/g ;
$ text =~ s/%EI%/$event->{Id}/g ;
$ text =~ s/%EN%/$event->{Name}/g ;
$ text =~ s/%EC%/$event->{Cause}/g ;
$ text =~ s/%ED%/$event->{Notes}/g ;
$ text =~ s/%ET%/$event->{StartTime}/g ;
$ text =~ s/%EL%/$event->{Length}/g ;
$ text =~ s/%EF%/$event->{Frames}/g ;
$ text =~ s/%EFA%/$event->{AlarmFrames}/g ;
$ text =~ s/%EST%/$event->{TotScore}/g ;
$ text =~ s/%ESA%/$event->{AvgScore}/g ;
$ text =~ s/%ESM%/$event->{MaxScore}/g ;
if ( $ first_alarm_frame )
{
$ text =~ s/%EPI1%/$url?view=frame&mid=$event->{MonitorId}&eid=$event->{Id}&fid=$first_alarm_frame->{FrameId}/g ;
$ text =~ s/%EPIM%/$url?view=frame&mid=$event->{MonitorId}&eid=$event->{Id}&fid=$max_alarm_frame->{FrameId}/g ;
if ( $ attachments_ref && $ text =~ s/%EI1%//g )
{
2008-02-14 06:41:17 +08:00
push ( @$ attachments_ref , { type = > "image/jpeg" , path = > sprintf ( "%s/%0" . ZM_EVENT_IMAGE_DIGITS . "d-capture.jpg" , getEventPath ( $ event ) , $ first_alarm_frame - > { FrameId } ) } ) ;
2007-09-04 22:52:26 +08:00
}
if ( $ attachments_ref && $ text =~ s/%EIM%//g )
{
# Don't attach the same image twice
if ( ! @$ attachments_ref || ( $ first_alarm_frame - > { FrameId } != $ max_alarm_frame - > { FrameId } ) )
{
2008-02-14 06:41:17 +08:00
push ( @$ attachments_ref , { type = > "image/jpeg" , path = > sprintf ( "%s/%0" . ZM_EVENT_IMAGE_DIGITS . "d-capture.jpg" , getEventPath ( $ event ) , $ max_alarm_frame - > { FrameId } ) } ) ;
2007-09-04 22:52:26 +08:00
}
}
}
2008-07-14 23:56:52 +08:00
if ( $ attachments_ref && ZM_OPT_FFMPEG )
2007-09-04 22:52:26 +08:00
{
if ( $ text =~ s/%EV%//g )
{
my ( $ format , $ path ) = generateVideo ( $ filter , $ event ) ;
if ( ! $ format )
{
return ( undef ) ;
}
push ( @$ attachments_ref , { type = > "video/$format" , path = > $ path } ) ;
}
if ( $ text =~ s/%EVM%//g )
{
my ( $ format , $ path ) = generateVideo ( $ filter , $ event , 1 ) ;
if ( ! $ format )
{
return ( undef ) ;
}
push ( @$ attachments_ref , { type = > "video/$format" , path = > $ path } ) ;
}
}
$ text =~ s/%FN%/$filter->{Name}/g ;
( my $ filter_name = $ filter - > { Name } ) =~ s/ /+/g ;
$ text =~ s/%FP%/$url?view=filter&mid=$event->{MonitorId}&filter_name=$filter_name/g ;
return ( $ text ) ;
2005-12-16 18:05:29 +08:00
}
sub sendEmail
{
2007-09-04 22:52:26 +08:00
my $ filter = shift ;
my $ event = shift ;
if ( ! ZM_FROM_EMAIL )
{
warn ( "No 'from' email address defined, not sending email" ) ;
return ( 0 ) ;
}
if ( ! ZM_EMAIL_ADDRESS )
{
warn ( "No email address defined, not sending email" ) ;
return ( 0 ) ;
}
Info ( "Creating notification email\n" ) ;
my $ subject = substituteTags ( ZM_EMAIL_SUBJECT , $ filter , $ event ) ;
return ( 0 ) if ( ! $ subject ) ;
my @ attachments ;
my $ body = substituteTags ( ZM_EMAIL_BODY , $ filter , $ event , \ @ attachments ) ;
return ( 0 ) if ( ! $ body ) ;
Info ( "Sending notification email '$subject'\n" ) ;
eval
{
if ( ZM_NEW_MAIL_MODULES )
{
### Create the multipart container
my $ mail = MIME::Lite - > new (
From = > ZM_FROM_EMAIL ,
To = > ZM_EMAIL_ADDRESS ,
Subject = > $ subject ,
Type = > "multipart/mixed"
) ;
### Add the text message part
$ mail - > attach (
Type = > "TEXT" ,
Data = > $ body
) ;
### Add the attachments
foreach my $ attachment ( @ attachments )
{
Info ( "Attaching '$attachment->{path}\n" ) ;
$ mail - > attach (
Path = > $ attachment - > { path } ,
Type = > $ attachment - > { type } ,
Disposition = > "attachment"
) ;
}
### Send the Message
MIME::Lite - > send ( "smtp" , ZM_EMAIL_HOST , Timeout = > 60 ) ;
$ mail - > send ( ) ;
2005-12-16 18:05:29 +08:00
}
2007-09-04 22:52:26 +08:00
else
{
my $ mail = MIME::Entity - > build (
From = > ZM_FROM_EMAIL ,
To = > ZM_EMAIL_ADDRESS ,
Subject = > $ subject ,
Type = > ( ( $ body =~ /<html>/ ) ? 'text/html' : 'text/plain' ) ,
Data = > $ body
) ;
foreach my $ attachment ( @ attachments )
{
Info ( "Attaching '$attachment->{path}\n" ) ;
$ mail - > attach (
Path = > $ attachment - > { path } ,
Type = > $ attachment - > { type } ,
Encoding = > "base64"
) ;
}
$ mail - > smtpsend ( Host = > ZM_EMAIL_HOST , MailFrom = > ZM_FROM_EMAIL ) ;
}
} ;
if ( $@ )
{
warn ( "Can't send email: $@" ) ;
return ( 0 ) ;
}
else
{
Info ( "Notification email sent\n" ) ;
}
my $ sql = "update Events set Emailed = 1 where Id = ?" ;
my $ sth = $ dbh - > prepare_cached ( $ sql ) or Fatal ( "Can't prepare '$sql': " . $ dbh - > errstr ( ) ) ;
my $ res = $ sth - > execute ( $ event - > { Id } ) or Fatal ( "Can't execute '$sql': " . $ sth - > errstr ( ) ) ;
return ( 1 ) ;
2005-12-16 18:05:29 +08:00
}
sub sendMessage
{
2007-09-04 22:52:26 +08:00
my $ filter = shift ;
my $ event = shift ;
if ( ! ZM_FROM_EMAIL )
{
warn ( "No 'from' email address defined, not sending message" ) ;
return ( 0 ) ;
}
if ( ! ZM_MESSAGE_ADDRESS )
{
warn ( "No message address defined, not sending message" ) ;
return ( 0 ) ;
}
Info ( "Creating notification message\n" ) ;
my $ subject = substituteTags ( ZM_MESSAGE_SUBJECT , $ filter , $ event ) ;
return ( 0 ) if ( ! $ subject ) ;
my @ attachments ;
my $ body = substituteTags ( ZM_MESSAGE_BODY , $ filter , $ event , \ @ attachments ) ;
return ( 0 ) if ( ! $ body ) ;
Info ( "Sending notification message '$subject'\n" ) ;
eval
{
if ( ZM_NEW_MAIL_MODULES )
{
### Create the multipart container
my $ mail = MIME::Lite - > new (
From = > ZM_FROM_EMAIL ,
To = > ZM_MESSAGE_ADDRESS ,
Subject = > $ subject ,
Type = > "multipart/mixed"
) ;
### Add the text message part
$ mail - > attach (
Type = > "TEXT" ,
Data = > $ body
) ;
### Add the attachments
foreach my $ attachment ( @ attachments )
{
Info ( "Attaching '$attachment->{path}\n" ) ;
$ mail - > attach (
Path = > $ attachment - > { path } ,
Type = > $ attachment - > { type } ,
Disposition = > "attachment"
) ;
}
### Send the Message
MIME::Lite - > send ( "smtp" , ZM_EMAIL_HOST , Timeout = > 60 ) ;
$ mail - > send ( ) ;
2005-12-16 18:05:29 +08:00
}
2007-09-04 22:52:26 +08:00
else
{
my $ mail = MIME::Entity - > build (
From = > ZM_FROM_EMAIL ,
To = > ZM_MESSAGE_ADDRESS ,
Subject = > $ subject ,
Type = > ( ( $ body =~ /<html>/ ) ? 'text/html' : 'text/plain' ) ,
Data = > $ body
) ;
foreach my $ attachment ( @ attachments )
{
Info ( "Attaching '$attachment->{path}\n" ) ;
$ mail - > attach (
Path = > $ attachment - > { path } ,
Type = > $ attachment - > { type } ,
Encoding = > "base64"
) ;
}
$ mail - > smtpsend ( Host = > ZM_EMAIL_HOST , MailFrom = > ZM_FROM_EMAIL ) ;
}
} ;
if ( $@ )
{
warn ( "Can't send email: $@" ) ;
return ( 0 ) ;
}
else
{
Info ( "Notification message sent\n" ) ;
}
my $ sql = "update Events set Messaged = 1 where Id = ?" ;
my $ sth = $ dbh - > prepare_cached ( $ sql ) or Fatal ( "Can't prepare '$sql': " . $ dbh - > errstr ( ) ) ;
my $ res = $ sth - > execute ( $ event - > { Id } ) or Fatal ( "Can't execute '$sql': " . $ sth - > errstr ( ) ) ;
return ( 1 ) ;
2005-12-16 18:05:29 +08:00
}
sub executeCommand
{
2007-09-04 22:52:26 +08:00
my $ filter = shift ;
my $ event = shift ;
2008-02-14 06:41:17 +08:00
my $ event_path = getEventPath ( $ event ) ;
2007-09-04 22:52:26 +08:00
my $ command = $ filter - > { AutoExecuteCmd } ;
$ command . = " $event_path" ;
Info ( "Executing '$command'\n" ) ;
my $ output = qx( $command ) ;
my $ status = $? >> 8 ;
2011-06-21 17:19:10 +08:00
if ( $ status || logDebugging ( ) )
2007-09-04 22:52:26 +08:00
{
chomp ( $ output ) ;
Debug ( "Output: $output\n" ) ;
}
if ( $ status )
{
Error ( "Command '$command' exited with status: $status\n" ) ;
return ( 0 ) ;
}
else
{
my $ sql = "update Events set Executed = 1 where Id = ?" ;
my $ sth = $ dbh - > prepare_cached ( $ sql ) or Fatal ( "Can't prepare '$sql': " . $ dbh - > errstr ( ) ) ;
my $ res = $ sth - > execute ( $ event - > { Id } ) or Fatal ( "Can't execute '$sql': " . $ sth - > errstr ( ) ) ;
}
return ( 1 ) ;
2005-12-16 18:05:29 +08:00
}