merge from SA, but remove Storageareas bits
This commit is contained in:
parent
ab85239d82
commit
1d5248c0b8
|
@ -28,30 +28,12 @@ use 5.006;
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
|
||||||
require Exporter;
|
|
||||||
require ZoneMinder::Base;
|
require ZoneMinder::Base;
|
||||||
|
require ZoneMinder::Object;
|
||||||
require Date::Manip;
|
require Date::Manip;
|
||||||
|
|
||||||
our @ISA = qw(Exporter ZoneMinder::Base);
|
#our @ISA = qw(ZoneMinder::Object);
|
||||||
|
use parent qw(ZoneMinder::Object);
|
||||||
# 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 = (
|
|
||||||
'functions' => [ qw(
|
|
||||||
) ]
|
|
||||||
);
|
|
||||||
push( @{$EXPORT_TAGS{all}}, @{$EXPORT_TAGS{$_}} ) foreach keys %EXPORT_TAGS;
|
|
||||||
|
|
||||||
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
|
||||||
|
|
||||||
our @EXPORT = qw();
|
|
||||||
|
|
||||||
our $VERSION = $ZoneMinder::Base::VERSION;
|
|
||||||
|
|
||||||
# ==========================================================================
|
# ==========================================================================
|
||||||
#
|
#
|
||||||
|
@ -62,39 +44,24 @@ our $VERSION = $ZoneMinder::Base::VERSION;
|
||||||
use ZoneMinder::Config qw(:all);
|
use ZoneMinder::Config qw(:all);
|
||||||
use ZoneMinder::Logger qw(:all);
|
use ZoneMinder::Logger qw(:all);
|
||||||
use ZoneMinder::Database qw(:all);
|
use ZoneMinder::Database qw(:all);
|
||||||
|
require Date::Parse;
|
||||||
|
|
||||||
|
use vars qw/ $table $primary_key /;
|
||||||
|
$table = 'Events';
|
||||||
|
$primary_key = 'Id';
|
||||||
|
|
||||||
use POSIX;
|
use POSIX;
|
||||||
|
|
||||||
sub new {
|
sub Time {
|
||||||
my ( $parent, $id, $data ) = @_;
|
if ( @_ > 1 ) {
|
||||||
|
$_[0]{Time} = $_[1];
|
||||||
my $self = {};
|
|
||||||
bless $self, $parent;
|
|
||||||
$$self{dbh} = $ZoneMinder::Database::dbh;
|
|
||||||
#zmDbConnect();
|
|
||||||
if ( ( $$self{Id} = $id ) or $data ) {
|
|
||||||
#$log->debug("loading $parent $id") if $debug or DEBUG_ALL;
|
|
||||||
$self->load( $data );
|
|
||||||
}
|
}
|
||||||
return $self;
|
if ( ! defined $_[0]{Time} ) {
|
||||||
} # end sub new
|
|
||||||
|
|
||||||
sub load {
|
$_[0]{Time} = Date::Parse::str2time( $_[0]{StartTime} );
|
||||||
my ( $self, $data ) = @_;
|
}
|
||||||
my $type = ref $self;
|
return $_[0]{Time};
|
||||||
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
|
|
||||||
} # end sub load
|
|
||||||
|
|
||||||
sub Name {
|
sub Name {
|
||||||
if ( @_ > 1 ) {
|
if ( @_ > 1 ) {
|
||||||
|
@ -130,6 +97,7 @@ sub find {
|
||||||
my $filter = new ZoneMinder::Event( $$db_filter{Id}, $db_filter );
|
my $filter = new ZoneMinder::Event( $$db_filter{Id}, $db_filter );
|
||||||
push @results, $filter;
|
push @results, $filter;
|
||||||
} # end while
|
} # end while
|
||||||
|
$sth->finish();
|
||||||
return @results;
|
return @results;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -138,36 +106,51 @@ sub find_one {
|
||||||
return $results[0] if @results;
|
return $results[0] if @results;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub getEventPath {
|
sub getPath {
|
||||||
|
return Path( @_ );
|
||||||
|
}
|
||||||
|
sub Path {
|
||||||
my $event = shift;
|
my $event = shift;
|
||||||
|
|
||||||
my $event_path = "";
|
if ( @_ > 1 ) {
|
||||||
if ( $Config{ZM_USE_DEEP_STORAGE} ) {
|
$$event{Path} = $_[1];
|
||||||
$event_path = $Config{ZM_DIR_EVENTS}
|
if ( ! -e $$event{Path} ) {
|
||||||
.'/'.$event->{MonitorId}
|
Error("Setting path for event $$event{Id} to $_[1] but does not exist!");
|
||||||
.'/'.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 ){
|
if ( ! $$event{Path} ) {
|
||||||
$event_path = $Config{ZM_PATH_WEB}
|
my $path = ($Config{ZM_DIR_EVENTS}=~/^\//) ? $Config{ZM_DIR_EVENTS} : $Config{ZM_PATH_WEB}.'/'.$Config{ZM_DIR_EVENTS};
|
||||||
.'/'.$event_path
|
|
||||||
;
|
if ( $Config{ZM_USE_DEEP_STORAGE} ) {
|
||||||
|
if ( $event->Time() ) {
|
||||||
|
$$event{Path} = join('/',
|
||||||
|
$path,
|
||||||
|
$event->{MonitorId},
|
||||||
|
strftime( "%y/%m/%d/%H/%M/%S",
|
||||||
|
localtime($event->Time())
|
||||||
|
),
|
||||||
|
);
|
||||||
|
} else {
|
||||||
|
Error("Event $$event{Id} has no value for Time(), unable to determine path");
|
||||||
|
$$event{Path} = '';
|
||||||
}
|
}
|
||||||
return( $event_path );
|
} else {
|
||||||
|
$$event{Path} = join('/',
|
||||||
|
$path,
|
||||||
|
$event->{MonitorId},
|
||||||
|
$event->{Id},
|
||||||
|
);
|
||||||
|
}
|
||||||
|
} # end if
|
||||||
|
|
||||||
|
return $$event{Path};
|
||||||
}
|
}
|
||||||
|
|
||||||
sub GenerateVideo {
|
sub GenerateVideo {
|
||||||
my ( $self, $rate, $fps, $scale, $size, $overwrite, $format ) = @_;
|
my ( $self, $rate, $fps, $scale, $size, $overwrite, $format ) = @_;
|
||||||
|
|
||||||
my $event_path = getEventPath( $self );
|
my $event_path = $self->getPath( );
|
||||||
chdir( $event_path );
|
chdir( $event_path );
|
||||||
( my $video_name = $self->{Name} ) =~ s/\s/_/g;
|
( my $video_name = $self->{Name} ) =~ s/\s/_/g;
|
||||||
|
|
||||||
|
@ -228,9 +211,7 @@ sub GenerateVideo {
|
||||||
my $command = $Config{ZM_PATH_FFMPEG}
|
my $command = $Config{ZM_PATH_FFMPEG}
|
||||||
." -y -r $frame_rate "
|
." -y -r $frame_rate "
|
||||||
.$Config{ZM_FFMPEG_INPUT_OPTIONS}
|
.$Config{ZM_FFMPEG_INPUT_OPTIONS}
|
||||||
." -i %0"
|
.' -i ' . ( $$self{DefaultVideo} ? $$self{DefaultVideo} : '%0'.$Config{ZM_EVENT_IMAGE_DIGITS} .'d-capture.jpg' )
|
||||||
.$Config{ZM_EVENT_IMAGE_DIGITS}
|
|
||||||
."d-capture.jpg -s $video_size "
|
|
||||||
#. " -f concat -i /tmp/event_files.txt"
|
#. " -f concat -i /tmp/event_files.txt"
|
||||||
." -s $video_size "
|
." -s $video_size "
|
||||||
.$Config{ZM_FFMPEG_OUTPUT_OPTIONS}
|
.$Config{ZM_FFMPEG_OUTPUT_OPTIONS}
|
||||||
|
@ -256,51 +237,140 @@ sub GenerateVideo {
|
||||||
return;
|
return;
|
||||||
} # end sub GenerateVideo
|
} # end sub GenerateVideo
|
||||||
|
|
||||||
|
sub delete {
|
||||||
|
my $event = $_[0];
|
||||||
|
Info( "Deleting event $event->{Id} from Monitor $event->{MonitorId} $event->{StartTime}\n" );
|
||||||
|
$ZoneMinder::Database::dbh->ping();
|
||||||
|
# Do it individually to avoid locking up the table for new events
|
||||||
|
my $sql = 'delete from Events where Id = ?';
|
||||||
|
my $sth = $ZoneMinder::Database::dbh->prepare_cached( $sql )
|
||||||
|
or Fatal( "Can't prepare '$sql': ".$ZoneMinder::Database::dbh->errstr() );
|
||||||
|
my $res = $sth->execute( $event->{Id} )
|
||||||
|
or Fatal( "Can't execute '$sql': ".$sth->errstr() );
|
||||||
|
$sth->finish();
|
||||||
|
|
||||||
|
if ( ! $Config{ZM_OPT_FAST_DELETE} ) {
|
||||||
|
my $sql = 'delete from Frames where EventId = ?';
|
||||||
|
my $sth = $ZoneMinder::Database::dbh->prepare_cached( $sql )
|
||||||
|
or Fatal( "Can't prepare '$sql': ".$ZoneMinder::Database::dbh->errstr() );
|
||||||
|
my $res = $sth->execute( $event->{Id} )
|
||||||
|
or Fatal( "Can't execute '$sql': ".$sth->errstr() );
|
||||||
|
$sth->finish();
|
||||||
|
|
||||||
|
$sql = 'delete from Stats where EventId = ?';
|
||||||
|
$sth = $ZoneMinder::Database::dbh->prepare_cached( $sql )
|
||||||
|
or Fatal( "Can't prepare '$sql': ".$ZoneMinder::Database::dbh->errstr() );
|
||||||
|
$res = $sth->execute( $event->{Id} )
|
||||||
|
or Fatal( "Can't execute '$sql': ".$sth->errstr() );
|
||||||
|
$sth->finish();
|
||||||
|
|
||||||
|
$event->delete_files( );
|
||||||
|
} else {
|
||||||
|
Debug('Not deleting frames, stats and files for speed.');
|
||||||
|
}
|
||||||
|
} # end sub delete
|
||||||
|
|
||||||
|
|
||||||
|
sub delete_files {
|
||||||
|
|
||||||
|
my $storage_path = ($Config{ZM_DIR_EVENTS}=~/^\//) ? $Config{ZM_DIR_EVENTS} : $Config{ZM_PATH_WEB}.'/'.$Config{ZM_DIR_EVENTS};
|
||||||
|
|
||||||
|
if ( ! $storage_path ) {
|
||||||
|
Fatal("Empty path when deleting files for event $_[0]{Id} ");
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
chdir ( $storage_path );
|
||||||
|
|
||||||
|
if ( $Config{ZM_USE_DEEP_STORAGE} ) {
|
||||||
|
if ( ! $_[0]{MonitorId} ) {
|
||||||
|
Error("No monitor id assigned to event $_[0]{Id}");
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
Debug("Deleting files for Event $_[0]{Id} from $storage_path.");
|
||||||
|
my $link_path = $_[0]{MonitorId}.'/*/*/*/.'.$_[0]{Id};
|
||||||
|
#Debug( "LP1:$link_path" );
|
||||||
|
my @links = glob($link_path);
|
||||||
|
#Debug( "L:".$links[0].": $!" );
|
||||||
|
if ( @links ) {
|
||||||
|
( $link_path ) = ( $links[0] =~ /^(.*)$/ ); # De-taint
|
||||||
|
#Debug( "LP2:$link_path" );
|
||||||
|
|
||||||
|
( my $day_path = $link_path ) =~ s/\.\d+//;
|
||||||
|
#Debug( "DP:$day_path" );
|
||||||
|
my $event_path = $day_path.readlink( $link_path );
|
||||||
|
( $event_path ) = ( $event_path =~ /^(.*)$/ ); # De-taint
|
||||||
|
#Debug( "EP:$event_path" );
|
||||||
|
my $command = "/bin/rm -rf $event_path";
|
||||||
|
#Debug( "C:$command" );
|
||||||
|
ZoneMinder::General::executeShellCommand( $command );
|
||||||
|
|
||||||
|
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-- ) {
|
||||||
|
my $delete_path = join( '/', @path_parts[0..$i] );
|
||||||
|
#Debug( "DP$i:$delete_path" );
|
||||||
|
my @has_files = glob( join('/', $storage_path,$delete_path,'*' ) );
|
||||||
|
#Debug( "HF1:".$has_files[0] ) if ( @has_files );
|
||||||
|
last if ( @has_files );
|
||||||
|
@has_files = glob( join('/', $storage_path, $delete_path, '.[0-9]*' ) );
|
||||||
|
#Debug( "HF2:".$has_files[0] ) if ( @has_files );
|
||||||
|
last if ( @has_files );
|
||||||
|
my $command = "/bin/rm -rf $storage_path/$delete_path";
|
||||||
|
ZoneMinder::General::executeShellCommand( $command );
|
||||||
|
}
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
my $command = "/bin/rm -rf $storage_path/$_[0]{MonitorId}/$_[0]{Id}";
|
||||||
|
ZoneMinder::General::executeShellCommand( $command );
|
||||||
|
}
|
||||||
|
} # end sub delete_files
|
||||||
|
|
||||||
|
sub Storage {
|
||||||
|
return new ZoneMinder::Storage( $_[0]{StorageId} );
|
||||||
|
}
|
||||||
|
|
||||||
|
sub check_for_in_filesystem {
|
||||||
|
my $path = $_[0]->Path();
|
||||||
|
if ( $path ) {
|
||||||
|
my @files = glob( $path . '/*' );
|
||||||
|
Debug("Checking for files for event $_[0]{Id} at $path using glob $path/* found " . scalar @files . " files");
|
||||||
|
return 1 if @files;
|
||||||
|
}
|
||||||
|
Debug("Checking for files for event $_[0]{Id} at $path using glob $path/* found no files");
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub age {
|
||||||
|
if ( ! $_[0]{age} ) {
|
||||||
|
$_[0]{age} = (time() - ($^T - ((-M $_[0]->Path() ) * 24*60*60)));
|
||||||
|
}
|
||||||
|
return $_[0]{age};
|
||||||
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
__END__
|
__END__
|
||||||
# Below is stub documentation for your module. You'd better edit it!
|
|
||||||
|
|
||||||
=head1 NAME
|
=head1 NAME
|
||||||
|
|
||||||
ZoneMinder::Database - Perl extension for blah blah blah
|
ZoneMinder::Event - Perl Class for events
|
||||||
|
|
||||||
=head1 SYNOPSIS
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
use ZoneMinder::Event;
|
use ZoneMinder::Event;
|
||||||
blah blah blah
|
|
||||||
|
|
||||||
=head1 DESCRIPTION
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
The Event class has everything you need to deal with events from Perl.
|
||||||
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
|
=head1 AUTHOR
|
||||||
|
|
||||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
Isaac Connor, E<lt>isaac@zoneminder.comE<gt>
|
||||||
|
|
||||||
=head1 COPYRIGHT AND LICENSE
|
=head1 COPYRIGHT AND LICENSE
|
||||||
|
|
||||||
Copyright (C) 2001-2008 Philip Coombes
|
Copyright (C) 2001-2017 ZoneMinder LLC
|
||||||
|
|
||||||
This library is free software; you can redistribute it and/or modify
|
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,
|
it under the same terms as Perl itself, either Perl version 5.8.3 or,
|
||||||
|
|
Loading…
Reference in New Issue