Perl: Работа с камерой

Зачастую стандартные драйвера и ПО для синхронизации данных с камерами не позволяют решать специфические задачи обмена информацией с устройством. В таких случаях удобно задействовать какой-либо api устройства для написание скрипта, утилиты для решения подобных задач.

#!/usr/bin/perl -w
use Net::HTTP;
use Getopt::Std;
use MIME::Base64;
 
our ($opt_f, $opt_u, $opt_p, $opt_i);
getopts('f:u:p:i:');
 
die 'please specify -f "folder_name" -u "userName" -p "Password" -i "CameraIpAddress' unless($opt_f && $opt_u && $opt_p && $opt_i);
 
# todo add custom directory support
$current_video_archive_directory = $opt_f;
 
$authorization_parameter = encode_base64($opt_u . ':' . $opt_p);
 
# change currentdirectory
chdir $current_video_archive_directory or
do
{
# looks like we should create archive dir
mkdir $current_video_archive_directory or die "we cannot create directory $current_video_archive_directory";
chdir $current_video_archive_directory or die "we cannot use directory $current_video_archive_directory as file archive directory";
};
 
 
my $s = Net::HTTP->new(Host => $opt_i) || die $@;
 
$s->write_request('GET' => "/nphMotionJpeg?Resolution=640x480&Quality=Standard",
'User-Agent' => "Mozilla/5.0",
'KeepAlive' => 300,
'Accept' => 'image/png,image/*;q=0.8,*/*;q=0.5',
'Accept-Language' => 'ru,en-us;q=0.7,en;q=0.3',
'Accept-Encoding' => 'gzip,deflate',
'Accept-Charset' => 'windows-1251,utf-8;q=0.7,*;q=0.7',
'Connection' => 'keep-alive',
'Authorization' => "Basic $authorization_parameter"
);
my($code, $mess, %h) = $s->read_response_headers;
 
my $boundary = undef;
 
for($h{'Content-type'})
{
die "inappropriate Content-type" unless /multipart\/x-mixed-replace/;
die "cannot find boundary from response header" unless /boundary=/;
$boundary = $';
}
 
my $current_buf;
my $content_length = undef;
my $boundary_found = undef;
my $content_type = undef;
my $new_line = undef;
my $skip_the_socket_read = undef;
 
my ($cur_hour, $cur_mday,$cur_mon,$cur_year);
my $sub_dir_created = undef;
 
MAIN_HTTP_READ:while (1) {
my $buf;
my $n = undef;
 
unless($skip_the_socket_read)
{
$n = $s->read_entity_body($buf, 1024);
die "http data read failed: $!" unless defined $n;
last unless $n;
$current_buf.= $buf;
}
else
{
$skip_the_socket_read = undef;
}
 
unless($boundary_found)
{
for($current_buf)
{
do
{
die "Strange Motion Jpeg. Looks like either parser error or unsupported device" if length($current_buf) >= length($boundary) + 2;
next MAIN_HTTP_READ;
} unless /^$boundary\r\n/m;
$current_buf = $';
$boundary_found = 1;
}
}
 
unless($content_length)
{
for($current_buf)
{
do
{
die "Strange Motion Jpeg. Looks like either parser error or unsupported device" if /\r\n/;
next MAIN_HTTP_READ;
} unless /^Content-length: (\d+)\r\n/;
$current_buf = $';
$content_length = $1;
}
}
 
unless($content_type)
{
for($current_buf)
{
do
{
die "Strange Motion Jpeg. Looks like either parser error or unsupported device" if length($current_buf) >= length("Content-type: image\/jpeg\r\n") + 2;
next MAIN_HTTP_READ;
} unless /^Content-type: image\/jpeg\r\n/;
$current_buf = $';
}
$content_type = 1;
}
 
unless($new_line)
{
for($current_buf)
{
do
{
die "Strange Motion Jpeg. Looks like either parser error or unsupported device" if length($current_buf) >= 2;
next MAIN_HTTP_READ;
} unless /^\r\n/;
 
$current_buf = $';
$new_line = 1;
}
}
 
# lets read the body
my $current_buf_length = length($current_buf);
my $need_2_read = ($content_length + 2) - $current_buf_length;
 
until(0 >= $need_2_read) # we don't already have the whole body
{
$n = $s->read_entity_body($buf, 1024);
die "http data read failed: $!" unless defined $n;
last unless $n;
$current_buf.= $buf;
 
$current_buf_length = length($current_buf);
$need_2_read = ($content_length + 2) - $current_buf_length;
}
 
if(0 > $need_2_read)
{
$skip_the_socket_read = 1;
}
 
$cur_body = substr $current_buf, 0, $content_length, '';
 
($sec,$min,$hour,$mday,$mon,$year) = localtime;
 
if( !(defined($cur_hour) && defined($cur_mday) && defined($cur_mon) && defined($cur_year)) ||
!( $cur_hour eq $hour && $cur_mday eq $mday && $cur_mon eq $mon && $cur_year eq $year) )
{
$sub_dir_created = undef;
}
 
unless($sub_dir_created)
{
if(defined($cur_hour) and defined($cur_mday) and defined($cur_mon) and defined($cur_year))
{
# goto video archive root
chdir ".." or die "cannot open videoarchive root directory";
}
 
($cur_hour, $cur_mday, $cur_mon, $cur_year) = ($hour, $mday, $mon, $year);
$dir_name = join '-', $year, $mon + 1, $mday, $hour;
 
unless(-d $dir_name)
{
mkdir $dir_name or die "cannot create $dir_name directory";
}
 
chdir $dir_name or die "cannot change directory to $dir_name";
 
$sub_dir_created = 1;
}
 
 
 
$file_name = join '-', $year, $mon + 1, $mday, $hour, $min, $sec;
$file_name_finally = $file_name . '.jpeg';
 
my $index = 0;
while(-e $file_name_finally)
{
$file_name_finally = $file_name .'-'. $index . '.jpeg';
$index++;
}
 
open JPEG_FILE, ">$file_name_finally" or die "cannot open file $file_name_finally";
binmode JPEG_FILE;
print JPEG_FILE $cur_body or die "cannot print into the file $file_name_finally";
close JPEG_FILE or die "cannot close the file $file_name_finally";
 
for($current_buf)
{
die "Strange Motion Jpeg. Looks like either parser error or unsupported device" unless /\r\n/;
$current_buf = $';
}
 
$content_length = undef;
$boundary_found = undef;
$content_type = undef;
$new_line = undef;
}
 
__END__

Сохраняет в папку 'archive' jpeg картинки полученные с камеры. Возможно будет работать с другими типами ip камер panasonic.
Небольшие изменения позволят работать с камерами axis и d-link

perl motionJpeg.pl -p xolopp -u ppolox -f archive -i 192.168.0.253

Поддержку работы функций ptz пока не добавлял.