Converted to use new style debug.
git-svn-id: http://svn.zoneminder.com/svn/zm/trunk@1476 e3e1d417-86f3-4887-817a-d78f3d33393f
This commit is contained in:
stan
parent
3d6e828fc7
commit
4a3cbed69a
|
|
@ -77,7 +77,8 @@ use constant EVENT_PATH => ZM_PATH_WEB.'/'.ZM_DIR_EVENTS;
|
|||
use constant LOG_FILE => ZM_PATH_LOGS.'/zmfilter.log';
|
||||
use constant START_DELAY => 5; # How long to wait before starting
|
||||
use constant CHECK_DELAY => 60; # How long between each event check
|
||||
use constant VERBOSE => 0; # Whether to output more verbose debug
|
||||
|
||||
use constant DBG_LEVEL => 0; # 0 is errors, warnings and info only, > 0 for debug
|
||||
|
||||
if ( ZM_OPT_UPLOAD )
|
||||
{
|
||||
|
|
@ -136,6 +137,7 @@ if ( ZM_OPT_MESSAGE )
|
|||
|
||||
use DBI;
|
||||
use POSIX;
|
||||
use Time::HiRes qw/gettimeofday/;
|
||||
use Date::Manip;
|
||||
use Data::Dumper;
|
||||
use Getopt::Long;
|
||||
|
|
@ -159,6 +161,73 @@ Parameters are :-
|
|||
exit( -1 );
|
||||
}
|
||||
|
||||
my $dbg_id = "";
|
||||
|
||||
sub dbgInit
|
||||
{
|
||||
my $id = shift;
|
||||
if ( $id )
|
||||
{
|
||||
$dbg_id = $id;
|
||||
my $add_parms = shift;
|
||||
if ( $add_parms )
|
||||
{
|
||||
foreach my $arg ( @ARGV )
|
||||
{
|
||||
if ( $arg =~ /^-(.*)$/ )
|
||||
{
|
||||
$dbg_id .= "_$1";
|
||||
}
|
||||
else
|
||||
{
|
||||
$dbg_id .= $arg;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub dbgPrint
|
||||
{
|
||||
my $code = shift;
|
||||
my $string = shift;
|
||||
my $line = shift;
|
||||
|
||||
$string =~ s/[\r\n]+$//g;
|
||||
|
||||
my ($seconds, $microseconds) = gettimeofday();
|
||||
if ( $line )
|
||||
{
|
||||
my $file = __FILE__;
|
||||
$file =~ s|^.*/||g;
|
||||
printf( "%s.%06d %s[%d].%s-%s/%d [%s]\n", strftime( "%x %H:%M:%S", localtime( $seconds ) ), $microseconds, $dbg_id, $$, $file, $line, $code, $string );
|
||||
}
|
||||
else
|
||||
{
|
||||
printf( "%s.%06d %s[%d].%s [%s]\n", strftime( "%x %H:%M:%S", localtime( $seconds ) ), $microseconds, $dbg_id, $$, $code, $string );
|
||||
}
|
||||
}
|
||||
|
||||
sub Debug
|
||||
{
|
||||
dbgPrint( "DBG", $_[0] ) if ( DBG_LEVEL >= 1 );
|
||||
}
|
||||
|
||||
sub Info
|
||||
{
|
||||
dbgPrint( "INF", $_[0] ) if ( DBG_LEVEL >= 0 );
|
||||
}
|
||||
|
||||
sub Warning
|
||||
{
|
||||
dbgPrint( "WAR", $_[0] ) if ( DBG_LEVEL >= -1 );
|
||||
}
|
||||
|
||||
sub Error
|
||||
{
|
||||
dbgPrint( "ERR", $_[0] ) if ( DBG_LEVEL >= -2 );
|
||||
}
|
||||
|
||||
#
|
||||
# More or less replicates the equivalent PHP function
|
||||
#
|
||||
|
|
@ -185,12 +254,14 @@ sub DateTimeToSQL
|
|||
my $dt_val = strtotime( $dt_str );
|
||||
if ( !$dt_val )
|
||||
{
|
||||
print( STDERR "Error, unable to parse date string '$dt_str'\n" );
|
||||
Error( "Unable to parse date string '$dt_str'\n" );
|
||||
return( undef );
|
||||
}
|
||||
return( strftime( "%Y-%m-%d %H:%M:%S", localtime( $dt_val ) ) );
|
||||
}
|
||||
|
||||
dbgInit( "zmfilter", 1 );
|
||||
|
||||
if ( !GetOptions( 'delay=i'=>\$delay ) )
|
||||
{
|
||||
Usage();
|
||||
|
|
@ -208,7 +279,7 @@ chdir( EVENT_PATH );
|
|||
|
||||
my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_SERVER, ZM_DB_USER, ZM_DB_PASS );
|
||||
|
||||
print( "Scanning for events\n" );
|
||||
Info( "Scanning for events\n" );
|
||||
|
||||
sleep( START_DELAY );
|
||||
|
||||
|
|
@ -219,7 +290,7 @@ while( 1 )
|
|||
{
|
||||
if ( (time() - $last_action) > ZM_FILTER_RELOAD_DELAY )
|
||||
{
|
||||
print( "Reloading filters\n" ) if ( VERBOSE );
|
||||
Debug( "Reloading filters\n" );
|
||||
$last_action = time();
|
||||
$filters = getFilters();
|
||||
}
|
||||
|
|
@ -229,7 +300,7 @@ while( 1 )
|
|||
checkFilter( $filter );
|
||||
}
|
||||
|
||||
print( "Sleeping for $delay seconds\n" ) if ( VERBOSE );
|
||||
Debug( "Sleeping for $delay seconds\n" );
|
||||
sleep( $delay );
|
||||
}
|
||||
|
||||
|
|
@ -265,7 +336,7 @@ sub getFilters
|
|||
my $res = $sth->execute() or die( "Can't execute '$sql': ".$sth->errstr() );
|
||||
FILTER: while( my $filter_data = $sth->fetchrow_hashref() )
|
||||
{
|
||||
print( "Found filter '$filter_data->{Name}'\n" ) if ( VERBOSE );
|
||||
Debug( "Found filter '$filter_data->{Name}'\n" );
|
||||
my %filter_terms;
|
||||
foreach my $filter_parm ( split( '&', $filter_data->{Query} ) )
|
||||
{
|
||||
|
|
@ -275,7 +346,7 @@ sub getFilters
|
|||
$filter_terms{$key} = $value;
|
||||
}
|
||||
}
|
||||
#print( Dumper( %filter_terms ) );
|
||||
#Debug( Dumper( %filter_terms ) );
|
||||
my $sql = "select E.Id,E.MonitorId,M.Name as MonitorName,E.Name,E.StartTime,unix_timestamp(E.StartTime) as Time,E.Length,E.Frames,E.AlarmFrames,E.TotScore,E.AvgScore,E.MaxScore,E.Archived,E.Uploaded,E.Emailed,E.Messaged,E.LearnState from Events as E inner join Monitors as M on M.Id = E.MonitorId where not isnull(E.EndTime)";
|
||||
my $filter_sql = '';
|
||||
for ( my $i = 1; $i <= $filter_terms{trms}; $i++ )
|
||||
|
|
@ -350,7 +421,7 @@ sub getFilters
|
|||
$value = DateTimeToSQL( $temp_value );
|
||||
if ( !$value )
|
||||
{
|
||||
print( STDERR "Error parsing date/time '$temp_value', skipping filter '$filter_data->{Name}'\n" );
|
||||
Error( "Error parsing date/time '$temp_value', skipping filter '$filter_data->{Name}'\n" );
|
||||
next FILTER;
|
||||
}
|
||||
$value = "'$value'";
|
||||
|
|
@ -360,7 +431,7 @@ sub getFilters
|
|||
$value = DateTimeToSQL( $temp_value );
|
||||
if ( !$value )
|
||||
{
|
||||
print( STDERR "Error parsing date/time '$temp_value', skipping filter '$filter_data->{Name}'\n" );
|
||||
Error( "Error parsing date/time '$temp_value', skipping filter '$filter_data->{Name}'\n" );
|
||||
next FILTER;
|
||||
}
|
||||
$value = "to_days( '$value' )";
|
||||
|
|
@ -370,7 +441,7 @@ sub getFilters
|
|||
$value = DateTimeToSQL( $temp_value );
|
||||
if ( !$value )
|
||||
{
|
||||
print( STDERR "Error parsing date/time '$temp_value', skipping filter '$filter_data->{Name}'\n" );
|
||||
Error( "Error parsing date/time '$temp_value', skipping filter '$filter_data->{Name}'\n" );
|
||||
next FILTER;
|
||||
}
|
||||
$value = "extract( hour_second from '$value' )";
|
||||
|
|
@ -380,7 +451,7 @@ sub getFilters
|
|||
$value = DateTimeToSQL( $temp_value );
|
||||
if ( !$value )
|
||||
{
|
||||
print( STDERR "Error parsing date/time '$temp_value', skipping filter '$filter_data->{Name}'\n" );
|
||||
Error( "Error parsing date/time '$temp_value', skipping filter '$filter_data->{Name}'\n" );
|
||||
next FILTER;
|
||||
}
|
||||
$value = "weekday( '$value' )";
|
||||
|
|
@ -505,20 +576,20 @@ sub getFilters
|
|||
{
|
||||
$sql .= " limit 0, ".$filter_terms{limit};
|
||||
}
|
||||
print "SQL:$sql\n" if ( VERBOSE );
|
||||
Debug( "SQL:$sql\n" );
|
||||
$filter_data->{Sql} = $sql;
|
||||
if ( $filter_data->{AutoExecute} )
|
||||
{
|
||||
my $script = $filter_data->{AutoExecute};
|
||||
if ( !-e $script )
|
||||
{
|
||||
print( STDERR "Error, auto execute script '$script' not found, skipping filter '$filter_data->{Name}'\n" );
|
||||
Error( "Auto execute script '$script' not found, skipping filter '$filter_data->{Name}'\n" );
|
||||
next FILTER;
|
||||
|
||||
}
|
||||
elsif ( !-x $script )
|
||||
{
|
||||
print( STDERR "Error, auto execute script '$script' not executable, skipping filter '$filter_data->{Name}'\n" );
|
||||
Error( "Auto execute script '$script' not executable, skipping filter '$filter_data->{Name}'\n" );
|
||||
next FILTER;
|
||||
}
|
||||
}
|
||||
|
|
@ -533,7 +604,7 @@ sub checkFilter
|
|||
{
|
||||
my $filter = shift;
|
||||
|
||||
print( "Checking filter '$filter->{Name}'".
|
||||
Debug( "Checking filter '$filter->{Name}'".
|
||||
($filter->{AutoArchive}?", archive":"").
|
||||
($filter->{AutoDelete}?", delete":"").
|
||||
($filter->{AutoUpload}?", upload":"").
|
||||
|
|
@ -541,7 +612,7 @@ sub checkFilter
|
|||
($filter->{AutoMessage}?", message":"").
|
||||
($filter->{AutoExecute}?", execute":"").
|
||||
"\n"
|
||||
) if ( VERBOSE );
|
||||
);
|
||||
my $sql = $filter->{Sql};
|
||||
|
||||
if ( $filter->{HasDiskPercent} )
|
||||
|
|
@ -560,7 +631,7 @@ sub checkFilter
|
|||
|
||||
while( my $event = $sth->fetchrow_hashref() )
|
||||
{
|
||||
print( "Checking event $event->{Id}\n" ) if ( VERBOSE );
|
||||
Debug( "Checking event $event->{Id}\n" );
|
||||
if ( $filter->{AutoExecute} )
|
||||
{
|
||||
if ( !$event->{Execute} )
|
||||
|
|
@ -591,7 +662,7 @@ sub checkFilter
|
|||
}
|
||||
if ( $filter->{AutoArchive} )
|
||||
{
|
||||
print( "Archiving event $event->{Id}\n" );
|
||||
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 die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
|
|
@ -599,7 +670,7 @@ sub checkFilter
|
|||
}
|
||||
if ( $filter->{AutoDelete} )
|
||||
{
|
||||
print( "Deleting event $event->{Id}\n" );
|
||||
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 die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
|
|
@ -618,10 +689,10 @@ sub checkFilter
|
|||
my $command = "rm -rf ".ZM_DIR_EVENTS."/*/".sprintf( "%d", $event->{Id} );
|
||||
my $output = qx($command);
|
||||
my $status = $? >> 8;
|
||||
if ( $status || VERBOSE )
|
||||
if ( $status || DBG_LEVEL > 0 )
|
||||
{
|
||||
chomp( $output );
|
||||
print( "Output: $output\n" );
|
||||
Debug( "Output: $output\n" );
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -639,17 +710,17 @@ sub executeCommand
|
|||
my $command = $filter->{AutoExecute};
|
||||
$command .= " $event_path";
|
||||
|
||||
print( "Executing '$command'\n" );
|
||||
Info( "Executing '$command'\n" );
|
||||
my $output = qx($command);
|
||||
my $status = $? >> 8;
|
||||
if ( $status || VERBOSE )
|
||||
if ( $status || DBG_LEVEL > 0 )
|
||||
{
|
||||
chomp( $output );
|
||||
print( "Output: $output\n" );
|
||||
Debug( "Output: $output\n" );
|
||||
}
|
||||
if ( $status )
|
||||
{
|
||||
print( "Command '$command' exited with status: $status\n" );
|
||||
Error( "Command '$command' exited with status: $status\n" );
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
@ -672,12 +743,12 @@ sub uploadArchFile
|
|||
{
|
||||
$arch_file .= '.zip';
|
||||
my $zip = Archive::Zip->new();
|
||||
print( "Creating upload file '$arch_file'\n" );
|
||||
Info( "Creating upload file '$arch_file'\n" );
|
||||
|
||||
my $status = &AZ_OK;
|
||||
foreach my $image_file ( <*$arch_image_path> )
|
||||
{
|
||||
print( "Adding $image_file\n" );
|
||||
Info( "Adding $image_file\n" );
|
||||
my $member = $zip->addFile( $image_file );
|
||||
last unless ( $member );
|
||||
$member->desiredCompressionMethod( (ZM_UPLOAD_ARCH_COMPRESS)?&COMPRESSION_DEFLATED:&COMPRESSION_STORED );
|
||||
|
|
@ -686,7 +757,7 @@ sub uploadArchFile
|
|||
|
||||
if ( $arch_error = ($status != &AZ_OK) )
|
||||
{
|
||||
print( "Zip error: $status\n " );
|
||||
Error( "Zip error: $status\n " );
|
||||
}
|
||||
}
|
||||
elsif ( ZM_UPLOAD_ARCH_FORMAT eq "tar" )
|
||||
|
|
@ -699,18 +770,18 @@ sub uploadArchFile
|
|||
{
|
||||
$arch_file .= '.tar';
|
||||
}
|
||||
print( "Creating upload file '$arch_file'\n" );
|
||||
Info( "Creating upload file '$arch_file'\n" );
|
||||
|
||||
if ( $arch_error = !Archive::Tar->create_archive( $arch_file, ZM_UPLOAD_ARCH_COMPRESS, <*$arch_image_path> ) )
|
||||
{
|
||||
print( "Tar error: ".Archive::Tar->error()."\n " );
|
||||
Error( "Tar error: ".Archive::Tar->error()."\n " );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
if ( !$arch_error )
|
||||
{
|
||||
print( "Uploading to ".ZM_UPLOAD_FTP_HOST."\n" );
|
||||
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 )
|
||||
{
|
||||
|
|
@ -746,14 +817,13 @@ sub sendEmail
|
|||
return;
|
||||
}
|
||||
|
||||
print( "Creating notification email\n" );
|
||||
Info( "Creating notification email\n" );
|
||||
|
||||
my $subject = substituteTags( $email_subject, $filter, $event );
|
||||
my @attachments;
|
||||
my $body = substituteTags( $email_body, $filter, $event, \@attachments );
|
||||
|
||||
print( "Sending notification email '$subject'\n" );
|
||||
print( "$body\n" ) if ( VERBOSE );
|
||||
Info( "Sending notification email '$subject'\n" );
|
||||
|
||||
eval
|
||||
{
|
||||
|
|
@ -774,7 +844,7 @@ sub sendEmail
|
|||
### Add the attachments
|
||||
foreach my $attachment ( @attachments )
|
||||
{
|
||||
print( "Attaching '$attachment->{path}\n" );
|
||||
Info( "Attaching '$attachment->{path}\n" );
|
||||
$mail->attach(
|
||||
Path => $attachment->{path},
|
||||
Type => $attachment->{type},
|
||||
|
|
@ -797,7 +867,7 @@ sub sendEmail
|
|||
|
||||
foreach my $attachment ( @attachments )
|
||||
{
|
||||
print( "Attaching '$attachment->{path}\n" );
|
||||
Info( "Attaching '$attachment->{path}\n" );
|
||||
$mail->attach(
|
||||
Path => $attachment->{path},
|
||||
Type => $attachment->{type},
|
||||
|
|
@ -814,7 +884,7 @@ sub sendEmail
|
|||
}
|
||||
else
|
||||
{
|
||||
print( "Notification email sent\n" );
|
||||
Info( "Notification email sent\n" );
|
||||
}
|
||||
my $sql = "update Events set Emailed = 1 where Id = ?";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
|
|
@ -837,14 +907,13 @@ sub sendMessage
|
|||
return;
|
||||
}
|
||||
|
||||
print( "Creating notification message\n" );
|
||||
Info( "Creating notification message\n" );
|
||||
|
||||
my $subject = substituteTags( $message_subject, $filter, $event );
|
||||
my @attachments;
|
||||
my $body = substituteTags( $message_body, $filter, $event, \@attachments );
|
||||
|
||||
print( "Sending notification message '$subject'\n" );
|
||||
print( "$body\n" ) if ( VERBOSE );
|
||||
Info( "Sending notification message '$subject'\n" );
|
||||
|
||||
eval
|
||||
{
|
||||
|
|
@ -865,7 +934,7 @@ sub sendMessage
|
|||
### Add the attachments
|
||||
foreach my $attachment ( @attachments )
|
||||
{
|
||||
print( "Attaching '$attachment->{path}\n" );
|
||||
Info( "Attaching '$attachment->{path}\n" );
|
||||
$mail->attach(
|
||||
Path => $attachment->{path},
|
||||
Type => $attachment->{type},
|
||||
|
|
@ -888,7 +957,7 @@ sub sendMessage
|
|||
|
||||
foreach my $attachment ( @attachments )
|
||||
{
|
||||
print( "Attaching '$attachment->{path}\n" );
|
||||
Info( "Attaching '$attachment->{path}\n" );
|
||||
$mail->attach(
|
||||
Path => $attachment->{path},
|
||||
Type => $attachment->{type},
|
||||
|
|
@ -905,7 +974,7 @@ sub sendMessage
|
|||
}
|
||||
else
|
||||
{
|
||||
print( "Notification message sent\n" );
|
||||
Info( "Notification message sent\n" );
|
||||
}
|
||||
my $sql = "update Events set Messaged = 1 where Id = ?";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
|
|
|
|||
Loading…
Reference in New Issue