Bug 231 - Created ZoneMinder perl module to abstract out common code.
git-svn-id: http://svn.zoneminder.com/svn/zm/trunk@1673 e3e1d417-86f3-4887-817a-d78f3d33393f
This commit is contained in:
stan
parent
f27e8da722
commit
821763e2bd
|
|
@ -17,6 +17,9 @@ bin_SCRIPTS = \
|
|||
zmcontrol-axis-v2.pl \
|
||||
zmtrack.pl
|
||||
|
||||
SUBDIRS = \
|
||||
ZoneMinder
|
||||
|
||||
EXTRA_DIST = \
|
||||
zmdc.pl.z \
|
||||
zmaudit.pl.z \
|
||||
|
|
@ -33,4 +36,16 @@ EXTRA_DIST = \
|
|||
zmcontrol-kx-hcm10.pl.z \
|
||||
zmcontrol-axis-v2.pl.z \
|
||||
zmtrack.pl.z \
|
||||
ZoneMinder/lib/ZoneMinder.pm.in \
|
||||
ZoneMinder/lib/ZoneMinder.pm \
|
||||
ZoneMinder/Makefile.PL \
|
||||
ZoneMinder/README \
|
||||
ZoneMinder/t/ZoneMinder.t \
|
||||
ZoneMinder/Changes \
|
||||
ZoneMinder/MANIFEST \
|
||||
ZoneMinder/META.yml \
|
||||
zm.z
|
||||
|
||||
dist-hook:
|
||||
cd ZoneMinder
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,6 @@
|
|||
Revision history for Perl extension ZoneMinder.
|
||||
|
||||
0.01 Thu Dec 15 17:22:29 2005
|
||||
- original version; created by h2xs 1.23 with options
|
||||
-XA -b 5.6.0 -n ZoneMinder
|
||||
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
Changes
|
||||
Makefile.PL
|
||||
MANIFEST
|
||||
README
|
||||
t/ZoneMinder.t
|
||||
lib/ZoneMinder.pm
|
||||
META.yml Module meta-data (added by MakeMaker)
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
use 5.006;
|
||||
use ExtUtils::MakeMaker;
|
||||
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
|
||||
# the contents of the Makefile that is written.
|
||||
WriteMakefile(
|
||||
NAME => 'ZoneMinder',
|
||||
VERSION_FROM => 'lib/ZoneMinder.pm', # finds $VERSION
|
||||
PREREQ_PM => {}, # e.g., Module::Name => 1.1
|
||||
PM => {'lib/ZoneMinder.pm' => '$(INST_LIBDIR)/ZoneMinder.pm'},
|
||||
($] >= 5.005 ? ## Add these new keywords supported since 5.005
|
||||
(ABSTRACT_FROM => 'lib/ZoneMinder.pm', # retrieve abstract from module
|
||||
AUTHOR => 'Philip Coombes <stan@localdomain>') : ()),
|
||||
);
|
||||
|
|
@ -0,0 +1,40 @@
|
|||
ZoneMinder version 0.01
|
||||
=======================
|
||||
|
||||
The README is used to introduce the module and provide instructions on
|
||||
how to install the module, any machine dependencies it may have (for
|
||||
example C compilers and installed libraries) and any other information
|
||||
that should be provided before the module is installed.
|
||||
|
||||
A README file is required for CPAN modules since CPAN extracts the
|
||||
README file from a module distribution so that people browsing the
|
||||
archive can use it get an idea of the modules uses. It is usually a
|
||||
good idea to provide version information here so that people can
|
||||
decide whether fixes for the module are worth downloading.
|
||||
|
||||
INSTALLATION
|
||||
|
||||
To install this module type the following:
|
||||
|
||||
perl Makefile.PL
|
||||
make
|
||||
make test
|
||||
make install
|
||||
|
||||
DEPENDENCIES
|
||||
|
||||
This module requires these other modules and libraries:
|
||||
|
||||
blah blah blah
|
||||
|
||||
COPYRIGHT AND LICENCE
|
||||
|
||||
Put the correct copyright and licence information here.
|
||||
|
||||
Copyright (C) 2005 by Philip Coombes
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.8.3 or,
|
||||
at your option, any later version of Perl 5 you may have available.
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,187 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Common Module, $Date$, $Revision$
|
||||
# Copyright (C) 2003, 2004, 2005 Philip Coombes
|
||||
#
|
||||
# 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 module contains the common definitions and functions used by the rest
|
||||
# of the ZoneMinder scripts
|
||||
#
|
||||
package ZoneMinder;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require Exporter;
|
||||
|
||||
our @ISA = qw(Exporter);
|
||||
|
||||
# Items to export into callers namespace by default. Note: do not export
|
||||
# names by default without a very good reason. Use EXPORT_OK instead.
|
||||
# Do not simply export all your public functions/methods/constants.
|
||||
|
||||
# This allows declaration use ZoneMinder ':all';
|
||||
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
|
||||
# will save memory.
|
||||
our %EXPORT_TAGS = ( 'all' => [ qw(
|
||||
|
||||
) ] );
|
||||
|
||||
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
||||
|
||||
our @EXPORT = qw(
|
||||
Error
|
||||
Warning
|
||||
Info
|
||||
Debug
|
||||
);
|
||||
|
||||
use constant ZM_CONFIG => "@ZM_CONFIG@"; # Path to the ZoneMinder config file, autogenerated do not change (from zmconfig)
|
||||
|
||||
our $VERSION = "@VERSION@";
|
||||
|
||||
# Load the config from the database into the symbol table
|
||||
BEGIN
|
||||
{
|
||||
no strict 'refs';
|
||||
|
||||
open( CONFIG, "<".ZM_CONFIG ) or die( "Can't open config file: $!" );
|
||||
foreach my $str ( <CONFIG> )
|
||||
{
|
||||
next if ( $str =~ /^\s*$/ );
|
||||
next if ( $str =~ /^\s*#/ );
|
||||
my ( $name, $value ) = $str =~ /^\s*([^=\\s]+)\s*=\s*(\S+)\s*$/;
|
||||
$name =~ tr/a-z/A-Z/;
|
||||
*{$name} = sub { $value };
|
||||
}
|
||||
close( CONFIG );
|
||||
|
||||
use DBI;
|
||||
my $dbh = DBI->connect( "DBI:mysql:database=".&ZM_DB_NAME.";host=".&ZM_DB_SERVER, &ZM_DB_USER, &ZM_DB_PASS );
|
||||
my $sql = "select * from Config";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute() or die( "Can't execute: ".$sth->errstr() );
|
||||
while( my $config = $sth->fetchrow_hashref() )
|
||||
{
|
||||
*{$config->{Name}} = sub { $config->{Value} };
|
||||
}
|
||||
$sth->finish();
|
||||
$dbh->disconnect();
|
||||
}
|
||||
|
||||
# Preloaded methods go here.
|
||||
|
||||
use POSIX;
|
||||
use Time::HiRes qw/gettimeofday/;
|
||||
|
||||
our $dbg_id = "zm";
|
||||
|
||||
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( STDERR "%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( STDERR "%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 ( main::DBG_LEVEL >= 1 );
|
||||
}
|
||||
|
||||
sub Info
|
||||
{
|
||||
dbgPrint( "INF", $_[0] ) if ( main::DBG_LEVEL >= 0 );
|
||||
}
|
||||
|
||||
sub Warning
|
||||
{
|
||||
dbgPrint( "WAR", $_[0] ) if ( main::DBG_LEVEL >= -1 );
|
||||
}
|
||||
|
||||
sub Error
|
||||
{
|
||||
dbgPrint( "ERR", $_[0] ) if ( main::DBG_LEVEL >= -2 );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>stan@localdomainE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (C) 2005 by Philip Coombes
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.8.3 or,
|
||||
at your option, any later version of Perl 5 you may have available.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
# Before `make install' is performed this script should be runnable with
|
||||
# `make test'. After `make install' it should work as `perl ZoneMinder.t'
|
||||
|
||||
#########################
|
||||
|
||||
# change 'tests => 1' to 'tests => last_test_to_print';
|
||||
|
||||
use Test;
|
||||
BEGIN { plan tests => 1 };
|
||||
use ZoneMinder;
|
||||
ok(1); # If we made it this far, we're ok.
|
||||
|
||||
#########################
|
||||
|
||||
# Insert your test code below, the Test::More module is use()ed here so read
|
||||
# its man page ( perldoc Test::More ) for help writing this test script.
|
||||
|
||||
|
|
@ -0,0 +1,409 @@
|
|||
#!/usr/bin/perl -wT
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Audit Script, $Date$, $Revision$
|
||||
# Copyright (C) 2003, 2004, 2005 Philip Coombes
|
||||
#
|
||||
# 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 checks for consistency between the event filesystem and
|
||||
# the database. If events are found in one and not the other they are
|
||||
# deleted (optionally). Additionally any monitor event directories that
|
||||
# do not correspond to a database monitor are similarly disposed of.
|
||||
# However monitors in the database that don't have a directory are left
|
||||
# alone as this is valid if they are newly created and have no events
|
||||
# yet.
|
||||
#
|
||||
use strict;
|
||||
use bytes;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# These are the elements you can edit to suit your installation
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use constant LOG_FILE => ZM_PATH_LOGS.'/zmaudit.log';
|
||||
use constant MIN_AGE => 300; # Minimum age when we will delete anything
|
||||
use constant RECOVER_TAG => "(r)"; # Tag to append to event name when recovered
|
||||
use constant RECOVER_TEXT => "Recovered."; # Text to append to event notes when recovered
|
||||
|
||||
use constant DBG_LEVEL => 1; # 0 is errors, warnings and info only, > 0 for debug
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# You shouldn't need to change anything from here downwards
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder;
|
||||
use DBI;
|
||||
use POSIX;
|
||||
use Time::HiRes qw/gettimeofday/;
|
||||
use Getopt::Long;
|
||||
|
||||
use constant IMAGE_PATH => ZM_PATH_WEB.'/'.ZM_DIR_IMAGES;
|
||||
use constant EVENT_PATH => ZM_PATH_WEB.'/'.ZM_DIR_EVENTS;
|
||||
|
||||
$| = 1;
|
||||
|
||||
$ENV{PATH} = '/bin:/usr/bin';
|
||||
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
|
||||
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
|
||||
|
||||
my $report = 0;
|
||||
my $yes = 0;
|
||||
my $delay = 0;
|
||||
|
||||
sub usage
|
||||
{
|
||||
print( "
|
||||
Usage: zmaudit.pl [-r,-report|-y,-yes] [-d <seconds>,-delay=<seconds>]
|
||||
Parameters are :-
|
||||
-r, --report - Just report don't actually do anything
|
||||
-y, --yes - Just do all actions without confirmation
|
||||
-d <seconds>, --delay=<seconds> - how long to delay between each pass, the default of 0 means run once only.
|
||||
");
|
||||
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 );
|
||||
}
|
||||
|
||||
sub aud_print
|
||||
{
|
||||
my $string = shift;
|
||||
if ( $delay )
|
||||
{
|
||||
Info( $string );
|
||||
}
|
||||
else
|
||||
{
|
||||
print( $string );
|
||||
}
|
||||
}
|
||||
|
||||
sub confirm
|
||||
{
|
||||
my $prompt = shift || "delete";
|
||||
my $action = shift || "deleting";
|
||||
|
||||
my $yesno = $yes?1:0;
|
||||
if ( $report )
|
||||
{
|
||||
if ( !$delay )
|
||||
{
|
||||
print( "\n" );
|
||||
}
|
||||
}
|
||||
elsif ( $yes )
|
||||
{
|
||||
if ( $delay )
|
||||
{
|
||||
Info( "$action\n" );
|
||||
}
|
||||
else
|
||||
{
|
||||
print( ", $action\n" );
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
print( ", $prompt y/n: " );
|
||||
my $char = <>;
|
||||
chomp( $char );
|
||||
if ( $char eq 'q' )
|
||||
{
|
||||
exit( 0 );
|
||||
}
|
||||
if ( !$char )
|
||||
{
|
||||
$char = 'y';
|
||||
}
|
||||
if ( $char eq "a" )
|
||||
{
|
||||
$yes = 1;
|
||||
return( 1 );
|
||||
}
|
||||
$yesno = ( $char =~ /[yY]/ );
|
||||
}
|
||||
return( $yesno );
|
||||
}
|
||||
|
||||
dbgInit( "zmaudit", 1 );
|
||||
|
||||
if ( !GetOptions( 'report'=>\$report, 'yes'=>\$yes, 'delay=i'=>\$delay ) )
|
||||
{
|
||||
usage();
|
||||
}
|
||||
|
||||
if ( $report && $yes )
|
||||
{
|
||||
print( STDERR "Error, only one of --report and --yes may be specified\n" );
|
||||
usage();
|
||||
}
|
||||
|
||||
my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_SERVER, ZM_DB_USER, ZM_DB_PASS );
|
||||
|
||||
chdir( EVENT_PATH );
|
||||
if ( $delay ) # Background mode
|
||||
{
|
||||
open( LOG, ">>".LOG_FILE ) or die( "Can't open log file: $!" );
|
||||
open( STDOUT, ">&LOG" ) || die( "Can't dup stdout: $!" );
|
||||
select( STDOUT ); $| = 1;
|
||||
open( STDERR, ">&LOG" ) || die( "Can't dup stderr: $!" );
|
||||
select( STDERR ); $| = 1;
|
||||
select( LOG ); $| = 1;
|
||||
}
|
||||
my $max_image_age = 15/(24*60); # 15 Minutes
|
||||
my $image_path = IMAGE_PATH;
|
||||
do
|
||||
{
|
||||
my $db_monitors;
|
||||
my $sql1 = "select Id from Monitors order by Id";
|
||||
my $sth1 = $dbh->prepare_cached( $sql1 ) or die( "Can't prepare '$sql1': ".$dbh->errstr() );
|
||||
my $sql2 = "select Id, (unix_timestamp() - unix_timestamp(StartTime)) as Age from Events where MonitorId = ? order by Id";
|
||||
my $sth2 = $dbh->prepare_cached( $sql2 ) or die( "Can't prepare '$sql2': ".$dbh->errstr() );
|
||||
my $res = $sth1->execute() or die( "Can't execute: ".$sth1->errstr() );
|
||||
while( my $monitor = $sth1->fetchrow_hashref() )
|
||||
{
|
||||
Debug( "Found database monitor '$monitor->{Id}'" );
|
||||
my $db_events = $db_monitors->{$monitor->{Id}} = {};
|
||||
my $res = $sth2->execute( $monitor->{Id} ) or die( "Can't execute: ".$sth2->errstr() );
|
||||
while ( my $event = $sth2->fetchrow_hashref() )
|
||||
{
|
||||
$db_events->{$event->{Id}} = $event->{Age};
|
||||
}
|
||||
Debug( "Got ".int(keys(%$db_events))." events\n" );
|
||||
$sth2->finish();
|
||||
}
|
||||
$sth1->finish();
|
||||
|
||||
my $fs_now = time();
|
||||
my $fs_monitors;
|
||||
foreach my $monitor ( <[0-9]*> )
|
||||
{
|
||||
Debug( "Found filesystem monitor '$monitor'" );
|
||||
my $fs_events = $fs_monitors->{$monitor} = {};
|
||||
( my $monitor_dir ) = ( $monitor =~ /^(.*)$/ ); # De-taint
|
||||
|
||||
opendir( DIR, $monitor_dir ) or die( "Can't open directory '$monitor_dir': $!" );
|
||||
my @temp_events = sort { $b <=> $a } grep { $_ =~ /^\d+$/ } readdir( DIR );
|
||||
closedir( DIR );
|
||||
chdir( $monitor_dir );
|
||||
my $count = 0;
|
||||
foreach my $event ( @temp_events )
|
||||
{
|
||||
if ( $count++ > 25 )
|
||||
{
|
||||
$fs_events->{$event} = -1;
|
||||
}
|
||||
else
|
||||
{
|
||||
$fs_events->{$event} = ($fs_now - ($^T - ((-M $event) * 24*60*60)));
|
||||
}
|
||||
}
|
||||
chdir( EVENT_PATH );
|
||||
Debug( "Got ".int(keys(%$fs_events))." events\n" );
|
||||
}
|
||||
|
||||
while ( my ( $fs_monitor, $fs_events ) = each(%$fs_monitors) )
|
||||
{
|
||||
if ( my $db_events = $db_monitors->{$fs_monitor} )
|
||||
{
|
||||
if ( $fs_events )
|
||||
{
|
||||
while ( my ( $fs_event, $age ) = each(%$fs_events ) )
|
||||
{
|
||||
if ( !defined($db_events->{$fs_event}) && ($age < 0 || ($age > MIN_AGE)) )
|
||||
{
|
||||
aud_print( "Filesystem event '$fs_monitor/$fs_event' does not exist in database" );
|
||||
if ( confirm() )
|
||||
{
|
||||
my $command = "/bin/rm -rf ".EVENT_PATH."/$fs_monitor/$fs_event";
|
||||
qx( $command );
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
aud_print( "Filesystem monitor '$fs_monitor' does not exist in database" );
|
||||
if ( confirm() )
|
||||
{
|
||||
my $command = "rm -rf ".EVENT_PATH."/$fs_monitor";
|
||||
qx( $command );
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my $sql3 = "delete from Monitors where Id = ?";
|
||||
my $sth3 = $dbh->prepare_cached( $sql3 ) or die( "Can't prepare '$sql3': ".$dbh->errstr() );
|
||||
my $sql4 = "delete from Events where Id = ?";
|
||||
my $sth4 = $dbh->prepare_cached( $sql4 ) or die( "Can't prepare '$sql4': ".$dbh->errstr() );
|
||||
my $sql5 = "delete from Frames where EventId = ?";
|
||||
my $sth5 = $dbh->prepare_cached( $sql5 ) or die( "Can't prepare '$sql5': ".$dbh->errstr() );
|
||||
my $sql6 = "delete from Stats where EventId = ?";
|
||||
my $sth6 = $dbh->prepare_cached( $sql6 ) or die( "Can't prepare '$sql6': ".$dbh->errstr() );
|
||||
while ( my ( $db_monitor, $db_events ) = each(%$db_monitors) )
|
||||
{
|
||||
if ( my $fs_events = $fs_monitors->{$db_monitor} )
|
||||
{
|
||||
if ( $db_events )
|
||||
{
|
||||
while ( my ( $db_event, $age ) = each(%$db_events ) )
|
||||
{
|
||||
if ( !defined($fs_events->{$db_event}) && ($age > MIN_AGE) )
|
||||
{
|
||||
aud_print( "Database event '$db_monitor/$db_event' does not exist in filesystem" );
|
||||
if ( confirm() )
|
||||
{
|
||||
my $res = $sth4->execute( $db_event ) or die( "Can't execute: ".$sth4->errstr() );
|
||||
$res = $sth5->execute( $db_event ) or die( "Can't execute: ".$sth5->errstr() );
|
||||
$res = $sth6->execute( $db_event ) or die( "Can't execute: ".$sth6->errstr() );
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
#aud_print( "Database monitor '$db_monitor' does not exist in filesystem" );
|
||||
#if ( confirm() )
|
||||
#{
|
||||
# We don't actually do this in case it's new
|
||||
#my $res = $sth3->execute( $db_monitor ) or die( "Can't execute: ".$sth3->errstr() );
|
||||
#}
|
||||
}
|
||||
}
|
||||
|
||||
my $sql7 = "select distinct EventId from Frames left join Events on Frames.EventId = Events.Id where isnull(Events.Id) group by EventId";
|
||||
my $sth7 = $dbh->prepare_cached( $sql7 ) or die( "Can't prepare '$sql7': ".$dbh->errstr() );
|
||||
$res = $sth7->execute() or die( "Can't execute: ".$sth7->errstr() );
|
||||
while( my $frame = $sth7->fetchrow_hashref() )
|
||||
{
|
||||
aud_print( "Found orphaned frame records for event '$frame->{EventId}'" );
|
||||
if ( confirm() )
|
||||
{
|
||||
$res = $sth5->execute( $frame->{EventId} ) or die( "Can't execute: ".$sth6->errstr() );
|
||||
}
|
||||
}
|
||||
|
||||
my $sql8 = "select distinct EventId from Stats left join Events on Stats.EventId = Events.Id where isnull(Events.Id) group by EventId";
|
||||
my $sth8 = $dbh->prepare_cached( $sql8 ) or die( "Can't prepare '$sql8': ".$dbh->errstr() );
|
||||
$res = $sth8->execute() or die( "Can't execute: ".$sth8->errstr() );
|
||||
while( my $stat = $sth8->fetchrow_hashref() )
|
||||
{
|
||||
aud_print( "Found orphaned statistic records for event '$stat->{EventId}'" );
|
||||
if ( confirm() )
|
||||
{
|
||||
$res = $sth6->execute( $stat->{EventId} ) or die( "Can't execute: ".$sth6->errstr() );
|
||||
}
|
||||
}
|
||||
|
||||
# New audit to close any events that were left open for longer than MIN_AGE seconds
|
||||
my $sql9 = "select E.Id, max(F.TimeStamp) as EndTime, unix_timestamp(max(F.TimeStamp)) - unix_timestamp(E.StartTime) as Length, count(F.Id) as Frames, count(if(F.Score>0,1,NULL)) as AlarmFrames, sum(F.Score) as TotScore, max(F.Score) as MaxScore, M.EventPrefix as Prefix from Events as E left join Monitors as M on E.MonitorId = M.Id inner join Frames as F on E.Id = F.EventId where isnull(E.Frames) group by E.Id having EndTime < (now() - interval ".MIN_AGE." second)";
|
||||
my $sth9 = $dbh->prepare_cached( $sql9 ) or die( "Can't prepare '$sql9': ".$dbh->errstr() );
|
||||
my $sql10 = "update Events set Name = ?, EndTime = ?, Length = ?, Frames = ?, AlarmFrames = ?, TotScore = ?, AvgScore = ?, MaxScore = ?, Notes = concat_ws( ' ', Notes, ? ) where Id = ?";
|
||||
my $sth10 = $dbh->prepare_cached( $sql10 ) or die( "Can't prepare '$sql10': ".$dbh->errstr() );
|
||||
$res = $sth9->execute() or die( "Can't execute: ".$sth9->errstr() );
|
||||
while( my $event = $sth9->fetchrow_hashref() )
|
||||
{
|
||||
aud_print( "Found open event '$event->{Id}'" );
|
||||
if ( confirm( 'close', 'closing' ) )
|
||||
{
|
||||
$res = $sth10->execute( sprintf( "%s%d%s", $event->{Prefix}, $event->{Id}, RECOVER_TAG ), $event->{EndTime}, $event->{Length}, $event->{Frames}, $event->{AlarmFrames}, $event->{TotScore}, $event->{AlarmFrames}?int($event->{TotScore}/$event->{AlarmFrames}):0, $event->{MaxScore}, RECOVER_TEXT, $event->{Id} ) or die( "Can't execute: ".$sth10->errstr() );
|
||||
}
|
||||
}
|
||||
|
||||
# Now delete any old image files
|
||||
if ( my @old_files = grep { -M > $max_image_age } <$image_path/*.{jpg,gif,wbmp}> )
|
||||
{
|
||||
aud_print( "Deleting ".int(@old_files)." old images\n" );
|
||||
my $untainted_old_files = join( ";", @old_files );
|
||||
( $untainted_old_files ) = ( $untainted_old_files =~ /^(.*)$/ );
|
||||
unlink( split( ";", $untainted_old_files ) );
|
||||
}
|
||||
|
||||
sleep( $delay ) if ( $delay );
|
||||
} while( $delay );
|
||||
|
|
@ -32,49 +32,13 @@
|
|||
use strict;
|
||||
use bytes;
|
||||
|
||||
use ZoneMinder;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# These are the elements you need to edit to suit your installation
|
||||
#
|
||||
# ==========================================================================
|
||||
use constant ZM_CONFIG => "<from zmconfig>";
|
||||
use constant ZM_PATH_BIN => "<from zmconfig>";
|
||||
use constant ZM_PATH_WEB => "<from zmconfig>";
|
||||
|
||||
# Load the config from the database into the symbol table
|
||||
BEGIN
|
||||
{
|
||||
no strict 'refs';
|
||||
|
||||
open( CONFIG, "<".ZM_CONFIG ) or die( "Can't open config file: $!" );
|
||||
foreach my $str ( <CONFIG> )
|
||||
{
|
||||
next if ( $str =~ /^\s*$/ );
|
||||
next if ( $str =~ /^\s*#/ );
|
||||
my ( $name, $value ) = $str =~ /^\s*([^=\\s]+)\s*=\s*(\S+)\s*$/;
|
||||
$name =~ tr/a-z/A-Z/;
|
||||
if (( $name eq 'ZM_DB_SERVER' ) ||
|
||||
( $name eq 'ZM_DB_NAME' ) ||
|
||||
( $name eq 'ZM_DB_USER' ) ||
|
||||
( $name eq 'ZM_DB_PASS' ))
|
||||
{
|
||||
*{$name} = sub { $value };
|
||||
}
|
||||
}
|
||||
close( CONFIG );
|
||||
|
||||
use DBI;
|
||||
my $dbh = DBI->connect( "DBI:mysql:database=".&ZM_DB_NAME.";host=".&ZM_DB_SERVER, &ZM_DB_USER, &ZM_DB_PASS );
|
||||
my $sql = "select * from Config";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute() or die( "Can't execute: ".$sth->errstr() );
|
||||
while( my $config = $sth->fetchrow_hashref() )
|
||||
{
|
||||
*{$config->{Name}} = sub { $config->{Value} };
|
||||
}
|
||||
$sth->finish();
|
||||
$dbh->disconnect();
|
||||
}
|
||||
|
||||
use constant IMAGE_PATH => ZM_PATH_WEB.'/'.ZM_DIR_IMAGES;
|
||||
use constant EVENT_PATH => ZM_PATH_WEB.'/'.ZM_DIR_EVENTS;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,512 @@
|
|||
#!/usr/bin/perl -wT
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Axis HTTP API v2 Control Script, $Date$, $Revision$
|
||||
# Copyright (C) 2003, 2004, 2005 Philip Coombes
|
||||
#
|
||||
# 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;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# These are the elements you can edit to suit your installation
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use constant LOG_FILE => ZM_PATH_LOGS.'/zmcontrol-axis-v2.log';
|
||||
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder;
|
||||
use Getopt::Long;
|
||||
use Device::SerialPort;
|
||||
|
||||
$| = 1;
|
||||
|
||||
$ENV{PATH} = '/bin:/usr/bin';
|
||||
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
|
||||
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
|
||||
|
||||
sub Usage
|
||||
{
|
||||
print( "
|
||||
Usage: zmcontrol-axis-v2.pl <various options>
|
||||
");
|
||||
exit( -1 );
|
||||
}
|
||||
|
||||
my $arg_string = join( " ", @ARGV );
|
||||
|
||||
my $address;
|
||||
my $command;
|
||||
my ( $speed, $step );
|
||||
my ( $xcoord, $ycoord );
|
||||
my ( $width, $height );
|
||||
my ( $panspeed, $tiltspeed );
|
||||
my ( $panstep, $tiltstep );
|
||||
my $preset;
|
||||
|
||||
if ( !GetOptions(
|
||||
'address=s'=>\$address,
|
||||
'command=s'=>\$command,
|
||||
'speed=i'=>\$speed,
|
||||
'step=i'=>\$step,
|
||||
'xcoord=i'=>\$xcoord,
|
||||
'ycoord=i'=>\$ycoord,
|
||||
'width=i'=>\$width,
|
||||
'height=i'=>\$height,
|
||||
'panspeed=i'=>\$panspeed,
|
||||
'tiltspeed=i'=>\$tiltspeed,
|
||||
'panstep=i'=>\$panstep,
|
||||
'tiltstep=i'=>\$tiltstep,
|
||||
'preset=i'=>\$preset
|
||||
)
|
||||
)
|
||||
{
|
||||
Usage();
|
||||
}
|
||||
|
||||
if ( !$address )
|
||||
{
|
||||
Usage();
|
||||
}
|
||||
|
||||
my $log_file = LOG_FILE;
|
||||
open( LOG, ">>$log_file" ) or die( "Can't open log file: $!" );
|
||||
open( STDOUT, ">&LOG" ) || die( "Can't dup stdout: $!" );
|
||||
select( STDOUT ); $| = 1;
|
||||
open( STDERR, ">&LOG" ) || die( "Can't dup stderr: $!" );
|
||||
select( STDERR ); $| = 1;
|
||||
select( LOG ); $| = 1;
|
||||
|
||||
print( $arg_string."\n" );
|
||||
|
||||
srand( time() );
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
print( $msg );
|
||||
print( "[".$msg_len."]\n" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $cmd = shift;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
printMsg( $cmd, "Tx" );
|
||||
|
||||
use LWP::UserAgent;
|
||||
my $ua = LWP::UserAgent->new;
|
||||
$ua->agent( "ZoneMinder Control Agent/".ZM_VERSION );
|
||||
|
||||
#print( "http://$address/$cmd\n" );
|
||||
my $req = HTTP::Request->new( GET=>"http://$address/$cmd" );
|
||||
my $res = $ua->request($req);
|
||||
|
||||
if ( $res->is_success )
|
||||
{
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Error check failed: '".$res->status_line()."'\n" );
|
||||
}
|
||||
|
||||
return( $result );
|
||||
}
|
||||
|
||||
sub cameraReset
|
||||
{
|
||||
print( "Camera Reset\n" );
|
||||
my $cmd = "nphRestart?PAGE=Restart&Restart=OK";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveUp
|
||||
{
|
||||
print( "Move Up\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=up";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveDown
|
||||
{
|
||||
print( "Move Down\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=down";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveLeft
|
||||
{
|
||||
print( "Move Left\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=left";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRight
|
||||
{
|
||||
print( "Move Right\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=right";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveUpRight
|
||||
{
|
||||
print( "Move Up/Right\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=upright";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveUpLeft
|
||||
{
|
||||
print( "Move Up/Left\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=upleft";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveDownRight
|
||||
{
|
||||
print( "Move Down/Right\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=downright";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveDownLeft
|
||||
{
|
||||
print( "Move Down/Left\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=downleft";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveMap
|
||||
{
|
||||
my ( $xcoord, $ycoord, $width, $height ) = @_;
|
||||
print( "Move Map to $xcoord,$ycoord\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?center=$xcoord,$ycoord&imagewidth=$width&imageheight=$height";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub stepUp
|
||||
{
|
||||
my $step = shift;
|
||||
print( "Step Up $step\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rtilt=$step";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub stepDown
|
||||
{
|
||||
my $step = shift;
|
||||
print( "Step Down $step\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rtilt=-$step";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub stepLeft
|
||||
{
|
||||
my $step = shift;
|
||||
print( "Step Left $step\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=-$step";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub stepRight
|
||||
{
|
||||
my $step = shift;
|
||||
print( "Step Right $step\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=$step";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub stepUpRight
|
||||
{
|
||||
my $panstep = shift;
|
||||
my $tiltstep = shift;
|
||||
print( "Step Up/Right $tiltstep/$panstep\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=$panstep&rtilt=$tiltstep";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub stepUpLeft
|
||||
{
|
||||
my $panstep = shift;
|
||||
my $tiltstep = shift;
|
||||
print( "Step Up/Left $tiltstep/$panstep\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=-$panstep&rtilt=$tiltstep";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub stepDownRight
|
||||
{
|
||||
my $panstep = shift;
|
||||
my $tiltstep = shift;
|
||||
print( "Step Down/Right $tiltstep/$panstep\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=$panstep&rtilt=-$tiltstep";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub stepDownLeft
|
||||
{
|
||||
my $panstep = shift;
|
||||
my $tiltstep = shift;
|
||||
print( "Step Down/Left $tiltstep/$panstep\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=-$panstep&rtilt=-$tiltstep";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub zoomTele
|
||||
{
|
||||
my $step = shift;
|
||||
print( "Zoom Tele\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rzoom=$step";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub zoomWide
|
||||
{
|
||||
my $step = shift;
|
||||
print( "Zoom Wide\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rzoom=-$step";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusNear
|
||||
{
|
||||
my $step = shift;
|
||||
print( "Focus Near\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rfocus=-$step";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusFar
|
||||
{
|
||||
my $step = shift;
|
||||
print( "Focus Far\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rfocus=$step";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusAuto
|
||||
{
|
||||
print( "Focus Auto\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?autofocus=on";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusMan
|
||||
{
|
||||
print( "Focus Manual\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?autofocus=off";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub irisOpen
|
||||
{
|
||||
my $step = shift;
|
||||
print( "Iris Open\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?riris=$step";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub irisClose
|
||||
{
|
||||
my $step = shift;
|
||||
print( "Iris Close\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?riris=-$step";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub irisAuto
|
||||
{
|
||||
print( "Iris Auto\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?autoiris=on";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub irisMan
|
||||
{
|
||||
print( "Iris Manual\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?autoiris=off";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetClear
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Clear Preset $preset\n" );
|
||||
my $cmd = "nphPresetNameCheck?Data=$preset";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Set Preset $preset\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?setserverpresetno=$preset";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Goto Preset $preset\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?gotoserverpresetno=$preset";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
print( "Home Preset\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=home";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
if ( $command eq "move_con_up" )
|
||||
{
|
||||
moveUp();
|
||||
}
|
||||
elsif ( $command eq "move_con_down" )
|
||||
{
|
||||
moveDown();
|
||||
}
|
||||
elsif ( $command eq "move_con_left" )
|
||||
{
|
||||
moveLeft();
|
||||
}
|
||||
elsif ( $command eq "move_con_right" )
|
||||
{
|
||||
moveRight();
|
||||
}
|
||||
elsif ( $command eq "move_con_upleft" )
|
||||
{
|
||||
moveUpLeft();
|
||||
}
|
||||
elsif ( $command eq "move_con_upright" )
|
||||
{
|
||||
moveUpRight();
|
||||
}
|
||||
elsif ( $command eq "move_con_downleft" )
|
||||
{
|
||||
moveDownLeft();
|
||||
}
|
||||
elsif ( $command eq "move_con_downright" )
|
||||
{
|
||||
moveDownLeft();
|
||||
}
|
||||
elsif ( $command eq "move_map" )
|
||||
{
|
||||
moveMap( $xcoord, $ycoord, $width, $height );
|
||||
}
|
||||
elsif ( $command eq "move_rel_up" )
|
||||
{
|
||||
stepUp( $tiltstep );
|
||||
}
|
||||
elsif ( $command eq "move_rel_down" )
|
||||
{
|
||||
stepDown( $tiltstep );
|
||||
}
|
||||
elsif ( $command eq "move_rel_left" )
|
||||
{
|
||||
stepLeft( $panstep );
|
||||
}
|
||||
elsif ( $command eq "move_rel_right" )
|
||||
{
|
||||
stepRight( $panstep );
|
||||
}
|
||||
elsif ( $command eq "move_rel_upleft" )
|
||||
{
|
||||
stepUpLeft( $panstep, $tiltstep );
|
||||
}
|
||||
elsif ( $command eq "move_rel_upright" )
|
||||
{
|
||||
stepUpRight( $panstep, $tiltstep );
|
||||
}
|
||||
elsif ( $command eq "move_rel_downleft" )
|
||||
{
|
||||
stepDownLeft( $panstep, $tiltstep );
|
||||
}
|
||||
elsif ( $command eq "move_rel_downright" )
|
||||
{
|
||||
stepDownRight( $panstep, $tiltstep );
|
||||
}
|
||||
elsif ( $command eq "zoom_rel_tele" )
|
||||
{
|
||||
zoomTele( $step );
|
||||
}
|
||||
elsif ( $command eq "zoom_rel_wide" )
|
||||
{
|
||||
zoomWide( $step );
|
||||
}
|
||||
elsif ( $command eq "focus_rel_near" )
|
||||
{
|
||||
focusNear( $step );
|
||||
}
|
||||
elsif ( $command eq "focus_rel_far" )
|
||||
{
|
||||
focusFar( $step );
|
||||
}
|
||||
elsif ( $command eq "focus_auto" )
|
||||
{
|
||||
focusAuto();
|
||||
}
|
||||
elsif ( $command eq "focus_man" )
|
||||
{
|
||||
focusMan();
|
||||
}
|
||||
elsif ( $command eq "iris_rel_open" )
|
||||
{
|
||||
irisOpen( $step );
|
||||
}
|
||||
elsif ( $command eq "iris_rel_close" )
|
||||
{
|
||||
irisClose( $step );
|
||||
}
|
||||
elsif ( $command eq "iris_auto" )
|
||||
{
|
||||
irisAuto();
|
||||
}
|
||||
elsif ( $command eq "iris_man" )
|
||||
{
|
||||
irisMan();
|
||||
}
|
||||
elsif ( $command eq "preset_home" )
|
||||
{
|
||||
presetHome();
|
||||
}
|
||||
elsif ( $command eq "preset_set" )
|
||||
{
|
||||
presetSet( $preset );
|
||||
}
|
||||
elsif ( $command eq "preset_goto" )
|
||||
{
|
||||
presetGoto( $preset );
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Error, can't handle command $command\n" );
|
||||
}
|
||||
|
|
@ -72,7 +72,6 @@ BEGIN
|
|||
}
|
||||
|
||||
use Getopt::Long;
|
||||
use Device::SerialPort;
|
||||
|
||||
use constant LOG_FILE => ZM_PATH_LOGS.'/zmcontrol-axis-v2.log';
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,311 @@
|
|||
#!/usr/bin/perl -wT
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Panasonic KX-HCM10 Control Script, $Date$, $Revision$
|
||||
# Copyright (C) 2003, 2004, 2005 Philip Coombes
|
||||
#
|
||||
# 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;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# These are the elements you can edit to suit your installation
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use constant LOG_FILE => ZM_PATH_LOGS.'/zmcontrol-kx-hcm10.log';
|
||||
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder;
|
||||
use Getopt::Long;
|
||||
use Device::SerialPort;
|
||||
|
||||
$| = 1;
|
||||
|
||||
$ENV{PATH} = '/bin:/usr/bin';
|
||||
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
|
||||
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
|
||||
|
||||
sub Usage
|
||||
{
|
||||
print( "
|
||||
Usage: zmcontrol-kx-hcm10.pl <various options>
|
||||
");
|
||||
exit( -1 );
|
||||
}
|
||||
|
||||
my $arg_string = join( " ", @ARGV );
|
||||
|
||||
my $address;
|
||||
my $command;
|
||||
my ( $speed, $step );
|
||||
my ( $xcoord, $ycoord );
|
||||
my ( $width, $height );
|
||||
my ( $panspeed, $tiltspeed );
|
||||
my ( $panstep, $tiltstep );
|
||||
my $preset;
|
||||
|
||||
if ( !GetOptions(
|
||||
'address=s'=>\$address,
|
||||
'command=s'=>\$command,
|
||||
'speed=i'=>\$speed,
|
||||
'step=i'=>\$step,
|
||||
'xcoord=i'=>\$xcoord,
|
||||
'ycoord=i'=>\$ycoord,
|
||||
'width=i'=>\$width,
|
||||
'height=i'=>\$height,
|
||||
'panspeed=i'=>\$panspeed,
|
||||
'tiltspeed=i'=>\$tiltspeed,
|
||||
'panstep=i'=>\$panstep,
|
||||
'tiltstep=i'=>\$tiltstep,
|
||||
'preset=i'=>\$preset
|
||||
)
|
||||
)
|
||||
{
|
||||
Usage();
|
||||
}
|
||||
|
||||
if ( !$address )
|
||||
{
|
||||
Usage();
|
||||
}
|
||||
|
||||
my $log_file = LOG_FILE;
|
||||
open( LOG, ">>$log_file" ) or die( "Can't open log file: $!" );
|
||||
open( STDOUT, ">&LOG" ) || die( "Can't dup stdout: $!" );
|
||||
select( STDOUT ); $| = 1;
|
||||
open( STDERR, ">&LOG" ) || die( "Can't dup stderr: $!" );
|
||||
select( STDERR ); $| = 1;
|
||||
select( LOG ); $| = 1;
|
||||
|
||||
print( $arg_string."\n" );
|
||||
|
||||
srand( time() );
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
print( $msg );
|
||||
print( "[".$msg_len."]\n" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $cmd = shift;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
printMsg( $cmd, "Tx" );
|
||||
|
||||
use LWP::UserAgent;
|
||||
my $ua = LWP::UserAgent->new;
|
||||
$ua->agent( "ZoneMinder Control Agent/".ZM_VERSION );
|
||||
|
||||
#print( "http://$address/$cmd\n" );
|
||||
my $req = HTTP::Request->new( GET=>"http://$address/$cmd" );
|
||||
my $res = $ua->request($req);
|
||||
|
||||
if ( $res->is_success )
|
||||
{
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Error check failed: '".$res->status_line()."'\n" );
|
||||
}
|
||||
|
||||
return( $result );
|
||||
}
|
||||
|
||||
sub cameraReset
|
||||
{
|
||||
print( "Camera Reset\n" );
|
||||
my $cmd = "nphRestart?PAGE=Restart&Restart=OK";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveUp
|
||||
{
|
||||
print( "Move Up\n" );
|
||||
my $cmd = "nphControlCamera?Direction=TiltUp";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveDown
|
||||
{
|
||||
print( "Move Down\n" );
|
||||
my $cmd = "nphControlCamera?Direction=TiltDown";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveLeft
|
||||
{
|
||||
print( "Move Left\n" );
|
||||
my $cmd = "nphControlCamera?Direction=PanLeft";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRight
|
||||
{
|
||||
print( "Move Right\n" );
|
||||
my $cmd = "nphControlCamera?Direction=PanRight";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveMap
|
||||
{
|
||||
my ( $xcoord, $ycoord, $width, $height ) = @_;
|
||||
print( "Move Map to $xcoord,$ycoord\n" );
|
||||
my $cmd = "nphControlCamera?Direction=Direct&NewPosition.x=$xcoord&NewPosition.y=$ycoord&Width=$width&Height=$height";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub zoomTele
|
||||
{
|
||||
print( "Zoom Tele\n" );
|
||||
my $cmd = "nphControlCamera?Direction=ZoomTele";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub zoomWide
|
||||
{
|
||||
print( "Zoom Wide\n" );
|
||||
my $cmd = "nphControlCamera?Direction=ZoomWide";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusNear
|
||||
{
|
||||
print( "Focus Near\n" );
|
||||
my $cmd = "nphControlCamera?Direction=FocusNear";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusFar
|
||||
{
|
||||
print( "Focus Far\n" );
|
||||
my $cmd = "nphControlCamera?Direction=FocusFar";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusAuto
|
||||
{
|
||||
print( "Focus Auto\n" );
|
||||
my $cmd = "nphControlCamera?Direction=FocusAuto";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetClear
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Clear Preset $preset\n" );
|
||||
my $cmd = "nphPresetNameCheck?Data=$preset";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Set Preset $preset\n" );
|
||||
my $cmd = "nphPresetNameCheck?PresetName=$preset&Data=$preset";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Goto Preset $preset\n" );
|
||||
my $cmd = "nphControlCamera?Direction=Preset&PresetOperation=Move&Data=$preset";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
print( "Home Preset\n" );
|
||||
my $cmd = "nphControlCamera?Direction=HomePosition";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
if ( $command eq "move_con_up" )
|
||||
{
|
||||
moveUp();
|
||||
}
|
||||
elsif ( $command eq "move_con_down" )
|
||||
{
|
||||
moveDown();
|
||||
}
|
||||
elsif ( $command eq "move_con_left" )
|
||||
{
|
||||
moveLeft();
|
||||
}
|
||||
elsif ( $command eq "move_con_right" )
|
||||
{
|
||||
moveRight();
|
||||
}
|
||||
elsif ( $command eq "move_map" )
|
||||
{
|
||||
moveMap( $xcoord, $ycoord, $width, $height );
|
||||
}
|
||||
elsif ( $command eq "zoom_con_tele" )
|
||||
{
|
||||
zoomTele();
|
||||
}
|
||||
elsif ( $command eq "zoom_con_wide" )
|
||||
{
|
||||
zoomWide();
|
||||
}
|
||||
elsif ( $command eq "focus_con_near" )
|
||||
{
|
||||
focusNear();
|
||||
}
|
||||
elsif ( $command eq "focus_con_far" )
|
||||
{
|
||||
focusFar();
|
||||
}
|
||||
elsif ( $command eq "focus_auto" )
|
||||
{
|
||||
focusAuto();
|
||||
}
|
||||
elsif ( $command eq "focus_man" )
|
||||
{
|
||||
#focusMan();
|
||||
}
|
||||
elsif ( $command eq "preset_home" )
|
||||
{
|
||||
presetHome();
|
||||
}
|
||||
elsif ( $command eq "preset_set" )
|
||||
{
|
||||
presetSet( $preset );
|
||||
}
|
||||
elsif ( $command eq "preset_goto" )
|
||||
{
|
||||
presetGoto( $preset );
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Error, can't handle command $command\n" );
|
||||
}
|
||||
|
|
@ -72,7 +72,6 @@ BEGIN
|
|||
}
|
||||
|
||||
use Getopt::Long;
|
||||
use Device::SerialPort;
|
||||
|
||||
use constant LOG_FILE => ZM_PATH_LOGS.'/zmcontrol-kx-hcm10.log';
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,676 @@
|
|||
#!/usr/bin/perl -wT
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Pelco-D Control Script, $Date$, $Revision$
|
||||
# Copyright (C) 2003, 2004, 2005 Philip Coombes
|
||||
#
|
||||
# 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;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# These are the elements you can edit to suit your installation
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use constant LOG_FILE => ZM_PATH_LOGS.'/zmcontrol-pelco-d.log';
|
||||
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder;
|
||||
use Getopt::Long;
|
||||
use Device::SerialPort;
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
$| = 1;
|
||||
|
||||
$ENV{PATH} = '/bin:/usr/bin';
|
||||
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
|
||||
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
|
||||
|
||||
sub Usage
|
||||
{
|
||||
print( "
|
||||
Usage: zmcontrol-pelco-d.pl <various options>
|
||||
");
|
||||
exit( -1 );
|
||||
}
|
||||
|
||||
my $arg_string = join( " ", @ARGV );
|
||||
|
||||
my $device = "/dev/ttyS0";
|
||||
my $address = 1;
|
||||
my $command;
|
||||
my $autostop;
|
||||
my ( $speed, $step );
|
||||
my ( $xcoord, $ycoord );
|
||||
my ( $panspeed, $tiltspeed );
|
||||
my ( $panstep, $tiltstep );
|
||||
my $preset;
|
||||
|
||||
if ( !GetOptions(
|
||||
'device=s'=>\$device,
|
||||
'address=i'=>\$address,
|
||||
'command=s'=>\$command,
|
||||
'autostop=f'=>\$autostop,
|
||||
'speed=i'=>\$speed,
|
||||
'step=i'=>\$step,
|
||||
'xcoord=i'=>\$xcoord,
|
||||
'ycoord=i'=>\$ycoord,
|
||||
'panspeed=i'=>\$panspeed,
|
||||
'tiltspeed=i'=>\$tiltspeed,
|
||||
'panstep=i'=>\$panstep,
|
||||
'tiltstep=i'=>\$tiltstep,
|
||||
'preset=i'=>\$preset
|
||||
)
|
||||
)
|
||||
{
|
||||
Usage();
|
||||
}
|
||||
|
||||
if ( defined($autostop) )
|
||||
{
|
||||
# Convert to microseconds.
|
||||
$autostop = int(1000000*$autostop);
|
||||
}
|
||||
|
||||
my $log_file = LOG_FILE;
|
||||
open( LOG, ">>$log_file" ) or die( "Can't open log file: $!" );
|
||||
open( STDOUT, ">&LOG" ) || die( "Can't dup stdout: $!" );
|
||||
select( STDOUT ); $| = 1;
|
||||
open( STDERR, ">&LOG" ) || die( "Can't dup stderr: $!" );
|
||||
select( STDERR ); $| = 1;
|
||||
select( LOG ); $| = 1;
|
||||
|
||||
print( $arg_string."\n" );
|
||||
|
||||
srand( time() );
|
||||
|
||||
my $serial_port = new Device::SerialPort( $device );
|
||||
$serial_port->baudrate(2400);
|
||||
$serial_port->databits(8);
|
||||
$serial_port->parity('none');
|
||||
$serial_port->stopbits(1);
|
||||
$serial_port->handshake('none');
|
||||
|
||||
$serial_port->read_const_time(50);
|
||||
$serial_port->read_char_time(10);
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $msg = shift;
|
||||
my $prefix = shift || "";
|
||||
$prefix = $prefix.": " if ( $prefix );
|
||||
|
||||
my $line_length = 16;
|
||||
my $msg_len = int(@$msg);
|
||||
|
||||
print( $prefix );
|
||||
for ( my $i = 0; $i < $msg_len; $i++ )
|
||||
{
|
||||
if ( ($i > 0) && ($i%$line_length == 0) && ($i != ($msg_len-1)) )
|
||||
{
|
||||
printf( "\n%*s", length($prefix), "" );
|
||||
}
|
||||
printf( "%02x ", $msg->[$i] );
|
||||
}
|
||||
print( "[".$msg_len."]\n" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $cmd = shift;
|
||||
my $ack = shift || 0;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
my $checksum = 0x00;
|
||||
for ( my $i = 1; $i < int(@$cmd); $i++ )
|
||||
{
|
||||
$checksum += $cmd->[$i];
|
||||
$checksum &= 0xff;
|
||||
}
|
||||
push( @$cmd, $checksum );
|
||||
|
||||
printMsg( $cmd, "Tx" );
|
||||
my $id = $cmd->[0] & 0xf;
|
||||
|
||||
my $tx_msg = pack( "C*", @$cmd );
|
||||
|
||||
#print( "Tx: ".length( $tx_msg )." bytes\n" );
|
||||
my $n_bytes = $serial_port->write( $tx_msg );
|
||||
if ( !$n_bytes )
|
||||
{
|
||||
print( "Error, write failed: $!" );
|
||||
}
|
||||
if ( $n_bytes != length($tx_msg) )
|
||||
{
|
||||
print( "Error, incomplete write, only ".$n_bytes." of ".length($tx_msg)." written: $!" );
|
||||
}
|
||||
|
||||
if ( $ack )
|
||||
{
|
||||
print( "Waiting for ack\n" );
|
||||
my $max_wait = 3;
|
||||
my $now = time();
|
||||
while( 1 )
|
||||
{
|
||||
my ( $count, $rx_msg ) = $serial_port->read(4);
|
||||
|
||||
if ( $count )
|
||||
{
|
||||
#print( "Rx1: ".$count." bytes\n" );
|
||||
my @resp = unpack( "C*", $rx_msg );
|
||||
printMsg( \@resp, "Rx" );
|
||||
|
||||
if ( $resp[0] = 0x80 + ($id<<4) )
|
||||
{
|
||||
if ( ($resp[1] & 0xf0) == 0x40 )
|
||||
{
|
||||
my $socket = $resp[1] & 0x0f;
|
||||
print( "Got ack for socket $socket\n" );
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Error, got bogus response\n" );
|
||||
}
|
||||
last;
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Error, got message for camera ".(($resp[0]-0x80)>>4)."\n" );
|
||||
}
|
||||
}
|
||||
if ( (time() - $now) > $max_wait )
|
||||
{
|
||||
print( "Warning, response timeout\n" );
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my $sync = 0xff;
|
||||
|
||||
sub remoteReset
|
||||
{
|
||||
print( "Remote Reset\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x0f, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub cameraOff
|
||||
{
|
||||
print( "Camera Off\n" );
|
||||
my @msg = ( $sync, $address, 0x08, 0x00, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub cameraOn
|
||||
{
|
||||
print( "Camera On\n" );
|
||||
my @msg = ( $sync, $address, 0x88, 0x00, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub autoScan
|
||||
{
|
||||
print( "Auto Scan\n" );
|
||||
my @msg = ( $sync, $address, 0x90, 0x00, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub manScan
|
||||
{
|
||||
print( "Manual Scan\n" );
|
||||
my @msg = ( $sync, $address, 0x10, 0x00, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub stop
|
||||
{
|
||||
print( "Stop\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x00, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveUp
|
||||
{
|
||||
print( "Move Up\n" );
|
||||
my $speed = shift || 0x3f;
|
||||
my @msg = ( $sync, $address, 0x00, 0x08, 0x00, $speed );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveDown
|
||||
{
|
||||
print( "Move Down\n" );
|
||||
my $speed = shift || 0x3f;
|
||||
my @msg = ( $sync, $address, 0x00, 0x10, 0x00, $speed );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveLeft
|
||||
{
|
||||
print( "Move Left\n" );
|
||||
my $speed = shift || 0x3f;
|
||||
my @msg = ( $sync, $address, 0x00, 0x04, $speed, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveRight
|
||||
{
|
||||
print( "Move Right\n" );
|
||||
my $speed = shift || 0x3f;
|
||||
my @msg = ( $sync, $address, 0x00, 0x02, $speed, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveUpLeft
|
||||
{
|
||||
print( "Move Up/Left\n" );
|
||||
my $panspeed = shift || 0x3f;
|
||||
my $tiltspeed = shift || 0x3f;
|
||||
my @msg = ( $sync, $address, 0x00, 0x0c, $panspeed, $tiltspeed );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveUpRight
|
||||
{
|
||||
print( "Move Up/Right\n" );
|
||||
my $panspeed = shift || 0x3f;
|
||||
my $tiltspeed = shift || 0x3f;
|
||||
my @msg = ( $sync, $address, 0x00, 0x0a, $panspeed, $tiltspeed );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveDownLeft
|
||||
{
|
||||
print( "Move Down/Left\n" );
|
||||
my $panspeed = shift || 0x3f;
|
||||
my $tiltspeed = shift || 0x3f;
|
||||
my @msg = ( $sync, $address, 0x00, 0x14, $panspeed, $tiltspeed );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveDownRight
|
||||
{
|
||||
print( "Move Down/Right\n" );
|
||||
my $panspeed = shift || 0x3f;
|
||||
my $tiltspeed = shift || 0x3f;
|
||||
my @msg = ( $sync, $address, 0x00, 0x12, $panspeed, $tiltspeed );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub flip180
|
||||
{
|
||||
print( "Flip 180\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x07, 0x00, 0x21 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub zeroPan
|
||||
{
|
||||
print( "Zero Pan\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x07, 0x00, 0x22 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub setZoomSpeed
|
||||
{
|
||||
my $speed = shift;
|
||||
my @msg = ( $sync, $address, 0x00, 0x25, 0x00, $speed );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub zoomTele
|
||||
{
|
||||
print( "Zoom Tele\n" );
|
||||
my $speed = shift || 0x01;
|
||||
setZoomSpeed( $speed );
|
||||
usleep( 250000 );
|
||||
my @msg = ( $sync, $address, 0x00, 0x20, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
setZoomSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub zoomWide
|
||||
{
|
||||
print( "Zoom Wide\n" );
|
||||
my $speed = shift || 0x01;
|
||||
setZoomSpeed( $speed );
|
||||
usleep( 250000 );
|
||||
my @msg = ( $sync, $address, 0x00, 0x40, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
setZoomSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub setFocusSpeed
|
||||
{
|
||||
my $speed = shift;
|
||||
my @msg = ( $sync, $address, 0x00, 0x27, 0x00, $speed );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusNear
|
||||
{
|
||||
print( "Focus Near\n" );
|
||||
my $speed = shift || 0x03;
|
||||
setFocusSpeed( $speed );
|
||||
usleep( 250000 );
|
||||
my @msg = ( $sync, $address, 0x01, 0x00, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
setFocusSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub focusFar
|
||||
{
|
||||
print( "Focus Far\n" );
|
||||
my $speed = shift || 0x03;
|
||||
setFocusSpeed( $speed );
|
||||
usleep( 250000 );
|
||||
my @msg = ( $sync, $address, 0x00, 0x80, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
setFocusSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub focusAuto
|
||||
{
|
||||
print( "Focus Auto\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x2b, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusMan
|
||||
{
|
||||
print( "Focus Man\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x2b, 0x00, 0x02 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub irisClose
|
||||
{
|
||||
print( "Iris Close\n" );
|
||||
my @msg = ( $sync, $address, 0x04, 0x00, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
setIrisSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub irisOpen
|
||||
{
|
||||
print( "Iris Open\n" );
|
||||
my @msg = ( $sync, $address, 0x02, 0x80, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
setIrisSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub irisAuto
|
||||
{
|
||||
print( "Iris Auto\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x2d, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub irisMan
|
||||
{
|
||||
print( "Iris Man\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x2d, 0x00, 0x02 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub writeScreen
|
||||
{
|
||||
my $string = shift;
|
||||
print( "Writing '$string' to screen\n" );
|
||||
|
||||
my @chars = unpack( "C*", $string );
|
||||
for ( my $i = 0; $i < length($string); $i++ )
|
||||
{
|
||||
printf( "0x%02x\n", $chars[$i] );
|
||||
my @msg = ( $sync, $address, 0x00, 0x15, $i, $chars[$i] );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
}
|
||||
|
||||
sub clearScreen
|
||||
{
|
||||
print( "Clear Screen\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x17, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub clearPreset
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Clear Preset $preset\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x05, 0x00, $preset );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Set Preset $preset\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x03, 0x00, $preset );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Goto Preset $preset\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x07, 0x00, $preset );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
print( "Home Preset\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x07, 0x00, 0x22 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
if ( $command eq "reset" )
|
||||
{
|
||||
remoteReset();
|
||||
}
|
||||
elsif ( $command eq "wake" )
|
||||
{
|
||||
cameraOn();
|
||||
}
|
||||
elsif ( $command eq "sleep" )
|
||||
{
|
||||
cameraOff();
|
||||
}
|
||||
elsif ( $command eq "move_con_up" )
|
||||
{
|
||||
moveUp( $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_down" )
|
||||
{
|
||||
moveDown( $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_left" )
|
||||
{
|
||||
moveLeft( $panspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_right" )
|
||||
{
|
||||
moveRight( $panspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_upleft" )
|
||||
{
|
||||
moveUpLeft( $panspeed, $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_upright" )
|
||||
{
|
||||
moveUpRight( $panspeed, $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_downleft" )
|
||||
{
|
||||
moveDownLeft( $panspeed, $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_downright" )
|
||||
{
|
||||
moveDownRight( $panspeed, $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_stop" )
|
||||
{
|
||||
stop();
|
||||
}
|
||||
elsif ( $command eq "zoom_con_tele" )
|
||||
{
|
||||
zoomTele( $speed );
|
||||
}
|
||||
elsif ( $command eq "zoom_con_wide" )
|
||||
{
|
||||
zoomWide( $speed );
|
||||
}
|
||||
elsif ( $command eq "zoom_stop" )
|
||||
{
|
||||
setZoomSpeed( 0 );
|
||||
}
|
||||
elsif ( $command eq "focus_con_near" )
|
||||
{
|
||||
focusNear();
|
||||
}
|
||||
elsif ( $command eq "focus_con_far" )
|
||||
{
|
||||
focusFar();
|
||||
}
|
||||
elsif ( $command eq "focus_stop" )
|
||||
{
|
||||
stop();
|
||||
#setFocusSpeed( 0 );
|
||||
}
|
||||
elsif ( $command eq "focus_auto" )
|
||||
{
|
||||
focusAuto();
|
||||
}
|
||||
elsif ( $command eq "focus_man" )
|
||||
{
|
||||
focusMan();
|
||||
}
|
||||
elsif ( $command eq "iris_con_close" )
|
||||
{
|
||||
irisClose();
|
||||
}
|
||||
elsif ( $command eq "iris_con_open" )
|
||||
{
|
||||
irisOpen();
|
||||
}
|
||||
elsif ( $command eq "iris_stop" )
|
||||
{
|
||||
stop();
|
||||
}
|
||||
elsif ( $command eq "iris_auto" )
|
||||
{
|
||||
irisAuto();
|
||||
}
|
||||
elsif ( $command eq "iris_man" )
|
||||
{
|
||||
irisMan();
|
||||
}
|
||||
elsif ( $command eq "preset_home" )
|
||||
{
|
||||
presetHome();
|
||||
}
|
||||
elsif ( $command eq "preset_set" )
|
||||
{
|
||||
presetSet( $preset );
|
||||
}
|
||||
elsif ( $command eq "preset_goto" )
|
||||
{
|
||||
presetGoto( $preset );
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Error, can't handle command $command\n" );
|
||||
}
|
||||
|
||||
$serial_port->close();
|
||||
|
|
@ -0,0 +1,606 @@
|
|||
#!/usr/bin/perl -wT
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Pelco-P Control Script, $Date$, $Revision$
|
||||
# Copyright (C) 2003, 2004, 2005 Philip Coombes
|
||||
#
|
||||
# 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;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# These are the elements you can edit to suit your installation
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use constant LOG_FILE => ZM_PATH_LOGS.'/zmcontrol-pelco-p.log';
|
||||
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder;
|
||||
#use Data::Dumper;
|
||||
use Getopt::Long;
|
||||
use Device::SerialPort;
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
$| = 1;
|
||||
|
||||
$ENV{PATH} = '/bin:/usr/bin';
|
||||
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
|
||||
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
|
||||
|
||||
sub Usage
|
||||
{
|
||||
print( "
|
||||
Usage: zmcontrol-pelco-d.pl <various options>
|
||||
");
|
||||
exit( -1 );
|
||||
}
|
||||
|
||||
my $arg_string = join( " ", @ARGV );
|
||||
|
||||
my $device = "/dev/ttyS0";
|
||||
my $address = 1;
|
||||
my $command;
|
||||
my $autostop;
|
||||
my ( $speed, $step );
|
||||
my ( $xcoord, $ycoord );
|
||||
my ( $panspeed, $tiltspeed );
|
||||
my ( $panstep, $tiltstep );
|
||||
my $preset;
|
||||
|
||||
if ( !GetOptions(
|
||||
'device=s'=>\$device,
|
||||
'address=i'=>\$address,
|
||||
'command=s'=>\$command,
|
||||
'autostop=f'=>\$autostop,
|
||||
'speed=i'=>\$speed,
|
||||
'step=i'=>\$step,
|
||||
'xcoord=i'=>\$xcoord,
|
||||
'ycoord=i'=>\$ycoord,
|
||||
'panspeed=i'=>\$panspeed,
|
||||
'tiltspeed=i'=>\$tiltspeed,
|
||||
'panstep=i'=>\$panstep,
|
||||
'tiltstep=i'=>\$tiltstep,
|
||||
'preset=i'=>\$preset
|
||||
)
|
||||
)
|
||||
{
|
||||
Usage();
|
||||
}
|
||||
|
||||
if ( defined($autostop) )
|
||||
{
|
||||
# Convert to microseconds.
|
||||
$autostop = int(1000000*$autostop);
|
||||
}
|
||||
|
||||
my $log_file = LOG_FILE;
|
||||
open( LOG, ">>$log_file" ) or die( "Can't open log file: $!" );
|
||||
open( STDOUT, ">&LOG" ) || die( "Can't dup stdout: $!" );
|
||||
select( STDOUT ); $| = 1;
|
||||
open( STDERR, ">&LOG" ) || die( "Can't dup stderr: $!" );
|
||||
select( STDERR ); $| = 1;
|
||||
select( LOG ); $| = 1;
|
||||
|
||||
print( $arg_string."\n" );
|
||||
|
||||
srand( time() );
|
||||
|
||||
my $serial_port = new Device::SerialPort( $device );
|
||||
$serial_port->baudrate(2400);
|
||||
$serial_port->databits(8);
|
||||
$serial_port->parity('none');
|
||||
$serial_port->stopbits(1);
|
||||
$serial_port->handshake('none');
|
||||
|
||||
$serial_port->read_const_time(50);
|
||||
$serial_port->read_char_time(10);
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $msg = shift;
|
||||
my $prefix = shift || "";
|
||||
$prefix = $prefix.": " if ( $prefix );
|
||||
|
||||
my $line_length = 16;
|
||||
my $msg_len = int(@$msg);
|
||||
|
||||
print( $prefix );
|
||||
for ( my $i = 0; $i < $msg_len; $i++ )
|
||||
{
|
||||
if ( ($i > 0) && ($i%$line_length == 0) && ($i != ($msg_len-1)) )
|
||||
{
|
||||
printf( "\n%*s", length($prefix), "" );
|
||||
}
|
||||
printf( "%02x ", $msg->[$i] );
|
||||
}
|
||||
print( "[".$msg_len."]\n" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $cmd = shift;
|
||||
my $ack = shift || 0;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
#print( Dumper( @$cmd ) );
|
||||
my $checksum = 0x00;
|
||||
for ( my $i = 0; $i < int(@$cmd)-1; $i++ )
|
||||
{
|
||||
$checksum ^= $cmd->[$i];
|
||||
$checksum &= 0xff;
|
||||
#printf( "%02x - %02x\n", $cmd->[$i], $checksum );
|
||||
}
|
||||
push( @$cmd, $checksum );
|
||||
|
||||
printMsg( $cmd, "Tx" );
|
||||
my $id = $cmd->[0] & 0xf;
|
||||
|
||||
my $tx_msg = pack( "C*", @$cmd );
|
||||
|
||||
#print( "Tx: ".length( $tx_msg )." bytes\n" );
|
||||
my $n_bytes = $serial_port->write( $tx_msg );
|
||||
if ( !$n_bytes )
|
||||
{
|
||||
print( "Error, write failed: $!" );
|
||||
}
|
||||
if ( $n_bytes != length($tx_msg) )
|
||||
{
|
||||
print( "Error, incomplete write, only ".$n_bytes." of ".length($tx_msg)." written: $!" );
|
||||
}
|
||||
|
||||
if ( $ack )
|
||||
{
|
||||
print( "Waiting for ack\n" );
|
||||
my $max_wait = 3;
|
||||
my $now = time();
|
||||
while( 1 )
|
||||
{
|
||||
my ( $count, $rx_msg ) = $serial_port->read(4);
|
||||
|
||||
if ( $count )
|
||||
{
|
||||
#print( "Rx1: ".$count." bytes\n" );
|
||||
my @resp = unpack( "C*", $rx_msg );
|
||||
printMsg( \@resp, "Rx" );
|
||||
|
||||
if ( $resp[0] = 0x80 + ($id<<4) )
|
||||
{
|
||||
if ( ($resp[1] & 0xf0) == 0x40 )
|
||||
{
|
||||
my $socket = $resp[1] & 0x0f;
|
||||
print( "Got ack for socket $socket\n" );
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Error, got bogus response\n" );
|
||||
}
|
||||
last;
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Error, got message for camera ".(($resp[0]-0x80)>>4)."\n" );
|
||||
}
|
||||
}
|
||||
if ( (time() - $now) > $max_wait )
|
||||
{
|
||||
print( "Warning, response timeout\n" );
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my $stx = 0xa0;
|
||||
my $etx = 0xaf;
|
||||
|
||||
sub cameraOff
|
||||
{
|
||||
print( "Camera Off\n" );
|
||||
my @msg = ( $stx, $address, 0x10, 0x00, 0x00, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub cameraOn
|
||||
{
|
||||
print( "Camera On\n" );
|
||||
my @msg = ( $stx, $address, 0x40, 0x00, 0x00, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub autoScan
|
||||
{
|
||||
print( "Auto Scan\n" );
|
||||
my @msg = ( $stx, $address, 0x90, 0x00, 0x00, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub manScan
|
||||
{
|
||||
print( "Manual Scan\n" );
|
||||
my @msg = ( $stx, $address, 0x10, 0x00, 0x00, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub stop
|
||||
{
|
||||
print( "Stop\n" );
|
||||
my @msg = ( $stx, $address, 0x00, 0x00, 0x00, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveUp
|
||||
{
|
||||
print( "Move Up\n" );
|
||||
my $speed = shift || 0x3f;
|
||||
my @msg = ( $stx, $address, 0x00, 0x08, 0x00, $speed, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveDown
|
||||
{
|
||||
print( "Move Down\n" );
|
||||
my $speed = shift || 0x3f;
|
||||
my @msg = ( $stx, $address, 0x00, 0x10, 0x00, $speed, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveLeft
|
||||
{
|
||||
print( "Move Left\n" );
|
||||
my $speed = shift || 0x3f;
|
||||
my @msg = ( $stx, $address, 0x00, 0x04, $speed, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveRight
|
||||
{
|
||||
print( "Move Right\n" );
|
||||
my $speed = shift || 0x3f;
|
||||
my @msg = ( $stx, $address, 0x00, 0x02, $speed, 0x00 , $etx);
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveUpLeft
|
||||
{
|
||||
print( "Move Up/Left\n" );
|
||||
my $panspeed = shift || 0x3f;
|
||||
my $tiltspeed = shift || 0x3f;
|
||||
my @msg = ( $stx, $address, 0x00, 0x0c, $panspeed, $tiltspeed, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveUpRight
|
||||
{
|
||||
print( "Move Up/Right\n" );
|
||||
my $panspeed = shift || 0x3f;
|
||||
my $tiltspeed = shift || 0x3f;
|
||||
my @msg = ( $stx, $address, 0x00, 0x0a, $panspeed, $tiltspeed, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveDownLeft
|
||||
{
|
||||
print( "Move Down/Left\n" );
|
||||
my $panspeed = shift || 0x3f;
|
||||
my $tiltspeed = shift || 0x3f;
|
||||
my @msg = ( $stx, $address, 0x00, 0x14, $panspeed, $tiltspeed, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveDownRight
|
||||
{
|
||||
print( "Move Down/Right\n" );
|
||||
my $panspeed = shift || 0x3f;
|
||||
my $tiltspeed = shift || 0x3f;
|
||||
my @msg = ( $stx, $address, 0x00, 0x12, $panspeed, $tiltspeed, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub flip180
|
||||
{
|
||||
print( "Flip 180\n" );
|
||||
my @msg = ( $stx, $address, 0x00, 0x07, 0x00, 0x21, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub zeroPan
|
||||
{
|
||||
print( "Zero Pan\n" );
|
||||
my @msg = ( $stx, $address, 0x00, 0x07, 0x00, 0x22, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub setZoomSpeed
|
||||
{
|
||||
my $speed = shift;
|
||||
my @msg = ( $stx, $address, 0x00, 0x25, 0x00, $speed, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub zoomTele
|
||||
{
|
||||
print( "Zoom Tele\n" );
|
||||
my $speed = shift || 0x01;
|
||||
setZoomSpeed( $speed );
|
||||
my @msg = ( $stx, $address, 0x00, 0x20, 0x00, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
setZoomSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub zoomWide
|
||||
{
|
||||
print( "Zoom Wide\n" );
|
||||
my $speed = shift || 0x01;
|
||||
setZoomSpeed( $speed );
|
||||
my @msg = ( $stx, $address, 0x00, 0x40, 0x00, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
setZoomSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub setFocusSpeed
|
||||
{
|
||||
my $speed = shift;
|
||||
my @msg = ( $stx, $address, 0x00, 0x27, 0x00, $speed, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusNear
|
||||
{
|
||||
print( "Focus Near\n" );
|
||||
my $speed = shift || 0x03;
|
||||
setFocusSpeed( $speed );
|
||||
my @msg = ( $stx, $address, 0x02, 0x00, 0x00, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
setFocusSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub focusFar
|
||||
{
|
||||
print( "Focus Far\n" );
|
||||
my $speed = shift || 0x03;
|
||||
setFocusSpeed( $speed );
|
||||
my @msg = ( $stx, $address, 0x01, 0x80, 0x00, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
setFocusSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub focusAuto
|
||||
{
|
||||
print( "Focus Auto\n" );
|
||||
my @msg = ( $stx, $address, 0x00, 0x2b, 0x00, 0x01, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusMan
|
||||
{
|
||||
print( "Focus Man\n" );
|
||||
my @msg = ( $stx, $address, 0x00, 0x2b, 0x00, 0x02, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub writeScreen
|
||||
{
|
||||
my $string = shift;
|
||||
print( "Writing '$string' to screen\n" );
|
||||
|
||||
my @chars = unpack( "C*", $string );
|
||||
for ( my $i = 0; $i < length($string); $i++ )
|
||||
{
|
||||
printf( "0x%02x\n", $chars[$i] );
|
||||
my @msg = ( $stx, $address, 0x00, 0x15, $i, $chars[$i], $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
}
|
||||
|
||||
sub clearScreen
|
||||
{
|
||||
print( "Clear Screen\n" );
|
||||
my @msg = ( $stx, $address, 0x00, 0x17, 0x00, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub clearPreset
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Clear Preset $preset\n" );
|
||||
my @msg = ( $stx, $address, 0x00, 0x05, 0x00, $preset, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Set Preset $preset\n" );
|
||||
my @msg = ( $stx, $address, 0x00, 0x03, 0x00, $preset, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Goto Preset $preset\n" );
|
||||
my @msg = ( $stx, $address, 0x00, 0x07, 0x00, $preset, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
print( "Home Preset\n" );
|
||||
my @msg = ( $stx, $address, 0x00, 0x07, 0x00, 0x22, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
if ( $command eq "wake" )
|
||||
{
|
||||
cameraOn();
|
||||
}
|
||||
elsif ( $command eq "sleep" )
|
||||
{
|
||||
cameraOff();
|
||||
}
|
||||
elsif ( $command eq "move_con_up" )
|
||||
{
|
||||
moveUp( $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_down" )
|
||||
{
|
||||
moveDown( $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_left" )
|
||||
{
|
||||
moveLeft( $panspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_right" )
|
||||
{
|
||||
moveRight( $panspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_upleft" )
|
||||
{
|
||||
moveUpLeft( $panspeed, $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_upright" )
|
||||
{
|
||||
moveUpRight( $panspeed, $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_downleft" )
|
||||
{
|
||||
moveDownLeft( $panspeed, $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_downright" )
|
||||
{
|
||||
moveDownRight( $panspeed, $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_stop" )
|
||||
{
|
||||
stop();
|
||||
}
|
||||
elsif ( $command eq "zoom_con_tele" )
|
||||
{
|
||||
zoomTele( $speed );
|
||||
}
|
||||
elsif ( $command eq "zoom_con_wide" )
|
||||
{
|
||||
zoomWide( $speed );
|
||||
}
|
||||
elsif ( $command eq "zoom_stop" )
|
||||
{
|
||||
setZoomSpeed( 0 );
|
||||
}
|
||||
elsif ( $command eq "focus_con_near" )
|
||||
{
|
||||
focusNear();
|
||||
}
|
||||
elsif ( $command eq "focus_con_far" )
|
||||
{
|
||||
focusFar();
|
||||
}
|
||||
elsif ( $command eq "focus_stop" )
|
||||
{
|
||||
setFocusSpeed( 0 );
|
||||
}
|
||||
elsif ( $command eq "focus_auto" )
|
||||
{
|
||||
focusAuto();
|
||||
}
|
||||
elsif ( $command eq "focus_man" )
|
||||
{
|
||||
focusMan();
|
||||
}
|
||||
elsif ( $command eq "preset_home" )
|
||||
{
|
||||
presetHome();
|
||||
}
|
||||
elsif ( $command eq "preset_set" )
|
||||
{
|
||||
presetSet( $preset );
|
||||
}
|
||||
elsif ( $command eq "preset_goto" )
|
||||
{
|
||||
presetGoto( $preset );
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Error, can't handle command $command\n" );
|
||||
}
|
||||
|
||||
$serial_port->close();
|
||||
|
|
@ -0,0 +1,625 @@
|
|||
#!/usr/bin/perl -wT
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder VISCA Control Script, $Date$, $Revision$
|
||||
# Copyright (C) 2003, 2004, 2005 Philip Coombes
|
||||
#
|
||||
# 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;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# These are the elements you can edit to suit your installation
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use constant LOG_FILE => ZM_PATH_LOGS.'/zmcontrol-visca.log';
|
||||
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder;
|
||||
use Getopt::Long;
|
||||
use Device::SerialPort;
|
||||
|
||||
$| = 1;
|
||||
|
||||
$ENV{PATH} = '/bin:/usr/bin';
|
||||
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
|
||||
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
|
||||
|
||||
sub Usage
|
||||
{
|
||||
print( "
|
||||
Usage: zmcontrol-visca.pl <various options>
|
||||
");
|
||||
exit( -1 );
|
||||
}
|
||||
|
||||
my $arg_string = join( " ", @ARGV );
|
||||
|
||||
my $device = "/dev/ttyS0";
|
||||
my $address = 1;
|
||||
my $command;
|
||||
my ( $speed, $step );
|
||||
my ( $xcoord, $ycoord );
|
||||
my ( $panspeed, $tiltspeed );
|
||||
my ( $panstep, $tiltstep );
|
||||
my $preset;
|
||||
|
||||
if ( !GetOptions(
|
||||
'device=s'=>\$device,
|
||||
'address=i'=>\$address,
|
||||
'command=s'=>\$command,
|
||||
'speed=i'=>\$speed,
|
||||
'step=i'=>\$step,
|
||||
'xcoord=i'=>\$xcoord,
|
||||
'ycoord=i'=>\$ycoord,
|
||||
'panspeed=i'=>\$panspeed,
|
||||
'tiltspeed=i'=>\$tiltspeed,
|
||||
'panstep=i'=>\$panstep,
|
||||
'tiltstep=i'=>\$tiltstep,
|
||||
'preset=i'=>\$preset
|
||||
)
|
||||
)
|
||||
{
|
||||
Usage();
|
||||
}
|
||||
|
||||
my $log_file = LOG_FILE;
|
||||
open( LOG, ">>$log_file" ) or die( "Can't open log file: $!" );
|
||||
open( STDOUT, ">&LOG" ) || die( "Can't dup stdout: $!" );
|
||||
select( STDOUT ); $| = 1;
|
||||
open( STDERR, ">&LOG" ) || die( "Can't dup stderr: $!" );
|
||||
select( STDERR ); $| = 1;
|
||||
select( LOG ); $| = 1;
|
||||
|
||||
print( $arg_string."\n" );
|
||||
|
||||
srand( time() );
|
||||
|
||||
my $serial_port = new Device::SerialPort( $device );
|
||||
$serial_port->baudrate(9600);
|
||||
$serial_port->databits(8);
|
||||
$serial_port->parity('none');
|
||||
$serial_port->stopbits(1);
|
||||
$serial_port->handshake('rts');
|
||||
$serial_port->stty_echo(0);
|
||||
|
||||
#$serial_port->read_const_time(250);
|
||||
$serial_port->read_char_time(2);
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $msg = shift;
|
||||
my $prefix = shift || "";
|
||||
$prefix = $prefix.": " if ( $prefix );
|
||||
|
||||
my $line_length = 16;
|
||||
my $msg_len = int(@$msg);
|
||||
|
||||
print( $prefix );
|
||||
for ( my $i = 0; $i < $msg_len; $i++ )
|
||||
{
|
||||
if ( ($i > 0) && ($i%$line_length == 0) && ($i != ($msg_len-1)) )
|
||||
{
|
||||
printf( "\n%*s", length($prefix), "" );
|
||||
}
|
||||
printf( "%02x ", $msg->[$i] );
|
||||
}
|
||||
print( "[".$msg_len."]\n" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $cmd = shift;
|
||||
my $ack = shift || 0;
|
||||
my $cmp = shift || 0;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
printMsg( $cmd, "Tx" );
|
||||
my $id = $cmd->[0] & 0xf;
|
||||
|
||||
my $tx_msg = pack( "C*", @$cmd );
|
||||
|
||||
#print( "Tx: ".length( $tx_msg )." bytes\n" );
|
||||
my $n_bytes = $serial_port->write( $tx_msg );
|
||||
if ( !$n_bytes )
|
||||
{
|
||||
print( "Error, write failed: $!" );
|
||||
}
|
||||
if ( $n_bytes != length($tx_msg) )
|
||||
{
|
||||
print( "Error, incomplete write, only ".$n_bytes." of ".length($tx_msg)." written: $!" );
|
||||
}
|
||||
|
||||
if ( $ack )
|
||||
{
|
||||
print( "Waiting for ack\n" );
|
||||
my $max_wait = 3;
|
||||
my $now = time();
|
||||
while( 1 )
|
||||
{
|
||||
my ( $count, $rx_msg ) = $serial_port->read(4);
|
||||
|
||||
if ( $count )
|
||||
{
|
||||
#print( "Rx1: ".$count." bytes\n" );
|
||||
my @resp = unpack( "C*", $rx_msg );
|
||||
printMsg( \@resp, "Rx" );
|
||||
|
||||
if ( $resp[0] = 0x80 + ($id<<4) )
|
||||
{
|
||||
if ( ($resp[1] & 0xf0) == 0x40 )
|
||||
{
|
||||
my $socket = $resp[1] & 0x0f;
|
||||
print( "Got ack for socket $socket\n" );
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
printf( "Error, got bogus response\n" );
|
||||
}
|
||||
last;
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Error, got message for camera ".(($resp[0]-0x80)>>4)."\n" );
|
||||
}
|
||||
}
|
||||
if ( (time() - $now) > $max_wait )
|
||||
{
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cmp )
|
||||
{
|
||||
print( "Waiting for command complete\n" );
|
||||
my $max_wait = 10;
|
||||
my $now = time();
|
||||
while( 1 )
|
||||
{
|
||||
#print( "Waiting\n" );
|
||||
my ( $count, $rx_msg ) = $serial_port->read(16);
|
||||
|
||||
if ( $count )
|
||||
{
|
||||
#print( "Rx1: ".$count." bytes\n" );
|
||||
my @resp = unpack( "C*", $rx_msg );
|
||||
printMsg( \@resp, "Rx" );
|
||||
|
||||
if ( $resp[0] = 0x80 + ($id<<4) )
|
||||
{
|
||||
if ( ($resp[1] & 0xf0) == 0x50 )
|
||||
{
|
||||
printf( "Got command complete\n" );
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
printf( "Error, got bogus response\n" );
|
||||
}
|
||||
last;
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Error, got message for camera ".(($resp[0]-0x80)>>4)."\n" );
|
||||
}
|
||||
}
|
||||
if ( (time() - $now) > $max_wait )
|
||||
{
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
return( $result );
|
||||
}
|
||||
|
||||
my $sync = 0xff;
|
||||
|
||||
sub cameraOff
|
||||
{
|
||||
print( "Camera Off\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x00, 0x03, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub cameraOn
|
||||
{
|
||||
print( "Camera On\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x00, 0x02, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub stop
|
||||
{
|
||||
print( "Stop\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, 0x00, 0x00, 0x03, 0x03, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveUp
|
||||
{
|
||||
print( "Move Up\n" );
|
||||
my $speed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, 0x00, $speed, 0x03, 0x01, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveDown
|
||||
{
|
||||
print( "Move Down\n" );
|
||||
my $speed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, 0x00, $speed, 0x03, 0x02, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveLeft
|
||||
{
|
||||
print( "Move Left\n" );
|
||||
my $speed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $speed, 0x00, 0x01, 0x03, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveRight
|
||||
{
|
||||
print( "Move Right\n" );
|
||||
my $speed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $speed, 0x00, 0x02, 0x03, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveUpLeft
|
||||
{
|
||||
print( "Move Up/Left\n" );
|
||||
my $panspeed = shift || 0x40;
|
||||
my $tiltspeed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x01, 0x01, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveUpRight
|
||||
{
|
||||
print( "Move Up/Right\n" );
|
||||
my $panspeed = shift || 0x40;
|
||||
my $tiltspeed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x02, 0x01, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveDownLeft
|
||||
{
|
||||
print( "Move Down/Left\n" );
|
||||
my $panspeed = shift || 0x40;
|
||||
my $tiltspeed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x01, 0x02, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveDownRight
|
||||
{
|
||||
print( "Move Down/Right\n" );
|
||||
my $panspeed = shift || 0x40;
|
||||
my $tiltspeed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x02, 0x02, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub stepUp
|
||||
{
|
||||
print( "Step Up\n" );
|
||||
my $step = shift;
|
||||
my $speed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x03, 0x00, $speed, 0x00, 0x00, 0x00, 0x00, ($step&0xf000)>>12, ($step&0x0f00)>>8, ($step&0x00f0)>>4, ($step&0x000f)>>0, $sync );
|
||||
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub stepDown
|
||||
{
|
||||
print( "Step Down\n" );
|
||||
my $step = shift;
|
||||
$step = -$step;
|
||||
my $speed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x03, 0x00, $speed, 0x00, 0x00, 0x00, 0x00, ($step&0xf000)>>12, ($step&0x0f00)>>8, ($step&0x00f0)>>4, ($step&0x000f)>>0, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub stepLeft
|
||||
{
|
||||
print( "Step Left\n" );
|
||||
my $step = shift;
|
||||
$step = -$step;
|
||||
my $speed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x03, $speed, 0x00, ($step&0xf000)>>12, ($step&0x0f00)>>8, ($step&0x00f0)>>4, ($step&0x000f)>>0, 0x00, 0x00, 0x00, 0x00, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub stepRight
|
||||
{
|
||||
print( "Step Right\n" );
|
||||
my $step = shift;
|
||||
my $speed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x03, $speed, 0x00, ($step&0xf000)>>12, ($step&0x0f00)>>8, ($step&0x00f0)>>4, ($step&0x000f)>>0, 0x00, 0x00, 0x00, 0x00, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub stepUpLeft
|
||||
{
|
||||
print( "Step Up/Left\n" );
|
||||
my $panstep = shift;
|
||||
$panstep = -$panstep;
|
||||
my $tiltstep = shift;
|
||||
my $panspeed = shift || 0x40;
|
||||
my $tiltspeed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x03, $panspeed, $tiltspeed, ($panstep&0xf000)>>12, ($panstep&0x0f00)>>8, ($panstep&0x00f0)>>4, ($panstep&0x000f)>>0, ($tiltstep&0xf000)>>12, ($tiltstep&0x0f00)>>8, ($tiltstep&0x00f0)>>4, ($tiltstep&0x000f)>>0, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub stepUpRight
|
||||
{
|
||||
print( "Step Up/Right\n" );
|
||||
my $panstep = shift;
|
||||
my $tiltstep = shift;
|
||||
my $panspeed = shift || 0x40;
|
||||
my $tiltspeed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x03, $panspeed, $tiltspeed, ($panstep&0xf000)>>12, ($panstep&0x0f00)>>8, ($panstep&0x00f0)>>4, ($panstep&0x000f)>>0, ($tiltstep&0xf000)>>12, ($tiltstep&0x0f00)>>8, ($tiltstep&0x00f0)>>4, ($tiltstep&0x000f)>>0, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub stepDownLeft
|
||||
{
|
||||
print( "Step Down/Left\n" );
|
||||
my $panstep = shift;
|
||||
$panstep = -$panstep;
|
||||
my $tiltstep = shift;
|
||||
$tiltstep = -$tiltstep;
|
||||
my $panspeed = shift || 0x40;
|
||||
my $tiltspeed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x03, $panspeed, $tiltspeed, ($panstep&0xf000)>>12, ($panstep&0x0f00)>>8, ($panstep&0x00f0)>>4, ($panstep&0x000f)>>0, ($tiltstep&0xf000)>>12, ($tiltstep&0x0f00)>>8, ($tiltstep&0x00f0)>>4, ($tiltstep&0x000f)>>0, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub stepDownRight
|
||||
{
|
||||
print( "Step Down/Right\n" );
|
||||
my $panstep = shift;
|
||||
my $tiltstep = shift;
|
||||
$tiltstep = -$tiltstep;
|
||||
my $panspeed = shift || 0x40;
|
||||
my $tiltspeed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x03, $panspeed, $tiltspeed, ($panstep&0xf000)>>12, ($panstep&0x0f00)>>8, ($panstep&0x00f0)>>4, ($panstep&0x000f)>>0, ($tiltstep&0xf000)>>12, ($tiltstep&0x0f00)>>8, ($tiltstep&0x00f0)>>4, ($tiltstep&0x000f)>>0, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub zoomTele
|
||||
{
|
||||
print( "Zoom Tele\n" );
|
||||
my $speed = shift || 0x06;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x07, 0x20|$speed, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub zoomWide
|
||||
{
|
||||
print( "Zoom Wide\n" );
|
||||
my $speed = shift || 0x06;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x07, 0x30|$speed, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub zoomStop
|
||||
{
|
||||
print( "Zoom Stop\n" );
|
||||
my $speed = shift || 0x06;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x07, 0x00, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusNear
|
||||
{
|
||||
print( "Focus Near\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x08, 0x03, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusFar
|
||||
{
|
||||
print( "Focus Far\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x08, 0x02, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusStop
|
||||
{
|
||||
print( "Focus Far\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x08, 0x00, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusAuto
|
||||
{
|
||||
print( "Focus Auto\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x38, 0x02, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusMan
|
||||
{
|
||||
print( "Focus Man\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x38, 0x03, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetClear
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Clear Preset $preset\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x3f, 0x00, $preset, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Set Preset $preset\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x3f, 0x01, $preset, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Goto Preset $preset\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x3f, 0x02, $preset, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
print( "Home Preset\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x04, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
if ( $command eq "move_con_up" )
|
||||
{
|
||||
moveUp( $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_down" )
|
||||
{
|
||||
moveDown( $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_left" )
|
||||
{
|
||||
moveLeft( $panspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_right" )
|
||||
{
|
||||
moveRight( $panspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_upleft" )
|
||||
{
|
||||
moveUpLeft( $panspeed, $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_upright" )
|
||||
{
|
||||
moveUpRight( $panspeed, $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_downleft" )
|
||||
{
|
||||
moveDownLeft( $panspeed, $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_con_downright" )
|
||||
{
|
||||
moveDownLeft( $panspeed, $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_stop" )
|
||||
{
|
||||
stop();
|
||||
}
|
||||
elsif ( $command eq "move_rel_up" )
|
||||
{
|
||||
stepUp( $tiltstep, $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_rel_down" )
|
||||
{
|
||||
stepDown( $tiltstep, $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_rel_left" )
|
||||
{
|
||||
stepLeft( $panstep, $panspeed );
|
||||
}
|
||||
elsif ( $command eq "move_rel_right" )
|
||||
{
|
||||
stepRight( $panstep, $panspeed );
|
||||
}
|
||||
elsif ( $command eq "move_rel_upleft" )
|
||||
{
|
||||
stepUpLeft( $panstep, $tiltstep, $panspeed, $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_rel_upright" )
|
||||
{
|
||||
stepUpRight( $panstep, $tiltstep, $panspeed, $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_rel_downleft" )
|
||||
{
|
||||
stepDownLeft( $panstep, $tiltstep, $panspeed, $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "move_rel_downright" )
|
||||
{
|
||||
stepDownRight( $panstep, $tiltstep, $panspeed, $tiltspeed );
|
||||
}
|
||||
elsif ( $command eq "zoom_con_tele" )
|
||||
{
|
||||
zoomTele( $speed );
|
||||
}
|
||||
elsif ( $command eq "zoom_con_wide" )
|
||||
{
|
||||
zoomWide( $speed );
|
||||
}
|
||||
elsif ( $command eq "zoom_stop" )
|
||||
{
|
||||
zoomStop();
|
||||
}
|
||||
elsif ( $command eq "focus_con_near" )
|
||||
{
|
||||
focusNear();
|
||||
}
|
||||
elsif ( $command eq "focus_con_far" )
|
||||
{
|
||||
focusFar();
|
||||
}
|
||||
elsif ( $command eq "focus_stop" )
|
||||
{
|
||||
focusStop();
|
||||
}
|
||||
elsif ( $command eq "focus_auto" )
|
||||
{
|
||||
focusAuto();
|
||||
}
|
||||
elsif ( $command eq "focus_man" )
|
||||
{
|
||||
focusMan();
|
||||
}
|
||||
elsif ( $command eq "preset_home" )
|
||||
{
|
||||
presetHome();
|
||||
}
|
||||
elsif ( $command eq "preset_set" )
|
||||
{
|
||||
presetSet( $preset );
|
||||
}
|
||||
elsif ( $command eq "preset_goto" )
|
||||
{
|
||||
presetGoto( $preset );
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Error, can't handle command $command\n" );
|
||||
}
|
||||
|
||||
$serial_port->close();
|
||||
|
|
@ -0,0 +1,596 @@
|
|||
#!/usr/bin/perl -wT
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Daemon Control Script, $Date$, $Revision$
|
||||
# Copyright (C) 2003, 2004, 2005 Philip Coombes
|
||||
#
|
||||
# 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 is the gateway for controlling the various ZoneMinder
|
||||
# daemons. All starting, stopping and restarting goes through here.
|
||||
# On the first invocation it starts up a server which subsequently
|
||||
# records what's running and what's not. Other invocations just
|
||||
# connect to the server and pass instructions to it.
|
||||
#
|
||||
use strict;
|
||||
use bytes;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# User config
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use constant DC_SOCK_FILE => ZM_PATH_SOCKS.'/zmdc.sock';
|
||||
use constant DC_LOG_FILE => ZM_PATH_LOGS.'/zmdc.log';
|
||||
use constant MAX_CONNECT_DELAY => 10;
|
||||
use constant VERBOSE => 0; # Whether to output more verbose debug
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Don't change anything from here on down
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder;
|
||||
use POSIX;
|
||||
use Socket;
|
||||
use IO::Handle;
|
||||
use Data::Dumper;
|
||||
|
||||
$| = 1;
|
||||
|
||||
$ENV{PATH} = '/bin:/usr/bin';
|
||||
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
|
||||
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
|
||||
|
||||
my @daemons = ( 'zmc', 'zma', 'zmf', 'zmfilter.pl', 'zmaudit.pl', 'zmtrigger.pl', 'zmx10.pl', 'zmwatch.pl', 'zmupdate.pl', 'zmtrack.pl' );
|
||||
|
||||
my $command = shift @ARGV;
|
||||
die( "No command given" ) unless( $command );
|
||||
my $needs_daemon = $command !~ /(?:shutdown|status|check)/;
|
||||
my $daemon = shift( @ARGV );
|
||||
die( "No daemon given" ) unless( !$needs_daemon || $daemon );
|
||||
my @args;
|
||||
|
||||
my $daemon_patt = '('.join( '|', @daemons ).')';
|
||||
if ( $needs_daemon )
|
||||
{
|
||||
if ( $daemon =~ /^${daemon_patt}$/ )
|
||||
{
|
||||
$daemon = $1;
|
||||
}
|
||||
else
|
||||
{
|
||||
die( "Invalid daemon '$daemon' specified" );
|
||||
}
|
||||
}
|
||||
|
||||
foreach my $arg ( @ARGV )
|
||||
{
|
||||
# Detaint arguments, if they look ok
|
||||
#if ( $arg =~ /^(-{0,2}[\w]+)/ )
|
||||
if ( $arg =~ /^(-{0,2}[\w\/?&=.-]+)$/ )
|
||||
{
|
||||
push( @args, $1 );
|
||||
}
|
||||
else
|
||||
{
|
||||
die( "Bogus argument '$arg' found" );
|
||||
}
|
||||
}
|
||||
|
||||
socket( CLIENT, PF_UNIX, SOCK_STREAM, 0 ) or die( "Can't open socket: $!" );
|
||||
|
||||
my $saddr = sockaddr_un( DC_SOCK_FILE );
|
||||
|
||||
if ( !connect( CLIENT, $saddr ) )
|
||||
{
|
||||
if ( $command eq "check" )
|
||||
{
|
||||
print( "stopped\n" );
|
||||
exit();
|
||||
}
|
||||
# The server isn't there
|
||||
print( "Unable to connect, starting server\n" );
|
||||
close( CLIENT );
|
||||
|
||||
if ( my $cpid = fork() )
|
||||
{
|
||||
# Parent process just sleep and fall through
|
||||
socket( CLIENT, PF_UNIX, SOCK_STREAM, 0 ) or die( "Can't open socket: $!" );
|
||||
my $attempts = 0;
|
||||
while (!connect( CLIENT, $saddr ))
|
||||
{
|
||||
$attempts++;
|
||||
die( "Can't connect: $!" ) if ($attempts > MAX_CONNECT_DELAY);
|
||||
sleep(1);
|
||||
}
|
||||
}
|
||||
elsif ( defined($cpid) )
|
||||
{
|
||||
setpgrp();
|
||||
|
||||
open( LOG, ">>".DC_LOG_FILE ) or die( "Can't open log file: $!" );
|
||||
open(STDOUT, ">&LOG") || die( "Can't dup stdout: $!" );
|
||||
select( STDOUT ); $| = 1;
|
||||
open(STDERR, ">&LOG") || die( "Can't dup stderr: $!" );
|
||||
select( STDERR ); $| = 1;
|
||||
select( LOG ); $| = 1;
|
||||
|
||||
dprint( "Server starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
||||
|
||||
kill_all( 1 );
|
||||
|
||||
socket( SERVER, PF_UNIX, SOCK_STREAM, 0 ) or die( "Can't open socket: $!" );
|
||||
unlink( DC_SOCK_FILE );
|
||||
bind( SERVER, $saddr ) or die( "Can't bind: $!" );
|
||||
listen( SERVER, SOMAXCONN ) or die( "Can't listen: $!" );
|
||||
|
||||
$SIG{CHLD} = \&reaper;
|
||||
$SIG{INT} = \&shutdown_all;
|
||||
$SIG{TERM} = \&shutdown_all;
|
||||
$SIG{ABRT} = \&shutdown_all;
|
||||
$SIG{HUP} = \&status;
|
||||
|
||||
my %cmd_hash;
|
||||
my %pid_hash;
|
||||
|
||||
sub cprint
|
||||
{
|
||||
if ( fileno(CLIENT) )
|
||||
{
|
||||
print CLIENT @_
|
||||
}
|
||||
}
|
||||
sub dprint
|
||||
{
|
||||
if ( fileno(CLIENT) )
|
||||
{
|
||||
print CLIENT @_
|
||||
}
|
||||
print @_;
|
||||
}
|
||||
sub start
|
||||
{
|
||||
my $daemon = shift;
|
||||
my @args = @_;
|
||||
|
||||
my $command = $daemon;
|
||||
$command .= ' '.join( ' ', ( @args ) ) if ( @args );
|
||||
my $process = $cmd_hash{$command};
|
||||
|
||||
if ( !$process )
|
||||
{
|
||||
# It's not running, or at least it's not been started by us
|
||||
$process = { daemon=>$daemon, args=>\@args, command=>$command, keepalive=>!undef };
|
||||
}
|
||||
elsif ( $process->{pid} && $pid_hash{$process->{pid}} )
|
||||
{
|
||||
dprint( "'$process->{command}' already running at ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{started}) ).", pid = $process->{pid}\n" );
|
||||
return();
|
||||
}
|
||||
|
||||
if ( my $cpid = fork() )
|
||||
{
|
||||
my $sigset = POSIX::SigSet->new;
|
||||
my $blockset = POSIX::SigSet->new( SIGCHLD );
|
||||
sigprocmask( SIG_BLOCK, $blockset, $sigset ) or die( "Can't block SIGCHLD: $!" );
|
||||
$process->{pid} = $cpid;
|
||||
$process->{started} = time();
|
||||
delete( $process->{pending} );
|
||||
|
||||
dprint( "'$command' starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{started}) ).", pid = $process->{pid}\n" );
|
||||
|
||||
$cmd_hash{$process->{command}} = $pid_hash{$cpid} = $process;
|
||||
sigprocmask( SIG_SETMASK, $sigset ) or die( "Can't restore SIGCHLD: $!" );
|
||||
}
|
||||
elsif ( defined($cpid ) )
|
||||
{
|
||||
# Child process
|
||||
$SIG{CHLD} = 'DEFAULT';
|
||||
$SIG{INT} = 'DEFAULT';
|
||||
$SIG{TERM} = 'DEFAULT';
|
||||
$SIG{ABRT} = 'DEFAULT';
|
||||
$SIG{HUP} = 'DEFAULT';
|
||||
dprint( "'".join( ' ', ( $daemon, @args ) )."' started at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
||||
|
||||
if ( $daemon =~ /^${daemon_patt}$/ )
|
||||
{
|
||||
$daemon = ZM_PATH_BIN.'/'.$1;
|
||||
}
|
||||
else
|
||||
{
|
||||
die( "Invalid daemon '$daemon' specified" );
|
||||
}
|
||||
|
||||
my @good_args;
|
||||
foreach my $arg ( @args )
|
||||
{
|
||||
# Detaint arguments, if they look ok
|
||||
if ( $arg =~ /^(-{0,2}[\w\/?&=.-]+)$/ )
|
||||
{
|
||||
push( @good_args, $1 );
|
||||
}
|
||||
else
|
||||
{
|
||||
die( "Bogus argument '$arg' found" );
|
||||
}
|
||||
}
|
||||
|
||||
exec( $daemon, @good_args ) or die( "Can't exec: $!" );
|
||||
}
|
||||
else
|
||||
{
|
||||
die( "Can't fork: $!" );
|
||||
}
|
||||
}
|
||||
sub _stop
|
||||
{
|
||||
my $final = shift;
|
||||
my $daemon = shift;
|
||||
my @args = @_;
|
||||
|
||||
my $command = $daemon;
|
||||
$command .= ' '.join( ' ', ( @args ) ) if ( @args );
|
||||
my $process = $cmd_hash{$command};
|
||||
if ( !$process )
|
||||
{
|
||||
dprint( "Can't find process with command of '$command'\n" );
|
||||
return();
|
||||
}
|
||||
elsif ( $process->{pending} )
|
||||
{
|
||||
delete( $cmd_hash{$command} );
|
||||
dprint( "Command '$command' removed from pending list at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
||||
return();
|
||||
}
|
||||
|
||||
my $cpid = $process->{pid};
|
||||
if ( !$pid_hash{$cpid} )
|
||||
{
|
||||
dprint( "No process with command of '$command' is running\n" );
|
||||
return();
|
||||
}
|
||||
|
||||
print( "'$daemon ".join( ' ', @args )."' stopping at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
||||
$process->{keepalive} = !$final;
|
||||
kill( 'TERM', $cpid );
|
||||
delete( $cmd_hash{$command} );
|
||||
|
||||
# Now check it has actually gone away, if not kill -9 it
|
||||
my $count = 0;
|
||||
while( $cpid && kill( 0, $cpid ) )
|
||||
{
|
||||
if ( $count++ > 5 )
|
||||
{
|
||||
kill( 'KILL', $cpid );
|
||||
}
|
||||
sleep( 1 );
|
||||
}
|
||||
}
|
||||
sub stop
|
||||
{
|
||||
_stop( 1, @_ );
|
||||
}
|
||||
sub restart
|
||||
{
|
||||
my $daemon = shift;
|
||||
my @args = @_;
|
||||
|
||||
my $command = $daemon;
|
||||
$command .= ' '.join( ' ', ( @args ) ) if ( @args );
|
||||
my $process = $cmd_hash{$command};
|
||||
if ( $process )
|
||||
{
|
||||
if ( $process->{pid} )
|
||||
{
|
||||
my $cpid = $process->{pid};
|
||||
if ( defined($pid_hash{$cpid}) )
|
||||
{
|
||||
_stop( 0, $daemon, @args );
|
||||
return;
|
||||
}
|
||||
}
|
||||
}
|
||||
start( $daemon, @args );
|
||||
}
|
||||
sub reaper
|
||||
{
|
||||
while ( (my $cpid = waitpid( -1, WNOHANG )) > 0 )
|
||||
{
|
||||
my $status = $?;
|
||||
|
||||
my $process = $pid_hash{$cpid};
|
||||
delete( $pid_hash{$cpid} );
|
||||
|
||||
if ( !$process )
|
||||
{
|
||||
dprint( "Can't find child with pid of '$cpid'\n" );
|
||||
next;
|
||||
}
|
||||
|
||||
$process->{stopped} = time();
|
||||
$process->{runtime} = ($process->{stopped}-$process->{started});
|
||||
delete( $process->{pid} );
|
||||
|
||||
my $exit_status = $status>>8;
|
||||
my $exit_signal = $status&0xfe;
|
||||
my $core_dumped = $status&0x01;
|
||||
|
||||
if ( $exit_status == 0 )
|
||||
{
|
||||
print( "'$process->{daemon} ".join( ' ', @{$process->{args}} )."' died at ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{stopped} ) ) );
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "'$process->{daemon} ".join( ' ', @{$process->{args}} )."' crashed at ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{stopped} ) ) );
|
||||
}
|
||||
print( ", exit status $exit_status" ) if ( $exit_status );
|
||||
print( ", signal $exit_signal" ) if ( $exit_signal );
|
||||
#print( ", core dumped" ) if ( $core_dumped );
|
||||
print( "\n" );
|
||||
|
||||
if ( $process->{keepalive} )
|
||||
{
|
||||
if ( !$process->{delay} || ($process->{runtime} > (10*$process->{delay})) )
|
||||
{
|
||||
start( $process->{daemon}, @{$process->{args}} );
|
||||
$process->{delay} = 5;
|
||||
}
|
||||
else
|
||||
{
|
||||
$cmd_hash{$process->{command}} = $process;
|
||||
$process->{pending} = $process->{stopped}+$process->{delay};
|
||||
$process->{delay} *= 2;
|
||||
# Limit the start delay to 15 minutes max
|
||||
if ( $process->{delay} > ZM_MAX_RESTART_DELAY )
|
||||
{
|
||||
$process->{delay} = ZM_MAX_RESTART_DELAY;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
$SIG{CHLD} = \&reaper;
|
||||
}
|
||||
sub kill_all
|
||||
{
|
||||
my $delay = shift;
|
||||
sleep( $delay );
|
||||
foreach my $daemon ( @daemons )
|
||||
{
|
||||
qx( killall --quiet --signal TERM $daemon );
|
||||
}
|
||||
sleep( $delay );
|
||||
foreach my $daemon ( @daemons )
|
||||
{
|
||||
qx( killall --quiet --signal KILL $daemon );
|
||||
}
|
||||
}
|
||||
sub shutdown_all()
|
||||
{
|
||||
foreach my $process ( values( %pid_hash ) )
|
||||
{
|
||||
stop( $process->{daemon}, @{$process->{args}} );
|
||||
}
|
||||
kill_all( 5 );
|
||||
dprint( "Server shutdown at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
||||
unlink( DC_SOCK_FILE );
|
||||
close( CLIENT );
|
||||
close( SERVER );
|
||||
exit();
|
||||
}
|
||||
sub check
|
||||
{
|
||||
my $daemon = shift;
|
||||
my @args = @_;
|
||||
|
||||
my $command = $daemon;
|
||||
$command .= ' '.join( ' ', ( @args ) ) if ( @args );
|
||||
my $process = $cmd_hash{$command};
|
||||
if ( !$process )
|
||||
{
|
||||
cprint( "unknown\n" );
|
||||
}
|
||||
elsif ( $process->{pending} )
|
||||
{
|
||||
cprint( "pending\n" );
|
||||
}
|
||||
else
|
||||
{
|
||||
my $cpid = $process->{pid};
|
||||
if ( !$pid_hash{$cpid} )
|
||||
{
|
||||
cprint( "stopped\n" );
|
||||
}
|
||||
else
|
||||
{
|
||||
cprint( "running\n" );
|
||||
}
|
||||
}
|
||||
}
|
||||
sub status
|
||||
{
|
||||
my $daemon = shift;
|
||||
my @args = @_;
|
||||
|
||||
if ( defined($daemon) )
|
||||
{
|
||||
my $command = $daemon;
|
||||
$command .= ' '.join( ' ', ( @args ) ) if ( @args );
|
||||
my $process = $cmd_hash{$command};
|
||||
if ( !$process )
|
||||
{
|
||||
dprint( "'$command' not running\n" );
|
||||
return();
|
||||
}
|
||||
|
||||
if ( $process->{pending} )
|
||||
{
|
||||
dprint( "'$process->{command}' pending at ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{pending}) )."\n" );
|
||||
}
|
||||
else
|
||||
{
|
||||
my $cpid = $process->{pid};
|
||||
if ( !$pid_hash{$cpid} )
|
||||
{
|
||||
dprint( "'$command' not running\n" );
|
||||
return();
|
||||
}
|
||||
}
|
||||
dprint( "'$process->{command}' running at ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{started}) ).", pid = $process->{pid}" );
|
||||
}
|
||||
else
|
||||
{
|
||||
foreach my $process ( values(%pid_hash) )
|
||||
{
|
||||
dprint( "'$process->{command}' running at ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{started}) ).", pid = $process->{pid}" );
|
||||
dprint( ", valid" ) if ( kill( 0, $process->{pid} ) );
|
||||
dprint( "\n" );
|
||||
}
|
||||
foreach my $process ( values( %cmd_hash ) )
|
||||
{
|
||||
if ( $process->{pending} )
|
||||
{
|
||||
dprint( "'$process->{command}' pending at ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{pending}) )."\n" );
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my $rin = '';
|
||||
vec( $rin, fileno(SERVER),1) = 1;
|
||||
my $win = $rin;
|
||||
my $ein = $win;
|
||||
my $timeout = 1;
|
||||
#my ( $nfound, $timeleft) = select( $rin, $win, $ein, $timeout );
|
||||
#print( "F:".fileno(SERVER)."\n" );
|
||||
while( 1 )
|
||||
{
|
||||
my $nfound = select( my $rout = $rin, undef, my $eout = $ein, $timeout );
|
||||
#print( "Off select, NF:$nfound, ER:$!\n" );
|
||||
#print( vec( $rout, fileno(SERVER),1)."\n" );
|
||||
#print( vec( $eout, fileno(SERVER),1)."\n" );
|
||||
#print( "C:".fileno(CLIENT)."S:".fileno(SERVER)."\n" );
|
||||
if ( $nfound > 0 )
|
||||
{
|
||||
if ( vec( $rout, fileno(SERVER),1) )
|
||||
{
|
||||
my $paddr = accept( CLIENT, SERVER );
|
||||
my $message = <CLIENT>;
|
||||
|
||||
next if ( !$message );
|
||||
|
||||
my ( $command, $daemon, @args ) = split( ';', $message );
|
||||
|
||||
if ( $command eq 'start' )
|
||||
{
|
||||
start( $daemon, @args );
|
||||
}
|
||||
elsif ( $command eq 'stop' )
|
||||
{
|
||||
stop( $daemon, @args );
|
||||
}
|
||||
elsif ( $command eq 'restart' )
|
||||
{
|
||||
restart( $daemon, @args );
|
||||
}
|
||||
elsif ( $command eq 'shutdown' )
|
||||
{
|
||||
shutdown_all();
|
||||
}
|
||||
elsif ( $command eq 'check' )
|
||||
{
|
||||
check( $daemon, @args );
|
||||
}
|
||||
elsif ( $command eq 'status' )
|
||||
{
|
||||
if ( $daemon )
|
||||
{
|
||||
status( $daemon, @args );
|
||||
}
|
||||
else
|
||||
{
|
||||
status();
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
dprint( "Invalid command '$command'\n" );
|
||||
}
|
||||
close( CLIENT );
|
||||
}
|
||||
else
|
||||
{
|
||||
die( "Bogus descriptor" );
|
||||
}
|
||||
}
|
||||
elsif ( $nfound < 0 )
|
||||
{
|
||||
if ( $! == EINTR )
|
||||
{
|
||||
# Dead child, will be reaped
|
||||
#print( "Probable dead child\n" );
|
||||
}
|
||||
else
|
||||
{
|
||||
die( "Can't select: $!" );
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
#print( "Select timed out\n" );
|
||||
foreach my $process ( values( %cmd_hash ) )
|
||||
{
|
||||
if ( $process->{pending} && $process->{pending} <= time() )
|
||||
{
|
||||
dprint( "Starting pending process, $process->{command}\n" );
|
||||
start( $process->{daemon}, @{$process->{args}} );
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
dprint( "Server exiting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
||||
close( LOG );
|
||||
exit();
|
||||
}
|
||||
else
|
||||
{
|
||||
die( "Can't fork: $!" );
|
||||
}
|
||||
}
|
||||
if ( $command eq "check" && !$daemon )
|
||||
{
|
||||
print( "running\n" );
|
||||
exit();
|
||||
}
|
||||
# The server is there, connect to it
|
||||
#print( "Writing commands\n" );
|
||||
CLIENT->autoflush();
|
||||
my $message = "$command";
|
||||
$message .= ";$daemon" if ( $daemon );
|
||||
$message .= ";".join( ';', @args ) if ( @args );
|
||||
print( CLIENT $message );
|
||||
shutdown( CLIENT, 1 );
|
||||
while ( my $line = <CLIENT> )
|
||||
{
|
||||
chomp( $line );
|
||||
print( "$line\n" );
|
||||
}
|
||||
close( CLIENT );
|
||||
#print( "Finished writing, bye\n" );
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,375 @@
|
|||
#!/usr/bin/perl -wT
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Package Control Script, $Date$, $Revision$
|
||||
# Copyright (C) 2003, 2004, 2005 Philip Coombes
|
||||
#
|
||||
# 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 is used to start and stop the ZoneMinder package primarily to
|
||||
# allow command line control for automatic restart on reboot (see zm script)
|
||||
#
|
||||
use strict;
|
||||
use bytes;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# These are the elements you can edit to suit your installation
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use constant LOG_FILE => ZM_PATH_LOGS.'/zmpkg.log';
|
||||
use constant DBG_LEVEL => 0; # 0 is errors, warnings and info only, > 0 for debug
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Don't change anything below here
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder;
|
||||
use DBI;
|
||||
use POSIX;
|
||||
use Time::HiRes qw/gettimeofday/;
|
||||
|
||||
# Detaint our environment
|
||||
$ENV{PATH} = '/bin:/usr/bin';
|
||||
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
|
||||
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
|
||||
|
||||
my $command = $ARGV[0];
|
||||
|
||||
my $state;
|
||||
|
||||
my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_SERVER, ZM_DB_USER, ZM_DB_PASS );
|
||||
|
||||
if ( !$command || $command !~ /^(?:start|stop|restart|status)$/ )
|
||||
{
|
||||
if ( $command )
|
||||
{
|
||||
# Check to see if it's a valid run state
|
||||
my $sql = "select * from States where Name = '$command'";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute() or die( "Can't execute: ".$sth->errstr() );
|
||||
if ( $state = $sth->fetchrow_hashref() )
|
||||
{
|
||||
$state->{Name} = $command;
|
||||
$state->{Definitions} = [];
|
||||
foreach( split( ',', $state->{Definition} ) )
|
||||
{
|
||||
my ( $id, $function ) = split( ':', $_ );
|
||||
push( @{$state->{Definitions}}, { Id=>$id, Function=>$function } );
|
||||
}
|
||||
$command = 'state';
|
||||
}
|
||||
else
|
||||
{
|
||||
$command = undef;
|
||||
}
|
||||
}
|
||||
if ( !$command )
|
||||
{
|
||||
print( "Usage: zmpkg.pl <start|stop|restart|status|'state'>\n" );
|
||||
exit( -1 );
|
||||
}
|
||||
}
|
||||
|
||||
# Move to the right place
|
||||
chdir( ZM_PATH_WEB ) or die( "Can't chdir to '".ZM_PATH_WEB."': $!" );
|
||||
|
||||
my $dbg_id = "";
|
||||
|
||||
my $log_file = LOG_FILE;
|
||||
open( LOG, ">>$log_file" ) or die( "Can't open log file: $!" );
|
||||
open( STDERR, ">&LOG" ) || die( "Can't dup stderr: $!" );
|
||||
select( STDERR ); $| = 1;
|
||||
select( LOG ); $| = 1;
|
||||
|
||||
Info( "Command: $command\n" );
|
||||
|
||||
my $web_uid = (getpwnam( ZM_WEB_USER ))[2];
|
||||
my $web_gid = (getgrnam( ZM_WEB_GROUP ))[2];
|
||||
if ( $> != $web_uid )
|
||||
{
|
||||
chown( $web_uid, $web_gid, $log_file ) or die( "Can't change permissions on log file: $!" )
|
||||
}
|
||||
|
||||
my $retval = 0;
|
||||
|
||||
# Determine the appropriate syntax for the su command
|
||||
|
||||
my $cmd_prefix = getCmdPrefix();
|
||||
|
||||
if ( $command eq "state" )
|
||||
{
|
||||
Info( "Updating DB: $state->{Name}\n" );
|
||||
my $sql = "select * from Monitors order by Id asc";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute() or die( "Can't execute: ".$sth->errstr() );
|
||||
while( my $monitor = $sth->fetchrow_hashref() )
|
||||
{
|
||||
foreach my $definition ( @{$state->{Definitions}} )
|
||||
{
|
||||
if ( $monitor->{Id} =~ /^$definition->{Id}$/ )
|
||||
{
|
||||
$monitor->{NewFunction} = $definition->{Function};
|
||||
}
|
||||
}
|
||||
#next if ( !$monitor->{NewFunction} );
|
||||
$monitor->{NewFunction} = 'None' if ( !$monitor->{NewFunction} );
|
||||
if ( $monitor->{Function} ne $monitor->{NewFunction} )
|
||||
{
|
||||
my $sql = "update Monitors set Function = ? where Id = ?";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute( $monitor->{NewFunction}, $monitor->{Id} ) or die( "Can't execute: ".$sth->errstr() );
|
||||
}
|
||||
}
|
||||
$sth->finish();
|
||||
|
||||
$command = "restart";
|
||||
}
|
||||
|
||||
if ( $command =~ /^(?:stop|restart)$/ )
|
||||
{
|
||||
my $status = runCommand( "zmdc.pl check" );
|
||||
|
||||
if ( $status eq "running" )
|
||||
{
|
||||
runCommand( "zmdc.pl shutdown" );
|
||||
removeShm();
|
||||
}
|
||||
else
|
||||
{
|
||||
$retval = 1;
|
||||
}
|
||||
}
|
||||
|
||||
if ( $command =~ /^(?:start|restart)$/ )
|
||||
{
|
||||
my $status = runCommand( "zmdc.pl check" );
|
||||
|
||||
if ( $status eq "stopped" )
|
||||
{
|
||||
removeShm();
|
||||
runCommand( "zmfix" );
|
||||
runCommand( "zmdc.pl status" );
|
||||
|
||||
my $sql = "select * from Monitors";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute() or die( "Can't execute: ".$sth->errstr() );
|
||||
while( my $monitor = $sth->fetchrow_hashref() )
|
||||
{
|
||||
if ( $monitor->{Function} ne 'None' )
|
||||
{
|
||||
if ( $monitor->{Type} eq 'Local' )
|
||||
{
|
||||
runCommand( "zmdc.pl start zmc -d $monitor->{Device}" );
|
||||
}
|
||||
else
|
||||
{
|
||||
runCommand( "zmdc.pl start zmc -m $monitor->{Id}" );
|
||||
}
|
||||
if ( $monitor->{Function} ne 'Monitor' )
|
||||
{
|
||||
if ( ZM_OPT_FRAME_SERVER )
|
||||
{
|
||||
runCommand( "zmdc.pl start zmf -m $monitor->{Id}" );
|
||||
}
|
||||
runCommand( "zmdc.pl start zma -m $monitor->{Id}" );
|
||||
}
|
||||
if ( ZM_OPT_CONTROL )
|
||||
{
|
||||
if ( $monitor->{Function} eq 'Modect' || $monitor->{Function} eq 'Mocord' )
|
||||
{
|
||||
if ( $monitor->{Controllable} && $monitor->{TrackMotion} )
|
||||
{
|
||||
runCommand( "zmdc.pl start zmtrack.pl -m $monitor->{Id}" );
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
$sth->finish();
|
||||
|
||||
# This is now started unconditionally
|
||||
runCommand( "zmdc.pl start zmfilter.pl" );
|
||||
runCommand( "zmdc.pl start zmaudit.pl -d 900 -y" );
|
||||
|
||||
if ( ZM_OPT_TRIGGERS )
|
||||
{
|
||||
runCommand( "zmdc.pl start zmtrigger.pl" );
|
||||
}
|
||||
if ( ZM_OPT_X10 )
|
||||
{
|
||||
runCommand( "zmdc.pl start zmx10.pl -c start" );
|
||||
}
|
||||
runCommand( "zmdc.pl start zmwatch.pl" );
|
||||
if ( ZM_CHECK_FOR_UPDATES )
|
||||
{
|
||||
runCommand( "zmdc.pl start zmupdate.pl -c" );
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
$retval = 1;
|
||||
}
|
||||
}
|
||||
|
||||
if ( $command eq "status" )
|
||||
{
|
||||
my $status = runCommand( "zmdc.pl check" );
|
||||
|
||||
print( STDOUT $status."\n" );
|
||||
}
|
||||
|
||||
exit( $retval );
|
||||
|
||||
sub getCmdPrefix
|
||||
{
|
||||
Debug( "Testing valid shell syntax\n" );
|
||||
|
||||
my ( $name ) = getpwuid( $> );
|
||||
if ( $name eq ZM_WEB_USER )
|
||||
{
|
||||
Debug( "Running as '$name', su commands not needed\n" );
|
||||
return( "" );
|
||||
}
|
||||
|
||||
my $null_command = "true";
|
||||
my $prefix = "su ".ZM_WEB_USER." -c ";
|
||||
my $command = $prefix."'".$null_command."'";
|
||||
Debug( "Testing '$command'\n" );
|
||||
my $output = qx($command);
|
||||
my $status = $? >> 8;
|
||||
if ( !$status )
|
||||
{
|
||||
Debug( "Test ok, using prefix '$prefix'\n" );
|
||||
return( $prefix );
|
||||
}
|
||||
else
|
||||
{
|
||||
chomp( $output );
|
||||
Debug( "Test failed, '$output'\n" );
|
||||
|
||||
$prefix = "su ".ZM_WEB_USER." --shell=/bin/sh --command=";
|
||||
$command = $prefix."'true'";
|
||||
Debug( "Testing '$command'\n" );
|
||||
$output = qx($command);
|
||||
$status = $? >> 8;
|
||||
if ( !$status )
|
||||
{
|
||||
Debug( "Test ok, using prefix '$prefix'\n" );
|
||||
return( $prefix );
|
||||
}
|
||||
else
|
||||
{
|
||||
chomp( $output );
|
||||
Debug( "Test failed, '$output'\n" );
|
||||
}
|
||||
}
|
||||
|
||||
Error( "Unable to find valid 'su' syntax\n" );
|
||||
exit( -1 );
|
||||
}
|
||||
|
||||
sub removeShm
|
||||
{
|
||||
Debug( "Removing shared memory\n" );
|
||||
# Find ZoneMinder shared memory
|
||||
my $command = "ipcs -m | grep '^".substr( sprintf( "0x%x", hex(ZM_SHM_KEY) ), 0, -2 )."'";
|
||||
Debug( "Checking for shared memory with '$command'\n" );
|
||||
open( CMD, "$command |" ) or die( "Can't execute '$command': $!" );
|
||||
while( <CMD> )
|
||||
{
|
||||
chomp;
|
||||
my ( $key, $id ) = split( /\s+/ );
|
||||
if ( $id =~ /^(\d+)/ )
|
||||
{
|
||||
$id = $1;
|
||||
$command = "ipcrm shm $id";
|
||||
Debug( "Removing shared memory with '$command'\n" );
|
||||
qx( $command );
|
||||
}
|
||||
}
|
||||
close( CMD );
|
||||
}
|
||||
|
||||
sub runCommand
|
||||
{
|
||||
my $command = shift;
|
||||
$command = $cmd_prefix."'".ZM_PATH_BIN."/".$command."'";
|
||||
Debug( "Command: $command\n" );
|
||||
my $output = qx($command);
|
||||
my $status = $? >> 8;
|
||||
chomp( $output );
|
||||
if ( $status || DBG_LEVEL > 0 )
|
||||
{
|
||||
if ( $status )
|
||||
{
|
||||
Error( "Unable to run '$command', output is '$output'\n" );
|
||||
exit( -1 );
|
||||
}
|
||||
else
|
||||
{
|
||||
Debug( "Output: $output\n" );
|
||||
}
|
||||
}
|
||||
return( $output );
|
||||
}
|
||||
|
||||
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( STDERR "%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( STDERR "%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 );
|
||||
}
|
||||
|
||||
|
|
@ -0,0 +1,232 @@
|
|||
#!/usr/bin/perl -wT
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Experimental PTZ Tracking Script, $Date$, $Revision$
|
||||
# Copyright (C) 2003, 2004, 2005 Philip Coombes
|
||||
#
|
||||
# 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 is used to trigger and cancel alarms from external sources
|
||||
# using an arbitrary text based format
|
||||
#
|
||||
use strict;
|
||||
use bytes;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# User config
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use constant LOG_FILE => ZM_PATH_LOGS.'/zmtrack-%s.log';
|
||||
use constant SLEEP_TIME => 10000; # In microseconds
|
||||
use constant VERBOSE => 1; # Whether to output more verbose debug
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Don't change anything from here on down
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder;
|
||||
use DBI;
|
||||
use POSIX;
|
||||
use Data::Dumper;
|
||||
use Getopt::Long;
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
$| = 1;
|
||||
|
||||
$ENV{PATH} = '/bin:/usr/bin';
|
||||
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
|
||||
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
|
||||
|
||||
my $mid = 0;
|
||||
|
||||
sub Usage
|
||||
{
|
||||
print( "
|
||||
Usage: zmtrack.pl -m <monitor>,--monitor=<monitor>]
|
||||
Parameters are :-
|
||||
-m<monitor>, --monitor=<monitor> - Id of the monitor to track
|
||||
");
|
||||
exit( -1 );
|
||||
}
|
||||
|
||||
if ( !GetOptions( 'monitor=s'=>\$mid ) )
|
||||
{
|
||||
Usage();
|
||||
}
|
||||
|
||||
my ( $detaint_mid ) = $mid =~ /^(\d+)$/;
|
||||
$mid = $detaint_mid;
|
||||
|
||||
my $log_file = sprintf( LOG_FILE, $mid );
|
||||
open( LOG, ">>$log_file" ) or die( "Can't open log file: $!" );
|
||||
open( STDOUT, ">&LOG" ) || die( "Can't dup stdout: $!" );
|
||||
select( STDOUT ); $| = 1;
|
||||
open( STDERR, ">&LOG" ) || die( "Can't dup stderr: $!" );
|
||||
select( STDERR ); $| = 1;
|
||||
select( LOG ); $| = 1;
|
||||
|
||||
print( "Tracker daemon $mid (experimental) starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
||||
|
||||
my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_SERVER, ZM_DB_USER, ZM_DB_PASS );
|
||||
|
||||
my $sql = "select C.*,M.* from Monitors as M left join Controls as C on M.ControlId = C.Id where M.Id = ?";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
|
||||
my $res = $sth->execute( $mid ) or die( "Can't execute '$sql': ".$sth->errstr() );
|
||||
my $monitor = $sth->fetchrow_hashref();
|
||||
|
||||
if ( !$monitor )
|
||||
{
|
||||
print( "Can't find monitor '$mid'\n" );
|
||||
exit( -1 );
|
||||
}
|
||||
if ( !$monitor->{Controllable} )
|
||||
{
|
||||
print( "Monitor '$mid' is not controllable\n" );
|
||||
exit( -1 );
|
||||
}
|
||||
if ( !$monitor->{TrackMotion} )
|
||||
{
|
||||
print( "Monitor '$mid' is not configured to track motion\n" );
|
||||
exit( -1 );
|
||||
}
|
||||
|
||||
if ( !$monitor->{CanMoveMap} )
|
||||
{
|
||||
print( "Monitor '$mid' cannot move in map mode" );
|
||||
if ( $monitor->{CanMoveRel} )
|
||||
{
|
||||
print( ", falling back to pseudo map mode\n" );
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "\n" );
|
||||
exit( -1 );
|
||||
}
|
||||
}
|
||||
|
||||
print( "Found monitor for id '$monitor'\n" ) if ( VERBOSE );
|
||||
my $size = 512; # We only need the first 512 bytes really for the alarm state and forced alarm
|
||||
$monitor->{ShmKey} = hex(ZM_SHM_KEY)|$monitor->{Id};
|
||||
$monitor->{ShmId} = shmget( $monitor->{ShmKey}, $size, 0 );
|
||||
if ( !defined($monitor->{ShmId}) )
|
||||
{
|
||||
printf( "Can't get shared memory id '%x': $!\n", $monitor->{ShmKey}, $! );
|
||||
exit( -1 );
|
||||
}
|
||||
|
||||
sub Suspend
|
||||
{
|
||||
my $monitor = shift;
|
||||
my $suspend_cmd = ZM_PATH_BIN."/zmu -m ".$monitor->{Id}." -u -U admin -P pc00zm";
|
||||
qx( $suspend_cmd );
|
||||
}
|
||||
|
||||
sub Resume
|
||||
{
|
||||
my $monitor = shift;
|
||||
sleep( $monitor->{TrackDelay} );
|
||||
my $resume_cmd = ZM_PATH_BIN."/zmu -m ".$monitor->{Id}." -r -U admin -P pc00zm";
|
||||
qx( $resume_cmd );
|
||||
}
|
||||
|
||||
sub Track
|
||||
{
|
||||
my $monitor = shift;
|
||||
my ( $x, $y ) = @_;
|
||||
my ( $detaint_x ) = $x =~ /^(\d+)$/; $x = $detaint_x;
|
||||
my ( $detaint_y ) = $y =~ /^(\d+)$/; $y = $detaint_y;
|
||||
my $move_cmd = $monitor->{Command};
|
||||
$move_cmd = ZM_PATH_BIN.'/'.$move_cmd if ( $move_cmd !~ m|^/| );
|
||||
$move_cmd .= " --device=".$monitor->{ControlDevice} if ( $monitor->{ControlDevice} );
|
||||
$move_cmd .= " --address=".$monitor->{ControlAddress} if ( $monitor->{ControlAddress} );
|
||||
$move_cmd .= " --command=".($monitor->{CanMoveMap}?"move_map":"move_pseudo_map")." --xcoord=$x --ycoord=$y --width=".$monitor->{Width}." --height=".$monitor->{Height};
|
||||
qx( $move_cmd );
|
||||
}
|
||||
|
||||
sub Return
|
||||
{
|
||||
my $monitor = shift;
|
||||
my $move_cmd = $monitor->{Command};
|
||||
$move_cmd = ZM_PATH_BIN.'/'.$move_cmd if ( $move_cmd !~ m|^/| );
|
||||
$move_cmd .= " --device=".$monitor->{ControlDevice} if ( $monitor->{ControlDevice} );
|
||||
$move_cmd .= " --address=".$monitor->{ControlAddress} if ( $monitor->{ControlAddress} );
|
||||
$move_cmd .= " --command=".($monitor->{ReturnLocation}?"preset1":"preset_home");
|
||||
qx( $move_cmd );
|
||||
}
|
||||
|
||||
my $last_alarm = 0;
|
||||
if ( ($monitor->{ReturnLocation} >= 0) )
|
||||
{
|
||||
Suspend( $monitor );
|
||||
Return( $monitor );
|
||||
Resume( $monitor );
|
||||
}
|
||||
|
||||
my $alarmed = undef;
|
||||
while( 1 )
|
||||
{
|
||||
my $state;
|
||||
if ( !shmread( $monitor->{ShmId}, $state, 8, 4 ) )
|
||||
{
|
||||
print( "Can't read from shared memory: $!\n" );
|
||||
exit( -1 );
|
||||
}
|
||||
$state = unpack( "l", $state );
|
||||
|
||||
if ( $state == 2 ) # Alarmed
|
||||
{
|
||||
my $alarm_pos;
|
||||
if ( !shmread( $monitor->{ShmId}, $alarm_pos, 48, 8 ) )
|
||||
{
|
||||
print( "Can't read from shared memory '$monitor->{ShmKey}/$monitor->{ShmId}': $!\n" );
|
||||
next;
|
||||
}
|
||||
my ( $alarm_x, $alarm_y ) = unpack( "ll", $alarm_pos );
|
||||
if ( $alarm_x > 0 && $alarm_y > 0 )
|
||||
{
|
||||
print( "Got alarm at $alarm_x, $alarm_y\n" ) if ( VERBOSE );
|
||||
Suspend( $monitor );
|
||||
Track( $monitor, $alarm_x, $alarm_y );
|
||||
Resume( $monitor );
|
||||
$last_alarm = time();
|
||||
$alarmed = !undef;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
if ( VERBOSE && $alarmed )
|
||||
{
|
||||
print( "Left alarm state\n" );
|
||||
$alarmed = undef;
|
||||
}
|
||||
if ( ($monitor->{ReturnLocation} >= 0) && ($last_alarm > 0) && ((time()-$last_alarm) > $monitor->{ReturnDelay}) )
|
||||
{
|
||||
print( "Returning to location ".$monitor->{ReturnLocation}."\n" ) if ( VERBOSE );
|
||||
Suspend( $monitor );
|
||||
Return( $monitor );
|
||||
Resume( $monitor );
|
||||
$last_alarm = 0;
|
||||
}
|
||||
}
|
||||
usleep( SLEEP_TIME );
|
||||
}
|
||||
|
|
@ -162,10 +162,30 @@ if ( !$monitor->{CanMoveMap} )
|
|||
}
|
||||
}
|
||||
|
||||
print( "Found monitor for id '$monitor'\n" ) if ( VERBOSE );
|
||||
my $size = 512; # We only need the first 512 bytes really for the alarm state and forced alarm
|
||||
my $shm_dets = {
|
||||
"Size" => 56, # Size of segment to read, must be big enough for all fields below
|
||||
"state"=>{ "Offset"=>8, "Size"=>4 },
|
||||
"alarm_post"=>{ "Offset"=>48, "Size"=>8 },
|
||||
};
|
||||
|
||||
sub ShmRead
|
||||
{
|
||||
my $monitor = shift;
|
||||
my $detail = shift;
|
||||
|
||||
my $shm_detail = $shm_dets->{$detail} or die( "Can't find shared memory detail for '$detail'" );
|
||||
my $shm_data;
|
||||
if ( !shmread( $monitor->{ShmId}, $shm_data, $shm_detail->{Offset}, $shm_detail->{Size} ) )
|
||||
{
|
||||
print( "Can't read ".$shm_detail->{Size}." bytes at offset ".$shm_detail->{Offset}." from shared memory '$monitor->{ShmKey}/$monitor->{ShmId}': $!\n" );
|
||||
return( undef );
|
||||
}
|
||||
return( $shm_data );
|
||||
}
|
||||
|
||||
print( "Found monitor for id '".$monitor->{Id}."'\n" ) if ( VERBOSE );
|
||||
$monitor->{ShmKey} = hex(ZM_SHM_KEY)|$monitor->{Id};
|
||||
$monitor->{ShmId} = shmget( $monitor->{ShmKey}, $size, 0 );
|
||||
$monitor->{ShmId} = shmget( $monitor->{ShmKey}, $shm_dets->{Size}, 0 );
|
||||
if ( !defined($monitor->{ShmId}) )
|
||||
{
|
||||
printf( "Can't get shared memory id '%x': $!\n", $monitor->{ShmKey}, $! );
|
||||
|
|
@ -223,22 +243,14 @@ if ( ($monitor->{ReturnLocation} >= 0) )
|
|||
my $alarmed = undef;
|
||||
while( 1 )
|
||||
{
|
||||
my $state;
|
||||
if ( !shmread( $monitor->{ShmId}, $state, 8, 4 ) )
|
||||
{
|
||||
print( "Can't read from shared memory: $!\n" );
|
||||
exit( -1 );
|
||||
}
|
||||
my $state = ShmRead( $monitor, "state" );
|
||||
next if ( !defined($state) );
|
||||
$state = unpack( "l", $state );
|
||||
|
||||
if ( $state == 2 ) # Alarmed
|
||||
{
|
||||
my $alarm_pos;
|
||||
if ( !shmread( $monitor->{ShmId}, $alarm_pos, 48, 8 ) )
|
||||
{
|
||||
print( "Can't read from shared memory '$monitor->{ShmKey}/$monitor->{ShmId}': $!\n" );
|
||||
next;
|
||||
}
|
||||
my $alarm_pos = ShmRead( $monitor, "alarm_pos" );
|
||||
next if ( !defined($alarm_pos) );
|
||||
my ( $alarm_x, $alarm_y ) = unpack( "ll", $alarm_pos );
|
||||
if ( $alarm_x > 0 && $alarm_y > 0 )
|
||||
{
|
||||
|
|
|
|||
|
|
@ -0,0 +1,338 @@
|
|||
#!/usr/bin/perl -wT
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder External Trigger Script, $Date$, $Revision$
|
||||
# Copyright (C) 2003, 2004, 2005 Philip Coombes
|
||||
#
|
||||
# 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 is used to trigger and cancel alarms from external sources
|
||||
# using an arbitrary text based format
|
||||
#
|
||||
use strict;
|
||||
use bytes;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# User config
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use constant LOG_FILE => ZM_PATH_LOGS.'/zmtrigger.log';
|
||||
use constant MAX_CONNECT_DELAY => 10;
|
||||
use constant VERBOSE => 0; # Whether to output more verbose debug
|
||||
|
||||
# Now define the trigger sources, can be inet socket, unix socket or file based
|
||||
# Ignore parser field for now.
|
||||
|
||||
my @sources = (
|
||||
{ name=>"S1", type=>"inet", port=>"6802", parser=>"", },
|
||||
{ name=>"S2", type=>"unix", path=>"/tmp/test.sock", parser=>"", },
|
||||
{ name=>"S3", type=>"file", path=>"/dev/ttyS0", parser=>"", },
|
||||
);
|
||||
|
||||
# Need to make sure each parser function is defined
|
||||
sub parseTrigger1
|
||||
{
|
||||
}
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Don't change anything from here on down
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder;
|
||||
use DBI;
|
||||
use POSIX;
|
||||
use Fcntl;
|
||||
use Socket;
|
||||
use IO::Handle;
|
||||
use Data::Dumper;
|
||||
|
||||
$| = 1;
|
||||
|
||||
$ENV{PATH} = '/bin:/usr/bin';
|
||||
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
|
||||
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
|
||||
|
||||
open( LOG, ">>".LOG_FILE ) or die( "Can't open log file: $!" );
|
||||
open(STDOUT, ">&LOG") || die( "Can't dup stdout: $!" );
|
||||
select( STDOUT ); $| = 1;
|
||||
open(STDERR, ">&LOG") || die( "Can't dup stderr: $!" );
|
||||
select( STDERR ); $| = 1;
|
||||
select( LOG ); $| = 1;
|
||||
|
||||
print( "Trigger daemon starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
||||
|
||||
my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_SERVER, ZM_DB_USER, ZM_DB_PASS );
|
||||
|
||||
my $sql = "select * from Monitors where Id = ? or Name = ?";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
|
||||
$SIG{HUP} = \&status;
|
||||
|
||||
my $base_rin = '';
|
||||
foreach my $source ( @sources )
|
||||
{
|
||||
print( "Opening source '$source->{name}'\n" );
|
||||
if ( $source->{type} eq "inet" )
|
||||
{
|
||||
local *sfh;
|
||||
my $saddr = sockaddr_in( $source->{port}, INADDR_ANY );
|
||||
socket( *sfh, PF_INET, SOCK_STREAM, getprotobyname('tcp') ) or die( "Can't open socket: $!" );
|
||||
setsockopt( *sfh, SOL_SOCKET, SO_REUSEADDR, 1 );
|
||||
bind( *sfh, $saddr ) or die( "Can't bind: $!" );
|
||||
listen( *sfh, SOMAXCONN ) or die( "Can't listen: $!" );
|
||||
$source->{handle} = *sfh;
|
||||
vec( $base_rin, fileno($source->{handle}),1) = 1;
|
||||
}
|
||||
elsif ( $source->{type} eq "unix" )
|
||||
{
|
||||
local *sfh;
|
||||
unlink( $source->{path} );
|
||||
my $saddr = sockaddr_un( $source->{path} );
|
||||
socket( *sfh, PF_UNIX, SOCK_STREAM, 0 ) or die( "Can't open socket: $!" );
|
||||
bind( *sfh, $saddr ) or die( "Can't bind: $!" );
|
||||
listen( *sfh, SOMAXCONN ) or die( "Can't listen: $!" );
|
||||
$source->{handle} = *sfh;
|
||||
vec( $base_rin, fileno($source->{handle}),1) = 1;
|
||||
}
|
||||
elsif ( $source->{type} eq "file" )
|
||||
{
|
||||
local *sfh;
|
||||
#sysopen( *sfh, $source->{path}, O_NONBLOCK|O_RDONLY ) or die( "Can't sysopen: $!" );
|
||||
#open( *sfh, "<".$source->{path} ) or die( "Can't open: $!" );
|
||||
open( *sfh, "+<".$source->{path} ) or die( "Can't open: $!" );
|
||||
$source->{handle} = *sfh;
|
||||
vec( $base_rin, fileno($source->{handle}),1) = 1;
|
||||
}
|
||||
else
|
||||
{
|
||||
die( "Bogus source type '$source->{type}' found for '$source->{name}'" );
|
||||
}
|
||||
}
|
||||
|
||||
my $sigset = POSIX::SigSet->new;
|
||||
my $blockset = POSIX::SigSet->new( SIGCHLD );
|
||||
sigprocmask( SIG_BLOCK, $blockset, $sigset ) or die( "Can't block SIGCHLD: $!" );
|
||||
|
||||
my %connections;
|
||||
|
||||
$! = undef;
|
||||
my $rin = '';
|
||||
my $win = $rin;
|
||||
my $ein = $win;
|
||||
my $timeout = 1;
|
||||
my %actions;
|
||||
while( 1 )
|
||||
{
|
||||
$rin = $base_rin;
|
||||
foreach my $fileno ( keys(%connections) )
|
||||
{
|
||||
vec( $rin, $fileno,1) = 1;
|
||||
}
|
||||
my $nfound = select( my $rout = $rin, undef, my $eout = $ein, $timeout );
|
||||
if ( $nfound > 0 )
|
||||
{
|
||||
print( "Got input from $nfound sources\n" ) if ( VERBOSE );
|
||||
foreach my $source ( @sources )
|
||||
{
|
||||
if ( vec( $rout, fileno($source->{handle}),1) )
|
||||
{
|
||||
print( "Got input from source $source->{name} (".fileno($source->{handle}).")\n" ) if ( VERBOSE );
|
||||
if ( $source->{type} eq "inet" || $source->{type} eq "unix" )
|
||||
{
|
||||
local *cfh;
|
||||
my $paddr = accept( *cfh, $source->{handle} );
|
||||
$connections{fileno(*cfh)} = { source=>$source, handle=>*cfh };
|
||||
print( "Added new connection (".fileno(*cfh)."), ".int(keys(%connections))." connections\n" ) if ( VERBOSE );
|
||||
}
|
||||
else
|
||||
{
|
||||
my $buffer;
|
||||
my $nbytes = sysread( $source->{handle}, $buffer, POSIX::BUFSIZ );
|
||||
if ( !$nbytes )
|
||||
{
|
||||
die( "Got unexpected close on source $source->{name}" );
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Got '$buffer' ($nbytes bytes)\n" ) if ( VERBOSE );
|
||||
handleMessage( $buffer );
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
foreach my $connection ( values(%connections) )
|
||||
{
|
||||
print( "Got input from connection on ".$connection->{source}->{name}." (".fileno($connection->{handle}).")\n" ) if ( VERBOSE );
|
||||
if ( vec( $rout, fileno($connection->{handle}),1) )
|
||||
{
|
||||
my $buffer;
|
||||
my $nbytes = sysread( $connection->{handle}, $buffer, POSIX::BUFSIZ );
|
||||
if ( !$nbytes )
|
||||
{
|
||||
delete( $connections{fileno($connection->{handle})} );
|
||||
print( "Removed connection (".fileno($connection->{handle})."), ".int(keys(%connections))." connections\n" ) if ( VERBOSE );
|
||||
close( $connection->{handle} );
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Got '$buffer' ($nbytes bytes)\n" ) if ( VERBOSE );
|
||||
handleMessage( $buffer );
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif ( $nfound < 0 )
|
||||
{
|
||||
if ( $! == EINTR )
|
||||
{
|
||||
# Dead child, will be reaped
|
||||
#print( "Probable dead child\n" );
|
||||
}
|
||||
else
|
||||
{
|
||||
die( "Can't select: $!" );
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Checking for timed actions at ".time()."\n" ) if ( VERBOSE && int(keys(%actions)) );
|
||||
my $now = time();
|
||||
foreach my $action_time ( sort( grep { $_ < $now } keys( %actions ) ) )
|
||||
{
|
||||
print( "Found actions expiring at $action_time\n" );
|
||||
foreach my $action ( @{$actions{$action_time}} )
|
||||
{
|
||||
print( "Found action '$action'\n" );
|
||||
handleMessage( $action );
|
||||
}
|
||||
delete( $actions{$action_time} );
|
||||
}
|
||||
}
|
||||
}
|
||||
print( "Trigger daemon exiting\n" );
|
||||
|
||||
sub handleMessage
|
||||
{
|
||||
my $buffer = shift;
|
||||
#chomp( $buffer );
|
||||
|
||||
print( "Processing buffer '$buffer'\n" ) if ( VERBOSE );
|
||||
foreach my $message ( split( /\r?\n/, $buffer ) )
|
||||
{
|
||||
next if ( !$message );
|
||||
print( "Processing message '$message'\n" ) if ( VERBOSE );
|
||||
my ( $id, $action, $score, $cause, $text, $showtext ) = split( /\|/, $message );
|
||||
$score = 0 if ( !defined($score) );
|
||||
$cause = 0 if ( !defined($cause) );
|
||||
$text = 0 if ( !defined($text) );
|
||||
|
||||
my $res = $sth->execute( $id, $id ) or die( "Can't execute '$sql': ".$sth->errstr() );
|
||||
my $monitor = $sth->fetchrow_hashref();
|
||||
|
||||
if ( !$monitor )
|
||||
{
|
||||
print( "Can't find monitor '$id' for message '$message'\n" );
|
||||
next;
|
||||
}
|
||||
print( "Found monitor for id '$id'\n" ) if ( VERBOSE );
|
||||
my $size = 512; # We only need the first 512 bytes really for the shared data and trigger section
|
||||
$monitor->{ShmKey} = hex(ZM_SHM_KEY)|$monitor->{Id};
|
||||
$monitor->{ShmId} = shmget( $monitor->{ShmKey}, $size, 0 );
|
||||
if ( !defined($monitor->{ShmId}) )
|
||||
{
|
||||
printf( "Can't get shared memory id '%x': $!\n", $monitor->{ShmKey}, $! );
|
||||
next;
|
||||
}
|
||||
|
||||
my $shm_data_size;
|
||||
if ( !shmread( $monitor->{ShmId}, $shm_data_size, 0, 4 ) )
|
||||
{
|
||||
print( "Can't read from shared memory: $!\n" );
|
||||
exit( -1 );
|
||||
}
|
||||
$shm_data_size = unpack( "l", $shm_data_size );
|
||||
my $trigger_data_offset = $shm_data_size+4; # Allow for 'size' member of trigger data
|
||||
|
||||
print( "Handling action '$action'\n" ) if ( VERBOSE );
|
||||
if ( $action =~ /^(on|off)(?:\+(\d+))?$/ )
|
||||
{
|
||||
my $trigger = $1;
|
||||
my $delay = $2;
|
||||
my $trigger_data;
|
||||
if ( defined($showtext) )
|
||||
{
|
||||
$trigger_data = pack( "llZ32Z256Z32", $trigger eq "on"?1:2, $trigger eq "on"?$score:0, $cause, $text, $showtext );
|
||||
}
|
||||
else
|
||||
{
|
||||
$trigger_data = pack( "llZ32Z256", $trigger eq "on"?1:2, $trigger eq "on"?$score:0, $cause, $text );
|
||||
}
|
||||
if ( !shmwrite( $monitor->{ShmId}, $trigger_data, $trigger_data_offset, length($trigger_data) ) )
|
||||
{
|
||||
print( "Can't write to shared memory: $!\n" );
|
||||
}
|
||||
print( "Triggered event $trigger '$cause'\n" );
|
||||
if ( $delay )
|
||||
{
|
||||
my $action_time = time()+$delay;
|
||||
my $action_text = $id."|cancel|0|".$cause."|".$text;
|
||||
my $action_array = $actions{$action_time};
|
||||
if ( !$action_array )
|
||||
{
|
||||
$action_array = $actions{$action_time} = [];
|
||||
}
|
||||
push( @$action_array, $action_text );
|
||||
print( "Added timed event '$action_text', expires at $action_time (+$delay secs)\n" ) if ( VERBOSE );
|
||||
}
|
||||
}
|
||||
elsif( $action eq "cancel" )
|
||||
{
|
||||
my $trigger_data;
|
||||
if ( defined($showtext) )
|
||||
{
|
||||
$trigger_data = pack( "llZ32Z256Z32", 0, 0, "", "", $showtext );
|
||||
}
|
||||
else
|
||||
{
|
||||
$trigger_data = pack( "llZ32Z256", 0, 0, "", "" );
|
||||
}
|
||||
if ( !shmwrite( $monitor->{ShmId}, $trigger_data, $trigger_data_offset, length($trigger_data) ) )
|
||||
{
|
||||
print( "Can't write to shared memory: $!\n" );
|
||||
}
|
||||
print( "Cancelled event '$cause'\n" );
|
||||
}
|
||||
elsif( $action eq "show" )
|
||||
{
|
||||
my $trigger_data = pack( "Z32", $showtext );
|
||||
if ( !shmwrite( $monitor->{ShmId}, $trigger_data, $trigger_data_offset, length($trigger_data) ) )
|
||||
{
|
||||
print( "Can't write to shared memory: $!\n" );
|
||||
}
|
||||
print( "Updated show text to '$showtext'\n" );
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Unrecognised action '$action' in message '$message'\n" );
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,543 @@
|
|||
#!/usr/bin/perl -w
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Update Script, $Date$, $Revision$
|
||||
# Copyright (C) 2003, 2004, 2005 Philip Coombes
|
||||
#
|
||||
# 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 just checks what the most recent release of ZoneMinder is
|
||||
# at the the moment. It will eventually be responsible for applying and
|
||||
# configuring upgrades etc, including on the fly upgrades.
|
||||
#
|
||||
use strict;
|
||||
use bytes;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# These are the elements you can edit to suit your installation
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use constant UPDATE_LOG_FILE => ZM_PATH_LOGS.'/zmupdate.log';
|
||||
use constant CHECK_INTERVAL => (1*24*60*60); # Interval between version checks
|
||||
use constant VERBOSE => 0; # Whether to output more verbose debug
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Don't change anything below here
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder;
|
||||
use POSIX;
|
||||
use DBI;
|
||||
use Getopt::Long;
|
||||
use Data::Dumper;
|
||||
|
||||
use constant EVENT_PATH => ZM_PATH_WEB.'/'.ZM_DIR_EVENTS;
|
||||
|
||||
$| = 1;
|
||||
|
||||
$ENV{PATH} = '/bin:/usr/bin';
|
||||
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
|
||||
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
|
||||
|
||||
my $check = 0;
|
||||
my $rename = 0;
|
||||
my $zone_fix = 0;
|
||||
my $version = '';
|
||||
my $db_user = ZM_DB_USER;
|
||||
my $db_pass = ZM_DB_PASS;
|
||||
sub Usage
|
||||
{
|
||||
print( "
|
||||
Usage: zmupdate.pl <-c,--check|-r,--rename|-z,--zone-fix|-v<version>,--version=<version> [-u<dbuser> -p<dbpass>]>
|
||||
Parameters are :-
|
||||
-c, --check - Check for updated versions of ZoneMinder
|
||||
-r, --rename - Rename images from old 'capture-nnn.jpg' format to new 'nnn-capture.jpg' style from v1.17.2
|
||||
-z, --zone-fix - Update zone percentage sizes from %ge of image to %ge of zone from 1.18.2 onwards
|
||||
-v<version>, --version=<version> - Upgrade to the current version from <version>
|
||||
-u<dbuser>, --user=<dbuser> - Alternate DB user with privileges to alter DB
|
||||
-p<dbpass>, --pass=<dbpass> - Password of alternate DB user with privileges to alter DB
|
||||
");
|
||||
exit( -1 );
|
||||
}
|
||||
|
||||
if ( !GetOptions( 'check'=>\$check, 'rename'=>\$rename, 'zone-fix'=>\$zone_fix, 'version=s'=>\$version, 'user:s'=>\$db_user, 'pass:s'=>\$db_pass ) )
|
||||
{
|
||||
Usage();
|
||||
}
|
||||
|
||||
if ( ! ($check || $rename || $zone_fix || $version) )
|
||||
{
|
||||
print( STDERR "Please give a valid option\n" );
|
||||
Usage();
|
||||
}
|
||||
|
||||
if ( ($check + $rename + $zone_fix + ($version?1:0)) > 1 )
|
||||
{
|
||||
print( STDERR "Please give only one option\n" );
|
||||
Usage();
|
||||
}
|
||||
|
||||
if ( $check )
|
||||
{
|
||||
open( LOG, '>>'.UPDATE_LOG_FILE ) or die( "Can't open log file: $!" );
|
||||
open( STDOUT, ">&LOG" ) || die( "Can't dup stdout: $!" );
|
||||
select( STDOUT ); $| = 1;
|
||||
open( STDERR, ">&LOG" ) || die( "Can't dup stderr: $!" );
|
||||
select( STDERR ); $| = 1;
|
||||
select( LOG ); $| = 1;
|
||||
}
|
||||
|
||||
print( "Update agent starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
||||
|
||||
if ( $check && ZM_CHECK_FOR_UPDATES )
|
||||
{
|
||||
my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_SERVER, ZM_DB_USER, ZM_DB_PASS );
|
||||
|
||||
my $curr_version = ZM_DYN_CURR_VERSION;
|
||||
my $last_version = ZM_DYN_LAST_VERSION;
|
||||
my $last_check = ZM_DYN_LAST_CHECK;
|
||||
|
||||
if ( !$curr_version )
|
||||
{
|
||||
$curr_version = ZM_VERSION;
|
||||
|
||||
my $sql = "update Config set Value = ? where Name = 'ZM_DYN_CURR_VERSION'";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute( $curr_version ) or die( "Can't execute: ".$sth->errstr() );
|
||||
}
|
||||
|
||||
$dbh->disconnect();
|
||||
while( 1 )
|
||||
{
|
||||
my $now = time();
|
||||
if ( !$last_version || !$last_check || (($now-$last_check) > CHECK_INTERVAL) )
|
||||
{
|
||||
print( "Checking for updates at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
||||
|
||||
use LWP::UserAgent;
|
||||
my $ua = LWP::UserAgent->new;
|
||||
$ua->agent( "ZoneMinder Update Agent/".ZM_VERSION );
|
||||
|
||||
my $req = HTTP::Request->new( GET=>'http://www.zoneminder.com/version' );
|
||||
my $res = $ua->request($req);
|
||||
|
||||
if ( $res->is_success )
|
||||
{
|
||||
$last_version = $res->content;
|
||||
chomp($last_version);
|
||||
$last_check = $now;
|
||||
|
||||
print( "Got version: '".$last_version."'\n" );
|
||||
|
||||
my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_SERVER, ZM_DB_USER, ZM_DB_PASS );
|
||||
|
||||
my $lv_sql = "update Config set Value = ? where Name = 'ZM_DYN_LAST_VERSION'";
|
||||
my $lv_sth = $dbh->prepare_cached( $lv_sql ) or die( "Can't prepare '$lv_sql': ".$dbh->errstr() );
|
||||
my $lv_res = $lv_sth->execute( $last_version ) or die( "Can't execute: ".$lv_sth->errstr() );
|
||||
|
||||
my $lc_sql = "update Config set Value = ? where Name = 'ZM_DYN_LAST_CHECK'";
|
||||
my $lc_sth = $dbh->prepare_cached( $lc_sql ) or die( "Can't prepare '$lc_sql': ".$dbh->errstr() );
|
||||
my $lc_res = $lc_sth->execute( $last_check ) or die( "Can't execute: ".$lc_sth->errstr() );
|
||||
|
||||
$dbh->disconnect();
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Error check failed: '".$res->status_line()."'\n" );
|
||||
}
|
||||
}
|
||||
sleep( 3600 );
|
||||
}
|
||||
}
|
||||
if ( $rename )
|
||||
{
|
||||
require File::Find;
|
||||
|
||||
chdir( EVENT_PATH );
|
||||
|
||||
sub renameImage
|
||||
{
|
||||
my $file = $_;
|
||||
|
||||
# Ignore directories
|
||||
if ( -d $file )
|
||||
{
|
||||
print( "Checking directory '$file'\n" );
|
||||
return;
|
||||
}
|
||||
if ( $file !~ /(capture|analyse)-(\d+)(\.jpg)/ )
|
||||
{
|
||||
return;
|
||||
}
|
||||
my $new_file = "$2-$1$3";
|
||||
|
||||
print( "Renaming '$file' to '$new_file'\n" );
|
||||
rename( $file, $new_file ) or warn( "Can't rename '$file' to '$new_file'" );
|
||||
}
|
||||
|
||||
File::Find::find( \&renameImage, '.' );
|
||||
}
|
||||
if ( $zone_fix )
|
||||
{
|
||||
require DBI;
|
||||
|
||||
my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_SERVER, ZM_DB_USER, ZM_DB_PASS );
|
||||
|
||||
my $sql = "select Z.*, M.Width as MonitorWidth, M.Height as MonitorHeight from Zones as Z inner join Monitors as M on Z.MonitorId = M.Id where Z.Units = 'Percent'";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute() or die( "Can't execute: ".$sth->errstr() );
|
||||
my @zones;
|
||||
while( my $zone = $sth->fetchrow_hashref() )
|
||||
{
|
||||
push( @zones, $zone );
|
||||
}
|
||||
$sth->finish();
|
||||
|
||||
foreach my $zone ( @zones )
|
||||
{
|
||||
my $zone_width = (($zone->{HiX}*$zone->{MonitorWidth})-($zone->{LoX}*$zone->{MonitorWidth}))/100;
|
||||
my $zone_height = (($zone->{HiY}*$zone->{MonitorHeight})-($zone->{LoY}*$zone->{MonitorHeight}))/100;
|
||||
my $zone_area = $zone_width * $zone_height;
|
||||
my $monitor_area = $zone->{MonitorWidth} * $zone->{MonitorHeight};
|
||||
my $sql = "update Zones set MinAlarmPixels = ?, MaxAlarmPixels = ?, MinFilterPixels = ?, MaxFilterPixels = ?, MinBlobPixels = ?, MaxBlobPixels = ? where Id = ?";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute(
|
||||
($zone->{MinAlarmPixels}*$monitor_area)/$zone_area,
|
||||
($zone->{MaxAlarmPixels}*$monitor_area)/$zone_area,
|
||||
($zone->{MinFilterPixels}*$monitor_area)/$zone_area,
|
||||
($zone->{MaxFilterPixels}*$monitor_area)/$zone_area,
|
||||
($zone->{MinBlobPixels}*$monitor_area)/$zone_area,
|
||||
($zone->{MaxBlobPixels}*$monitor_area)/$zone_area,
|
||||
$zone->{Id}
|
||||
) or die( "Can't execute: ".$sth->errstr() );
|
||||
}
|
||||
}
|
||||
if ( $version )
|
||||
{
|
||||
my ( $detaint_version ) = $version =~ /^([\w.]+)$/;
|
||||
$version = $detaint_version;
|
||||
|
||||
print( "\nInitiating database upgrade to version ".ZM_VERSION."\n" );
|
||||
print( "Please ensure that ZoneMinder is stopped on your system prior to upgrading the database.\nPress enter to continue or ctrl-C to stop : " );
|
||||
my $response = <STDIN>;
|
||||
|
||||
if ( 0 )
|
||||
{
|
||||
print( "\nDo you wish to take a backup of your database prior to upgrading?\nThis may result in a large file if you have a lot of events.\nPress 'y' for a backup or 'n' to continue : " );
|
||||
|
||||
$response = <STDIN>;
|
||||
chomp( $response );
|
||||
while ( $response !~ /^[yYnN]$/ )
|
||||
{
|
||||
print( "Please press 'y' for a backup or 'n' to continue only : " );
|
||||
$response = <STDIN>;
|
||||
chomp( $response );
|
||||
}
|
||||
|
||||
if ( $response =~ /^[yY]$/ )
|
||||
{
|
||||
my $command = "mysqldump -h".ZM_DB_SERVER;
|
||||
if ( $db_user )
|
||||
{
|
||||
$command .= " -u".$db_user;
|
||||
if ( $db_pass )
|
||||
{
|
||||
$command .= " -p".$db_pass;
|
||||
}
|
||||
}
|
||||
my $backup = ZM_DB_NAME."-".$version.".dump";
|
||||
$command .= " --add-drop-table --databases ".ZM_DB_NAME." > ".$backup;
|
||||
print( "Creating backup to $backup. This may take several minutes.\n" );
|
||||
print( "Executing '$command'\n" ) if ( VERBOSE );
|
||||
my $output = qx($command);
|
||||
my $status = $? >> 8;
|
||||
if ( $status || VERBOSE )
|
||||
{
|
||||
chomp( $output );
|
||||
print( "Output: $output\n" );
|
||||
}
|
||||
if ( $status )
|
||||
{
|
||||
die( "Command '$command' exited with status: $status\n" );
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Database successfully backed up to $backup, proceeding to upgrade.\n" );
|
||||
}
|
||||
}
|
||||
elsif ( $response !~ /^[nN]$/ )
|
||||
{
|
||||
die( "Unexpected response '$response'" );
|
||||
}
|
||||
}
|
||||
|
||||
sub patchDB
|
||||
{
|
||||
my $dbh = shift;
|
||||
my $version = shift;
|
||||
|
||||
my $command = "mysql -h".ZM_DB_SERVER;
|
||||
if ( $db_user )
|
||||
{
|
||||
$command .= " -u".$db_user;
|
||||
if ( $db_pass )
|
||||
{
|
||||
$command .= " -p".$db_pass;
|
||||
}
|
||||
}
|
||||
$command .= " ".ZM_DB_NAME." < ".ZM_PATH_BUILD."/db/zmalter-".$version.".sql";
|
||||
|
||||
print( "Executing '$command'\n" ) if ( VERBOSE );
|
||||
my $output = qx($command);
|
||||
my $status = $? >> 8;
|
||||
if ( $status || VERBOSE )
|
||||
{
|
||||
chomp( $output );
|
||||
print( "Output: $output\n" );
|
||||
}
|
||||
if ( $status )
|
||||
{
|
||||
die( "Command '$command' exited with status: $status\n" );
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "\nDatabase successfully upgraded to version $version.\n" );
|
||||
my $sql = "update Config set Value = ? where Name = 'ZM_DYN_DB_VERSION'";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute( $version ) or die( "Can't execute: ".$sth->errstr() );
|
||||
}
|
||||
}
|
||||
|
||||
if ( ZM_DYN_DB_VERSION && ZM_DYN_DB_VERSION ne $version )
|
||||
{
|
||||
# Nothing yet
|
||||
}
|
||||
|
||||
print( "\nUpgrading database to version ".ZM_VERSION."\n" );
|
||||
|
||||
my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_SERVER, ZM_DB_USER, ZM_DB_PASS );
|
||||
|
||||
my $cascade = undef;
|
||||
if ( $cascade || $version eq "1.19.0" )
|
||||
{
|
||||
# Patch the database
|
||||
patchDB( $dbh, "1.19.0" );
|
||||
$cascade = !undef;
|
||||
}
|
||||
if ( $cascade || $version eq "1.19.1" )
|
||||
{
|
||||
# Patch the database
|
||||
patchDB( $dbh, "1.19.1");
|
||||
$cascade = !undef;
|
||||
}
|
||||
if ( $cascade || $version eq "1.19.2" )
|
||||
{
|
||||
# Patch the database
|
||||
patchDB( $dbh, "1.19.2" );
|
||||
$cascade = !undef;
|
||||
}
|
||||
if ( $cascade || $version eq "1.19.3" )
|
||||
{
|
||||
# Patch the database
|
||||
patchDB( $dbh, "1.19.3" );
|
||||
$cascade = !undef;
|
||||
}
|
||||
if ( $cascade || $version eq "1.19.4" )
|
||||
{
|
||||
require DBI;
|
||||
|
||||
# Rename the event directories and create a new symlink for the names
|
||||
chdir( EVENT_PATH );
|
||||
|
||||
my $sql = "select * from Monitors order by Id";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute() or die( "Can't execute: ".$sth->errstr() );
|
||||
while( my $monitor = $sth->fetchrow_hashref() )
|
||||
{
|
||||
if ( -d $monitor->{Name} )
|
||||
{
|
||||
rename( $monitor->{Name}, $monitor->{Id} ) or warn( "Can't rename existing monitor directory '$monitor->{Name}' to '$monitor->{Id}': $!" );
|
||||
symlink( $monitor->{Id}, $monitor->{Name} ) or warn( "Can't symlink monitor directory '$monitor->{Id}' to '$monitor->{Name}': $!" );
|
||||
}
|
||||
}
|
||||
$sth->finish();
|
||||
|
||||
# Patch the database
|
||||
patchDB( $dbh, "1.19.4" );
|
||||
|
||||
$cascade = !undef;
|
||||
}
|
||||
if ( $cascade || $version eq "1.19.5" )
|
||||
{
|
||||
print( "\nThis version now only uses one database user.\nPlease ensure you have run zmconfig.pl and re-entered your database username and password prior to upgrading, or the upgrade will fail.\nPress enter to continue or ctrl-C to stop : " );
|
||||
# Patch the database
|
||||
my $dummy = <STDIN>;
|
||||
patchDB( $dbh, "1.19.5" );
|
||||
$cascade = !undef;
|
||||
}
|
||||
if ( $cascade || $version eq "1.20.0" )
|
||||
{
|
||||
# Patch the database
|
||||
patchDB( $dbh, "1.20.0" );
|
||||
$cascade = !undef;
|
||||
}
|
||||
if ( $cascade || $version eq "1.20.1" )
|
||||
{
|
||||
# Patch the database
|
||||
patchDB( $dbh, "1.20.1" );
|
||||
$cascade = !undef;
|
||||
}
|
||||
if ( $cascade || $version eq "1.21.0" )
|
||||
{
|
||||
# Patch the database
|
||||
patchDB( $dbh, "1.21.0" );
|
||||
$cascade = !undef;
|
||||
}
|
||||
if ( $cascade || $version eq "1.21.1" )
|
||||
{
|
||||
# Patch the database
|
||||
patchDB( $dbh, "1.21.1" );
|
||||
$cascade = !undef;
|
||||
}
|
||||
if ( $cascade || $version eq "1.21.2" )
|
||||
{
|
||||
# Patch the database
|
||||
patchDB( $dbh, "1.21.2" );
|
||||
$cascade = !undef;
|
||||
}
|
||||
if ( $cascade || $version eq "1.21.3" )
|
||||
{
|
||||
# Patch the database
|
||||
patchDB( $dbh, "1.21.3" );
|
||||
|
||||
# Add appropriate widths and heights to events
|
||||
{
|
||||
print( "Updating events. This may take a few minutes. Please wait.\n" );
|
||||
my $sql = "select * from Monitors order by Id";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute() or die( "Can't execute: ".$sth->errstr() );
|
||||
while( my $monitor = $sth->fetchrow_hashref() )
|
||||
{
|
||||
my $sql = "update Events set Width = ?, Height = ? where MonitorId = ?";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute( $monitor->{Width}, $monitor->{Height}, $monitor->{Id} ) or die( "Can't execute: ".$sth->errstr() );
|
||||
}
|
||||
$sth->finish();
|
||||
}
|
||||
|
||||
# Add sequence numbers
|
||||
{
|
||||
print( "Updating monitor sequences. Please wait.\n" );
|
||||
my $sql = "select * from Monitors order by Id";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute() or die( "Can't execute: ".$sth->errstr() );
|
||||
my $sequence = 1;
|
||||
while( my $monitor = $sth->fetchrow_hashref() )
|
||||
{
|
||||
my $sql = "update Monitors set Sequence = ? where Id = ?";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute( $sequence++, $monitor->{Id} ) or die( "Can't execute: ".$sth->errstr() );
|
||||
}
|
||||
$sth->finish();
|
||||
}
|
||||
|
||||
# Update saved filters
|
||||
{
|
||||
print( "Updating saved filters. Please wait.\n" );
|
||||
my $sql = "select * from Filters";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute() or die( "Can't execute: ".$sth->errstr() );
|
||||
my @filters;
|
||||
while( my $filter = $sth->fetchrow_hashref() )
|
||||
{
|
||||
push( @filters, $filter );
|
||||
}
|
||||
$sth->finish();
|
||||
$sql = "update Filters set Query = ? where Name = ?";
|
||||
$sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
foreach my $filter ( @filters )
|
||||
{
|
||||
if ( $filter->{Query} =~ /op\d=&/ )
|
||||
{
|
||||
( my $new_query = $filter->{Query} ) =~ s/(op\d=)&/$1=&/g;
|
||||
$res = $sth->execute( $new_query, $filter->{Name} ) or die( "Can't execute: ".$sth->errstr() );
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
$cascade = !undef;
|
||||
}
|
||||
if ( $cascade || $version eq "1.21.4" )
|
||||
{
|
||||
# Patch the database
|
||||
patchDB( $dbh, "1.21.4" );
|
||||
|
||||
# Convert zones to new format
|
||||
{
|
||||
print( "Updating zones. Please wait.\n" );
|
||||
|
||||
# Get the existing zones from the DB
|
||||
my $sql = "select Z.*,M.Width,M.Height from Zones as Z inner join Monitors as M on (Z.MonitorId = M.Id)";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute() or die( "Can't execute: ".$sth->errstr() );
|
||||
my @zones;
|
||||
while( my $zone = $sth->fetchrow_hashref() )
|
||||
{
|
||||
push( @zones, $zone );
|
||||
}
|
||||
$sth->finish();
|
||||
|
||||
no strict 'refs';
|
||||
foreach my $zone ( @zones )
|
||||
{
|
||||
# Create the coordinate strings
|
||||
if ( $zone->{Units} eq "Pixels" )
|
||||
{
|
||||
my $sql = "update Zones set NumCoords = 4, Coords = concat( LoX,',',LoY,' ',HiX,',',LoY,' ',HiX,',',HiY,' ',LoX,',',HiY ), Area = round( ((HiX-LoX)+1)*((HiY-LoY)+1) ) where Id = ?";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute( $zone->{Id} ) or die( "Can't execute: ".$sth->errstr() );
|
||||
}
|
||||
else
|
||||
{
|
||||
my $lo_x = ($zone->{LoX} * ($zone->{Width}-1) ) / 100;
|
||||
my $hi_x = ($zone->{HiX} * ($zone->{Width}-1) ) / 100;
|
||||
my $lo_y = ($zone->{LoY} * ($zone->{Height}-1) ) / 100;
|
||||
my $hi_y = ($zone->{HiY} * ($zone->{Height}-1) ) / 100;
|
||||
my $area = (($hi_x-$lo_x)+1)*(($hi_y-$lo_y)+1);
|
||||
my $sql = "update Zones set NumCoords = 4, Coords = concat( round(?),',',round(?),' ',round(?),',',round(?),' ',round(?),',',round(?),' ',round(?),',',round(?) ), Area = round(?), MinAlarmPixels = round(?), MaxAlarmPixels = round(?), MinFilterPixels = round(?), MaxFilterPixels = round(?), MinBlobPixels = round(?), MaxBlobPixels = round(?) where Id = ?";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute( $lo_x, $lo_y, $hi_x, $lo_y, $hi_x, $hi_y, $lo_x, $hi_y, $area, ($zone->{MinAlarmPixels}*$area)/100, ($zone->{MaxAlarmPixels}*$area)/100, ($zone->{MinFilterPixels}*$area)/100, ($zone->{MaxFilterPixels}*$area)/100, ($zone->{MinBlobPixels}*$area)/100, ($zone->{MaxBlobPixels}*$area)/100, $zone->{Id} ) or die( "Can't execute: ".$sth->errstr() );
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
$cascade = !undef;
|
||||
}
|
||||
if ( !$cascade )
|
||||
{
|
||||
die( "Can't find upgrade from version '$version'" );
|
||||
}
|
||||
$dbh->disconnect();
|
||||
print( "\nDatabase upgrade to version ".ZM_VERSION." successful.\n" );
|
||||
}
|
||||
print( "Update agent exiting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
||||
exit();
|
||||
|
|
@ -0,0 +1,345 @@
|
|||
#!/usr/bin/perl -wT
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Video Creation Script, $Date$, $Revision$
|
||||
# Copyright (C) 2003, 2004, 2005 Philip Coombes
|
||||
#
|
||||
# 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 is used to create MPEG videos of events for the web pages
|
||||
# or as email attachments.
|
||||
#
|
||||
use strict;
|
||||
use bytes;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# These are the elements you can edit to suit your installation
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use constant LOG_FILE => ZM_PATH_LOGS.'/zmvideo.log';
|
||||
use constant VERBOSE => 0; # Whether to output more verbose debug
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# You shouldn't need to change anything from here downwards
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder;
|
||||
use DBI;
|
||||
use Data::Dumper;
|
||||
use Getopt::Long qw(:config no_ignore_case );
|
||||
|
||||
$| = 1;
|
||||
|
||||
$ENV{PATH} = '/bin:/usr/bin';
|
||||
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
|
||||
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
|
||||
|
||||
my $event_id;
|
||||
my $format = 'mpg';
|
||||
my $rate = '';
|
||||
my $scale = '';
|
||||
my $fps = '';
|
||||
my $size = '';
|
||||
my $overwrite = 0;
|
||||
|
||||
my @formats = split( '/\s+/', ZM_FFMPEG_FORMATS );
|
||||
for ( my $i = 0; $i < @formats; $i++ )
|
||||
{
|
||||
if ( $i =~ /^(.+)\*$/ )
|
||||
{
|
||||
$format = $formats[$i] = $1;
|
||||
}
|
||||
}
|
||||
|
||||
sub Usage
|
||||
{
|
||||
print( "
|
||||
Usage: zmvideo.pl -e <event_id>,--event=<event_id> [--format <format>] [--rate=<rate>] [--scale=<scale>] [--fps=<fps>] [--size=<size>] [--overwrite]
|
||||
Parameters are :-
|
||||
-e<event_id>, --event=<event_id> - What event to create the video for
|
||||
-f<format>, --format=<format> - What format to create the video in, default is mpg. For ffmpeg only.
|
||||
-r<rate>, --rate=<rate> - Relative rate , 1 = realtime, 2 = double speed , 0.5 = half speed etc
|
||||
-s<scale>, --scale=<scale> - Scale, 1 = normal, 2 = double size, 0.5 = half size etc
|
||||
-F<fps>, --fps=<fps> - Absolute frame rate, in frames per second
|
||||
-S<size>, --size=<size> - Absolute video size, WxH or other specification supported by ffmpeg
|
||||
-o, --overwrite - Whether to overwrite an existing file, off by default.
|
||||
");
|
||||
exit( -1 );
|
||||
}
|
||||
|
||||
if ( !GetOptions( 'event=i'=>\$event_id, 'format|f=s'=>\$format, 'rate|r=f'=>\$rate, 'scale|s=f'=>\$scale, 'fps|F=f'=>\$fps, 'size|S=s'=>\$size, 'overwrite'=>\$overwrite ) )
|
||||
{
|
||||
Usage();
|
||||
}
|
||||
|
||||
if ( !$event_id || $event_id < 0 )
|
||||
{
|
||||
print( STDERR "Please give a valid event id\n" );
|
||||
Usage();
|
||||
}
|
||||
|
||||
if ( ZM_OPT_MPEG eq "no" )
|
||||
{
|
||||
print( STDERR "Mpeg encoding is not currently enabled\n" );
|
||||
exit(-1);
|
||||
}
|
||||
|
||||
if ( ZM_OPT_MPEG eq "mpeg_encode" && $rate != 1.0 )
|
||||
{
|
||||
print( STDERR "Variable rate not supported with mpeg_encode\n" );
|
||||
exit(-1);
|
||||
}
|
||||
|
||||
if ( $format ne 'mpg' && ZM_OPT_MPEG eq "mpeg_encode" )
|
||||
{
|
||||
print( STDERR "Format not supported for mpeg_encode\n" );
|
||||
Usage();
|
||||
}
|
||||
|
||||
if ( !$rate && !$fps )
|
||||
{
|
||||
$rate = 1;
|
||||
}
|
||||
|
||||
if ( !$scale && !$size )
|
||||
{
|
||||
$scale = 1;
|
||||
}
|
||||
|
||||
if ( $rate && ($rate < 0.25 || $rate > 100) )
|
||||
{
|
||||
print( STDERR "Rate is out of range, 0.25 >= rate <= 100\n" );
|
||||
Usage();
|
||||
}
|
||||
|
||||
if ( $scale && ($scale < 0.25 || $scale > 4) )
|
||||
{
|
||||
print( STDERR "Scale is out of range, 0.25 >= scale <= 4\n" );
|
||||
Usage();
|
||||
}
|
||||
|
||||
if ( $fps && ($fps > 30) )
|
||||
{
|
||||
print( STDERR "FPS is out of range, <= 30\n" );
|
||||
Usage();
|
||||
}
|
||||
|
||||
my ( $detaint_format ) = $format =~ /^(\w+)$/;
|
||||
my ( $detaint_rate ) = $rate =~ /^(-?\d+(?:\.\d+)?)$/;
|
||||
my ( $detaint_scale ) = $scale =~ /^(-?\d+(?:\.\d+)?)$/;
|
||||
my ( $detaint_fps ) = $fps =~ /^(-?\d+(?:\.\d+)?)$/;
|
||||
my ( $detaint_size ) = $size =~ /^(\w+)$/;
|
||||
|
||||
$format = $detaint_format;
|
||||
$rate = $detaint_rate;
|
||||
$scale = $detaint_scale;
|
||||
$fps = $detaint_fps;
|
||||
$size = $detaint_size;
|
||||
|
||||
my $log_file = LOG_FILE;
|
||||
open( LOG, ">>$log_file" ) or die( "Can't open log file: $!" );
|
||||
#open( STDOUT, ">&LOG" ) || die( "Can't dup stdout: $!" );
|
||||
#select( STDOUT ); $| = 1;
|
||||
open( STDERR, ">&LOG" ) || die( "Can't dup stderr: $!" );
|
||||
select( STDERR ); $| = 1;
|
||||
select( LOG ); $| = 1;
|
||||
|
||||
my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_SERVER, ZM_DB_USER, ZM_DB_PASS );
|
||||
|
||||
my @filters;
|
||||
my $sql = "select max(F.Delta)-min(F.Delta) as FullLength, E.*, M.Name as MonitorName, M.Width as MonitorWidth, M.Height as MonitorHeight, M.Palette from Frames as F inner join Events as E on F.EventId = E.Id inner join Monitors as M on E.MonitorId = M.Id where EventId = '$event_id' group by F.EventId";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute() or die( "Can't execute: ".$sth->errstr() );
|
||||
my $event = $sth->fetchrow_hashref();
|
||||
$sth->finish();
|
||||
chdir( ZM_PATH_WEB.'/'.ZM_DIR_EVENTS.'/'.$event->{MonitorId}.'/'.$event->{Id} );
|
||||
( my $video_name = $event->{Name} ) =~ s/\s/_/g;
|
||||
|
||||
my @file_parts;
|
||||
if ( $rate )
|
||||
{
|
||||
my $file_rate = $rate;
|
||||
$file_rate =~ s/\./_/;
|
||||
$file_rate =~ s/_00//;
|
||||
$file_rate =~ s/(_\d+)0+$/$1/;
|
||||
$file_rate = 'r'.$file_rate;
|
||||
push( @file_parts, $file_rate );
|
||||
}
|
||||
elsif ( $fps )
|
||||
{
|
||||
my $file_fps = $fps;
|
||||
$file_fps =~ s/\./_/;
|
||||
$file_fps =~ s/_00//;
|
||||
$file_fps =~ s/(_\d+)0+$/$1/;
|
||||
$file_fps = 'R'.$file_fps;
|
||||
push( @file_parts, $file_fps );
|
||||
}
|
||||
|
||||
if ( $scale )
|
||||
{
|
||||
my $file_scale = $scale;
|
||||
$file_scale =~ s/\./_/;
|
||||
$file_scale =~ s/_00//;
|
||||
$file_scale =~ s/(_\d+)0+$/$1/;
|
||||
$file_scale = 's'.$file_scale;
|
||||
push( @file_parts, $file_scale );
|
||||
}
|
||||
elsif ( $size )
|
||||
{
|
||||
my $file_size = 'S'.$size;
|
||||
push( @file_parts, $file_size );
|
||||
}
|
||||
my $video_file = "$video_name-".$file_parts[0]."-".$file_parts[1].".$format";
|
||||
|
||||
if ( $overwrite || !-s $video_file )
|
||||
{
|
||||
print( LOG "Creating video file $video_file for event $event->{Id}\n" );
|
||||
|
||||
if ( ZM_OPT_MPEG eq "mpeg_encode" )
|
||||
{
|
||||
my $param_file = "$video_name.mpe";
|
||||
open( PARAMS, ">$param_file" ) or die( "Can't open '$param_file': $!" );
|
||||
|
||||
print( PARAMS "PATTERN IBBPBBPBBPBBPBB\n" );
|
||||
print( PARAMS "FORCE_ENCODE_LAST_FRAME\n" );
|
||||
print( PARAMS "OUTPUT $video_file\n" );
|
||||
|
||||
print( PARAMS "BASE_FILE_FORMAT JPEG\n" );
|
||||
print( PARAMS "GOP_SIZE 30\n" );
|
||||
print( PARAMS "SLICES_PER_FRAME 1\n" );
|
||||
|
||||
print( PARAMS "PIXEL HALF\n" );
|
||||
print( PARAMS "RANGE 10\n" );
|
||||
print( PARAMS "PSEARCH_ALG LOGARITHMIC\n" );
|
||||
print( PARAMS "BSEARCH_ALG CROSS2\n" );
|
||||
print( PARAMS "IQSCALE 8\n" );
|
||||
print( PARAMS "PQSCALE 10\n" );
|
||||
print( PARAMS "BQSCALE 25\n" );
|
||||
|
||||
print( PARAMS "REFERENCE_FRAME ORIGINAL\n" );
|
||||
print( PARAMS "FRAME_RATE 24\n" );
|
||||
|
||||
my $scale_conversion = "";
|
||||
if ( $scale != 1 )
|
||||
{
|
||||
if ( $scale > 1 )
|
||||
{
|
||||
$scale_conversion = ZM_PATH_NETPBM."/pnmscale $scale";
|
||||
}
|
||||
else
|
||||
{
|
||||
$scale_conversion = ZM_PATH_NETPBM."/pnmscale ".(1/$scale);
|
||||
}
|
||||
if ( $event->{Palette} == 1 && !ZM_COLOUR_JPEG_FILES )
|
||||
{
|
||||
print( PARAMS "INPUT_CONVERT ".ZM_PATH_NETPBM."/jpegtopnm * | ".$scale_conversion." | ".ZM_PATH_NETPBM."/pgmtoppm white | ".ZM_PATH_NETPBM."/ppmtojpeg\n" );
|
||||
}
|
||||
else
|
||||
{
|
||||
print( PARAMS "INPUT_CONVERT ".ZM_PATH_NETPBM."/jpegtopnm * | ".$scale_conversion." | ".ZM_PATH_NETPBM."/ppmtojpeg\n" );
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
if ( $event->{Palette} == 1 && !ZM_COLOUR_JPEG_FILES )
|
||||
{
|
||||
print( PARAMS "INPUT_CONVERT ".ZM_PATH_NETPBM."/jpegtopnm * | ".ZM_PATH_NETPBM."/pgmtoppm white | ".ZM_PATH_NETPBM."/ppmtojpeg\n" );
|
||||
}
|
||||
else
|
||||
{
|
||||
print( PARAMS "INPUT_CONVERT *\n" );
|
||||
}
|
||||
}
|
||||
print( PARAMS "INPUT_DIR .\n" );
|
||||
|
||||
print( PARAMS "INPUT\n" );
|
||||
for ( my $i = 1; $i <= $event->{Frames}; $i++ )
|
||||
{
|
||||
printf( PARAMS "%0".ZM_EVENT_IMAGE_DIGITS."d-capture.jpg\n", $i );
|
||||
}
|
||||
print( PARAMS "END_INPUT\n" );
|
||||
close( PARAMS );
|
||||
|
||||
my $command = ZM_PATH_MPEG_ENCODE." $param_file >mpeg_encode.log";
|
||||
print( LOG $command."\n" );
|
||||
my $output = qx($command);
|
||||
print( LOG $output."\n" );
|
||||
}
|
||||
elsif ( ZM_OPT_MPEG eq "ffmpeg" )
|
||||
{
|
||||
my $frame_rate = sprintf( "%.2f", $event->{Frames}/$event->{FullLength} );
|
||||
if ( $rate )
|
||||
{
|
||||
if ( $rate != 1.0 )
|
||||
{
|
||||
$frame_rate *= $rate;
|
||||
}
|
||||
}
|
||||
elsif ( $fps )
|
||||
{
|
||||
$frame_rate = $fps;
|
||||
}
|
||||
|
||||
my $width = $event->{MonitorWidth};
|
||||
my $height = $event->{MonitorHeight};
|
||||
my $video_size = " ${width}x${height}";
|
||||
|
||||
if ( $scale )
|
||||
{
|
||||
if ( $scale != 1.0 )
|
||||
{
|
||||
$width = int($width*$scale);
|
||||
$height = int($height*$scale);
|
||||
$video_size = " ${width}x${height}";
|
||||
}
|
||||
}
|
||||
elsif ( $size )
|
||||
{
|
||||
$video_size = $size;
|
||||
}
|
||||
|
||||
|
||||
my $command = ZM_PATH_FFMPEG." -y -r $frame_rate ".ZM_FFMPEG_INPUT_OPTIONS." -i %0".ZM_EVENT_IMAGE_DIGITS."d-capture.jpg -s $video_size ".ZM_FFMPEG_OUTPUT_OPTIONS." $video_file > ffmpeg.log";
|
||||
print( LOG $command."\n" );
|
||||
my $output = qx($command);
|
||||
print( LOG $output."\n" );
|
||||
}
|
||||
else
|
||||
{
|
||||
die( "Bogus mpeg option ".ZM_OPT_MPEG."\n" );
|
||||
}
|
||||
|
||||
my $status = $? >> 8;
|
||||
if ( $status )
|
||||
{
|
||||
die( "Error: $status" );
|
||||
}
|
||||
|
||||
print( LOG "Finished $video_file\n" );
|
||||
}
|
||||
else
|
||||
{
|
||||
print( LOG "Video file $video_file already exists for event $event->{Id}\n" );
|
||||
}
|
||||
#print( STDOUT $event->{MonitorId}.'/'.$event->{Id}.'/'.$video_file."\n" );
|
||||
print( STDOUT $video_file."\n" );
|
||||
exit( 0 );
|
||||
|
|
@ -0,0 +1,143 @@
|
|||
#!/usr/bin/perl -wT
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder WatchDog Script, $Date$, $Revision$
|
||||
# Copyright (C) 2003, 2004, 2005 Philip Coombes
|
||||
#
|
||||
# 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 does some basic setup for ZoneMinder to run and then periodically
|
||||
# checks the fps output of the active daemons to check they haven't
|
||||
# locked up. If they have then they are killed and restarted
|
||||
#
|
||||
use strict;
|
||||
use bytes;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# These are the elements you can edit to suit your installation
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use constant WATCH_LOG_FILE => ZM_PATH_LOGS.'/zmwatch.log';
|
||||
use constant START_DELAY => 30; # To give everything else time to start
|
||||
use constant VERBOSE => 0; # Whether to output more verbose debug
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Don't change anything below here
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder;
|
||||
use POSIX;
|
||||
use DBI;
|
||||
use Data::Dumper;
|
||||
|
||||
$| = 1;
|
||||
|
||||
$ENV{PATH} = '/bin:/usr/bin';
|
||||
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
|
||||
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
|
||||
|
||||
sub Usage
|
||||
{
|
||||
print( "
|
||||
Usage: zmwatch.pl
|
||||
");
|
||||
exit( -1 );
|
||||
}
|
||||
|
||||
open( LOG, '>>'.WATCH_LOG_FILE ) or die( "Can't open log file: $!" );
|
||||
open( STDOUT, ">&LOG" ) || die( "Can't dup stdout: $!" );
|
||||
select( STDOUT ); $| = 1;
|
||||
open( STDERR, ">&LOG" ) || die( "Can't dup stderr: $!" );
|
||||
select( STDERR ); $| = 1;
|
||||
select( LOG ); $| = 1;
|
||||
print( "Watchdog starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
||||
print( "Watchdog pausing for ".START_DELAY." seconds\n" );
|
||||
sleep( START_DELAY );
|
||||
|
||||
my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_SERVER, ZM_DB_USER, ZM_DB_PASS );
|
||||
|
||||
my $sql = "select * from Monitors";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
|
||||
while( 1 )
|
||||
{
|
||||
my $now = time();
|
||||
my $res = $sth->execute() or die( "Can't execute: ".$sth->errstr() );
|
||||
my $shm_size = 24; # We only need the first 24 bytes really for the last event time
|
||||
while( my $monitor = $sth->fetchrow_hashref() )
|
||||
{
|
||||
if ( $monitor->{Function} ne 'None' )
|
||||
{
|
||||
# Check we have got an image recently
|
||||
$monitor->{ShmKey} = hex(ZM_SHM_KEY)|$monitor->{Id};
|
||||
$monitor->{ShmId} = shmget( $monitor->{ShmKey}, $shm_size, 0 );
|
||||
if ( !defined($monitor->{ShmId}) )
|
||||
{
|
||||
print( "Can't get shared memory id '$monitor->{ShmKey}': $!\n" );
|
||||
next;
|
||||
}
|
||||
my $image_time;
|
||||
if ( !shmread( $monitor->{ShmId}, $image_time, 20, 4 ) )
|
||||
{
|
||||
print( "Can't read from shared memory '$monitor->{ShmKey}/$monitor->{ShmId}': $!\n" );
|
||||
next;
|
||||
}
|
||||
$image_time = unpack( "l", $image_time );
|
||||
|
||||
#my $command = ZM_PATH_BIN."/zmu -m ".$monitor->{Id}." -t";
|
||||
#print( "Getting last image time for monitor $monitor->{Id} ('$command')\n" ) if ( VERBOSE );
|
||||
#my $image_time = qx( $command );
|
||||
#chomp($image_time);
|
||||
|
||||
if ( !$image_time )
|
||||
{
|
||||
# We can't get the last capture time so can't be sure it's died.
|
||||
next;
|
||||
}
|
||||
|
||||
my $max_image_delay = (($monitor->{MaxFPS}>0)&&($monitor->{MaxFPS}<1))?(3/$monitor->{MaxFPS}):ZM_WATCH_MAX_DELAY;
|
||||
my $image_delay = $now-$image_time;
|
||||
print( "Monitor $monitor->{Id} last captured $image_delay seconds ago, max is $max_image_delay\n" ) if ( VERBOSE );
|
||||
if ( $image_delay <= $max_image_delay )
|
||||
{
|
||||
# Yes, so continue
|
||||
next;
|
||||
}
|
||||
|
||||
my $command;
|
||||
# If we are here then something bad has happened
|
||||
if ( $monitor->{Type} eq 'Local' )
|
||||
{
|
||||
$command = ZM_PATH_BIN."/zmdc.pl restart zmc -d $monitor->{Device}";
|
||||
}
|
||||
else
|
||||
{
|
||||
$command = ZM_PATH_BIN."/zmdc.pl restart zmc -m $monitor->{Id}";
|
||||
}
|
||||
print( "Restarting capture daemon ('$command'), time since last capture $image_delay seconds ($now-$image_time)\n" );
|
||||
print( qx( $command ) );
|
||||
}
|
||||
}
|
||||
sleep( ZM_WATCH_CHECK_INTERVAL );
|
||||
}
|
||||
print( "Watchdog exiting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
||||
exit();
|
||||
|
|
@ -0,0 +1,684 @@
|
|||
#!/usr/bin/perl -wT
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder X10 Control Script, $Date$, $Revision$
|
||||
# Copyright (C) 2003, 2004, 2005 Philip Coombes
|
||||
#
|
||||
# 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 controls the monitoring of the X10 interface and the consequent
|
||||
# management of the ZM daemons based on the receipt of X10 signals.
|
||||
#
|
||||
use strict;
|
||||
use bytes;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# These are the elements you can edit to suit your installation
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use constant X10_SOCK_FILE => ZM_PATH_SOCKS.'/zmx10.sock';
|
||||
use constant X10_LOG_FILE => ZM_PATH_LOGS.'/zmx10.log';
|
||||
use constant VERBOSE => 0; # Whether to output more verbose debug
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Don't change anything below here
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder;
|
||||
use POSIX;
|
||||
use Socket;
|
||||
use Getopt::Long;
|
||||
use Data::Dumper;
|
||||
|
||||
$| = 1;
|
||||
|
||||
$ENV{PATH} = '/bin:/usr/bin';
|
||||
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
|
||||
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
|
||||
|
||||
sub Usage
|
||||
{
|
||||
print( "
|
||||
Usage: zmx10.pl -c <command>,--command=<command> [-u <unit code>,--unit-code=<unit code>]
|
||||
Parameters are :-
|
||||
-c <command>, --command=<command> - Command to issue, one of 'on','off','dim','bright','status','shutdown'
|
||||
-u <unit code>, --unit-code=<unit code> - Unit code to act on required for all commands except 'status' (optional) and 'shutdown'
|
||||
");
|
||||
exit( -1 );
|
||||
}
|
||||
|
||||
my $command;
|
||||
my $unit_code;
|
||||
|
||||
if ( !GetOptions( 'command=s'=>\$command, 'unit-code=i'=>\$unit_code ) )
|
||||
{
|
||||
Usage();
|
||||
}
|
||||
|
||||
die( "No command given" ) unless( $command );
|
||||
die( "No unit code given" ) unless( $unit_code || ($command =~ /(?:start|status|shutdown)/) );
|
||||
|
||||
if ( $command eq "start" )
|
||||
{
|
||||
X10Server::runServer();
|
||||
exit();
|
||||
}
|
||||
|
||||
socket( CLIENT, PF_UNIX, SOCK_STREAM, 0 ) or die( "Can't open socket: $!" );
|
||||
|
||||
my $saddr = sockaddr_un( X10_SOCK_FILE );
|
||||
|
||||
if ( !connect( CLIENT, $saddr ) )
|
||||
{
|
||||
# The server isn't there
|
||||
print( "Unable to connect, starting server\n" );
|
||||
close( CLIENT );
|
||||
|
||||
if ( my $cpid = fork() )
|
||||
{
|
||||
# Parent process just sleep and fall through
|
||||
sleep( 2 );
|
||||
socket( CLIENT, PF_UNIX, SOCK_STREAM, 0 ) or die( "Can't open socket: $!" );
|
||||
connect( CLIENT, $saddr ) or die( "Can't connect: $!" );
|
||||
}
|
||||
elsif ( defined($cpid) )
|
||||
{
|
||||
setpgrp();
|
||||
|
||||
X10Server::runServer();
|
||||
}
|
||||
else
|
||||
{
|
||||
die( "Can't fork: $!" );
|
||||
}
|
||||
}
|
||||
# The server is there, connect to it
|
||||
#print( "Writing commands\n" );
|
||||
CLIENT->autoflush();
|
||||
my $message = "$command";
|
||||
$message .= ";$unit_code" if ( $unit_code );
|
||||
print( CLIENT $message );
|
||||
shutdown( CLIENT, 1 );
|
||||
while ( my $line = <CLIENT> )
|
||||
{
|
||||
chomp( $line );
|
||||
print( "$line\n" );
|
||||
}
|
||||
close( CLIENT );
|
||||
#print( "Finished writing, bye\n" );
|
||||
exit;
|
||||
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This is the X10 Server package
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
package X10Server;
|
||||
|
||||
use strict;
|
||||
use bytes;
|
||||
|
||||
use POSIX;
|
||||
use DBI;
|
||||
use Socket;
|
||||
use X10::ActiveHome;
|
||||
use Data::Dumper;
|
||||
|
||||
our $dbh;
|
||||
our $x10;
|
||||
|
||||
our %monitor_hash;
|
||||
our %device_hash;
|
||||
our %pending_tasks;
|
||||
|
||||
sub runServer
|
||||
{
|
||||
my $log_file = main::X10_LOG_FILE;
|
||||
open( LOG, ">>$log_file" ) or die( "Can't open log file: $!" );
|
||||
open( STDOUT, ">&LOG" ) || die( "Can't dup stdout: $!" );
|
||||
select( STDOUT ); $| = 1;
|
||||
open( STDERR, ">&LOG" ) || die( "Can't dup stderr: $!" );
|
||||
select( STDERR ); $| = 1;
|
||||
select( LOG ); $| = 1;
|
||||
|
||||
print( "X10 server starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
||||
|
||||
socket( SERVER, PF_UNIX, SOCK_STREAM, 0 ) or die( "Can't open socket: $!" );
|
||||
unlink( main::X10_SOCK_FILE );
|
||||
my $saddr = sockaddr_un( main::X10_SOCK_FILE );
|
||||
bind( SERVER, $saddr ) or die( "Can't bind: $!" );
|
||||
listen( SERVER, SOMAXCONN ) or die( "Can't listen: $!" );
|
||||
|
||||
$dbh = DBI->connect( "DBI:mysql:database=".main::ZM_DB_NAME.";host=".main::ZM_DB_SERVER, main::ZM_DB_USER, main::ZM_DB_PASS );
|
||||
|
||||
$x10 = new X10::ActiveHome( port=>main::ZM_X10_DEVICE, house_code=>main::ZM_X10_HOUSE_CODE, debug=>1 );
|
||||
|
||||
loadTasks();
|
||||
|
||||
$x10->register_listener( \&x10listen );
|
||||
|
||||
my $rin = '';
|
||||
vec( $rin, fileno(SERVER),1) = 1;
|
||||
vec( $rin, $x10->select_fds(),1) = 1;
|
||||
my $timeout = 0.2;
|
||||
#print( "F:".fileno(SERVER)."\n" );
|
||||
my $reload = undef;
|
||||
my $reload_count = 0;
|
||||
my $reload_limit = (main::ZM_X10_DB_RELOAD_INTERVAL)/$timeout;
|
||||
while( 1 )
|
||||
{
|
||||
my $nfound = select( my $rout = $rin, undef, undef, $timeout );
|
||||
#print( "Off select, NF:$nfound, ER:$!\n" );
|
||||
#print( vec( $rout, fileno(SERVER),1)."\n" );
|
||||
#print( vec( $rout, $x10->select_fds(),1)."\n" );
|
||||
if ( $nfound > 0 )
|
||||
{
|
||||
if ( vec( $rout, fileno(SERVER),1) )
|
||||
{
|
||||
my $paddr = accept( CLIENT, SERVER );
|
||||
my $message = <CLIENT>;
|
||||
|
||||
my ( $command, $unit_code ) = split( ';', $message );
|
||||
|
||||
my $device;
|
||||
if ( defined($unit_code) )
|
||||
{
|
||||
if ( $unit_code < 1 || $unit_code > 16 )
|
||||
{
|
||||
dprint( "Error, invalid unit code '$unit_code'\n" );
|
||||
next;
|
||||
}
|
||||
|
||||
$device = $device_hash{$unit_code};
|
||||
if ( !$device )
|
||||
{
|
||||
$device = $device_hash{$unit_code} = { appliance=>$x10->Appliance( unit_code=>$unit_code ), status=>'unknown' };
|
||||
}
|
||||
}
|
||||
|
||||
my $result;
|
||||
if ( $command eq 'on' )
|
||||
{
|
||||
$result = $device->{appliance}->on();
|
||||
}
|
||||
elsif ( $command eq 'off' )
|
||||
{
|
||||
$result = $device->{appliance}->off();
|
||||
}
|
||||
#elsif ( $command eq 'dim' )
|
||||
#{
|
||||
#$result = $device->{appliance}->dim();
|
||||
#}
|
||||
#elsif ( $command eq 'bright' )
|
||||
#{
|
||||
#$result = $device->{appliance}->bright();
|
||||
#}
|
||||
elsif ( $command eq 'status' )
|
||||
{
|
||||
if ( $device )
|
||||
{
|
||||
dprint( $unit_code." ".$device->{status}."\n" );
|
||||
}
|
||||
else
|
||||
{
|
||||
foreach my $unit_code ( sort( keys(%device_hash) ) )
|
||||
{
|
||||
my $device = $device_hash{$unit_code};
|
||||
dprint( $unit_code." ".$device->{status}."\n" );
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif ( $command eq 'shutdown' )
|
||||
{
|
||||
last;
|
||||
}
|
||||
else
|
||||
{
|
||||
dprint( "Error, invalid command '$command'\n" );
|
||||
}
|
||||
if ( defined($result) )
|
||||
{
|
||||
if ( 1 || $result )
|
||||
{
|
||||
$device->{status} = uc($command);
|
||||
dprint( $device->{appliance}->address()." $command, ok\n" );
|
||||
#x10listen( new X10::Event( sprintf("%s %s", $device->{appliance}->address, uc($command) ) ) );
|
||||
}
|
||||
else
|
||||
{
|
||||
dprint( $device->{appliance}->address()." $command, failed\n" );
|
||||
}
|
||||
}
|
||||
close( CLIENT );
|
||||
}
|
||||
elsif ( vec( $rout, $x10->select_fds(),1) )
|
||||
{
|
||||
$x10->handle_input();
|
||||
}
|
||||
else
|
||||
{
|
||||
die( "Bogus descriptor" );
|
||||
}
|
||||
}
|
||||
elsif ( $nfound < 0 )
|
||||
{
|
||||
die( "Can't select: $!" );
|
||||
}
|
||||
else
|
||||
{
|
||||
#print( "Select timed out\n" );
|
||||
# Check for state changes
|
||||
foreach my $monitor_id ( sort(keys(%monitor_hash) ) )
|
||||
{
|
||||
my $monitor = $monitor_hash{$monitor_id};
|
||||
my $state;
|
||||
if ( !shmread( $monitor->{ShmId}, $state, 8, 4 ) )
|
||||
{
|
||||
print( "Can't read from shared memory: $!\n" );
|
||||
$reload = !undef;
|
||||
next;
|
||||
}
|
||||
$state = unpack( "l", $state );
|
||||
if ( defined( $monitor->{LastState} ) )
|
||||
{
|
||||
my $task_list;
|
||||
if ( $state == 2 && $monitor->{LastState} == 0 ) # Gone into alarm state
|
||||
{
|
||||
print( "Applying ON_list for $monitor_id\n" ) if ( main::VERBOSE );
|
||||
$task_list = $monitor->{"ON_list"};
|
||||
}
|
||||
elsif ( $state == 0 && $monitor->{LastState} > 0 ) # Come out of alarm state
|
||||
{
|
||||
print( "Applying OFF_list for $monitor_id\n" ) if ( main::VERBOSE );
|
||||
$task_list = $monitor->{"OFF_list"};
|
||||
}
|
||||
if ( $task_list )
|
||||
{
|
||||
foreach my $task ( @$task_list )
|
||||
{
|
||||
processTask( $task );
|
||||
}
|
||||
}
|
||||
}
|
||||
$monitor->{LastState} = $state;
|
||||
}
|
||||
|
||||
# Check for pending tasks
|
||||
my $now = time();
|
||||
foreach my $activation_time ( sort(keys(%pending_tasks) ) )
|
||||
{
|
||||
last if ( $activation_time > $now );
|
||||
my $pending_list = $pending_tasks{$activation_time};
|
||||
foreach my $task ( @$pending_list )
|
||||
{
|
||||
processTask( $task );
|
||||
}
|
||||
delete( $pending_tasks{$activation_time} );
|
||||
}
|
||||
if ( $reload || ++$reload_count >= $reload_limit )
|
||||
{
|
||||
loadTasks();
|
||||
$reload = undef;
|
||||
$reload_count = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
print( "X10 server exiting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
||||
close( LOG );
|
||||
close( SERVER );
|
||||
exit();
|
||||
}
|
||||
|
||||
sub addToDeviceList
|
||||
{
|
||||
my $unit_code = shift;
|
||||
my $event = shift;
|
||||
my $monitor = shift;
|
||||
my $function = shift;
|
||||
my $limit = shift;
|
||||
|
||||
print( "Adding to device list, uc:$unit_code, ev:$event, mo:$monitor, fu:$function, li:$limit\n" ) if ( main::VERBOSE );
|
||||
my $device = $device_hash{$unit_code};
|
||||
if ( !$device )
|
||||
{
|
||||
$device = $device_hash{$unit_code} = { appliance=>$x10->Appliance( unit_code=>$unit_code ), status=>'unknown' };
|
||||
}
|
||||
|
||||
my $task = { type=>"device", monitor=>$monitor, function=>$function };
|
||||
if ( $limit )
|
||||
{
|
||||
$task->{limit} = $limit
|
||||
}
|
||||
|
||||
my $task_list = $device->{$event."_list"};
|
||||
if ( !$task_list )
|
||||
{
|
||||
$task_list = $device->{$event."_list"} = [];
|
||||
}
|
||||
push( @$task_list, $task );
|
||||
}
|
||||
|
||||
sub addToMonitorList
|
||||
{
|
||||
my $monitor = shift;
|
||||
my $event = shift;
|
||||
my $unit_code = shift;
|
||||
my $function = shift;
|
||||
my $limit = shift;
|
||||
|
||||
print( "Adding to monitor list, uc:$unit_code, ev:$event, mo:$monitor, fu:$function, li:$limit\n" ) if ( main::VERBOSE );
|
||||
my $device = $device_hash{$unit_code};
|
||||
if ( !$device )
|
||||
{
|
||||
$device = $device_hash{$unit_code} = { appliance=>$x10->Appliance( unit_code=>$unit_code ), status=>'unknown' };
|
||||
}
|
||||
|
||||
my $task = { type=>"monitor", device=>$device, function=>$function };
|
||||
if ( $limit )
|
||||
{
|
||||
$task->{limit} = $limit;
|
||||
}
|
||||
|
||||
my $task_list = $monitor->{$event."_list"};
|
||||
if ( !$task_list )
|
||||
{
|
||||
$task_list = $monitor->{$event."_list"} = [];
|
||||
}
|
||||
push( @$task_list, $task );
|
||||
}
|
||||
|
||||
sub loadTasks
|
||||
{
|
||||
%monitor_hash = ();
|
||||
|
||||
print( "Loading tasks\n" ) if ( main::VERBOSE );
|
||||
# Clear out all old device task lists
|
||||
foreach my $unit_code ( sort( keys(%device_hash) ) )
|
||||
{
|
||||
my $device = $device_hash{$unit_code};
|
||||
$device->{ON_list} = [];
|
||||
$device->{OFF_list} = [];
|
||||
}
|
||||
|
||||
my $sql = "select M.*,T.* from Monitors as M inner join TriggersX10 as T on (M.Id = T.MonitorId) where find_in_set( M.Function, 'Modect,Record,Mocord' ) and M.RunMode = 'Triggered' and find_in_set( 'X10', M.Triggers )";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute() or die( "Can't execute: ".$sth->errstr() );
|
||||
while( my $monitor = $sth->fetchrow_hashref() )
|
||||
{
|
||||
my $size = 512; # We only need the first 512 bytes really for the alarm state and forced alarm
|
||||
$monitor->{ShmKey} = hex(main::ZM_SHM_KEY)|$monitor->{Id};
|
||||
$monitor->{ShmId} = shmget( $monitor->{ShmKey}, $size, 0 );
|
||||
if ( !defined($monitor->{ShmId}) )
|
||||
{
|
||||
print( "Can't get shared memory id '$monitor->{ShmKey}': $!\n" );
|
||||
next;
|
||||
}
|
||||
|
||||
$monitor_hash{$monitor->{Id}} = $monitor;
|
||||
|
||||
if ( $monitor->{Activation} )
|
||||
{
|
||||
print( "$monitor->{Name} has active string '$monitor->{Activation}'\n" ) if ( main::VERBOSE );
|
||||
foreach my $code_string ( split( ',', $monitor->{Activation} ) )
|
||||
{
|
||||
#print( "Code string: $code_string\n" );
|
||||
my ( $invert, $unit_code, $modifier, $limit ) = ( $code_string =~ /^([!~])?(\d+)(?:([+-])(\d+)?)?$/ );
|
||||
$limit = 0 if ( !$limit );
|
||||
if ( $unit_code )
|
||||
{
|
||||
if ( !$modifier || $modifier eq '+' )
|
||||
{
|
||||
addToDeviceList( $unit_code, "ON", $monitor, !$invert?"start_active":"stop_active", $limit );
|
||||
}
|
||||
if ( !$modifier || $modifier eq '-' )
|
||||
{
|
||||
addToDeviceList( $unit_code, "OFF", $monitor, !$invert?"stop_active":"start_active", $limit );
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if ( $monitor->{AlarmInput} )
|
||||
{
|
||||
print( "$monitor->{Name} has alarm input string '$monitor->{AlarmInput}'\n" ) if ( main::VERBOSE );
|
||||
foreach my $code_string ( split( ',', $monitor->{AlarmInput} ) )
|
||||
{
|
||||
#print( "Code string: $code_string\n" );
|
||||
my ( $invert, $unit_code, $modifier, $limit ) = ( $code_string =~ /^([!~])?(\d+)(?:([+-])(\d+)?)?$/ );
|
||||
$limit = 0 if ( !$limit );
|
||||
if ( $unit_code )
|
||||
{
|
||||
if ( !$modifier || $modifier eq '+' )
|
||||
{
|
||||
addToDeviceList( $unit_code, "ON", $monitor, !$invert?"start_alarm":"stop_alarm", $limit );
|
||||
}
|
||||
if ( !$modifier || $modifier eq '-' )
|
||||
{
|
||||
addToDeviceList( $unit_code, "OFF", $monitor, !$invert?"stop_alarm":"start_alarm", $limit );
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if ( $monitor->{AlarmOutput} )
|
||||
{
|
||||
print( "$monitor->{Name} has alarm output string '$monitor->{AlarmOutput}'\n" ) if ( main::VERBOSE );
|
||||
foreach my $code_string ( split( ',', $monitor->{AlarmOutput} ) )
|
||||
{
|
||||
#print( "Code string: $code_string\n" );
|
||||
my ( $invert, $unit_code, $modifier, $limit ) = ( $code_string =~ /^([!~])?(\d+)(?:([+-])(\d+)?)?$/ );
|
||||
$limit = 0 if ( !$limit );
|
||||
if ( $unit_code )
|
||||
{
|
||||
if ( !$modifier || $modifier eq '+' )
|
||||
{
|
||||
addToMonitorList( $monitor, "ON", $unit_code, !$invert?"on":"off", $limit );
|
||||
}
|
||||
if ( !$modifier || $modifier eq '-' )
|
||||
{
|
||||
addToMonitorList( $monitor, "OFF", $unit_code, !$invert?"off":"on", $limit );
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub addPendingTask
|
||||
{
|
||||
my $task = shift;
|
||||
|
||||
# Check whether we are just extending a previous pending task
|
||||
# and remove it if it's there
|
||||
foreach my $activation_time ( sort(keys(%pending_tasks) ) )
|
||||
{
|
||||
my $pending_list = $pending_tasks{$activation_time};
|
||||
my $new_pending_list = [];
|
||||
foreach my $pending_task ( @$pending_list )
|
||||
{
|
||||
if ( $task->{type} ne $pending_task->{type} )
|
||||
{
|
||||
push( @$new_pending_list, $pending_task )
|
||||
}
|
||||
elsif ( $task->{type} eq "device" )
|
||||
{
|
||||
if (( $task->{monitor}->{Id} != $pending_task->{monitor}->{Id} )
|
||||
|| ( $task->{function} ne $pending_task->{function} ))
|
||||
{
|
||||
push( @$new_pending_list, $pending_task )
|
||||
}
|
||||
}
|
||||
elsif ( $task->{type} eq "monitor" )
|
||||
{
|
||||
if (( $task->{device}->{appliance}->unit_code() != $pending_task->{device}->{appliance}->unit_code() )
|
||||
|| ( $task->{function} ne $pending_task->{function} ))
|
||||
{
|
||||
push( @$new_pending_list, $pending_task )
|
||||
}
|
||||
}
|
||||
}
|
||||
if ( @$new_pending_list )
|
||||
{
|
||||
$pending_tasks{$activation_time} = $new_pending_list;
|
||||
}
|
||||
else
|
||||
{
|
||||
delete( $pending_tasks{$activation_time} );
|
||||
}
|
||||
}
|
||||
|
||||
my $end_time = time() + $task->{limit};
|
||||
my $pending_list = $pending_tasks{$end_time};
|
||||
if ( !$pending_list )
|
||||
{
|
||||
$pending_list = $pending_tasks{$end_time} = [];
|
||||
}
|
||||
my $pending_task;
|
||||
if ( $task->{type} eq "device" )
|
||||
{
|
||||
$pending_task = { type=>$task->{type}, monitor=>$task->{monitor}, function=>$task->{function} };
|
||||
$pending_task->{function} =~ s/start/stop/;
|
||||
}
|
||||
elsif ( $task->{type} eq "monitor" )
|
||||
{
|
||||
$pending_task = { type=>$task->{type}, device=>$task->{device}, function=>$task->{function} };
|
||||
$pending_task->{function} =~ s/on/off/;
|
||||
}
|
||||
push( @$pending_list, $pending_task );
|
||||
}
|
||||
|
||||
sub processTask
|
||||
{
|
||||
my $task = shift;
|
||||
|
||||
if ( $task->{type} eq "device" )
|
||||
{
|
||||
my ( $instruction, $class ) = ( $task->{function} =~ /^(.+)_(.+)$/ );
|
||||
|
||||
my @commands;
|
||||
if ( $class eq "active" )
|
||||
{
|
||||
if ( $instruction eq "start" )
|
||||
{
|
||||
push( @commands, main::ZM_PATH_BIN."/zmdc.pl start zma -m ".$task->{monitor}->{Id} );
|
||||
push( @commands, main::ZM_PATH_BIN."/zmdc.pl start zmf -m ".$task->{monitor}->{Id} );
|
||||
if ( main::ZM_OPT_FRAME_SERVER )
|
||||
{
|
||||
}
|
||||
if ( $task->{limit} )
|
||||
{
|
||||
addPendingTask( $task );
|
||||
}
|
||||
}
|
||||
elsif( $instruction eq "stop" )
|
||||
{
|
||||
$command = main::ZM_PATH_BIN."/zmdc.pl stop zma -m ".$task->{monitor}->{Id};
|
||||
push( @commands, main::ZM_PATH_BIN."/zmdc.pl stop zma -m ".$task->{monitor}->{Id} );
|
||||
push( @commands, main::ZM_PATH_BIN."/zmdc.pl stop zmf -m ".$task->{monitor}->{Id} );
|
||||
}
|
||||
}
|
||||
elsif( $class eq "alarm" )
|
||||
{
|
||||
if ( $instruction eq "start" )
|
||||
{
|
||||
#$command = main::ZM_PATH_BIN."/zmu --monitor ".$task->{monitor}->{Id}." --alarm";
|
||||
my $force_data = pack( "llZ*", 1, 0, "X10" );
|
||||
if ( !shmwrite( $task->{monitor}->{ShmId}, $force_data, 52, 12 ) )
|
||||
{
|
||||
print( "Can't write to shared memory: $!\n" );
|
||||
}
|
||||
if ( $task->{limit} )
|
||||
{
|
||||
addPendingTask( $task );
|
||||
}
|
||||
}
|
||||
elsif( $instruction eq "stop" )
|
||||
{
|
||||
#$command = main::ZM_PATH_BIN."/zmu --monitor ".$task->{monitor}->{Id}." --cancel";
|
||||
my $force_data = pack( "llZ*", 0, 0, "" );
|
||||
if ( !shmwrite( $task->{monitor}->{ShmId}, $force_data, 52, 12 ) )
|
||||
{
|
||||
print( "Can't write to shared memory: $!\n" );
|
||||
}
|
||||
}
|
||||
}
|
||||
foreach my $command ( @commands )
|
||||
{
|
||||
print( "Executing command '$command'\n" );
|
||||
qx( $command );
|
||||
}
|
||||
}
|
||||
elsif( $task->{type} eq "monitor" )
|
||||
{
|
||||
if ( $task->{function} eq "on" )
|
||||
{
|
||||
$task->{device}->{appliance}->on();
|
||||
if ( $task->{limit} )
|
||||
{
|
||||
addPendingTask( $task );
|
||||
}
|
||||
}
|
||||
elsif ( $task->{function} eq "off" )
|
||||
{
|
||||
$task->{device}->{appliance}->off();
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub dprint
|
||||
{
|
||||
if ( fileno(CLIENT) )
|
||||
{
|
||||
print CLIENT @_
|
||||
}
|
||||
print @_;
|
||||
}
|
||||
|
||||
sub x10listen
|
||||
{
|
||||
foreach my $event ( @_ )
|
||||
{
|
||||
#print( Data::Dumper( $_ )."\n" );
|
||||
if ( $event->house_code() eq main::ZM_X10_HOUSE_CODE )
|
||||
{
|
||||
my $unit_code = $event->unit_code();
|
||||
my $device = $device_hash{$unit_code};
|
||||
if ( !$device )
|
||||
{
|
||||
$device = $device_hash{$unit_code} = { appliance=>$x10->Appliance( unit_code=>$unit_code ), status=>'unknown' };
|
||||
}
|
||||
next if ( $event->func() !~ /(?:ON|OFF)/ );
|
||||
$device->{status} = $event->func();
|
||||
my $task_list = $device->{$event->func()."_list"};
|
||||
if ( $task_list )
|
||||
{
|
||||
foreach my $task ( @$task_list )
|
||||
{
|
||||
processTask( $task );
|
||||
}
|
||||
}
|
||||
}
|
||||
print( strftime( "%y/%m/%d %H:%M:%S", localtime() )." - ".$event->as_string()."\n" );
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -27,50 +27,14 @@
|
|||
use strict;
|
||||
use bytes;
|
||||
|
||||
use ZoneMinder;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# These are the elements you need to edit to suit your installation
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use constant ZM_CONFIG => "<from zmconfig>";
|
||||
use constant ZM_PATH_BIN => "<from zmconfig>";
|
||||
|
||||
# Load the config from the database into the symbol table
|
||||
BEGIN
|
||||
{
|
||||
no strict 'refs';
|
||||
|
||||
open( CONFIG, "<".ZM_CONFIG ) or die( "Can't open config file: $!" );
|
||||
foreach my $str ( <CONFIG> )
|
||||
{
|
||||
next if ( $str =~ /^\s*$/ );
|
||||
next if ( $str =~ /^\s*#/ );
|
||||
my ( $name, $value ) = $str =~ /^\s*([^=\\s]+)\s*=\s*(\S+)\s*$/;
|
||||
$name =~ tr/a-z/A-Z/;
|
||||
if (( $name eq 'ZM_DB_SERVER' ) ||
|
||||
( $name eq 'ZM_DB_NAME' ) ||
|
||||
( $name eq 'ZM_DB_USER' ) ||
|
||||
( $name eq 'ZM_DB_PASS' ))
|
||||
{
|
||||
*{$name} = sub { $value };
|
||||
}
|
||||
}
|
||||
close( CONFIG );
|
||||
|
||||
use DBI;
|
||||
my $dbh = DBI->connect( "DBI:mysql:database=".&ZM_DB_NAME.";host=".&ZM_DB_SERVER, &ZM_DB_USER, &ZM_DB_PASS );
|
||||
my $sql = "select * from Config";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute() or die( "Can't execute: ".$sth->errstr() );
|
||||
while( my $config = $sth->fetchrow_hashref() )
|
||||
{
|
||||
*{$config->{Name}} = sub { $config->{Value} };
|
||||
}
|
||||
$sth->finish();
|
||||
$dbh->disconnect();
|
||||
}
|
||||
|
||||
use constant X10_SOCK_FILE => ZM_PATH_SOCKS.'/zmx10.sock';
|
||||
use constant X10_LOG_FILE => ZM_PATH_LOGS.'/zmx10.log';
|
||||
use constant VERBOSE => 0; # Whether to output more verbose debug
|
||||
|
|
@ -395,7 +359,7 @@ sub addToDeviceList
|
|||
my $function = shift;
|
||||
my $limit = shift;
|
||||
|
||||
print( "Adding to device list, uc:$unit_code, ev:$event, mo:$monitor, fu:$function, li:$limit\n" ) if ( main::VERBOSE );
|
||||
print( "Adding to device list, uc:$unit_code, ev:$event, mo:".$monitor->{Id}.", fu:$function, li:$limit\n" ) if ( main::VERBOSE );
|
||||
my $device = $device_hash{$unit_code};
|
||||
if ( !$device )
|
||||
{
|
||||
|
|
@ -424,7 +388,7 @@ sub addToMonitorList
|
|||
my $function = shift;
|
||||
my $limit = shift;
|
||||
|
||||
print( "Adding to monitor list, uc:$unit_code, ev:$event, mo:$monitor, fu:$function, li:$limit\n" ) if ( main::VERBOSE );
|
||||
print( "Adding to monitor list, uc:$unit_code, ev:$event, mo:".$monitor->{Id}.", fu:$function, li:$limit\n" ) if ( main::VERBOSE );
|
||||
my $device = $device_hash{$unit_code};
|
||||
if ( !$device )
|
||||
{
|
||||
|
|
|
|||
Loading…
Reference in New Issue