Merge branch 'master' into improve_filter

This commit is contained in:
Isaac Connor committed 2016-11-04 15:20:43 -04:00
commit 1e233c0ce5
37 files changed
+6105 -5977

No files matched your search

+1 -1
View File
@@ -58,7 +58,7 @@ ZoneMinder::Base - Base perl module for ZoneMinder
=head1 SYNOPSIS
use ZoneMinder::Base;
use ZoneMinder::Base;
=head1 DESCRIPTION
+63 -63
View File
@@ -46,14 +46,14 @@ our @EXPORT_CONFIG = qw( %Config ); # Get populated by BEGIN
our %EXPORT_TAGS = (
functions => [ qw(
zmConfigLoad
loadConfigFromDB
saveConfigToDB
) ],
zmConfigLoad
loadConfigFromDB
saveConfigToDB
) ],
constants => [ qw(
ZM_PID
) ]
);
ZM_PID
) ]
);
push( @{$EXPORT_TAGS{config}}, @EXPORT_CONFIG );
push( @{$EXPORT_TAGS{all}}, @{$EXPORT_TAGS{$_}} ) foreach keys %EXPORT_TAGS;
@@ -71,69 +71,69 @@ use Carp;
# Load the config from the database into the symbol table
BEGIN
{
my $config_file = ZM_CONFIG;
open( my $CONFIG, "<", $config_file )
or croak( "Can't open config file '$config_file': $!" );
foreach my $str ( <$CONFIG> )
{
next if ( $str =~ /^\s*$/ );
next if ( $str =~ /^\s*#/ );
my ( $name, $value ) = $str =~ /^\s*([^=\s]+)\s*=\s*(.*?)\s*$/;
if ( ! $name ) {
print( STDERR "Warning, bad line in $config_file: $str\n" );
next;
} # end if
$name =~ tr/a-z/A-Z/;
$Config{$name} = $value;
}
close( $CONFIG );
my $config_file = ZM_CONFIG;
open( my $CONFIG, "<", $config_file )
or croak( "Can't open config file '$config_file': $!" );
foreach my $str ( <$CONFIG> )
{
next if ( $str =~ /^\s*$/ );
next if ( $str =~ /^\s*#/ );
my ( $name, $value ) = $str =~ /^\s*([^=\s]+)\s*=\s*(.*?)\s*$/;
if ( ! $name ) {
print( STDERR "Warning, bad line in $config_file: $str\n" );
next;
} # end if
$name =~ tr/a-z/A-Z/;
$Config{$name} = $value;
}
close( $CONFIG );
use DBI;
my $socket;
my ( $host, $portOrSocket ) = ( $Config{ZM_DB_HOST} =~ /^([^:]+)(?::(.+))?$/ );
use DBI;
my $socket;
my ( $host, $portOrSocket ) = ( $Config{ZM_DB_HOST} =~ /^([^:]+)(?::(.+))?$/ );
if ( defined($portOrSocket) )
if ( defined($portOrSocket) )
{
if ( $portOrSocket =~ /^\// )
{
if ( $portOrSocket =~ /^\// )
{
$socket = ";mysql_socket=".$portOrSocket;
}
else
{
$socket = ";host=".$host.";port=".$portOrSocket;
}
$socket = ";mysql_socket=".$portOrSocket;
}
else
{
$socket = ";host=".$Config{ZM_DB_HOST};
$socket = ";host=".$host.";port=".$portOrSocket;
}
my $dbh = DBI->connect( "DBI:mysql:database=".$Config{ZM_DB_NAME}
.$socket
, $Config{ZM_DB_USER}
, $Config{ZM_DB_PASS}
) or croak( "Can't connect to db" );
my $sql = 'select * from Config';
my $sth = $dbh->prepare_cached( $sql ) or croak( "Can't prepare '$sql': ".$dbh->errstr() );
my $res = $sth->execute() or croak( "Can't execute: ".$sth->errstr() );
while( my $config = $sth->fetchrow_hashref() ) {
$Config{$config->{Name}} = $config->{Value};
}
else
{
$socket = ";host=".$Config{ZM_DB_HOST};
}
my $dbh = DBI->connect( "DBI:mysql:database=".$Config{ZM_DB_NAME}
.$socket
, $Config{ZM_DB_USER}
, $Config{ZM_DB_PASS}
) or croak( "Can't connect to db" );
my $sql = 'select * from Config';
my $sth = $dbh->prepare_cached( $sql ) or croak( "Can't prepare '$sql': ".$dbh->errstr() );
my $res = $sth->execute() or croak( "Can't execute: ".$sth->errstr() );
while( my $config = $sth->fetchrow_hashref() ) {
$Config{$config->{Name}} = $config->{Value};
}
$sth->finish();
#$dbh->disconnect();
if ( ! exists $Config{ZM_SERVER_ID} ) {
$Config{ZM_SERVER_ID} = undef;
$sth = $dbh->prepare_cached( 'SELECT * FROM Servers WHERE Name=?' );
if ( $Config{ZM_SERVER_NAME} ) {
$res = $sth->execute( $Config{ZM_SERVER_NAME} );
my $result = $sth->fetchrow_hashref();
$Config{ZM_SERVER_ID} = $$result{Id};
} elsif ( $Config{ZM_SERVER_HOST} ) {
$res = $sth->execute( $Config{ZM_SERVER_HOST} );
my $result = $sth->fetchrow_hashref();
$Config{ZM_SERVER_ID} = $$result{Id};
}
$sth->finish();
#$dbh->disconnect();
if ( ! exists $Config{ZM_SERVER_ID} ) {
$Config{ZM_SERVER_ID} = undef;
$sth = $dbh->prepare_cached( 'SELECT * FROM Servers WHERE Name=?' );
if ( $Config{ZM_SERVER_NAME} ) {
$res = $sth->execute( $Config{ZM_SERVER_NAME} );
my $result = $sth->fetchrow_hashref();
$Config{ZM_SERVER_ID} = $$result{Id};
} elsif ( $Config{ZM_SERVER_HOST} ) {
$res = $sth->execute( $Config{ZM_SERVER_HOST} );
my $result = $sth->fetchrow_hashref();
$Config{ZM_SERVER_ID} = $$result{Id};
}
$sth->finish();
}
}
}
sub loadConfigFromDB {
@@ -315,7 +315,7 @@ Copyright (C) 2001-2008 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.
at your option, any later version of Perl 5 you may have available.
=cut
=cut
File diff suppressed because it is too large. Load diff
+64 -64
View File
@@ -45,17 +45,17 @@ our $AUTOLOAD;
sub new
{
my $class = shift;
my $id = shift;
my $self = {};
$self->{name} = "PelcoD";
if ( !defined($id) )
{
Fatal( "No monitor defined when invoking protocol ".$self->{name} );
}
$self->{id} = $id;
bless( $self, $class );
return $self;
my $class = shift;
my $id = shift;
my $self = {};
$self->{name} = "PelcoD";
if ( !defined($id) )
{
Fatal( "No monitor defined when invoking protocol ".$self->{name} );
}
$self->{id} = $id;
bless( $self, $class );
return $self;
}
sub DESTROY
@@ -64,91 +64,91 @@ sub DESTROY
sub AUTOLOAD
{
my $self = shift;
my $class = ref($self) || croak( "$self not object" );
my $name = $AUTOLOAD;
$name =~ s/.*://;
if ( exists($self->{$name}) )
{
return( $self->{$name} );
}
croak( "Can't access $name member of object of class $class" );
my $self = shift;
my $class = ref($self) || croak( "$self not object" );
my $name = $AUTOLOAD;
$name =~ s/.*://;
if ( exists($self->{$name}) )
{
return( $self->{$name} );
}
croak( "Can't access $name member of object of class $class" );
}
sub getKey
{
my $self = shift;
return( $self->{id} );
my $self = shift;
return( $self->{id} );
}
sub open
{
my $self = shift;
Fatal( "No open method defined for protocol ".$self->{name} );
my $self = shift;
Fatal( "No open method defined for protocol ".$self->{name} );
}
sub close
{
my $self = shift;
Fatal( "No close method defined for protocol ".$self->{name} );
my $self = shift;
Fatal( "No close method defined for protocol ".$self->{name} );
}
sub loadMonitor
{
my $self = shift;
if ( !$self->{Monitor} )
my $self = shift;
if ( !$self->{Monitor} )
{
if ( !($self->{Monitor} = zmDbGetMonitor( $self->{id} )) )
{
if ( !($self->{Monitor} = zmDbGetMonitor( $self->{id} )) )
{
Fatal( "Monitor id ".$self->{id}." not found or not controllable" );
}
if ( defined($self->{Monitor}->{AutoStopTimeout}) )
{
# Convert to microseconds.
$self->{Monitor}->{AutoStopTimeout} = int(1000000*$self->{Monitor}->{AutoStopTimeout});
}
Fatal( "Monitor id ".$self->{id}." not found or not controllable" );
}
if ( defined($self->{Monitor}->{AutoStopTimeout}) )
{
# Convert to microseconds.
$self->{Monitor}->{AutoStopTimeout} = int(1000000*$self->{Monitor}->{AutoStopTimeout});
}
}
}
sub getParam
{
my $self = shift;
my $params = shift;
my $name = shift;
my $default = shift;
my $self = shift;
my $params = shift;
my $name = shift;
my $default = shift;
if ( defined($params->{$name}) )
{
return( $params->{$name} );
}
elsif ( defined($default) )
{
return( $default );
}
Fatal( "Missing mandatory parameter '$name'" );
if ( defined($params->{$name}) )
{
return( $params->{$name} );
}
elsif ( defined($default) )
{
return( $default );
}
Fatal( "Missing mandatory parameter '$name'" );
}
sub executeCommand
{
my $self = shift;
my $params = shift;
my $self = shift;
my $params = shift;
$self->loadMonitor();
$self->loadMonitor();
my $command = $params->{command};
delete $params->{command};
my $command = $params->{command};
delete $params->{command};
#if ( !defined($self->{$command}) )
#{
#Fatal( "Unsupported command '$command'" );
#}
&{$self->{$command}}( $self, $params );
#if ( !defined($self->{$command}) )
#{
#Fatal( "Unsupported command '$command'" );
#}
&{$self->{$command}}( $self, $params );
}
sub printMsg
{
my $self = shift;
Fatal( "No printMsg method defined for protocol ".$self->{name} );
my $self = shift;
Fatal( "No printMsg method defined for protocol ".$self->{name} );
}
1;
@@ -161,8 +161,8 @@ ZoneMinder::Database - Perl extension for blah blah blah
=head1 SYNOPSIS
use ZoneMinder::Database;
blah blah blah
use ZoneMinder::Database;
blah blah blah
=head1 DESCRIPTION
+102 -102
View File
@@ -42,13 +42,13 @@ our @ISA = qw(Exporter ZoneMinder::Base);
# will save memory.
our %EXPORT_TAGS = (
'functions' => [ qw(
zmDbConnect
zmDbDisconnect
zmDbGetMonitors
zmDbGetMonitor
zmDbGetMonitorAndControl
) ]
);
zmDbConnect
zmDbDisconnect
zmDbGetMonitors
zmDbGetMonitor
zmDbGetMonitorAndControl
) ]
);
push( @{$EXPORT_TAGS{all}}, @{$EXPORT_TAGS{$_}} ) foreach keys %EXPORT_TAGS;
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
@@ -72,48 +72,48 @@ our $dbh = undef;
sub zmDbConnect
{
my $force = shift;
if ( $force )
{
zmDbDisconnect();
}
if ( !defined( $dbh ) )
{
my $socket;
my ( $host, $portOrSocket ) = ( $Config{ZM_DB_HOST} =~ /^([^:]+)(?::(.+))?$/ );
my $force = shift;
if ( $force )
{
zmDbDisconnect();
}
if ( !defined( $dbh ) )
{
my $socket;
my ( $host, $portOrSocket ) = ( $Config{ZM_DB_HOST} =~ /^([^:]+)(?::(.+))?$/ );
if ( defined($portOrSocket) )
{
if ( $portOrSocket =~ /^\// )
{
$socket = ";mysql_socket=".$portOrSocket;
}
else
{
$socket = ";host=".$host.";port=".$portOrSocket;
}
}
else
{
$socket = ";host=".$Config{ZM_DB_HOST};
}
$dbh = DBI->connect( "DBI:mysql:database=".$Config{ZM_DB_NAME}
.$socket
, $Config{ZM_DB_USER}
, $Config{ZM_DB_PASS}
);
$dbh->trace( 0 );
if ( defined($portOrSocket) )
{
if ( $portOrSocket =~ /^\// )
{
$socket = ";mysql_socket=".$portOrSocket;
}
else
{
$socket = ";host=".$host.";port=".$portOrSocket;
}
}
return( $dbh );
else
{
$socket = ";host=".$Config{ZM_DB_HOST};
}
$dbh = DBI->connect( "DBI:mysql:database=".$Config{ZM_DB_NAME}
.$socket
, $Config{ZM_DB_USER}
, $Config{ZM_DB_PASS}
);
$dbh->trace( 0 );
}
return( $dbh );
}
sub zmDbDisconnect
{
if ( defined( $dbh ) )
{
$dbh->disconnect();
$dbh = undef;
}
if ( defined( $dbh ) )
{
$dbh->disconnect();
$dbh = undef;
}
}
use constant DB_MON_ALL => 0; # All monitors
@@ -125,86 +125,86 @@ use constant DB_MON_PASSIVE => 5; # All monitors that are in nodect state
sub zmDbGetMonitors
{
zmDbConnect();
zmDbConnect();
my $function = shift || DB_MON_ALL;
my $sql = "select * from Monitors";
my $function = shift || DB_MON_ALL;
my $sql = "select * from Monitors";
if ( $function )
if ( $function )
{
if ( $function == DB_MON_CAPT )
{
if ( $function == DB_MON_CAPT )
{
$sql .= " where Function >= 'Monitor'";
}
elsif ( $function == DB_MON_ACTIVE )
{
$sql .= " where Function > 'Monitor'";
}
elsif ( $function == DB_MON_MOTION )
{
$sql .= " where Function = 'Modect' or Function = 'Mocord'";
}
elsif ( $function == DB_MON_RECORD )
{
$sql .= " where Function = 'Record' or Function = 'Mocord'";
}
elsif ( $function == DB_MON_PASSIVE )
{
$sql .= " where Function = 'Nodect'";
}
$sql .= " where Function >= 'Monitor'";
}
my $sth = $dbh->prepare_cached( $sql )
or croak( "Can't prepare '$sql': ".$dbh->errstr() );
my $res = $sth->execute()
or croak( "Can't execute '$sql': ".$sth->errstr() );
my @monitors;
while( my $monitor = $sth->fetchrow_hashref() )
elsif ( $function == DB_MON_ACTIVE )
{
push( @monitors, $monitor );
$sql .= " where Function > 'Monitor'";
}
$sth->finish();
return( \@monitors );
elsif ( $function == DB_MON_MOTION )
{
$sql .= " where Function = 'Modect' or Function = 'Mocord'";
}
elsif ( $function == DB_MON_RECORD )
{
$sql .= " where Function = 'Record' or Function = 'Mocord'";
}
elsif ( $function == DB_MON_PASSIVE )
{
$sql .= " where Function = 'Nodect'";
}
}
my $sth = $dbh->prepare_cached( $sql )
or croak( "Can't prepare '$sql': ".$dbh->errstr() );
my $res = $sth->execute()
or croak( "Can't execute '$sql': ".$sth->errstr() );
my @monitors;
while( my $monitor = $sth->fetchrow_hashref() )
{
push( @monitors, $monitor );
}
$sth->finish();
return( \@monitors );
}
sub zmDbGetMonitor
{
zmDbConnect();
zmDbConnect();
my $id = shift;
my $id = shift;
return( undef ) if ( !defined($id) );
return( undef ) if ( !defined($id) );
my $sql = "select * from Monitors where Id = ?";
my $sth = $dbh->prepare_cached( $sql )
or croak( "Can't prepare '$sql': ".$dbh->errstr() );
my $res = $sth->execute( $id )
or croak( "Can't execute '$sql': ".$sth->errstr() );
my $monitor = $sth->fetchrow_hashref();
my $sql = "select * from Monitors where Id = ?";
my $sth = $dbh->prepare_cached( $sql )
or croak( "Can't prepare '$sql': ".$dbh->errstr() );
my $res = $sth->execute( $id )
or croak( "Can't execute '$sql': ".$sth->errstr() );
my $monitor = $sth->fetchrow_hashref();
return( $monitor );
return( $monitor );
}
sub zmDbGetMonitorAndControl
{
zmDbConnect();
zmDbConnect();
my $id = shift;
my $id = shift;
return( undef ) if ( !defined($id) );
return( undef ) if ( !defined($id) );
my $sql = "SELECT C.*,M.*,C.Protocol
FROM Monitors as M
INNER JOIN Controls as C on (M.ControlId = C.Id)
WHERE M.Id = ?"
my $sql = "SELECT C.*,M.*,C.Protocol
FROM Monitors as M
INNER JOIN Controls as C on (M.ControlId = C.Id)
WHERE M.Id = ?"
;
my $sth = $dbh->prepare_cached( $sql )
or Fatal( "Can't prepare '$sql': ".$dbh->errstr() );
my $res = $sth->execute( $id )
or Fatal( "Can't execute '$sql': ".$sth->errstr() );
my $monitor = $sth->fetchrow_hashref();
my $sth = $dbh->prepare_cached( $sql )
or Fatal( "Can't prepare '$sql': ".$dbh->errstr() );
my $res = $sth->execute( $id )
or Fatal( "Can't execute '$sql': ".$sth->errstr() );
my $monitor = $sth->fetchrow_hashref();
return( $monitor );
return( $monitor );
}
1;
@@ -217,8 +217,8 @@ ZoneMinder::Database - Perl extension for blah blah blah
=head1 SYNOPSIS
use ZoneMinder::Database;
blah blah blah
use ZoneMinder::Database;
blah blah blah
=head1 DESCRIPTION
+172 -172
View File
@@ -43,8 +43,8 @@ our @ISA = qw(Exporter ZoneMinder::Base);
# will save memory.
our %EXPORT_TAGS = (
'functions' => [ qw(
) ]
);
) ]
);
push( @{$EXPORT_TAGS{all}}, @{$EXPORT_TAGS{$_}} ) foreach keys %EXPORT_TAGS;
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
@@ -66,214 +66,214 @@ use ZoneMinder::Database qw(:all);
use POSIX;
sub new {
my ( $parent, $id, $data ) = @_;
my ( $parent, $id, $data ) = @_;
my $self = {};
bless $self, $parent;
$$self{dbh} = $ZoneMinder::Database::dbh;
my $self = {};
bless $self, $parent;
$$self{dbh} = $ZoneMinder::Database::dbh;
#zmDbConnect();
if ( ( $$self{Id} = $id ) or $data ) {
if ( ( $$self{Id} = $id ) or $data ) {
#$log->debug("loading $parent $id") if $debug or DEBUG_ALL;
$self->load( $data );
}
return $self;
$self->load( $data );
}
return $self;
} # end sub new
sub load {
my ( $self, $data ) = @_;
my $type = ref $self;
if ( ! $data ) {
my ( $self, $data ) = @_;
my $type = ref $self;
if ( ! $data ) {
#$log->debug("Object::load Loading from db $type");
$data = $$self{dbh}->selectrow_hashref( 'SELECT * FROM Events WHERE Id=?', {}, $$self{Id} );
if ( ! $data ) {
Error( "Failure to load Event record for $$self{Id}: Reason: " . $$self{dbh}->errstr );
} else {
Debug( 3, "Loaded Event $$self{Id}" );
} # end if
} # end if ! $data
if ( $data and %$data ) {
@$self{keys %$data} = values %$data;
} # end if
$data = $$self{dbh}->selectrow_hashref( 'SELECT * FROM Events WHERE Id=?', {}, $$self{Id} );
if ( ! $data ) {
Error( "Failure to load Event record for $$self{Id}: Reason: " . $$self{dbh}->errstr );
} else {
Debug( 3, "Loaded Event $$self{Id}" );
} # end if
} # end if ! $data
if ( $data and %$data ) {
@$self{keys %$data} = values %$data;
} # end if
} # end sub load
sub Name {
if ( @_ > 1 ) {
$_[0]{Name} = $_[1];
}
return $_[0]{Name};
if ( @_ > 1 ) {
$_[0]{Name} = $_[1];
}
return $_[0]{Name};
} # end sub Path
sub find {
shift if $_[0] eq 'ZoneMinder::Event';
my %sql_filters = @_;
shift if $_[0] eq 'ZoneMinder::Event';
my %sql_filters = @_;
my $sql = 'SELECT * FROM Events';
my @sql_filters;
my @sql_values;
my $sql = 'SELECT * FROM Events';
my @sql_filters;
my @sql_values;
if ( exists $sql_filters{Name} ) {
push @sql_filters , ' Name = ? ';
push @sql_values, $sql_filters{Name};
}
if ( exists $sql_filters{Name} ) {
push @sql_filters , ' Name = ? ';
push @sql_values, $sql_filters{Name};
}
$sql .= ' WHERE ' . join(' AND ', @sql_filters ) if @sql_filters;
$sql .= ' LIMIT ' . $sql_filters{limit} if $sql_filters{limit};
$sql .= ' WHERE ' . join(' AND ', @sql_filters ) if @sql_filters;
$sql .= ' LIMIT ' . $sql_filters{limit} if $sql_filters{limit};
my $sth = $ZoneMinder::Database::dbh->prepare_cached( $sql )
or Fatal( "Can't prepare '$sql': ".$ZoneMinder::Database::dbh->errstr() );
my $res = $sth->execute( @sql_values )
or Fatal( "Can't execute '$sql': ".$sth->errstr() );
my $sth = $ZoneMinder::Database::dbh->prepare_cached( $sql )
or Fatal( "Can't prepare '$sql': ".$ZoneMinder::Database::dbh->errstr() );
my $res = $sth->execute( @sql_values )
or Fatal( "Can't execute '$sql': ".$sth->errstr() );
my @results;
my @results;
while( my $db_filter = $sth->fetchrow_hashref() ) {
my $filter = new ZoneMinder::Event( $$db_filter{Id}, $db_filter );
push @results, $filter;
} # end while
return @results;
while( my $db_filter = $sth->fetchrow_hashref() ) {
my $filter = new ZoneMinder::Event( $$db_filter{Id}, $db_filter );
push @results, $filter;
} # end while
return @results;
}
sub find_one {
my @results = find(@_);
return $results[0] if @results;
my @results = find(@_);
return $results[0] if @results;
}
sub getEventPath
{
my $event = shift;
my $event = shift;
my $event_path = "";
if ( $Config{ZM_USE_DEEP_STORAGE} )
{
$event_path = $Config{ZM_DIR_EVENTS}
.'/'.$event->{MonitorId}
.'/'.strftime( "%y/%m/%d/%H/%M/%S",
localtime($event->{Time})
)
;
}
else
{
$event_path = $Config{ZM_DIR_EVENTS}
.'/'.$event->{MonitorId}
.'/'.$event->{Id}
;
}
my $event_path = "";
if ( $Config{ZM_USE_DEEP_STORAGE} )
{
$event_path = $Config{ZM_DIR_EVENTS}
.'/'.$event->{MonitorId}
.'/'.strftime( "%y/%m/%d/%H/%M/%S",
localtime($event->{Time})
)
;
}
else
{
$event_path = $Config{ZM_DIR_EVENTS}
.'/'.$event->{MonitorId}
.'/'.$event->{Id}
;
}
if ( index($Config{ZM_DIR_EVENTS},'/') != 0 ){
$event_path = $Config{ZM_PATH_WEB}
.'/'.$event_path
;
}
return( $event_path );
if ( index($Config{ZM_DIR_EVENTS},'/') != 0 ){
$event_path = $Config{ZM_PATH_WEB}
.'/'.$event_path
;
}
return( $event_path );
}
sub GenerateVideo {
my ( $self, $rate, $fps, $scale, $size, $overwrite, $format ) = @_;
my ( $self, $rate, $fps, $scale, $size, $overwrite, $format ) = @_;
my $event_path = getEventPath( $self );
chdir( $event_path );
( my $video_name = $self->{Name} ) =~ s/\s/_/g;
my $event_path = getEventPath( $self );
chdir( $event_path );
( my $video_name = $self->{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 );
}
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 )
{
Info( "Creating video file $video_file for event $self->{Id}\n" );
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 )
{
Info( "Creating video file $video_file for event $self->{Id}\n" );
my $frame_rate = sprintf( "%.2f", $self->{Frames}/$self->{FullLength} );
if ( $rate )
{
if ( $rate != 1.0 )
{
$frame_rate *= $rate;
}
}
elsif ( $fps )
{
$frame_rate = $fps;
}
my $frame_rate = sprintf( "%.2f", $self->{Frames}/$self->{FullLength} );
if ( $rate )
{
if ( $rate != 1.0 )
{
$frame_rate *= $rate;
}
}
elsif ( $fps )
{
$frame_rate = $fps;
}
my $width = $self->{MonitorWidth};
my $height = $self->{MonitorHeight};
my $video_size = " ${width}x${height}";
my $width = $self->{MonitorWidth};
my $height = $self->{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 = $Config{ZM_PATH_FFMPEG}
." -y -r $frame_rate "
.$Config{ZM_FFMPEG_INPUT_OPTIONS}
." -i %0"
.$Config{ZM_EVENT_IMAGE_DIGITS}
."d-capture.jpg -s $video_size "
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 = $Config{ZM_PATH_FFMPEG}
." -y -r $frame_rate "
.$Config{ZM_FFMPEG_INPUT_OPTIONS}
." -i %0"
.$Config{ZM_EVENT_IMAGE_DIGITS}
."d-capture.jpg -s $video_size "
#. " -f concat -i /tmp/event_files.txt"
." -s $video_size "
.$Config{ZM_FFMPEG_OUTPUT_OPTIONS}
." '$video_file' > ffmpeg.log 2>&1"
;
Debug( $command."\n" );
my $output = qx($command);
." -s $video_size "
.$Config{ZM_FFMPEG_OUTPUT_OPTIONS}
." '$video_file' > ffmpeg.log 2>&1"
;
Debug( $command."\n" );
my $output = qx($command);
my $status = $? >> 8;
if ( $status )
{
Error( "Unable to generate video, check "
.$event_path."/ffmpeg.log for details"
);
return;
}
my $status = $? >> 8;
if ( $status )
{
Error( "Unable to generate video, check "
.$event_path."/ffmpeg.log for details"
);
return;
}
Info( "Finished $video_file\n" );
return $event_path.'/'.$video_file;
} else {
Info( "Video file $video_file already exists for event $self->{Id}\n" );
return $event_path.'/'.$video_file;
}
return;
Info( "Finished $video_file\n" );
return $event_path.'/'.$video_file;
} else {
Info( "Video file $video_file already exists for event $self->{Id}\n" );
return $event_path.'/'.$video_file;
}
return;
} # end sub GenerateVideo
1;
@@ -286,8 +286,8 @@ ZoneMinder::Database - Perl extension for blah blah blah
=head1 SYNOPSIS
use ZoneMinder::Event;
blah blah blah
use ZoneMinder::Event;
blah blah blah
=head1 DESCRIPTION
+1 -1
View File
@@ -88,7 +88,7 @@ sub load {
if ( ! $data ) {
Error( "Failure to load Filter record for $$self{Id}: Reason: " . $$self{dbh}->errstr );
} else {
Debug( 3, "Loaded Filter $$self{Id}" );
Debug( 3, "Loaded Filter $$self{Id}" );
} # end if
} # end if ! $data
if ( $data and %$data ) {
File diff suppressed because it is too large. Load diff
File diff suppressed because it is too large. Load diff
File diff suppressed because it is too large. Load diff
+32 -32
View File
@@ -42,8 +42,8 @@ our @ISA = qw(Exporter ZoneMinder::Base);
# will save memory.
our %EXPORT_TAGS = (
'functions' => [ qw(
) ]
);
) ]
);
push( @{$EXPORT_TAGS{all}}, @{$EXPORT_TAGS{$_}} ) foreach keys %EXPORT_TAGS;
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
@@ -65,46 +65,46 @@ use ZoneMinder::Database qw(:all);
use POSIX;
sub new {
my ( $parent, $id, $data ) = @_;
my ( $parent, $id, $data ) = @_;
my $self = {};
bless $self, $parent;
if ( ( $$self{Id} = $id ) or $data ) {
my $self = {};
bless $self, $parent;
if ( ( $$self{Id} = $id ) or $data ) {
#$log->debug("loading $parent $id") if $debug or DEBUG_ALL;
$self->load( $data );
}
return $self;
$self->load( $data );
}
return $self;
} # end sub new
sub load {
my ( $self, $data ) = @_;
my $type = ref $self;
if ( ! $data ) {
my ( $self, $data ) = @_;
my $type = ref $self;
if ( ! $data ) {
#$log->debug("Object::load Loading from db $type");
$data = $ZoneMinder::Database::dbh->selectrow_hashref( 'SELECT * FROM Servers WHERE Id=?', {}, $$self{Id} );
if ( ! $data ) {
if ( $ZoneMinder::Database::dbh->errstr ) {
Error( "Failure to load Server record for $$self{id}: Reason: " . $ZoneMinder::Database::dbh->errstr );
} # end if
} # end if
} # end if ! $data
if ( $data and %$data ) {
@$self{keys %$data} = values %$data;
} # end if
$data = $ZoneMinder::Database::dbh->selectrow_hashref( 'SELECT * FROM Servers WHERE Id=?', {}, $$self{Id} );
if ( ! $data ) {
if ( $ZoneMinder::Database::dbh->errstr ) {
Error( "Failure to load Server record for $$self{id}: Reason: " . $ZoneMinder::Database::dbh->errstr );
} # end if
} # end if
} # end if ! $data
if ( $data and %$data ) {
@$self{keys %$data} = values %$data;
} # end if
} # end sub load
sub Name {
if ( @_ > 1 ) {
$_[0]{Name} = $_[1];
}
return $_[0]{Name};
if ( @_ > 1 ) {
$_[0]{Name} = $_[1];
}
return $_[0]{Name};
} # end sub Name
sub Hostname {
if ( @_ > 1 ) {
$_[0]{Hostname} = $_[1];
}
return $_[0]{Hostname};
if ( @_ > 1 ) {
$_[0]{Hostname} = $_[1];
}
return $_[0]{Hostname};
} # end sub Hostname
1;
@@ -117,8 +117,8 @@ ZoneMinder::Database - Perl extension for blah blah blah
=head1 SYNOPSIS
use ZoneMinder::Server;
blah blah blah
use ZoneMinder::Server;
blah blah blah
=head1 DESCRIPTION