Merge branch 'fix_braces' into storageareas
This commit is contained in:
Isaac Connor
commit
911256785e
|
|
@ -69,13 +69,11 @@ use constant ZM_CONFIG => "@ZM_CONFIG@"; # Path to the ZoneMinder config file
|
|||
use Carp;
|
||||
|
||||
# Load the config from the database into the symbol table
|
||||
BEGIN
|
||||
{
|
||||
BEGIN {
|
||||
my $config_file = ZM_CONFIG;
|
||||
open( my $CONFIG, "<", $config_file )
|
||||
or croak( "Can't open config file '$config_file': $!" );
|
||||
foreach my $str ( <$CONFIG> )
|
||||
{
|
||||
foreach my $str ( <$CONFIG> ) {
|
||||
next if ( $str =~ /^\s*$/ );
|
||||
next if ( $str =~ /^\s*#/ );
|
||||
my ( $name, $value ) = $str =~ /^\s*([^=\s]+)\s*=\s*(.*?)\s*$/;
|
||||
|
|
@ -92,19 +90,13 @@ BEGIN
|
|||
my $socket;
|
||||
my ( $host, $portOrSocket ) = ( $Config{ZM_DB_HOST} =~ /^([^:]+)(?::(.+))?$/ );
|
||||
|
||||
if ( defined($portOrSocket) )
|
||||
{
|
||||
if ( $portOrSocket =~ /^\// )
|
||||
{
|
||||
if ( defined($portOrSocket) ) {
|
||||
if ( $portOrSocket =~ /^\// ) {
|
||||
$socket = ";mysql_socket=".$portOrSocket;
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
$socket = ";host=".$host.";port=".$portOrSocket;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
$socket = ";host=".$Config{ZM_DB_HOST};
|
||||
}
|
||||
my $dbh = DBI->connect( "DBI:mysql:database=".$Config{ZM_DB_NAME}
|
||||
|
|
@ -134,7 +126,7 @@ BEGIN
|
|||
}
|
||||
$sth->finish();
|
||||
}
|
||||
}
|
||||
} # end BEGIN
|
||||
|
||||
sub loadConfigFromDB {
|
||||
print( "Loading config from DB\n" );
|
||||
|
|
@ -169,13 +161,12 @@ sub loadConfigFromDB {
|
|||
}
|
||||
$sth->finish();
|
||||
return( $option_count );
|
||||
}
|
||||
} # end sub loadConfigFromDB
|
||||
|
||||
sub saveConfigToDB {
|
||||
print( "Saving config to DB\n" );
|
||||
my $dbh = ZoneMinder::Database::zmDbConnect();
|
||||
if ( !$dbh )
|
||||
{
|
||||
if ( !$dbh ) {
|
||||
print( "Error: unable to save options to database: $DBI::errstr\n" );
|
||||
return( 0 );
|
||||
}
|
||||
|
|
@ -193,41 +184,27 @@ sub saveConfigToDB {
|
|||
$sql = "replace into Config set Id = ?, Name = ?, Value = ?, Type = ?, DefaultValue = ?, Hint = ?, Pattern = ?, Format = ?, Prompt = ?, Help = ?, Category = ?, Readonly = ?, Requires = ?";
|
||||
my $sth = $dbh->prepare_cached( $sql )
|
||||
or croak( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
foreach my $option ( @options )
|
||||
{
|
||||
foreach my $option ( @options ) {
|
||||
#next if ( $option->{category} eq 'hidden' );
|
||||
#print( $option->{name}."\n" ) if ( !$option->{category} );
|
||||
$option->{db_type} = $option->{type}->{db_type};
|
||||
$option->{db_hint} = $option->{type}->{hint};
|
||||
$option->{db_pattern} = $option->{type}->{pattern};
|
||||
$option->{db_format} = $option->{type}->{format};
|
||||
if ( $option->{db_type} eq "boolean" )
|
||||
{
|
||||
$option->{db_value} = ($option->{value} eq "yes")
|
||||
? "1"
|
||||
: "0"
|
||||
;
|
||||
}
|
||||
else
|
||||
{
|
||||
if ( $option->{db_type} eq "boolean" ) {
|
||||
$option->{db_value} = ($option->{value} eq "yes") ? "1" : "0";
|
||||
} else {
|
||||
$option->{db_value} = $option->{value};
|
||||
}
|
||||
if ( my $requires = $option->{requires} )
|
||||
{
|
||||
if ( my $requires = $option->{requires} ) {
|
||||
$option->{db_requires} = join( ";",
|
||||
map {
|
||||
my $value = $_->{value};
|
||||
$value = ($value eq "yes")
|
||||
? 1
|
||||
: 0
|
||||
if ( $options_hash{$_->{name}}->{db_type} eq "boolean" )
|
||||
; ( "$_->{name}=$value" )
|
||||
my $value = $_->{value};
|
||||
$value = ($value eq "yes") ? 1 : 0 if ( $options_hash{$_->{name}}->{db_type} eq "boolean" );
|
||||
( "$_->{name}=$value" )
|
||||
} @$requires
|
||||
);
|
||||
}
|
||||
else
|
||||
{
|
||||
}
|
||||
my $res = $sth->execute(
|
||||
$option->{id},
|
||||
$option->{name},
|
||||
|
|
@ -243,12 +220,12 @@ sub saveConfigToDB {
|
|||
$option->{readonly} ? 1 : 0,
|
||||
$option->{db_requires}
|
||||
) or croak( "Can't execute: ".$sth->errstr() );
|
||||
}
|
||||
} # end foreach option
|
||||
$sth->finish();
|
||||
|
||||
$dbh->do('UNLOCK TABLES');
|
||||
$dbh->{AutoCommit} = $ac;
|
||||
}
|
||||
} # end sub saveConfigToDB
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
|
|
|||
|
|
@ -65,14 +65,12 @@ use Carp;
|
|||
|
||||
our $configInitialised = 0;
|
||||
|
||||
sub INIT
|
||||
{
|
||||
sub INIT {
|
||||
initialiseConfig();
|
||||
}
|
||||
|
||||
# Types
|
||||
our %types =
|
||||
(
|
||||
our %types = (
|
||||
string => {
|
||||
db_type => "string",
|
||||
hint => "string",
|
||||
|
|
@ -270,7 +268,7 @@ our @options = (
|
|||
db_type => "string",
|
||||
hint => "hashed|plain|none",
|
||||
pattern => qr|^([hpn])|i,
|
||||
format => q( ($1 =~ /^h/) ? "hashed" : ($1 =~ /^p/ ? "plain" : "none" ))
|
||||
format => q( ($1 =~ /^h/) ? "hashed" : ($1 =~ /^p/ ? "plain" : "none" ) )
|
||||
},
|
||||
category => "system",
|
||||
},
|
||||
|
|
@ -3897,21 +3895,16 @@ our %options_hash = map { ( $_->{name}, $_ ) } @options;
|
|||
|
||||
# This function should never need to be called explicitly, except if
|
||||
# this module is 'require'd rather than 'use'd. See zmconfgen.pl.
|
||||
sub initialiseConfig
|
||||
{
|
||||
sub initialiseConfig {
|
||||
return if ( $configInitialised );
|
||||
|
||||
# Do some initial data munging to finish the data structures
|
||||
# Create option ids
|
||||
my $option_id = 0;
|
||||
foreach my $option ( @options )
|
||||
{
|
||||
if ( defined($option->{default}) )
|
||||
{
|
||||
foreach my $option ( @options ) {
|
||||
if ( defined($option->{default}) ) {
|
||||
$option->{value} = $option->{default}
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
$option->{value} = '';
|
||||
}
|
||||
#next if ( $option->{category} eq 'hidden' );
|
||||
|
|
|
|||
|
|
@ -43,14 +43,12 @@ use ZoneMinder::Database qw(:all);
|
|||
|
||||
our $AUTOLOAD;
|
||||
|
||||
sub new
|
||||
{
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = {};
|
||||
$self->{name} = "PelcoD";
|
||||
if ( !defined($id) )
|
||||
{
|
||||
if ( !defined($id) ) {
|
||||
Fatal( "No monitor defined when invoking protocol ".$self->{name} );
|
||||
}
|
||||
$self->{id} = $id;
|
||||
|
|
@ -58,12 +56,10 @@ sub new
|
|||
return $self;
|
||||
}
|
||||
|
||||
sub DESTROY
|
||||
{
|
||||
sub DESTROY {
|
||||
}
|
||||
|
||||
sub AUTOLOAD
|
||||
{
|
||||
sub AUTOLOAD {
|
||||
my $self = shift;
|
||||
my $class = ref($self) || croak( "$self not object" );
|
||||
my $name = $AUTOLOAD;
|
||||
|
|
@ -75,61 +71,49 @@ sub AUTOLOAD
|
|||
croak( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub getKey
|
||||
{
|
||||
sub getKey {
|
||||
my $self = shift;
|
||||
return( $self->{id} );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
sub open {
|
||||
my $self = shift;
|
||||
Fatal( "No open method defined for protocol ".$self->{name} );
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
sub close {
|
||||
my $self = shift;
|
||||
Fatal( "No close method defined for protocol ".$self->{name} );
|
||||
}
|
||||
|
||||
sub loadMonitor
|
||||
{
|
||||
sub loadMonitor {
|
||||
my $self = shift;
|
||||
if ( !$self->{Monitor} )
|
||||
{
|
||||
if ( !($self->{Monitor} = zmDbGetMonitor( $self->{id} )) )
|
||||
{
|
||||
if ( !$self->{Monitor} ) {
|
||||
if ( !($self->{Monitor} = zmDbGetMonitor( $self->{id} )) ) {
|
||||
Fatal( "Monitor id ".$self->{id}." not found or not controllable" );
|
||||
}
|
||||
if ( defined($self->{Monitor}->{AutoStopTimeout}) )
|
||||
{
|
||||
if ( defined($self->{Monitor}->{AutoStopTimeout}) ) {
|
||||
# Convert to microseconds.
|
||||
$self->{Monitor}->{AutoStopTimeout} = int(1000000*$self->{Monitor}->{AutoStopTimeout});
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub getParam
|
||||
{
|
||||
sub getParam {
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $name = shift;
|
||||
my $default = shift;
|
||||
|
||||
if ( defined($params->{$name}) )
|
||||
{
|
||||
if ( defined($params->{$name}) ) {
|
||||
return( $params->{$name} );
|
||||
}
|
||||
elsif ( defined($default) )
|
||||
{
|
||||
} elsif ( defined($default) ) {
|
||||
return( $default );
|
||||
}
|
||||
Fatal( "Missing mandatory parameter '$name'" );
|
||||
}
|
||||
|
||||
sub executeCommand
|
||||
{
|
||||
sub executeCommand {
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
|
||||
|
|
@ -145,8 +129,7 @@ sub executeCommand
|
|||
&{$self->{$command}}( $self, $params );
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
sub printMsg {
|
||||
my $self = shift;
|
||||
Fatal( "No printMsg method defined for protocol ".$self->{name} );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -77,13 +77,11 @@ use ZoneMinder::Database qw(:all);
|
|||
use POSIX;
|
||||
|
||||
# For running general shell commands
|
||||
sub executeShellCommand
|
||||
{
|
||||
sub executeShellCommand {
|
||||
my $command = shift;
|
||||
my $output = qx( $command );
|
||||
my $status = $? >> 8;
|
||||
if ( $status || logDebugging() )
|
||||
{
|
||||
if ( $status || logDebugging() ) {
|
||||
Debug( "Command: $command\n" );
|
||||
chomp( $output );
|
||||
Debug( "Output: $output\n" );
|
||||
|
|
@ -91,13 +89,11 @@ sub executeShellCommand
|
|||
return( $status );
|
||||
}
|
||||
|
||||
sub getCmdFormat
|
||||
{
|
||||
sub getCmdFormat {
|
||||
Debug( "Testing valid shell syntax\n" );
|
||||
|
||||
my ( $name ) = getpwuid( $> );
|
||||
if ( $name eq $Config{ZM_WEB_USER} )
|
||||
{
|
||||
if ( $name eq $Config{ZM_WEB_USER} ) {
|
||||
Debug( "Running as '$name', su commands not needed\n" );
|
||||
return( "" );
|
||||
}
|
||||
|
|
@ -110,13 +106,10 @@ sub getCmdFormat
|
|||
Debug( "Testing \"$command\"\n" );
|
||||
my $output = qx($command);
|
||||
my $status = $? >> 8;
|
||||
if ( !$status )
|
||||
{
|
||||
if ( !$status ) {
|
||||
Debug( "Test ok, using format \"$prefix<command>$suffix\"\n" );
|
||||
return( $prefix, $suffix );
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
chomp( $output );
|
||||
Debug( "Test failed, '$output'\n" );
|
||||
|
||||
|
|
@ -126,13 +119,10 @@ sub getCmdFormat
|
|||
Debug( "Testing \"$command\"\n" );
|
||||
my $output = qx($command);
|
||||
my $status = $? >> 8;
|
||||
if ( !$status )
|
||||
{
|
||||
if ( !$status ) {
|
||||
Debug( "Test ok, using format \"$prefix<command>$suffix\"\n" );
|
||||
return( $prefix, $suffix );
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
chomp( $output );
|
||||
Debug( "Test failed, '$output'\n" );
|
||||
|
||||
|
|
@ -142,13 +132,10 @@ sub getCmdFormat
|
|||
Debug( "Testing \"$command\"\n" );
|
||||
$output = qx($command);
|
||||
$status = $? >> 8;
|
||||
if ( !$status )
|
||||
{
|
||||
if ( !$status ) {
|
||||
Debug( "Test ok, using format \"$prefix<command>$suffix\"\n" );
|
||||
return( $prefix, $suffix );
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
chomp( $output );
|
||||
Debug( "Test failed, '$output'\n" );
|
||||
}
|
||||
|
|
@ -162,10 +149,8 @@ our $testedShellSyntax = 0;
|
|||
our ( $cmdPrefix, $cmdSuffix );
|
||||
|
||||
# For running ZM daemons etc
|
||||
sub runCommand
|
||||
{
|
||||
if ( !$testedShellSyntax )
|
||||
{
|
||||
sub runCommand {
|
||||
if ( !$testedShellSyntax ) {
|
||||
# Determine the appropriate syntax for the su command
|
||||
( $cmdPrefix, $cmdSuffix ) = getCmdFormat();
|
||||
$testedShellSyntax = !undef;
|
||||
|
|
@ -173,31 +158,25 @@ sub runCommand
|
|||
|
||||
my $command = shift;
|
||||
$command = $Config{ZM_PATH_BIN}."/".$command;
|
||||
if ( $cmdPrefix )
|
||||
{
|
||||
if ( $cmdPrefix ) {
|
||||
$command = $cmdPrefix.$command.$cmdSuffix;
|
||||
}
|
||||
Debug( "Command: $command\n" );
|
||||
my $output = qx($command);
|
||||
my $status = $? >> 8;
|
||||
chomp( $output );
|
||||
if ( $status || logDebugging() )
|
||||
{
|
||||
if ( $status )
|
||||
{
|
||||
if ( $status || logDebugging() ) {
|
||||
if ( $status ) {
|
||||
Error( "Unable to run \"$command\", output is \"$output\"\n" );
|
||||
exit( -1 );
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
Debug( "Output: $output\n" );
|
||||
}
|
||||
}
|
||||
return( $output );
|
||||
}
|
||||
|
||||
sub getEventPath
|
||||
{
|
||||
sub getEventPath {
|
||||
my $event = shift;
|
||||
|
||||
my $Storage = new ZoneMinder::Storage( $$event{Id} );
|
||||
|
|
@ -210,8 +189,7 @@ sub getEventPath
|
|||
return( $event_path );
|
||||
}
|
||||
|
||||
sub createEventPath
|
||||
{
|
||||
sub createEventPath {
|
||||
#
|
||||
# WARNING assumes running from events directory
|
||||
#
|
||||
|
|
@ -219,8 +197,7 @@ sub createEventPath
|
|||
my $Storage = new ZoneMinder::Storage( $$event{Id} );
|
||||
my $eventPath = $Storage->Path() . '/'.$event->{MonitorId};
|
||||
|
||||
if ( $Config{ZM_USE_DEEP_STORAGE} )
|
||||
{
|
||||
if ( $Config{ZM_USE_DEEP_STORAGE} ) {
|
||||
my @startTime = localtime( $event->{StartTime} );
|
||||
|
||||
my @datetimeParts = ();
|
||||
|
|
@ -252,9 +229,7 @@ sub createEventPath
|
|||
or Fatal( "Can't open $idFile: $!" );
|
||||
close( $ID_FP );
|
||||
setFileOwner( $idFile );
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
makePath( $event->{Id}, $eventPath );
|
||||
$eventPath .= '/'.$event->{Id};
|
||||
|
||||
|
|
@ -272,13 +247,10 @@ use Data::Dumper;
|
|||
our $_setFileOwner = undef;
|
||||
our ( $_ownerUid, $_ownerGid );
|
||||
|
||||
sub _checkProcessOwner
|
||||
{
|
||||
if ( !defined($_setFileOwner) )
|
||||
{
|
||||
sub _checkProcessOwner {
|
||||
if ( !defined($_setFileOwner) ) {
|
||||
my ( $processOwner ) = getpwuid( $> );
|
||||
if ( $processOwner ne $Config{ZM_WEB_USER} )
|
||||
{
|
||||
if ( $processOwner ne $Config{ZM_WEB_USER} ) {
|
||||
# Not running as web user, so should be root in which case chown
|
||||
# the temporary directory
|
||||
( my $ownerName, my $ownerPass, $_ownerUid, $_ownerGid )
|
||||
|
|
@ -287,21 +259,17 @@ sub _checkProcessOwner
|
|||
.$Config{ZM_WEB_USER}."': $!"
|
||||
);
|
||||
$_setFileOwner = 1;
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
$_setFileOwner = 0;
|
||||
}
|
||||
}
|
||||
return( $_setFileOwner );
|
||||
}
|
||||
|
||||
sub setFileOwner
|
||||
{
|
||||
sub setFileOwner {
|
||||
my $file = shift;
|
||||
|
||||
if ( _checkProcessOwner() )
|
||||
{
|
||||
if ( _checkProcessOwner() ) {
|
||||
chown( $_ownerUid, $_ownerGid, $file )
|
||||
or Fatal( "Can't change ownership of file '$file' to '"
|
||||
.$Config{ZM_WEB_USER}.":".$Config{ZM_WEB_GROUP}."': $!"
|
||||
|
|
@ -311,12 +279,9 @@ sub setFileOwner
|
|||
|
||||
our $_hasImageInfo = undef;
|
||||
|
||||
sub _checkForImageInfo
|
||||
{
|
||||
if ( !defined($_hasImageInfo) )
|
||||
{
|
||||
my $result = eval
|
||||
{
|
||||
sub _checkForImageInfo {
|
||||
if ( !defined($_hasImageInfo) ) {
|
||||
my $result = eval {
|
||||
require Image::Info;
|
||||
Image::Info->import();
|
||||
};
|
||||
|
|
@ -325,8 +290,7 @@ sub _checkForImageInfo
|
|||
return( $_hasImageInfo );
|
||||
}
|
||||
|
||||
sub createEvent
|
||||
{
|
||||
sub createEvent {
|
||||
my $event = shift;
|
||||
|
||||
Debug( "Creating event" );
|
||||
|
|
@ -336,12 +300,9 @@ sub createEvent
|
|||
|
||||
my $dbh = zmDbConnect();
|
||||
|
||||
if ( $event->{monitor} )
|
||||
{
|
||||
if ( $event->{monitor} ) {
|
||||
$event->{MonitorId} = $event->{monitor}->{Id};
|
||||
}
|
||||
elsif ( $event->{MonitorId} )
|
||||
{
|
||||
} elsif ( $event->{MonitorId} ) {
|
||||
my $sql = "select * from Monitors where Id = ?";
|
||||
my $sth = $dbh->prepare_cached( $sql )
|
||||
or Fatal( "Can't prepare sql '$sql': ".$dbh->errstr() );
|
||||
|
|
@ -352,9 +313,7 @@ sub createEvent
|
|||
.$event->{MonitorId}."'"
|
||||
);
|
||||
$sth->finish();
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
Fatal( "Unable to create event, no monitor or monitor id supplied" );
|
||||
}
|
||||
$event->{Name} = "New Event" unless( $event->{Name} );
|
||||
|
|
@ -362,21 +321,15 @@ sub createEvent
|
|||
$event->{TotScore} = $event->{MaxScore} = 0;
|
||||
|
||||
my $lastTimestamp = 0.0;
|
||||
foreach my $frame ( @{$event->{frames}} )
|
||||
{
|
||||
if ( !$event->{Width} )
|
||||
{
|
||||
if ( $_hasImageInfo )
|
||||
{
|
||||
foreach my $frame ( @{$event->{frames}} ) {
|
||||
if ( !$event->{Width} ) {
|
||||
if ( $_hasImageInfo ) {
|
||||
my $imageInfo = Image::Info::image_info( $frame->{imagePath} );
|
||||
if ( $imageInfo->{error} )
|
||||
{
|
||||
if ( $imageInfo->{error} ) {
|
||||
Error( "Unable to extract image info from '"
|
||||
.$frame->{imagePath}."': ".$imageInfo->{error}
|
||||
);
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
( $event->{Width}, $event->{Height} ) = Image::Info::dim( $imageInfo );
|
||||
}
|
||||
}
|
||||
|
|
@ -401,8 +354,7 @@ sub createEvent
|
|||
);
|
||||
|
||||
my ( @fields, @formats, @values );
|
||||
while ( my ( $field, $value ) = each( %$event ) )
|
||||
{
|
||||
while ( my ( $field, $value ) = each( %$event ) ) {
|
||||
next unless $field =~ /^[A-Z]/;
|
||||
push( @fields, $field );
|
||||
push( @formats, ($formats{$field} or '?') );
|
||||
|
|
@ -419,8 +371,7 @@ sub createEvent
|
|||
$event->{Id} = $dbh->{mysql_insertid};
|
||||
Info( "Created event ".$event->{Id} );
|
||||
|
||||
if ( $event->{EndTime} )
|
||||
{
|
||||
if ( $event->{EndTime} ) {
|
||||
$event->{Name} = $event->{monitor}->{EventPrefix}.$event->{Id}
|
||||
if ( $event->{Name} eq 'New Event' );
|
||||
my $sql = "update Events set Name = ? where Id = ?";
|
||||
|
|
@ -436,14 +387,12 @@ sub createEvent
|
|||
TimeStamp => 'from_unixtime(?)',
|
||||
);
|
||||
my $frameId = 1;
|
||||
foreach my $frame ( @{$event->{frames}} )
|
||||
{
|
||||
foreach my $frame ( @{$event->{frames}} ) {
|
||||
$frame->{EventId} = $event->{Id};
|
||||
$frame->{FrameId} = $frameId++;
|
||||
|
||||
my ( @fields, @formats, @values );
|
||||
while ( my ( $field, $value ) = each( %$frame ) )
|
||||
{
|
||||
while ( my ( $field, $value ) = each( %$frame ) ) {
|
||||
next unless $field =~ /^[A-Z]/;
|
||||
push( @fields, $field );
|
||||
push( @formats, ($frameFormats{$field} or '?') );
|
||||
|
|
@ -458,8 +407,7 @@ sub createEvent
|
|||
my $res = $sth->execute( @values )
|
||||
or Fatal( "Can't execute sql '$sql': ".$sth->errstr() );
|
||||
#$frame->{FrameId} = $dbh->{mysql_insertid};
|
||||
if ( $frame->{imagePath} )
|
||||
{
|
||||
if ( $frame->{imagePath} ) {
|
||||
$frame->{capturePath} = sprintf(
|
||||
"%s/%0".$Config{ZM_EVENT_IMAGE_DIGITS}
|
||||
."d-capture.jpg"
|
||||
|
|
@ -471,8 +419,7 @@ sub createEvent
|
|||
." to ".$frame->{capturePath}.": $!"
|
||||
);
|
||||
setFileOwner( $frame->{capturePath} );
|
||||
if ( 0 && $Config{ZM_CREATE_ANALYSIS_IMAGES} )
|
||||
{
|
||||
if ( 0 && $Config{ZM_CREATE_ANALYSIS_IMAGES} ) {
|
||||
$frame->{analysePath} = sprintf(
|
||||
"%s/%0".$Config{ZM_EVENT_IMAGE_DIGITS}
|
||||
."d-analyse.jpg"
|
||||
|
|
@ -489,20 +436,17 @@ sub createEvent
|
|||
}
|
||||
}
|
||||
|
||||
sub addEventImage
|
||||
{
|
||||
sub addEventImage {
|
||||
my $event = shift;
|
||||
my $frame = shift;
|
||||
|
||||
# TBD
|
||||
}
|
||||
|
||||
sub updateEvent
|
||||
{
|
||||
sub updateEvent {
|
||||
my $event = shift;
|
||||
|
||||
if ( !$event->{EventId} )
|
||||
{
|
||||
if ( !$event->{EventId} ) {
|
||||
Error( "Unable to update event, no event id supplied" );
|
||||
return( 0 );
|
||||
}
|
||||
|
|
@ -518,8 +462,7 @@ sub updateEvent
|
|||
);
|
||||
|
||||
my ( @values, @sets );
|
||||
while ( my ( $field, $value ) = each( %$event ) )
|
||||
{
|
||||
while ( my ( $field, $value ) = each( %$event ) ) {
|
||||
next if ( $field eq 'Id' );
|
||||
push( @values, $event->{$field} );
|
||||
push( @sets, $field." = ".($formats{$field} or '?') );
|
||||
|
|
@ -533,8 +476,7 @@ sub updateEvent
|
|||
or Fatal( "Can't execute sql '$sql': ".$sth->errstr() );
|
||||
}
|
||||
|
||||
sub deleteEventFiles
|
||||
{
|
||||
sub deleteEventFiles {
|
||||
#
|
||||
# WARNING assumes running from events directory
|
||||
#
|
||||
|
|
@ -542,14 +484,12 @@ sub deleteEventFiles
|
|||
my $monitor_id = shift;
|
||||
$monitor_id = '*' if ( !defined($monitor_id) );
|
||||
|
||||
if ( $Config{ZM_USE_DEEP_STORAGE} )
|
||||
{
|
||||
if ( $Config{ZM_USE_DEEP_STORAGE} ) {
|
||||
my $link_path = $monitor_id."/*/*/*/.".$event_id;
|
||||
#Debug( "LP1:$link_path" );
|
||||
my @links = glob($link_path);
|
||||
#Debug( "L:".$links[0].": $!" );
|
||||
if ( @links )
|
||||
{
|
||||
if ( @links ) {
|
||||
( $link_path ) = ( $links[0] =~ /^(.*)$/ ); # De-taint
|
||||
#Debug( "LP2:$link_path" );
|
||||
|
||||
|
|
@ -564,8 +504,7 @@ sub deleteEventFiles
|
|||
|
||||
unlink( $link_path ) or Error( "Unable to unlink '$link_path': $!" );
|
||||
my @path_parts = split( /\//, $event_path );
|
||||
for ( my $i = int(@path_parts)-2; $i >= 1; $i-- )
|
||||
{
|
||||
for ( my $i = int(@path_parts)-2; $i >= 1; $i-- ) {
|
||||
my $delete_path = join( '/', @path_parts[0..$i] );
|
||||
#Debug( "DP$i:$delete_path" );
|
||||
my @has_files = glob( $delete_path."/*" );
|
||||
|
|
@ -578,16 +517,13 @@ sub deleteEventFiles
|
|||
executeShellCommand( $command );
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
my $command = "/bin/rm -rf $monitor_id/$event_id";
|
||||
executeShellCommand( $command );
|
||||
}
|
||||
}
|
||||
|
||||
sub makePath
|
||||
{
|
||||
sub makePath {
|
||||
my $path = shift;
|
||||
my $root = shift;
|
||||
$root = (( $path =~ m|^/| )?'':'.' ) unless( $root );
|
||||
|
|
@ -595,17 +531,12 @@ sub makePath
|
|||
Debug( "Creating path '$path' in $root'\n" );
|
||||
my @parts = split( '/', $path );
|
||||
my $fullPath = $root;
|
||||
foreach my $dir ( @parts )
|
||||
{
|
||||
foreach my $dir ( @parts ) {
|
||||
$fullPath .= '/'.$dir;
|
||||
if ( !-d $fullPath )
|
||||
{
|
||||
if ( -e $fullPath )
|
||||
{
|
||||
if ( !-d $fullPath ) {
|
||||
if ( -e $fullPath ) {
|
||||
Fatal( "Can't create '$fullPath', already exists as non directory" );
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
Debug( "Creating '$fullPath'\n" );
|
||||
mkdir( $fullPath, 0755 ) or Fatal( "Can't mkdir '$fullPath': $!" );
|
||||
setFileOwner( $fullPath );
|
||||
|
|
@ -618,11 +549,9 @@ sub makePath
|
|||
our $testedJSON = 0;
|
||||
our $hasJSONAny = 0;
|
||||
|
||||
sub _testJSON
|
||||
{
|
||||
sub _testJSON {
|
||||
return if ( $testedJSON );
|
||||
my $result = eval
|
||||
{
|
||||
my $result = eval {
|
||||
require JSON::Any;
|
||||
JSON::Any->import();
|
||||
};
|
||||
|
|
@ -630,8 +559,7 @@ sub _testJSON
|
|||
$hasJSONAny = 1 if ( $result );
|
||||
}
|
||||
|
||||
sub _getJSONType
|
||||
{
|
||||
sub _getJSONType {
|
||||
my $value = shift;
|
||||
return( 'null' ) unless( defined($value) );
|
||||
return( 'integer' ) if ( $value =~ /^\d+$/ );
|
||||
|
|
@ -643,64 +571,46 @@ sub _getJSONType
|
|||
|
||||
sub jsonEncode;
|
||||
|
||||
sub jsonEncode
|
||||
{
|
||||
sub jsonEncode {
|
||||
my $value = shift;
|
||||
|
||||
_testJSON();
|
||||
if ( $hasJSONAny )
|
||||
{
|
||||
if ( $hasJSONAny ) {
|
||||
my $string = eval { JSON::Any->objToJson( $value ) };
|
||||
Fatal( "Unable to encode object to JSON: $@" ) unless( $string );
|
||||
return( $string );
|
||||
}
|
||||
|
||||
my $type = _getJSONType($value);
|
||||
if ( $type eq 'integer' || $type eq 'double' )
|
||||
{
|
||||
if ( $type eq 'integer' || $type eq 'double' ) {
|
||||
return( $value );
|
||||
}
|
||||
elsif ( $type eq 'boolean' )
|
||||
{
|
||||
} elsif ( $type eq 'boolean' ) {
|
||||
return( $value?'true':'false' );
|
||||
}
|
||||
elsif ( $type eq 'string' )
|
||||
{
|
||||
} elsif ( $type eq 'string' ) {
|
||||
$value =~ s|(["\\/])|\\$1|g;
|
||||
$value =~ s|\r?\n|\n|g;
|
||||
return( '"'.$value.'"' );
|
||||
}
|
||||
elsif ( $type eq 'null' )
|
||||
{
|
||||
} elsif ( $type eq 'null' ) {
|
||||
return( 'null' );
|
||||
}
|
||||
elsif ( $type eq 'array' )
|
||||
{
|
||||
} elsif ( $type eq 'array' ) {
|
||||
return( '['.join( ',', map { jsonEncode( $_ ) } @$value ).']' );
|
||||
}
|
||||
elsif ( $type eq 'hash' )
|
||||
{
|
||||
} elsif ( $type eq 'hash' ) {
|
||||
my $result = '{';
|
||||
while ( my ( $subKey=>$subValue ) = each( %$value ) )
|
||||
{
|
||||
while ( my ( $subKey=>$subValue ) = each( %$value ) ) {
|
||||
$result .= ',' if ( $result ne '{' );
|
||||
$result .= '"'.$subKey.'":'.jsonEncode( $subValue );
|
||||
}
|
||||
return( $result.'}' );
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
Fatal( "Unexpected type '$type'" );
|
||||
}
|
||||
}
|
||||
|
||||
sub jsonDecode
|
||||
{
|
||||
sub jsonDecode {
|
||||
my $value = shift;
|
||||
|
||||
_testJSON();
|
||||
if ( $hasJSONAny )
|
||||
{
|
||||
if ( $hasJSONAny ) {
|
||||
my $object = eval { JSON::Any->jsonToObj( $value ) };
|
||||
Fatal( "Unable to decode JSON string '$value': $@" ) unless( $object );
|
||||
return( $object );
|
||||
|
|
@ -710,41 +620,27 @@ sub jsonDecode
|
|||
my $unescape = 0;
|
||||
my $out = '';
|
||||
my @chars = split( //, $value );
|
||||
for ( my $i = 0; $i < @chars; $i++ )
|
||||
{
|
||||
if ( !$comment )
|
||||
{
|
||||
if ( $chars[$i] eq ':' )
|
||||
{
|
||||
for ( my $i = 0; $i < @chars; $i++ ) {
|
||||
if ( !$comment ) {
|
||||
if ( $chars[$i] eq ':' ) {
|
||||
$out .= '=>';
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
$out .= $chars[$i];
|
||||
}
|
||||
}
|
||||
elsif ( !$unescape )
|
||||
{
|
||||
if ( $chars[$i] eq '\\' )
|
||||
{
|
||||
} elsif ( !$unescape ) {
|
||||
if ( $chars[$i] eq '\\' ) {
|
||||
$unescape = 1;
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
$out .= $chars[$i];
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
if ( $chars[$i] ne '/' )
|
||||
{
|
||||
} else {
|
||||
if ( $chars[$i] ne '/' ) {
|
||||
$out .= '\\';
|
||||
}
|
||||
$out .= $chars[$i];
|
||||
$unescape = 0;
|
||||
}
|
||||
if ( $chars[$i] eq '"' )
|
||||
{
|
||||
if ( $chars[$i] eq '"' ) {
|
||||
$comment = !$comment;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -128,8 +128,7 @@ our %priorities = (
|
|||
our $logger;
|
||||
our $LOGFILE;
|
||||
|
||||
sub new
|
||||
{
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $this = {};
|
||||
|
||||
|
|
@ -160,12 +159,10 @@ sub new
|
|||
return $this;
|
||||
}
|
||||
|
||||
sub BEGIN
|
||||
{
|
||||
sub BEGIN {
|
||||
# Fake the config variables that are used in case they are not defined yet
|
||||
# Only really necessary to support upgrade from previous version
|
||||
if ( !eval('defined($Config{ZM_LOG_DEBUG})') )
|
||||
{
|
||||
if ( !eval('defined($Config{ZM_LOG_DEBUG})') ) {
|
||||
no strict 'subs';
|
||||
no strict 'refs';
|
||||
my %dbgConfig = (
|
||||
|
|
@ -177,8 +174,7 @@ sub BEGIN
|
|||
ZM_LOG_DEBUG_LEVEL => 1,
|
||||
ZM_LOG_DEBUG_FILE => ""
|
||||
);
|
||||
while ( my ( $name, $value ) = each( %dbgConfig ) )
|
||||
{
|
||||
while ( my ( $name, $value ) = each( %dbgConfig ) ) {
|
||||
*{$name} = sub { $value };
|
||||
}
|
||||
use strict 'subs';
|
||||
|
|
@ -186,14 +182,12 @@ sub BEGIN
|
|||
}
|
||||
}
|
||||
|
||||
sub DESTROY
|
||||
{
|
||||
sub DESTROY {
|
||||
my $this = shift;
|
||||
$this->terminate();
|
||||
}
|
||||
|
||||
sub initialise( @ )
|
||||
{
|
||||
sub initialise( @ ) {
|
||||
my $this = shift;
|
||||
my %options = @_;
|
||||
|
||||
|
|
@ -204,8 +198,7 @@ sub initialise( @ )
|
|||
my $tempLogFile;
|
||||
$tempLogFile = $this->{logPath}."/".$this->{id}.".log";
|
||||
$tempLogFile = $options{logFile} if ( defined($options{logFile}) );
|
||||
if ( my $logFile = $this->getTargettedEnv('LOG_FILE') )
|
||||
{
|
||||
if ( my $logFile = $this->getTargettedEnv('LOG_FILE') ) {
|
||||
$tempLogFile = $logFile;
|
||||
}
|
||||
|
||||
|
|
@ -216,33 +209,23 @@ sub initialise( @ )
|
|||
my $tempSyslogLevel = $this->{syslogLevel};
|
||||
|
||||
$tempTermLevel = $options{termLevel} if ( defined($options{termLevel}) );
|
||||
if ( defined($options{databaseLevel}) )
|
||||
{
|
||||
if ( defined($options{databaseLevel}) ) {
|
||||
$tempDatabaseLevel = $options{databaseLevel};
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
$tempDatabaseLevel = $Config{ZM_LOG_LEVEL_DATABASE};
|
||||
}
|
||||
if ( defined($options{fileLevel}) )
|
||||
{
|
||||
if ( defined($options{fileLevel}) ) {
|
||||
$tempFileLevel = $options{fileLevel};
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
$tempFileLevel = $Config{ZM_LOG_LEVEL_FILE};
|
||||
}
|
||||
if ( defined($options{syslogLevel}) )
|
||||
{
|
||||
if ( defined($options{syslogLevel}) ) {
|
||||
$tempSyslogLevel = $options{syslogLevel};
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
$tempSyslogLevel = $Config{ZM_LOG_LEVEL_SYSLOG};
|
||||
}
|
||||
|
||||
if ( defined($ENV{'LOG_PRINT'}) )
|
||||
{
|
||||
if ( defined($ENV{'LOG_PRINT'}) ) {
|
||||
$tempTermLevel = $ENV{'LOG_PRINT'}? DEBUG : NOLOG;
|
||||
}
|
||||
|
||||
|
|
@ -254,22 +237,17 @@ sub initialise( @ )
|
|||
$tempFileLevel = $level if ( defined($level = $this->getTargettedEnv('LOG_LEVEL_FILE')) );
|
||||
$tempSyslogLevel = $level if ( defined($level = $this->getTargettedEnv('LOG_LEVEL_SYSLOG')) );
|
||||
|
||||
if ( $Config{ZM_LOG_DEBUG} )
|
||||
{
|
||||
foreach my $target ( split( /\|/, $Config{ZM_LOG_DEBUG_TARGET} ) )
|
||||
{
|
||||
if ( $Config{ZM_LOG_DEBUG} ) {
|
||||
foreach my $target ( split( /\|/, $Config{ZM_LOG_DEBUG_TARGET} ) ) {
|
||||
if ( $target eq $this->{id}
|
||||
|| $target eq "_".$this->{id}
|
||||
|| $target eq $this->{idRoot}
|
||||
|| $target eq "_".$this->{idRoot}
|
||||
|| $target eq ""
|
||||
)
|
||||
{
|
||||
if ( $Config{ZM_LOG_DEBUG_LEVEL} > NOLOG )
|
||||
{
|
||||
) {
|
||||
if ( $Config{ZM_LOG_DEBUG_LEVEL} > NOLOG ) {
|
||||
$tempLevel = $this->limit( $Config{ZM_LOG_DEBUG_LEVEL} );
|
||||
if ( $Config{ZM_LOG_DEBUG_FILE} ne "" )
|
||||
{
|
||||
if ( $Config{ZM_LOG_DEBUG_FILE} ne "" ) {
|
||||
$tempLogFile = $Config{ZM_LOG_DEBUG_FILE};
|
||||
$tempFileLevel = $tempLevel;
|
||||
}
|
||||
|
|
@ -303,8 +281,7 @@ sub initialise( @ )
|
|||
);
|
||||
}
|
||||
|
||||
sub terminate
|
||||
{
|
||||
sub terminate {
|
||||
my $this = shift;
|
||||
return unless ( $this->{initialised} );
|
||||
$this->syslogLevel( NOLOG );
|
||||
|
|
@ -313,8 +290,7 @@ sub terminate
|
|||
$this->termLevel( NOLOG );
|
||||
}
|
||||
|
||||
sub reinitialise
|
||||
{
|
||||
sub reinitialise {
|
||||
my $this = shift;
|
||||
|
||||
return unless ( $this->{initialised} );
|
||||
|
|
@ -335,8 +311,7 @@ sub reinitialise
|
|||
$this->databaseLevel( $databaseLevel ) if ( $databaseLevel > NOLOG );
|
||||
}
|
||||
|
||||
sub limit
|
||||
{
|
||||
sub limit {
|
||||
my $this = shift;
|
||||
my $level = shift;
|
||||
return( DEBUG ) if ( $level > DEBUG );
|
||||
|
|
@ -344,55 +319,45 @@ sub limit
|
|||
return( $level );
|
||||
}
|
||||
|
||||
sub getTargettedEnv
|
||||
{
|
||||
sub getTargettedEnv {
|
||||
my $this = shift;
|
||||
my $name = shift;
|
||||
my $envName = $name."_".$this->{id};
|
||||
my $value;
|
||||
$value = $ENV{$envName} if ( defined($ENV{$envName}) );
|
||||
if ( !defined($value) && $this->{id} ne $this->{idRoot} )
|
||||
{
|
||||
if ( !defined($value) && $this->{id} ne $this->{idRoot} ) {
|
||||
$envName = $name."_".$this->{idRoot};
|
||||
$value = $ENV{$envName} if ( defined($ENV{$envName}) );
|
||||
}
|
||||
if ( !defined($value) )
|
||||
{
|
||||
if ( !defined($value) ) {
|
||||
$value = $ENV{$name} if ( defined($ENV{$name}) );
|
||||
}
|
||||
if ( defined($value) )
|
||||
{
|
||||
if ( defined($value) ) {
|
||||
( $value ) = $value =~ m/(.*)/;
|
||||
}
|
||||
return( $value );
|
||||
}
|
||||
|
||||
sub fetch
|
||||
{
|
||||
if ( !$logger )
|
||||
{
|
||||
sub fetch {
|
||||
if ( !$logger ) {
|
||||
$logger = ZoneMinder::Logger->new();
|
||||
$logger->initialise( 'syslogLevel'=>INFO, 'databaseLevel'=>INFO );
|
||||
}
|
||||
return( $logger );
|
||||
}
|
||||
|
||||
sub id
|
||||
{
|
||||
sub id {
|
||||
my $this = shift;
|
||||
my $id = shift;
|
||||
if ( defined($id) && $this->{id} ne $id )
|
||||
{
|
||||
if ( defined($id) && $this->{id} ne $id ) {
|
||||
# Remove whitespace
|
||||
$id =~ s/\S//g;
|
||||
# Replace non-alphanum with underscore
|
||||
$id =~ s/[^a-zA-Z_]/_/g;
|
||||
|
||||
if ( $this->{id} ne $id )
|
||||
{
|
||||
if ( $this->{id} ne $id ) {
|
||||
$this->{id} = $this->{idRoot} = $id;
|
||||
if ( $id =~ /^([^_]+)_(.+)$/ )
|
||||
{
|
||||
if ( $id =~ /^([^_]+)_(.+)$/ ) {
|
||||
$this->{idRoot} = $1;
|
||||
$this->{idArgs} = $2;
|
||||
}
|
||||
|
|
@ -401,12 +366,10 @@ sub id
|
|||
return( $this->{id} );
|
||||
}
|
||||
|
||||
sub level
|
||||
{
|
||||
sub level {
|
||||
my $this = shift;
|
||||
my $level = shift;
|
||||
if ( defined($level) )
|
||||
{
|
||||
if ( defined($level) ) {
|
||||
$this->{level} = $this->limit( $level );
|
||||
$this->{effectiveLevel} = NOLOG;
|
||||
$this->{effectiveLevel} = $this->{termLevel} if ( $this->{termLevel} > $this->{effectiveLevel} );
|
||||
|
|
@ -418,64 +381,48 @@ sub level
|
|||
return( $this->{level} );
|
||||
}
|
||||
|
||||
sub debugOn
|
||||
{
|
||||
sub debugOn {
|
||||
my $this = shift;
|
||||
return( $this->{effectiveLevel} >= DEBUG );
|
||||
}
|
||||
|
||||
sub trace
|
||||
{
|
||||
sub trace {
|
||||
my $this = shift;
|
||||
$this->{trace} = $_[0] if ( @_ );
|
||||
return( $this->{trace} );
|
||||
}
|
||||
|
||||
sub termLevel
|
||||
{
|
||||
sub termLevel {
|
||||
my $this = shift;
|
||||
my $termLevel = shift;
|
||||
if ( defined($termLevel) )
|
||||
{
|
||||
if ( defined($termLevel) ) {
|
||||
$termLevel = NOLOG if ( !$this->{hasTerm} );
|
||||
$termLevel = $this->limit( $termLevel );
|
||||
if ( $this->{termLevel} != $termLevel )
|
||||
{
|
||||
if ( $this->{termLevel} != $termLevel ) {
|
||||
$this->{termLevel} = $termLevel;
|
||||
}
|
||||
}
|
||||
return( $this->{termLevel} );
|
||||
}
|
||||
|
||||
sub databaseLevel
|
||||
{
|
||||
sub databaseLevel {
|
||||
my $this = shift;
|
||||
my $databaseLevel = shift;
|
||||
if ( defined($databaseLevel) )
|
||||
{
|
||||
if ( defined($databaseLevel) ) {
|
||||
$databaseLevel = $this->limit( $databaseLevel );
|
||||
if ( $this->{databaseLevel} != $databaseLevel )
|
||||
{
|
||||
if ( $databaseLevel > NOLOG && $this->{databaseLevel} <= NOLOG )
|
||||
{
|
||||
if ( !$this->{dbh} )
|
||||
{
|
||||
if ( $this->{databaseLevel} != $databaseLevel ) {
|
||||
if ( $databaseLevel > NOLOG && $this->{databaseLevel} <= NOLOG ) {
|
||||
if ( !$this->{dbh} ) {
|
||||
my $socket;
|
||||
my ( $host, $portOrSocket ) = ( $Config{ZM_DB_HOST} =~ /^([^:]+)(?::(.+))?$/ );
|
||||
|
||||
if ( defined($portOrSocket) )
|
||||
{
|
||||
if ( $portOrSocket =~ /^\// )
|
||||
{
|
||||
if ( defined($portOrSocket) ) {
|
||||
if ( $portOrSocket =~ /^\// ) {
|
||||
$socket = ";mysql_socket=".$portOrSocket;
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
$socket = ";host=".$host.";port=".$portOrSocket;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
$socket = ";host=".$Config{ZM_DB_HOST};
|
||||
}
|
||||
$this->{dbh} = DBI->connect( "DBI:mysql:database=".$Config{ZM_DB_NAME}
|
||||
|
|
@ -483,8 +430,7 @@ sub databaseLevel
|
|||
, $Config{ZM_DB_USER}
|
||||
, $Config{ZM_DB_PASS}
|
||||
);
|
||||
if ( !$this->{dbh} )
|
||||
{
|
||||
if ( !$this->{dbh} ) {
|
||||
$databaseLevel = NOLOG;
|
||||
Error( "Unable to write log entries to DB, can't connect to database '"
|
||||
.$Config{ZM_DB_NAME}
|
||||
|
|
@ -492,9 +438,7 @@ sub databaseLevel
|
|||
.$Config{ZM_DB_HOST}
|
||||
."'"
|
||||
);
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
$this->{dbh}->{AutoCommit} = 1;
|
||||
Fatal( "Can't set AutoCommit on in database connection" )
|
||||
unless( $this->{dbh}->{AutoCommit} );
|
||||
|
|
@ -504,11 +448,8 @@ sub databaseLevel
|
|||
$this->{dbh}->trace( 0 );
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif ( $databaseLevel <= NOLOG && $this->{databaseLevel} > NOLOG )
|
||||
{
|
||||
if ( $this->{dbh} )
|
||||
{
|
||||
} elsif ( $databaseLevel <= NOLOG && $this->{databaseLevel} > NOLOG ) {
|
||||
if ( $this->{dbh} ) {
|
||||
$this->{dbh}->disconnect();
|
||||
undef($this->{dbh});
|
||||
}
|
||||
|
|
@ -519,15 +460,12 @@ sub databaseLevel
|
|||
return( $this->{databaseLevel} );
|
||||
}
|
||||
|
||||
sub fileLevel
|
||||
{
|
||||
sub fileLevel {
|
||||
my $this = shift;
|
||||
my $fileLevel = shift;
|
||||
if ( defined($fileLevel) )
|
||||
{
|
||||
if ( defined($fileLevel) ) {
|
||||
$fileLevel = $this->limit($fileLevel);
|
||||
if ( $this->{fileLevel} != $fileLevel )
|
||||
{
|
||||
if ( $this->{fileLevel} != $fileLevel ) {
|
||||
$this->closeFile() if ( $this->{fileLevel} > NOLOG );
|
||||
$this->{fileLevel} = $fileLevel;
|
||||
$this->openFile() if ( $this->{fileLevel} > NOLOG );
|
||||
|
|
@ -536,15 +474,12 @@ sub fileLevel
|
|||
return( $this->{fileLevel} );
|
||||
}
|
||||
|
||||
sub syslogLevel
|
||||
{
|
||||
sub syslogLevel {
|
||||
my $this = shift;
|
||||
my $syslogLevel = shift;
|
||||
if ( defined($syslogLevel) )
|
||||
{
|
||||
if ( defined($syslogLevel) ) {
|
||||
$syslogLevel = $this->limit($syslogLevel);
|
||||
if ( $this->{syslogLevel} != $syslogLevel )
|
||||
{
|
||||
if ( $this->{syslogLevel} != $syslogLevel ) {
|
||||
$this->closeSyslog() if ( $syslogLevel <= NOLOG && $this->{syslogLevel} > NOLOG );
|
||||
$this->openSyslog() if ( $syslogLevel > NOLOG && $this->{syslogLevel} <= NOLOG );
|
||||
$this->{syslogLevel} = $syslogLevel;
|
||||
|
|
@ -553,70 +488,56 @@ sub syslogLevel
|
|||
return( $this->{syslogLevel} );
|
||||
}
|
||||
|
||||
sub openSyslog
|
||||
{
|
||||
sub openSyslog {
|
||||
my $this = shift;
|
||||
openlog( $this->{id}, "pid", "local1" );
|
||||
}
|
||||
|
||||
sub closeSyslog
|
||||
{
|
||||
sub closeSyslog {
|
||||
my $this = shift;
|
||||
#closelog();
|
||||
}
|
||||
|
||||
sub logFile
|
||||
{
|
||||
sub logFile {
|
||||
my $this = shift;
|
||||
my $logFile = shift;
|
||||
if ( $logFile =~ /^(.+)\+$/ )
|
||||
{
|
||||
if ( $logFile =~ /^(.+)\+$/ ) {
|
||||
$this->{logFile} = $1.'.'.$$;
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
$this->{logFile} = $logFile;
|
||||
}
|
||||
}
|
||||
|
||||
sub openFile
|
||||
{
|
||||
sub openFile {
|
||||
my $this = shift;
|
||||
if ( open( $LOGFILE, ">>", $this->{logFile} ) )
|
||||
{
|
||||
if ( open( $LOGFILE, ">>", $this->{logFile} ) ) {
|
||||
$LOGFILE->autoflush() if ( $this->{autoFlush} );
|
||||
|
||||
my $webUid = (getpwnam( $Config{ZM_WEB_USER} ))[2];
|
||||
my $webGid = (getgrnam( $Config{ZM_WEB_GROUP} ))[2];
|
||||
if ( $> == 0 )
|
||||
{
|
||||
if ( $> == 0 ) {
|
||||
chown( $webUid, $webGid, $this->{logFile} )
|
||||
or Fatal( "Can't change permissions on log file '"
|
||||
.$this->{logFile}."': $!"
|
||||
)
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
$this->fileLevel( NOLOG );
|
||||
Error( "Can't open log file '".$this->{logFile}."': $!" );
|
||||
}
|
||||
}
|
||||
|
||||
sub closeFile
|
||||
{
|
||||
sub closeFile {
|
||||
my $this = shift;
|
||||
close( $LOGFILE ) if ( fileno($LOGFILE) );
|
||||
}
|
||||
|
||||
sub logPrint
|
||||
{
|
||||
sub logPrint {
|
||||
my $this = shift;
|
||||
my $level = shift;
|
||||
my $string = shift;
|
||||
|
||||
if ( $level <= $this->{effectiveLevel} )
|
||||
{
|
||||
if ( $level <= $this->{effectiveLevel} ) {
|
||||
$string =~ s/[\r\n]+$//g;
|
||||
|
||||
my $code = $codes{$level};
|
||||
|
|
@ -633,23 +554,19 @@ sub logPrint
|
|||
, $code
|
||||
, $string
|
||||
);
|
||||
if ( $this->{trace} )
|
||||
{
|
||||
if ( $this->{trace} ) {
|
||||
$message = Carp::shortmess( $message );
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
$message = $message."\n";
|
||||
}
|
||||
syslog( $priorities{$level}, $code." [%s]", $string )
|
||||
if ( $level <= $this->{syslogLevel} );
|
||||
if ( $level <= $this->{syslogLevel} ) {
|
||||
syslog( $priorities{$level}, $code." [%s]", $string );
|
||||
}
|
||||
print( $LOGFILE $message ) if ( $level <= $this->{fileLevel} );
|
||||
if ( $level <= $this->{databaseLevel} )
|
||||
{
|
||||
if ( $level <= $this->{databaseLevel} ) {
|
||||
my $sql = "insert into Logs ( TimeKey, Component, Pid, Level, Code, Message, File, Line ) values ( ?, ?, ?, ?, ?, ?, ?, NULL )";
|
||||
$this->{sth} = $this->{dbh}->prepare_cached( $sql );
|
||||
if ( !$this->{sth} )
|
||||
{
|
||||
if ( !$this->{sth} ) {
|
||||
$this->{databaseLevel} = NOLOG;
|
||||
Fatal( "Can't prepare log entry '$sql': ".$this->{dbh}->errstr() );
|
||||
}
|
||||
|
|
@ -661,8 +578,7 @@ sub logPrint
|
|||
, $string
|
||||
, $this->{fileName}
|
||||
);
|
||||
if ( !$res )
|
||||
{
|
||||
if ( !$res ) {
|
||||
$this->{databaseLevel} = NOLOG;
|
||||
Fatal( "Can't execute log entry '$sql': ".$this->{sth}->errstr() );
|
||||
}
|
||||
|
|
@ -671,27 +587,23 @@ sub logPrint
|
|||
}
|
||||
}
|
||||
|
||||
sub logInit( ;@ )
|
||||
{
|
||||
sub logInit( ;@ ) {
|
||||
my %options = @_ ? @_ : ();
|
||||
$logger = ZoneMinder::Logger->new() if ( !$logger );
|
||||
$logger->initialise( %options );
|
||||
}
|
||||
|
||||
sub logReinit
|
||||
{
|
||||
sub logReinit {
|
||||
fetch()->reinitialise();
|
||||
}
|
||||
|
||||
sub logTerm
|
||||
{
|
||||
sub logTerm {
|
||||
return unless ( $logger );
|
||||
$logger->terminate();
|
||||
$logger = undef;
|
||||
}
|
||||
|
||||
sub logHupHandler
|
||||
{
|
||||
sub logHupHandler {
|
||||
my $savedErrno = $!;
|
||||
return unless( $logger );
|
||||
fetch()->reinitialise();
|
||||
|
|
@ -699,90 +611,74 @@ sub logHupHandler
|
|||
$! = $savedErrno;
|
||||
}
|
||||
|
||||
sub logSetSignal
|
||||
{
|
||||
sub logSetSignal {
|
||||
$SIG{HUP} = \&logHupHandler;
|
||||
}
|
||||
|
||||
sub logClearSignal
|
||||
{
|
||||
sub logClearSignal {
|
||||
$SIG{HUP} = 'DEFAULT';
|
||||
}
|
||||
|
||||
sub logLevel
|
||||
{
|
||||
sub logLevel {
|
||||
return( fetch()->level( @_ ) );
|
||||
}
|
||||
|
||||
sub logDebugging
|
||||
{
|
||||
sub logDebugging {
|
||||
return( fetch()->debugOn() );
|
||||
}
|
||||
|
||||
sub logTermLevel
|
||||
{
|
||||
sub logTermLevel {
|
||||
return( fetch()->termLevel( @_ ) );
|
||||
}
|
||||
|
||||
sub logDatabaseLevel
|
||||
{
|
||||
sub logDatabaseLevel {
|
||||
return( fetch()->databaseLevel( @_ ) );
|
||||
}
|
||||
|
||||
sub logFileLevel
|
||||
{
|
||||
sub logFileLevel {
|
||||
return( fetch()->fileLevel( @_ ) );
|
||||
}
|
||||
|
||||
sub logSyslogLevel
|
||||
{
|
||||
sub logSyslogLevel {
|
||||
return( fetch()->syslogLevel( @_ ) );
|
||||
}
|
||||
|
||||
sub Mark
|
||||
{
|
||||
sub Mark {
|
||||
my $level = shift;
|
||||
$level = DEBUG unless( defined($level) );
|
||||
my $tag = "Mark";
|
||||
fetch()->logPrint( $level, $tag );
|
||||
}
|
||||
|
||||
sub Dump
|
||||
{
|
||||
sub Dump {
|
||||
my $var = shift;
|
||||
my $label = shift;
|
||||
$label = "VAR" unless( defined($label) );
|
||||
fetch()->logPrint( DEBUG, Data::Dumper->Dump( [ $var ], [ $label ] ) );
|
||||
}
|
||||
|
||||
sub Debug( @ )
|
||||
{
|
||||
sub Debug( @ ) {
|
||||
fetch()->logPrint( DEBUG, @_ );
|
||||
}
|
||||
|
||||
sub Info( @ )
|
||||
{
|
||||
sub Info( @ ) {
|
||||
fetch()->logPrint( INFO, @_ );
|
||||
}
|
||||
|
||||
sub Warning( @ )
|
||||
{
|
||||
sub Warning( @ ) {
|
||||
fetch()->logPrint( WARNING, @_ );
|
||||
}
|
||||
|
||||
sub Error( @ )
|
||||
{
|
||||
sub Error( @ ) {
|
||||
fetch()->logPrint( ERROR, @_ );
|
||||
}
|
||||
|
||||
sub Fatal( @ )
|
||||
{
|
||||
sub Fatal( @ ) {
|
||||
fetch()->logPrint( FATAL, @_ );
|
||||
exit( -1 );
|
||||
}
|
||||
|
||||
sub Panic( @ )
|
||||
{
|
||||
sub Panic( @ ) {
|
||||
fetch()->logPrint( PANIC, @_ );
|
||||
confess( $_[0] );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -116,13 +116,11 @@ use constant TRIGGER_OFF => 2;
|
|||
|
||||
use Storable qw( freeze thaw );
|
||||
|
||||
if ( "@ENABLE_MMAP@" eq 'yes' ) # 'yes' if memory is mmapped
|
||||
{
|
||||
if ( "@ENABLE_MMAP@" eq 'yes' ) {
|
||||
# 'yes' if memory is mmapped
|
||||
require ZoneMinder::Memory::Mapped;
|
||||
ZoneMinder::Memory::Mapped->import();
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
require ZoneMinder::Memory::Shared;
|
||||
ZoneMinder::Memory::Shared->import();
|
||||
}
|
||||
|
|
@ -143,8 +141,7 @@ our $arch = 32 + 32*( qx(uname -m) =~ /64/ );
|
|||
our $native = $arch/8;
|
||||
our $mem_seq = 0;
|
||||
|
||||
our $mem_data =
|
||||
{
|
||||
our $mem_data = {
|
||||
"shared_data" => { "type"=>"SharedData", "seq"=>$mem_seq++, "contents"=> {
|
||||
"size" => { "type"=>"uint32", "seq"=>$mem_seq++ },
|
||||
"last_write_index" => { "type"=>"uint32", "seq"=>$mem_seq++ },
|
||||
|
|
@ -187,73 +184,54 @@ our $mem_data =
|
|||
our $mem_size = 0;
|
||||
our $mem_verified = {};
|
||||
|
||||
sub zmMemInit
|
||||
{
|
||||
sub zmMemInit {
|
||||
my $offset = 0;
|
||||
|
||||
foreach my $section_data ( sort { $a->{seq} <=> $b->{seq} } values( %$mem_data ) )
|
||||
{
|
||||
foreach my $section_data ( sort { $a->{seq} <=> $b->{seq} } values( %$mem_data ) ) {
|
||||
$section_data->{offset} = $offset;
|
||||
$section_data->{align} = 0;
|
||||
|
||||
if ( $section_data->{align} > 1 )
|
||||
{
|
||||
if ( $section_data->{align} > 1 ) {
|
||||
my $rem = $offset % $section_data->{align};
|
||||
if ( $rem > 0 )
|
||||
{
|
||||
if ( $rem > 0 ) {
|
||||
$offset += ($section_data->{align} - $rem);
|
||||
}
|
||||
}
|
||||
foreach my $member_data ( sort { $a->{seq} <=> $b->{seq} } values( %{$section_data->{contents}} ) )
|
||||
{
|
||||
foreach my $member_data ( sort { $a->{seq} <=> $b->{seq} } values( %{$section_data->{contents}} ) ) {
|
||||
if ( $member_data->{type} eq "long"
|
||||
|| $member_data->{type} eq "ulong"
|
||||
|| $member_data->{type} eq "size_t"
|
||||
)
|
||||
{
|
||||
) {
|
||||
$member_data->{size} = $member_data->{align} = $native;
|
||||
}
|
||||
elsif( $member_data->{type} eq "int64"
|
||||
} elsif ( $member_data->{type} eq "int64"
|
||||
|| $member_data->{type} eq "uint64"
|
||||
|| $member_data->{type} eq "time_t64"
|
||||
)
|
||||
{
|
||||
) {
|
||||
$member_data->{size} = $member_data->{align} = 8;
|
||||
}
|
||||
elsif ( $member_data->{type} eq "int32"
|
||||
} elsif ( $member_data->{type} eq "int32"
|
||||
|| $member_data->{type} eq "uint32"
|
||||
|| $member_data->{type} eq "bool4"
|
||||
)
|
||||
{
|
||||
) {
|
||||
$member_data->{size} = $member_data->{align} = 4;
|
||||
}
|
||||
elsif ($member_data->{type} eq "int16"
|
||||
} elsif ($member_data->{type} eq "int16"
|
||||
|| $member_data->{type} eq "uint16"
|
||||
)
|
||||
{
|
||||
) {
|
||||
$member_data->{size} = $member_data->{align} = 2;
|
||||
}
|
||||
elsif ( $member_data->{type} eq "int8"
|
||||
} elsif ( $member_data->{type} eq "int8"
|
||||
|| $member_data->{type} eq "uint8"
|
||||
|| $member_data->{type} eq "bool1"
|
||||
)
|
||||
{
|
||||
) {
|
||||
$member_data->{size} = $member_data->{align} = 1;
|
||||
}
|
||||
elsif ( $member_data->{type} =~ /^u?int8\[(\d+)\]$/ )
|
||||
{
|
||||
} elsif ( $member_data->{type} =~ /^u?int8\[(\d+)\]$/ ) {
|
||||
$member_data->{size} = $1;
|
||||
$member_data->{align} = 1;
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
Fatal( "Unexpected type '".$member_data->{type}
|
||||
."' found in shared data definition."
|
||||
);
|
||||
}
|
||||
|
||||
if ( $member_data->{align} > 1 && ($offset%$member_data->{align}) > 0 )
|
||||
{
|
||||
if ( $member_data->{align} > 1 && ($offset%$member_data->{align}) > 0 ) {
|
||||
$offset += ($member_data->{align} - ($offset%$member_data->{align}));
|
||||
}
|
||||
$member_data->{offset} = $offset;
|
||||
|
|
@ -267,22 +245,17 @@ sub zmMemInit
|
|||
|
||||
&zmMemInit();
|
||||
|
||||
sub zmMemVerify
|
||||
{
|
||||
sub zmMemVerify {
|
||||
my $monitor = shift;
|
||||
if ( !zmMemAttach( $monitor, $mem_size ) )
|
||||
{
|
||||
if ( !zmMemAttach( $monitor, $mem_size ) ) {
|
||||
return( undef );
|
||||
}
|
||||
|
||||
my $mem_key = zmMemKey( $monitor );
|
||||
if ( !defined($mem_verified->{$mem_key}) )
|
||||
{
|
||||
if ( !defined($mem_verified->{$mem_key}) ) {
|
||||
my $sd_size = zmMemRead( $monitor, "shared_data:size", 1 );
|
||||
if ( $sd_size != $mem_data->{shared_data}->{size} )
|
||||
{
|
||||
if ( $sd_size )
|
||||
{
|
||||
if ( $sd_size != $mem_data->{shared_data}->{size} ) {
|
||||
if ( $sd_size ) {
|
||||
Error( "Shared data size conflict in shared_data for monitor "
|
||||
.$monitor->{Name}
|
||||
.", expected "
|
||||
|
|
@ -290,9 +263,7 @@ sub zmMemVerify
|
|||
.", got "
|
||||
.$sd_size
|
||||
);
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
Debug( "Shared data size conflict in shared_data for monitor "
|
||||
.$monitor->{Name}
|
||||
.", expected "
|
||||
|
|
@ -303,10 +274,8 @@ sub zmMemVerify
|
|||
return( undef );
|
||||
}
|
||||
my $td_size = zmMemRead( $monitor, "trigger_data:size", 1 );
|
||||
if ( $td_size != $mem_data->{trigger_data}->{size} )
|
||||
{
|
||||
if ( $td_size )
|
||||
{
|
||||
if ( $td_size != $mem_data->{trigger_data}->{size} ) {
|
||||
if ( $td_size ) {
|
||||
Error( "Shared data size conflict in trigger_data for monitor "
|
||||
.$monitor->{Name}
|
||||
.", expected "
|
||||
|
|
@ -314,9 +283,7 @@ sub zmMemVerify
|
|||
.", got "
|
||||
.$td_size
|
||||
);
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
Debug( "Shared data size conflict in trigger_data for monitor "
|
||||
.$monitor->{Name}
|
||||
.", expected "
|
||||
|
|
@ -332,24 +299,20 @@ sub zmMemVerify
|
|||
return( !undef );
|
||||
}
|
||||
|
||||
sub zmMemRead
|
||||
{
|
||||
sub zmMemRead {
|
||||
my $monitor = shift;
|
||||
my $fields = shift;
|
||||
my $nocheck = shift;
|
||||
|
||||
if ( !($nocheck || zmMemVerify( $monitor )) )
|
||||
{
|
||||
if ( !($nocheck || zmMemVerify( $monitor )) ) {
|
||||
return( undef );
|
||||
}
|
||||
|
||||
if ( !ref($fields) )
|
||||
{
|
||||
if ( !ref($fields) ) {
|
||||
$fields = [ $fields ];
|
||||
}
|
||||
my @values;
|
||||
foreach my $field ( @$fields )
|
||||
{
|
||||
foreach my $field ( @$fields ) {
|
||||
my ( $section, $element ) = split( /[\/:.]/, $field );
|
||||
Fatal( "Invalid shared data selector '$field'" ) if ( !$section || !$element );
|
||||
|
||||
|
|
@ -358,171 +321,113 @@ sub zmMemRead
|
|||
my $size = $mem_data->{$section}->{contents}->{$element}->{size};
|
||||
|
||||
my $data = zmMemGet( $monitor, $offset, $size );
|
||||
if ( !defined($data) )
|
||||
{
|
||||
if ( !defined($data) ) {
|
||||
Error( "Unable to read '$field' from memory for monitor ".$monitor->{Id} );
|
||||
zmMemInvalidate( $monitor );
|
||||
return( undef );
|
||||
}
|
||||
my $value;
|
||||
if ( $type eq "long" )
|
||||
{
|
||||
if ( $type eq "long" ) {
|
||||
( $value ) = unpack( "l!", $data );
|
||||
}
|
||||
elsif ( $type eq "ulong" || $type eq "size_t" )
|
||||
{
|
||||
} elsif ( $type eq "ulong" || $type eq "size_t" ) {
|
||||
( $value ) = unpack( "L!", $data );
|
||||
}
|
||||
elsif ( $type eq "int64" || $type eq "time_t64" )
|
||||
{
|
||||
} elsif ( $type eq "int64" || $type eq "time_t64" ) {
|
||||
# The "q" type is only available on 64bit platforms, so use native.
|
||||
( $value ) = unpack( "l!", $data );
|
||||
}
|
||||
elsif ( $type eq "uint64" )
|
||||
{
|
||||
} elsif ( $type eq "uint64" ) {
|
||||
# The "q" type is only available on 64bit platforms, so use native.
|
||||
( $value ) = unpack( "L!", $data );
|
||||
}
|
||||
elsif ( $type eq "int32" )
|
||||
{
|
||||
} elsif ( $type eq "int32" ) {
|
||||
( $value ) = unpack( "l", $data );
|
||||
}
|
||||
elsif ( $type eq "uint32" || $type eq "bool4" )
|
||||
{
|
||||
} elsif ( $type eq "uint32" || $type eq "bool4" ) {
|
||||
( $value ) = unpack( "L", $data );
|
||||
}
|
||||
elsif ( $type eq "int16" )
|
||||
{
|
||||
} elsif ( $type eq "int16" ) {
|
||||
( $value ) = unpack( "s", $data );
|
||||
}
|
||||
elsif ( $type eq "uint16" )
|
||||
{
|
||||
} elsif ( $type eq "uint16" ) {
|
||||
( $value ) = unpack( "S", $data );
|
||||
}
|
||||
elsif ( $type eq "int8" )
|
||||
{
|
||||
} elsif ( $type eq "int8" ) {
|
||||
( $value ) = unpack( "c", $data );
|
||||
}
|
||||
elsif ( $type eq "uint8" || $type eq "bool1" )
|
||||
{
|
||||
} elsif ( $type eq "uint8" || $type eq "bool1" ) {
|
||||
( $value ) = unpack( "C", $data );
|
||||
}
|
||||
elsif ( $type =~ /^int8\[\d+\]$/ )
|
||||
{
|
||||
} elsif ( $type =~ /^int8\[\d+\]$/ ) {
|
||||
( $value ) = unpack( "Z".$size, $data );
|
||||
}
|
||||
elsif ( $type =~ /^uint8\[\d+\]$/ )
|
||||
{
|
||||
} elsif ( $type =~ /^uint8\[\d+\]$/ ) {
|
||||
( $value ) = unpack( "C".$size, $data );
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
Fatal( "Unexpected type '".$type."' found for '".$field."'" );
|
||||
}
|
||||
push( @values, $value );
|
||||
}
|
||||
if ( wantarray() )
|
||||
{
|
||||
if ( wantarray() ) {
|
||||
return( @values )
|
||||
}
|
||||
return( $values[0] );
|
||||
}
|
||||
|
||||
sub zmMemInvalidate
|
||||
{
|
||||
sub zmMemInvalidate {
|
||||
my $monitor = shift;
|
||||
my $mem_key = zmMemKey($monitor);
|
||||
if ( $mem_key )
|
||||
{
|
||||
if ( $mem_key ) {
|
||||
delete $mem_verified->{$mem_key};
|
||||
zmMemDetach( $monitor );
|
||||
}
|
||||
}
|
||||
|
||||
sub zmMemTidy
|
||||
{
|
||||
sub zmMemTidy {
|
||||
zmMemClean();
|
||||
}
|
||||
|
||||
sub zmMemWrite
|
||||
{
|
||||
sub zmMemWrite {
|
||||
my $monitor = shift;
|
||||
my $field_values = shift;
|
||||
my $nocheck = shift;
|
||||
|
||||
if ( !($nocheck || zmMemVerify( $monitor )) )
|
||||
{
|
||||
if ( !($nocheck || zmMemVerify( $monitor )) ) {
|
||||
return( undef );
|
||||
}
|
||||
|
||||
while ( my ( $field, $value ) = each( %$field_values ) )
|
||||
{
|
||||
while ( my ( $field, $value ) = each( %$field_values ) ) {
|
||||
my ( $section, $element ) = split( /[\/:.]/, $field );
|
||||
Fatal( "Invalid shared data selector '$field'" )
|
||||
if ( !$section || !$element );
|
||||
if ( !$section || !$element ) {
|
||||
Fatal( "Invalid shared data selector '$field'" );
|
||||
}
|
||||
|
||||
my $offset = $mem_data->{$section}->{contents}->{$element}->{offset};
|
||||
my $type = $mem_data->{$section}->{contents}->{$element}->{type};
|
||||
my $size = $mem_data->{$section}->{contents}->{$element}->{size};
|
||||
|
||||
my $data;
|
||||
if ( $type eq "long" )
|
||||
{
|
||||
if ( $type eq "long" ) {
|
||||
$data = pack( "l!", $value );
|
||||
}
|
||||
elsif ( $type eq "ulong" || $type eq "size_t" )
|
||||
{
|
||||
} elsif ( $type eq "ulong" || $type eq "size_t" ) {
|
||||
$data = pack( "L!", $value );
|
||||
}
|
||||
elsif ( $type eq "int64" || $type eq "time_t64" )
|
||||
{
|
||||
} elsif ( $type eq "int64" || $type eq "time_t64" ) {
|
||||
# The "q" type is only available on 64bit platforms, so use native.
|
||||
$data = pack( "l!", $value );
|
||||
}
|
||||
elsif ( $type eq "uint64" )
|
||||
{
|
||||
} elsif ( $type eq "uint64" ) {
|
||||
# The "q" type is only available on 64bit platforms, so use native.
|
||||
$data = pack( "L!", $value );
|
||||
}
|
||||
elsif ( $type eq "int32" )
|
||||
{
|
||||
} elsif ( $type eq "int32" ) {
|
||||
$data = pack( "l", $value );
|
||||
}
|
||||
elsif ( $type eq "uint32" || $type eq "bool4" )
|
||||
{
|
||||
} elsif ( $type eq "uint32" || $type eq "bool4" ) {
|
||||
$data = pack( "L", $value );
|
||||
}
|
||||
elsif ( $type eq "int16" )
|
||||
{
|
||||
} elsif ( $type eq "int16" ) {
|
||||
$data = pack( "s", $value );
|
||||
}
|
||||
elsif ( $type eq "uint16" )
|
||||
{
|
||||
} elsif ( $type eq "uint16" ) {
|
||||
$data = pack( "S", $value );
|
||||
}
|
||||
elsif ( $type eq "int8" )
|
||||
{
|
||||
} elsif ( $type eq "int8" ) {
|
||||
$data = pack( "c", $value );
|
||||
}
|
||||
elsif ( $type eq "uint8" || $type eq "bool1" )
|
||||
{
|
||||
} elsif ( $type eq "uint8" || $type eq "bool1" ) {
|
||||
$data = pack( "C", $value );
|
||||
}
|
||||
elsif ( $type =~ /^int8\[\d+\]$/ )
|
||||
{
|
||||
} elsif ( $type =~ /^int8\[\d+\]$/ ) {
|
||||
$data = pack( "Z".$size, $value );
|
||||
}
|
||||
elsif ( $type =~ /^uint8\[\d+\]$/ )
|
||||
{
|
||||
} elsif ( $type =~ /^uint8\[\d+\]$/ ) {
|
||||
$data = pack( "C".$size, $value );
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
Fatal( "Unexpected type '".$type."' found for '".$field."'" );
|
||||
}
|
||||
|
||||
if ( !zmMemPut( $monitor, $offset, $size, $data ) )
|
||||
{
|
||||
if ( !zmMemPut( $monitor, $offset, $size, $data ) ) {
|
||||
Error( "Unable to write '$value' to '$field' in memory for monitor "
|
||||
.$monitor->{Id}
|
||||
);
|
||||
|
|
@ -533,52 +438,45 @@ sub zmMemWrite
|
|||
return( !undef );
|
||||
}
|
||||
|
||||
sub zmGetMonitorState
|
||||
{
|
||||
sub zmGetMonitorState {
|
||||
my $monitor = shift;
|
||||
|
||||
return( zmMemRead( $monitor, "shared_data:state" ) );
|
||||
}
|
||||
|
||||
sub zmGetAlarmLocation
|
||||
{
|
||||
sub zmGetAlarmLocation {
|
||||
my $monitor = shift;
|
||||
|
||||
return( zmMemRead( $monitor, [ "shared_data:alarm_x", "shared_data:alarm_y" ] ) );
|
||||
}
|
||||
|
||||
sub zmSetControlState
|
||||
{
|
||||
sub zmSetControlState {
|
||||
my $monitor = shift;
|
||||
my $control_state = shift;
|
||||
|
||||
zmMemWrite( $monitor, { "shared_data:control_state" => $control_state } );
|
||||
}
|
||||
|
||||
sub zmGetControlState
|
||||
{
|
||||
sub zmGetControlState {
|
||||
my $monitor = shift;
|
||||
|
||||
return( zmMemRead( $monitor, "shared_data:control_state" ) );
|
||||
}
|
||||
|
||||
sub zmSaveControlState
|
||||
{
|
||||
sub zmSaveControlState {
|
||||
my $monitor = shift;
|
||||
my $control_state = shift;
|
||||
|
||||
zmSetControlState( $monitor, freeze( $control_state ) );
|
||||
}
|
||||
|
||||
sub zmRestoreControlState
|
||||
{
|
||||
sub zmRestoreControlState {
|
||||
my $monitor = shift;
|
||||
|
||||
return( thaw( zmGetControlState( $monitor ) ) );
|
||||
}
|
||||
|
||||
sub zmIsAlarmed
|
||||
{
|
||||
sub zmIsAlarmed {
|
||||
my $monitor = shift;
|
||||
|
||||
my $state = zmGetMonitorState( $monitor );
|
||||
|
|
@ -586,8 +484,7 @@ sub zmIsAlarmed
|
|||
return( $state == STATE_ALARM );
|
||||
}
|
||||
|
||||
sub zmInAlarm
|
||||
{
|
||||
sub zmInAlarm {
|
||||
my $monitor = shift;
|
||||
|
||||
my $state = zmGetMonitorState( $monitor );
|
||||
|
|
@ -595,8 +492,7 @@ sub zmInAlarm
|
|||
return( $state == STATE_ALARM || $state == STATE_ALERT );
|
||||
}
|
||||
|
||||
sub zmHasAlarmed
|
||||
{
|
||||
sub zmHasAlarmed {
|
||||
my $monitor = shift;
|
||||
my $last_event_id = shift;
|
||||
|
||||
|
|
@ -605,12 +501,9 @@ sub zmHasAlarmed
|
|||
]
|
||||
);
|
||||
|
||||
if ( $state == STATE_ALARM || $state == STATE_ALERT )
|
||||
{
|
||||
if ( $state == STATE_ALARM || $state == STATE_ALERT ) {
|
||||
return( $last_event );
|
||||
}
|
||||
elsif( $last_event != $last_event_id )
|
||||
{
|
||||
} elsif( $last_event != $last_event_id ) {
|
||||
return( $last_event );
|
||||
}
|
||||
return( undef );
|
||||
|
|
@ -620,36 +513,31 @@ sub zmGetStartupTime {
|
|||
return zmMemRead( $_[0], 'shared_data:startup_time' );
|
||||
}
|
||||
|
||||
sub zmGetLastEvent
|
||||
{
|
||||
sub zmGetLastEvent {
|
||||
my $monitor = shift;
|
||||
|
||||
return( zmMemRead( $monitor, "shared_data:last_event" ) );
|
||||
}
|
||||
|
||||
sub zmGetLastWriteTime
|
||||
{
|
||||
sub zmGetLastWriteTime {
|
||||
my $monitor = shift;
|
||||
|
||||
return( zmMemRead( $monitor, "shared_data:last_write_time" ) );
|
||||
}
|
||||
|
||||
sub zmGetLastReadTime
|
||||
{
|
||||
sub zmGetLastReadTime {
|
||||
my $monitor = shift;
|
||||
|
||||
return( zmMemRead( $monitor, "shared_data:last_read_time" ) );
|
||||
}
|
||||
|
||||
sub zmGetMonitorActions
|
||||
{
|
||||
sub zmGetMonitorActions {
|
||||
my $monitor = shift;
|
||||
|
||||
return( zmMemRead( $monitor, "shared_data:action" ) );
|
||||
}
|
||||
|
||||
sub zmMonitorEnable
|
||||
{
|
||||
sub zmMonitorEnable {
|
||||
my $monitor = shift;
|
||||
|
||||
my $action = zmMemRead( $monitor, "shared_data:action" );
|
||||
|
|
@ -657,8 +545,7 @@ sub zmMonitorEnable
|
|||
zmMemWrite( $monitor, { "shared_data:action" => $action } );
|
||||
}
|
||||
|
||||
sub zmMonitorDisable
|
||||
{
|
||||
sub zmMonitorDisable {
|
||||
my $monitor = shift;
|
||||
|
||||
my $action = zmMemRead( $monitor, "shared_data:action" );
|
||||
|
|
@ -666,8 +553,7 @@ sub zmMonitorDisable
|
|||
zmMemWrite( $monitor, { "shared_data:action" => $action } );
|
||||
}
|
||||
|
||||
sub zmMonitorSuspend
|
||||
{
|
||||
sub zmMonitorSuspend {
|
||||
my $monitor = shift;
|
||||
|
||||
my $action = zmMemRead( $monitor, "shared_data:action" );
|
||||
|
|
@ -675,8 +561,7 @@ sub zmMonitorSuspend
|
|||
zmMemWrite( $monitor, { "shared_data:action" => $action } );
|
||||
}
|
||||
|
||||
sub zmMonitorResume
|
||||
{
|
||||
sub zmMonitorResume {
|
||||
my $monitor = shift;
|
||||
|
||||
my $action = zmMemRead( $monitor, "shared_data:action" );
|
||||
|
|
@ -684,15 +569,13 @@ sub zmMonitorResume
|
|||
zmMemWrite( $monitor, { "shared_data:action" => $action } );
|
||||
}
|
||||
|
||||
sub zmGetTriggerState
|
||||
{
|
||||
sub zmGetTriggerState {
|
||||
my $monitor = shift;
|
||||
|
||||
return( zmMemRead( $monitor, "trigger_data:trigger_state" ) );
|
||||
}
|
||||
|
||||
sub zmTriggerEventOn
|
||||
{
|
||||
sub zmTriggerEventOn {
|
||||
my $monitor = shift;
|
||||
my $score = shift;
|
||||
my $cause = shift;
|
||||
|
|
@ -707,11 +590,10 @@ sub zmTriggerEventOn
|
|||
$values->{"trigger_data:trigger_showtext"} = $showtext if ( defined($showtext) );
|
||||
$values->{"trigger_data:trigger_state"} = TRIGGER_ON; # Write state last so event not read incomplete
|
||||
|
||||
zmMemWrite( $monitor, $values );
|
||||
zmMemWrite( $monitor, $values );
|
||||
}
|
||||
|
||||
sub zmTriggerEventOff
|
||||
{
|
||||
sub zmTriggerEventOff {
|
||||
my $monitor = shift;
|
||||
|
||||
my $values = {
|
||||
|
|
@ -725,8 +607,7 @@ sub zmTriggerEventOff
|
|||
zmMemWrite( $monitor, $values );
|
||||
}
|
||||
|
||||
sub zmTriggerEventCancel
|
||||
{
|
||||
sub zmTriggerEventCancel {
|
||||
my $monitor = shift;
|
||||
|
||||
my $values = {
|
||||
|
|
@ -740,8 +621,7 @@ sub zmTriggerEventCancel
|
|||
zmMemWrite( $monitor, $values );
|
||||
}
|
||||
|
||||
sub zmTriggerShowtext
|
||||
{
|
||||
sub zmTriggerShowtext {
|
||||
my $monitor = shift;
|
||||
my $showtext = shift;
|
||||
|
||||
|
|
@ -764,11 +644,9 @@ ZoneMinder::MappedMem - ZoneMinder Mapped Memory access module
|
|||
use ZoneMinder::MappedMem;
|
||||
use ZoneMinder::MappedMem qw(:all);
|
||||
|
||||
if ( zmMemVerify( $monitor ) )
|
||||
{
|
||||
if ( zmMemVerify( $monitor ) ) {
|
||||
$state = zmGetMonitorState( $monitor );
|
||||
if ( $state == STATE_ALARM )
|
||||
{
|
||||
if ( $state == STATE_ALARM ) {
|
||||
...
|
||||
}
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue