add ubuntu15.04 using cmake with split packages
This commit is contained in:
Isaac Connor
parent
bda35ed4d6
commit
106d543367
|
|
@ -0,0 +1,51 @@
|
|||
zoneminder for Debian
|
||||
---------------------
|
||||
|
||||
There is one manual step to get the web interface working.
|
||||
You need to link /etc/zm/apache.conf to /etc/apache2/conf.d/zoneminder.conf,
|
||||
then reload the apache config (i.e. /etc/init.d/apache2 reload)
|
||||
|
||||
Changing the location for images and events
|
||||
-------------------------------------------
|
||||
|
||||
Zoneminder, in its upstream form, stores data in /usr/share/zoneminder/. This
|
||||
package modifies that by changing /usr/share/zoneminder/images and
|
||||
/usr/share/zoneminder/events to symlinks to directories under
|
||||
/var/cache/zoneminder.
|
||||
|
||||
There are numerous places these could be put and ways to do it. But, at the
|
||||
moment, if you change this, an upgrade will fail with a warning about these
|
||||
locations having changed (the reason for this was that previously, an upgrade
|
||||
would silently revert the changes and cause event loss - refer
|
||||
bug #608793).
|
||||
|
||||
If you do want to change the location, here are a couple of suggestions.
|
||||
|
||||
These lines would mount /dev/sdX1 to /video_storage, and then 'link' /video_storage
|
||||
to the locations that ZoneMinder expects them to be at.
|
||||
|
||||
/dev/sdX1 /video_storage ext4 defaults 0 2
|
||||
/video_storage/zoneminder/images /var/cache/zoneminder/images none bind 0 2
|
||||
/video_storage/zoneminder/events /var/cache/zoneminder/events none bind 0 2
|
||||
|
||||
or if you have a separate partition for each:
|
||||
|
||||
/dev/sdX1 /var/cache/zoneminder/images ext4 defaults 0 2
|
||||
/dev/sdX2 /var/cache/zoneminder/events ext4 defaults 0 2
|
||||
|
||||
|
||||
|
||||
-- Peter Howard <pjh@northern-ridge.com.au>, Sun, 16 Jan 2010 01:35:51 +1100
|
||||
|
||||
Access to /dev/video*
|
||||
---------------------
|
||||
|
||||
For cameras which require access to /dev/video*, zoneminder may need the
|
||||
www-data user added to the video group in order to see those cameras:
|
||||
|
||||
adduser www-data video
|
||||
|
||||
Note that all web applications running on the zoneminder server will then have
|
||||
access to all video devices on the system.
|
||||
|
||||
-- Vagrant Cascadian <vagrant@debian.org> Sun, 27 Mar 2011 13:06:56 -0700
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
Alias /zm /usr/share/zoneminder
|
||||
|
||||
<Directory /usr/share/zoneminder>
|
||||
php_flag register_globals off
|
||||
Options Indexes FollowSymLinks
|
||||
<IfModule mod_dir.c>
|
||||
DirectoryIndex index.php
|
||||
</IfModule>
|
||||
</Directory>
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,149 @@
|
|||
zoneminder (1.29.0-vivid-38) vivid; urgency=medium
|
||||
|
||||
* merge angular-ui
|
||||
|
||||
-- Isaac Connor <iconnor@connortechnology.com> Thu, 11 Jun 2015 09:10:34 -0400
|
||||
|
||||
zoneminder (1.29.0-vivid-37) vivid; urgency=medium
|
||||
|
||||
* Merge some things from master.
|
||||
|
||||
-- Isaac Connor <iconnor@connortechnology.com> Mon, 08 Jun 2015 10:48:59 -0400
|
||||
|
||||
zoneminder (1.29.0-trusty-36) trusty; urgency=medium
|
||||
|
||||
* Detect select interuption when no action on our fd
|
||||
|
||||
-- Isaac Connor <iconnor@testing.internal.point-one.com> Thu, 28 May 2015 09:35:59 -0400
|
||||
|
||||
zoneminder (1.29.0-trusty-35) trusty; urgency=medium
|
||||
|
||||
* better logging
|
||||
|
||||
-- Isaac Connor <iconnor@testing.internal.point-one.com> Fri, 22 May 2015 15:30:42 -0400
|
||||
|
||||
zoneminder (1.29.0-trusty-34) trusty; urgency=medium
|
||||
|
||||
* Faster shutdown and changes to ReadData
|
||||
|
||||
-- Isaac Connor <iconnor@testing.internal.point-one.com> Thu, 21 May 2015 15:54:47 -0400
|
||||
|
||||
zoneminder (1.29.0-trusty-33) trusty; urgency=medium
|
||||
|
||||
* update zmaudit some more
|
||||
|
||||
-- Isaac Connor <iconnor@testing.internal.point-one.com> Thu, 14 May 2015 13:44:35 -0400
|
||||
|
||||
zoneminder (1.29.0-trusty-32) trusty; urgency=medium
|
||||
|
||||
* merge zmaudit_updates1
|
||||
|
||||
-- Isaac Connor <iconnor@testing.internal.point-one.com> Wed, 13 May 2015 15:51:56 -0400
|
||||
|
||||
zoneminder (1.29.0-trusty-31) trusty; urgency=medium
|
||||
|
||||
* Merge some fixes and zmaudit improvements
|
||||
|
||||
-- Isaac Connor <iconnor@testing.internal.point-one.com> Wed, 13 May 2015 15:16:19 -0400
|
||||
|
||||
zoneminder (1.29.0-trusty-27) trusty; urgency=medium
|
||||
|
||||
* fflush logs, merge master.
|
||||
|
||||
-- Isaac Connor <iconnor@testing.internal.point-one.com> Mon, 30 Mar 2015 19:28:05 -0400
|
||||
|
||||
zoneminder (1.29.0-vivid-26) vivid; urgency=medium
|
||||
|
||||
* logging improvements, merge RedData changes
|
||||
|
||||
-- Isaac Connor <iconnor@connortechnology.com> Wed, 04 Mar 2015 16:39:19 -0500
|
||||
|
||||
zoneminder (1.29.0-vivid-25) vivid; urgency=medium
|
||||
|
||||
* some change to ReadData
|
||||
|
||||
-- Isaac Connor <iconnor@connortechnology.com> Mon, 02 Mar 2015 12:57:16 -0500
|
||||
|
||||
zoneminder (1.29.0-utopic-24) utopic; urgency=medium
|
||||
|
||||
* merge local_raw
|
||||
|
||||
-- Isaac Connor <iconnor@connortechnology.com> Mon, 23 Feb 2015 17:49:36 -0500
|
||||
|
||||
zoneminder (1.29.0-trusty-23) trusty; urgency=medium
|
||||
|
||||
* more onvif merges, fix to zmfilter
|
||||
|
||||
-- Isaac Connor <iconnor@testing.internal.point-one.com> Sat, 21 Feb 2015 16:17:01 -0500
|
||||
|
||||
zoneminder (1.29.0-trusty-22) trusty; urgency=medium
|
||||
|
||||
* updates from master: merge onvif, default to classic if skin not defined.
|
||||
|
||||
-- Isaac Connor <iconnor@connortechnology.com> Thu, 19 Feb 2015 18:14:58 -0500
|
||||
|
||||
zoneminder (1.29.0-utopic-21) utopic; urgency=medium
|
||||
|
||||
* updates from master, improve monitor probing and support TRENDnet cameras
|
||||
|
||||
-- Isaac Connor <iconnor@connortechnology.com> Tue, 17 Feb 2015 14:18:52 -0500
|
||||
|
||||
zoneminder (1.29.0-wheezy-20) wheezy; urgency=medium
|
||||
|
||||
* zmaudit.pl improvements - double check db before deleting fs event
|
||||
|
||||
-- Isaac Connor <iconnor@connortechnology.com> Wed, 04 Feb 2015 11:09:22 -0500
|
||||
|
||||
zoneminder (1.29.0-utopic-18) utopic; urgency=medium
|
||||
|
||||
* RTSP Timeout fixes
|
||||
|
||||
-- Isaac Connor <iconnor@connortechnology.com> Wed, 28 Jan 2015 13:49:16 -0500
|
||||
|
||||
zoneminder (1.29.0-utopic-17) utopic; urgency=medium
|
||||
|
||||
* Merge master, use new split-up debian build
|
||||
|
||||
-- Isaac Connor <iconnor@connortechnology.com> Mon, 26 Jan 2015 11:21:07 -0500
|
||||
|
||||
zoneminder (1.28.0+nmu1) testing; urgency=medium
|
||||
|
||||
* Non-maintainer upload
|
||||
* Split the debian package into several packages
|
||||
* Switch to native source format
|
||||
|
||||
-- Emmanuel Papin <manupap01@gmail.com> Thu, 15 Jan 2015 20:00:08 +0100
|
||||
|
||||
zoneminder (1.28.0-0.2) testing; urgency=medium
|
||||
|
||||
* Non-maintainer upload.
|
||||
* Upstream release for debian jessie
|
||||
* Package dependencies updated
|
||||
* debhelper version upgraded
|
||||
* Standards-Version upgraded
|
||||
* Use debhelper commands instead of standard commands
|
||||
* Install man pages in /usr/share/man (patch added)
|
||||
* Switch to quilt
|
||||
* Switch to systemd
|
||||
* Some lintian fixes
|
||||
|
||||
-- Emmanuel Papin <manupap01@gmail.com> Wed, 26 Nov 2014 00:26:01 +0100
|
||||
|
||||
zoneminder (1.28.0-0.1) stable; urgency=medium
|
||||
|
||||
* Release
|
||||
|
||||
-- Isaac Connor <iconnor@connortechnology.com> Fri, 17 Oct 2014 09:27:22 -0400
|
||||
|
||||
zoneminder (1.27.99+1-testing-SNAPSHOT2014072901) testing; urgency=medium
|
||||
|
||||
* improve error messages
|
||||
* Make zmupdate re-run the most recent patch so that people running the daily builds get their db updates
|
||||
|
||||
-- Isaac Connor <iconnor@connortechnology.com> Tue, 29 Jul 2014 14:50:20 -0400
|
||||
|
||||
zoneminder (1.27.0+1-testing-v4ltomonitor-1) testing; urgency=high
|
||||
|
||||
* Snapshot release -
|
||||
|
||||
-- Isaac Connor <iconnor@connortechnology.com> Wed, 09 Jul 2014 21:35:29 -0400
|
||||
|
|
@ -0,0 +1 @@
|
|||
9
|
||||
|
|
@ -0,0 +1,133 @@
|
|||
Source: zoneminder
|
||||
Section: net
|
||||
Priority: optional
|
||||
Maintainer: Isaac Connor <iconnor@connortechnology.com>
|
||||
Build-Depends: debhelper (>= 9), po-debconf (>= 1.0), autoconf, automake, libphp-serialization-perl, libgnutls-dev, libmysqlclient-dev | libmariadbclient-dev, libdbd-mysql-perl, libdate-manip-perl, libwww-perl, libjpeg8-dev | libjpeg9-dev | libjpeg62-turbo-dev, libpcre3-dev, libavcodec-dev, libavformat-dev (>= 3:0.svn20090204), libswscale-dev (>= 3:0.svn20090204), libavutil-dev, libv4l-dev (>= 0.8.3), libbz2-dev, libtool, libsys-mmap-perl, libavdevice-dev, libdevice-serialport-perl, libarchive-zip-perl, libmime-lite-perl, dh-autoreconf, libvlccore-dev, libvlc-dev, libcurl4-gnutls-dev | libcurl4-nss-dev | libcurl4-openssl-dev, libgcrypt11-dev | libgcrypt20-dev, libpolkit-gobject-1-dev, libdbi-perl, libnet-sftp-foreign-perl, libexpect-perl, libmime-tools-perl, libx264-dev, libmp4v2-dev, libpcre3-dev
|
||||
Standards-Version: 3.9.6
|
||||
|
||||
Package: zoneminder
|
||||
Section: metapackages
|
||||
Architecture: all
|
||||
Depends: ${misc:Depends},
|
||||
libzoneminder-perl (>= ${source:Version}),
|
||||
zoneminder-database (>= ${source:Version}),
|
||||
zoneminder-core (>= ${binary:Version}),
|
||||
zoneminder-ui-base (>= ${source:Version}),
|
||||
zoneminder-ui-classic (>= ${source:Version}),
|
||||
zoneminder-ui-mobile (>= ${source:Version}),
|
||||
zoneminder-ui-xml (>= ${source:Version})
|
||||
Description: Video camera security and surveillance solution (metapackage)
|
||||
ZoneMinder is intended for use in single or multi-camera video security
|
||||
applications, including commercial or home CCTV, theft prevention and child
|
||||
or family member or home monitoring and other care scenarios. It
|
||||
supports capture, analysis, recording, and monitoring of video data coming
|
||||
from one or more video or network cameras attached to a Linux system.
|
||||
ZoneMinder also support web and semi-automatic control of Pan/Tilt/Zoom
|
||||
cameras using a variety of protocols. It is suitable for use as a home
|
||||
video security system and for commercial or professional video security
|
||||
and surveillance. It can also be integrated into a home automation system
|
||||
via X.10 or other protocols.
|
||||
|
||||
Package: libzoneminder-perl
|
||||
Section: perl
|
||||
Architecture: all
|
||||
Depends: ${misc:Depends}, ${perl:Depends}, libdbi-perl,
|
||||
libdevice-serialport-perl, libimage-info-perl, libjson-any-perl,
|
||||
libsys-mmap-perl, liburi-encode-perl, libwww-perl
|
||||
Description: Perl libraries for ZoneMinder
|
||||
ZoneMinder is a video camera security and surveillance solution.
|
||||
.
|
||||
This package provides the libraries for the perl scripts, it can be used to
|
||||
write custom interfaces as well.
|
||||
|
||||
Package: zoneminder-database
|
||||
Section: database
|
||||
Architecture: all
|
||||
Depends: ${misc:Depends}, debconf, dbconfig-common,
|
||||
mysql-client | mariadb-client
|
||||
Recommends: mysql-server | mariadb-server
|
||||
Description: Database management package for ZoneMinder
|
||||
ZoneMinder is a video camera security and surveillance solution.
|
||||
.
|
||||
This package provides the sql files and maintenance scripts to perform all the
|
||||
database operations (installation, upgrade or removal) on a local or a remote
|
||||
server.
|
||||
|
||||
Package: zoneminder-core
|
||||
Section: video
|
||||
Architecture: any
|
||||
Depends: libzoneminder-perl (= ${source:Version}),
|
||||
zoneminder-database (= ${source:Version}), ${shlibs:Depends}, ${misc:Depends},
|
||||
${perl:Depends}, libarchive-tar-perl, libarchive-zip-perl, libdate-manip-perl,
|
||||
libdbi-perl, libmodule-load-conditional-perl, libmime-lite-perl,
|
||||
libmime-tools-perl, libnet-sftp-foreign-perl, libphp-serialization-perl,
|
||||
debconf, ffmpeg | libav-tools, rsyslog | system-log-daemon, zip,
|
||||
policykit-1, apache2, libmp4v2-2, libpcre++0
|
||||
Description: Core binaries and perl scripts for ZoneMinder
|
||||
ZoneMinder is a video camera security and surveillance solution.
|
||||
.
|
||||
This package provides the executable compiled binaries which do the main video
|
||||
processing work and the perl scripts which perform helper and/or external
|
||||
interface tasks.
|
||||
|
||||
Package: zoneminder-core-dbg
|
||||
Priority: extra
|
||||
Section: debug
|
||||
Architecture: any
|
||||
Depends: zoneminder-core (= ${binary:Version}), ${misc:Depends}
|
||||
Description: Debugging symbols for ZoneMinder
|
||||
ZoneMinder is a video camera security and surveillance solution.
|
||||
.
|
||||
This package provides the debugging symbols for the executable compiled
|
||||
binaries.
|
||||
|
||||
Package: zoneminder-ui-base
|
||||
Section: web
|
||||
Architecture: any
|
||||
Depends: zoneminder-core (= ${binary:Version}), ${shlibs:Depends},
|
||||
${misc:Depends}, debconf, apache2, libapache2-mod-php5 | libapache2-mod-fcgid,
|
||||
php5, php5-mysql | php5-mysqlnd
|
||||
Description: Essential files for ZoneMinder's web user interface
|
||||
ZoneMinder is a video camera security and surveillance solution.
|
||||
.
|
||||
This package provides the essential web files and maintenance scripts to set up
|
||||
a basic web environment.
|
||||
|
||||
Package: zoneminder-ui-classic
|
||||
Section: web
|
||||
Architecture: all
|
||||
Depends: zoneminder-ui-base (>= ${source:Version}), ${misc:Depends}
|
||||
Description: Classic web user interface for ZoneMinder
|
||||
ZoneMinder is a video camera security and surveillance solution.
|
||||
.
|
||||
This package provides the classic web user interface.
|
||||
|
||||
Package: zoneminder-ui-mobile
|
||||
Section: web
|
||||
Architecture: all
|
||||
Depends: zoneminder-ui-base (>= ${source:Version}), ${misc:Depends}
|
||||
Description: Mobile web user interface for ZoneMinder
|
||||
ZoneMinder is a video camera security and surveillance solution.
|
||||
.
|
||||
This package provides the web user interface for mobile devices.
|
||||
|
||||
Package: zoneminder-ui-xml
|
||||
Section: web
|
||||
Architecture: all
|
||||
Depends: zoneminder-ui-base (>= ${source:Version}), ${misc:Depends}
|
||||
Description: XML interface for ZoneMinder
|
||||
ZoneMinder is a video camera security and surveillance solution.
|
||||
.
|
||||
This package provides a XML interface mainly intended for use with the eyeZm
|
||||
iPhone Application, but can be used with any other custom programs as well.
|
||||
|
||||
Package: zoneminder-ui-api
|
||||
Section: web
|
||||
Architecture: all
|
||||
Depends: zoneminder-ui-base (>= ${source:Version}), ${misc:Depends}
|
||||
Description: API interface for ZoneMinder
|
||||
ZoneMinder is a video camera security and surveillance solution.
|
||||
.
|
||||
This package provides an API interface mainly intended for use with angular-ui
|
||||
or mobile applications, but can be used with any other custom programs as well.
|
||||
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
Copyright:
|
||||
|
||||
Copyright 2002 Philip Coombes <philip.coombes@zoneminder.com>
|
||||
|
||||
License:
|
||||
|
||||
This package is free software; you can redistribute it and/or modify it
|
||||
under the terms of the GNU General Public License as published by the
|
||||
Free Software Foundation; either version 2 of the License, or (at your
|
||||
option) any later version.
|
||||
|
||||
This package is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public
|
||||
License along with this package; if not, write to the Free Software
|
||||
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
|
||||
On Debian GNU/Linux systems, the text of the GPL can be found in
|
||||
/usr/share/common-licenses/GPL.
|
||||
|
|
@ -0,0 +1 @@
|
|||
README.md
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
zoneminder_1.29.0-vivid-38_all.deb metapackages optional
|
||||
libzoneminder-perl_1.29.0-vivid-38_all.deb perl optional
|
||||
zoneminder-database_1.29.0-vivid-38_all.deb database optional
|
||||
zoneminder-core_1.29.0-vivid-38_amd64.deb video optional
|
||||
zoneminder-core-dbg_1.29.0-vivid-38_amd64.deb debug extra
|
||||
zoneminder-ui-base_1.29.0-vivid-38_amd64.deb web optional
|
||||
zoneminder-ui-classic_1.29.0-vivid-38_all.deb web optional
|
||||
zoneminder-ui-mobile_1.29.0-vivid-38_all.deb web optional
|
||||
zoneminder-ui-xml_1.29.0-vivid-38_all.deb web optional
|
||||
zoneminder-ui-api_1.29.0-vivid-38_all.deb web optional
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
override_dh_auto_configure dh_auto_configure
|
||||
dh_auto_configure
|
||||
dh_auto_build
|
||||
dh_auto_test
|
||||
dh_prep
|
||||
dh_installdirs
|
||||
dh_auto_install
|
||||
override_dh_install dh_install
|
||||
dh_install
|
||||
dh_installdocs
|
||||
dh_installchangelogs
|
||||
dh_installman
|
||||
dh_installdebconf
|
||||
dh_installinit
|
||||
dh_perl
|
||||
dh_link
|
||||
dh_compress
|
||||
override_dh_fixperms dh_fixperms
|
||||
dh_fixperms
|
||||
override_dh_strip dh_strip
|
||||
dh_strip
|
||||
dh_makeshlibs
|
||||
dh_shlibdeps
|
||||
dh_installdeb
|
||||
dh_gencontrol
|
||||
dh_md5sums
|
||||
dh_builddeb
|
||||
dh_builddeb
|
||||
dh_builddeb
|
||||
dh_builddeb
|
||||
dh_builddeb
|
||||
dh_builddeb
|
||||
dh_builddeb
|
||||
dh_builddeb
|
||||
dh_builddeb
|
||||
dh_builddeb
|
||||
dh_builddeb
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
usr/share/perl5/ZoneMinder
|
||||
usr/share/perl5/ZoneMinder.pm
|
||||
debian/tmp/usr/share/man/man3/ZoneMinder.3pm
|
||||
debian/tmp/usr/share/man/man3/ZoneMinder::*
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
perl:Depends=perl
|
||||
misc:Depends=
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
Package: libzoneminder-perl
|
||||
Source: zoneminder
|
||||
Version: 1.29.0-vivid-38
|
||||
Architecture: all
|
||||
Maintainer: Isaac Connor <iconnor@connortechnology.com>
|
||||
Installed-Size: 734
|
||||
Depends: perl, libdbi-perl, libdevice-serialport-perl, libimage-info-perl, libjson-any-perl, libsys-mmap-perl, liburi-encode-perl, libwww-perl
|
||||
Section: perl
|
||||
Priority: optional
|
||||
Description: Perl libraries for ZoneMinder
|
||||
ZoneMinder is a video camera security and surveillance solution.
|
||||
.
|
||||
This package provides the libraries for the perl scripts, it can be used to
|
||||
write custom interfaces as well.
|
||||
|
|
@ -0,0 +1,78 @@
|
|||
ee60a32a6eb4cc0af766cddf0aafe6f9 usr/share/doc/libzoneminder-perl/changelog.Debian.gz
|
||||
722ee23d6e76b10f1eae240ea1a49117 usr/share/doc/libzoneminder-perl/copyright
|
||||
25c721886678c988b9fd8377974bbb86 usr/share/man/man3/ZoneMinder.3pm.gz
|
||||
b17f8aea47437d67523a646985d1b898 usr/share/man/man3/ZoneMinder::Base.3pm.gz
|
||||
43496fb7448ff32de1d7ebcad96303a3 usr/share/man/man3/ZoneMinder::Config.3pm.gz
|
||||
b2c598a0dae9aa0fc4daae8c1040a5f7 usr/share/man/man3/ZoneMinder::ConfigAdmin.3pm.gz
|
||||
d466b285bda4f936bb6aff5514186dc7 usr/share/man/man3/ZoneMinder::ConfigData.3pm.gz
|
||||
7185fdb667dd5e7c1fe1170bf0a499c5 usr/share/man/man3/ZoneMinder::Control.3pm.gz
|
||||
945be4443f3d744f7ede2ce0a2fd82c7 usr/share/man/man3/ZoneMinder::Control::3S.3pm.gz
|
||||
df568504369729716c3b1b49f3e482f1 usr/share/man/man3/ZoneMinder::Control::AxisV2.3pm.gz
|
||||
3c4cd3a95681e4dc8904b134f97aff47 usr/share/man/man3/ZoneMinder::Control::FI8608W_Y2k.3pm.gz
|
||||
a7132e675d27db9d8a5213f8e4ad3157 usr/share/man/man3/ZoneMinder::Control::FI8620_Y2k.3pm.gz
|
||||
33e796137b229e6f07b6563326100161 usr/share/man/man3/ZoneMinder::Control::FI8908W.3pm.gz
|
||||
150bdc511107b22c2afefd1e1a9ccbac usr/share/man/man3/ZoneMinder::Control::FI9821W_Y2k.3pm.gz
|
||||
81f105f3d176bba37c0fa22e9a137663 usr/share/man/man3/ZoneMinder::Control::M8640.3pm.gz
|
||||
4a53e5868060b302d52c9722950cbd25 usr/share/man/man3/ZoneMinder::Control::Ncs370.3pm.gz
|
||||
a49881ecabe0caa8225d4f817eb5db41 usr/share/man/man3/ZoneMinder::Control::PanasonicIP.3pm.gz
|
||||
3907cc074403fecce09a48bab3abb9d3 usr/share/man/man3/ZoneMinder::Control::PelcoD.3pm.gz
|
||||
6e644d35bb114cccfebc6544c103452f usr/share/man/man3/ZoneMinder::Control::PelcoP.3pm.gz
|
||||
35eec5d99e5e6cb09c16067fc94be3f7 usr/share/man/man3/ZoneMinder::Control::SkyIPCam7xx.3pm.gz
|
||||
81c34c31f2955dd2ac1e5ce394f84950 usr/share/man/man3/ZoneMinder::Control::TVIP862.3pm.gz
|
||||
259d87371e49395f7e8df8aa15fd96b5 usr/share/man/man3/ZoneMinder::Control::Toshiba_IK_WB11A.3pm.gz
|
||||
136189999e6296622908d543c0e95236 usr/share/man/man3/ZoneMinder::Control::Visca.3pm.gz
|
||||
97c5b3eee717f288a8251d0b8d66fea4 usr/share/man/man3/ZoneMinder::Control::Wanscam.3pm.gz
|
||||
2af80aa1fc7e7322a774554a97ccfd84 usr/share/man/man3/ZoneMinder::Control::mjpgStreamer.3pm.gz
|
||||
85c31c62d15e54bb7ff6e81cd5803f4f usr/share/man/man3/ZoneMinder::Database.3pm.gz
|
||||
c4fe238b0662e7e87bb9c947f90b2694 usr/share/man/man3/ZoneMinder::General.3pm.gz
|
||||
0cfe2ec5910f955f6e11174987bce0bf usr/share/man/man3/ZoneMinder::Logger.3pm.gz
|
||||
62099a36d98136808b1dcc2b4040da2b usr/share/man/man3/ZoneMinder::Memory.3pm.gz
|
||||
18a663cf9a42890c02abcf2c727ba245 usr/share/man/man3/ZoneMinder::Trigger::Channel.3pm.gz
|
||||
51ac914667501a93a2ca8327ec87fae2 usr/share/man/man3/ZoneMinder::Trigger::Channel::File.3pm.gz
|
||||
cc5d5475fa645dd504bd2495bdcfd328 usr/share/man/man3/ZoneMinder::Trigger::Channel::Handle.3pm.gz
|
||||
22b0c943e9e793799a90995f63d28d6e usr/share/man/man3/ZoneMinder::Trigger::Channel::Inet.3pm.gz
|
||||
d0ca71a4cc0bfe822cffca4f4a00b28f usr/share/man/man3/ZoneMinder::Trigger::Channel::Serial.3pm.gz
|
||||
16f2e58fbf81ef1b52da99583be9536a usr/share/man/man3/ZoneMinder::Trigger::Channel::Spawning.3pm.gz
|
||||
2783f75e5c44dc9924cbd106306d1c5f usr/share/man/man3/ZoneMinder::Trigger::Channel::Unix.3pm.gz
|
||||
43eb31c858888a4b19f1b08c506186cb usr/share/man/man3/ZoneMinder::Trigger::Connection.3pm.gz
|
||||
7da81b98676a574cb2ce4a603166686c usr/share/man/man3/ZoneMinder::Trigger::Connection::Example.3pm.gz
|
||||
e84d25345d7953c4ae06467f69dc2746 usr/share/perl5/ZoneMinder.pm
|
||||
be29b7736e2daf386d42157853e0bb69 usr/share/perl5/ZoneMinder/Base.pm
|
||||
f69da3b334749f8a031518a814e83ee3 usr/share/perl5/ZoneMinder/Config.pm
|
||||
d26840e36049a6b20a86116835766814 usr/share/perl5/ZoneMinder/ConfigAdmin.pm
|
||||
05bca0158f08b70454f6c74eac906d08 usr/share/perl5/ZoneMinder/ConfigData.pm
|
||||
e7fac2ef32d10538b559c5cfc2ab246f usr/share/perl5/ZoneMinder/Control.pm
|
||||
9cc2e3fa06f47cbdd4dc9728f42073d3 usr/share/perl5/ZoneMinder/Control/3S.pm
|
||||
5b33d25c49b10d08dc1e3ecde3c19337 usr/share/perl5/ZoneMinder/Control/AxisV2.pm
|
||||
20968374f9be0aecad08fe746a765863 usr/share/perl5/ZoneMinder/Control/FI8608W_Y2k.pm
|
||||
19a1ab5b89f9e8989a176bbf08070c58 usr/share/perl5/ZoneMinder/Control/FI8620_Y2k.pm
|
||||
469f80662f3f9397fc19c127b3429db4 usr/share/perl5/ZoneMinder/Control/FI8908W.pm
|
||||
3c95537f3b24911244cd8c166f5bdfb1 usr/share/perl5/ZoneMinder/Control/FI9821W_Y2k.pm
|
||||
37b2053f17ecf97a398ae5b49dcb7e43 usr/share/perl5/ZoneMinder/Control/LoftekSentinel.pm
|
||||
f6ef21aea163be37e3d72b5ec6dec17c usr/share/perl5/ZoneMinder/Control/M8640.pm
|
||||
4b02c4c5a2b7593eedcddf5d5a8f2cac usr/share/perl5/ZoneMinder/Control/Ncs370.pm
|
||||
d66a2faf7390a6668e32a799658e8ae5 usr/share/perl5/ZoneMinder/Control/PanasonicIP.pm
|
||||
b28878a0cd796fad48c53b1643ed542a usr/share/perl5/ZoneMinder/Control/PelcoD.pm
|
||||
ee07b782ac2e790d82b9bc00540835bf usr/share/perl5/ZoneMinder/Control/PelcoP.pm
|
||||
71c881b550c010cbdcbcea690f75584f usr/share/perl5/ZoneMinder/Control/SkyIPCam7xx.pm
|
||||
1d0ae84d7bd9e71611bea845f79f02c7 usr/share/perl5/ZoneMinder/Control/TVIP862.pm
|
||||
568b527e03f2ebcc99e93085d8d8eae5 usr/share/perl5/ZoneMinder/Control/Toshiba_IK_WB11A.pm
|
||||
f0c4a4c08f53620a30909c7816f6e3a7 usr/share/perl5/ZoneMinder/Control/Visca.pm
|
||||
0a793251749dadf86b5ee68381cdd2c2 usr/share/perl5/ZoneMinder/Control/Wanscam.pm
|
||||
b0baa717a7239653be568d1ca73a55e6 usr/share/perl5/ZoneMinder/Control/mjpgStreamer.pm
|
||||
ae94627d4dfb52f4ec93885555c0803f usr/share/perl5/ZoneMinder/Control/onvif.pm
|
||||
fad29ee7bab98373c9f837bba390134a usr/share/perl5/ZoneMinder/Database.pm
|
||||
29129dcae091093a8f705b662de03b81 usr/share/perl5/ZoneMinder/General.pm
|
||||
cbdc04a1e76f8f53b6489fa7646a4432 usr/share/perl5/ZoneMinder/Logger.pm
|
||||
4ec48da29fdd6ce8fbb4b07c80eb55aa usr/share/perl5/ZoneMinder/Memory.pm
|
||||
2a8c4a4c924910d9f25b473846c1d376 usr/share/perl5/ZoneMinder/Memory/Mapped.pm
|
||||
f1bc93190f0e0e101cc18c445c051625 usr/share/perl5/ZoneMinder/Memory/Shared.pm
|
||||
8cd1b8057a2e3e45abb21b483800bfb4 usr/share/perl5/ZoneMinder/Trigger/Channel.pm
|
||||
75794d19dae22b8e0d93a1004478838c usr/share/perl5/ZoneMinder/Trigger/Channel/File.pm
|
||||
8e2868f171a9dd76d5ed9aea1caed667 usr/share/perl5/ZoneMinder/Trigger/Channel/Handle.pm
|
||||
b55c3cde5afe9438c4b3930e86ef380c usr/share/perl5/ZoneMinder/Trigger/Channel/Inet.pm
|
||||
a6d796f873159d059c802cdfad7cfc07 usr/share/perl5/ZoneMinder/Trigger/Channel/Serial.pm
|
||||
3a4cf147dc5c25f03f417cbc9f4781ec usr/share/perl5/ZoneMinder/Trigger/Channel/Spawning.pm
|
||||
122129f9ee1444e7ce1f37ef20a5532c usr/share/perl5/ZoneMinder/Trigger/Channel/Unix.pm
|
||||
f71b1c4fb3aaadd94fc3a8679028a7e5 usr/share/perl5/ZoneMinder/Trigger/Connection.pm
|
||||
9266185080bea9c7562977e93aadf73f usr/share/perl5/ZoneMinder/Trigger/Connection/Example.pm
|
||||
Binary file not shown.
|
|
@ -0,0 +1,22 @@
|
|||
Copyright:
|
||||
|
||||
Copyright 2002 Philip Coombes <philip.coombes@zoneminder.com>
|
||||
|
||||
License:
|
||||
|
||||
This package is free software; you can redistribute it and/or modify it
|
||||
under the terms of the GNU General Public License as published by the
|
||||
Free Software Foundation; either version 2 of the License, or (at your
|
||||
option) any later version.
|
||||
|
||||
This package is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public
|
||||
License along with this package; if not, write to the Free Software
|
||||
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
|
||||
On Debian GNU/Linux systems, the text of the GPL can be found in
|
||||
/usr/share/common-licenses/GPL.
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
|
|
@ -0,0 +1,138 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Common Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the common definitions and functions used by the rest
|
||||
# of the ZoneMinder scripts
|
||||
#
|
||||
package ZoneMinder;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require Exporter;
|
||||
use ZoneMinder::Base qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::General qw(:all);
|
||||
use ZoneMinder::Database qw(:all);
|
||||
use ZoneMinder::Memory qw(:all);
|
||||
|
||||
our @ISA = qw(
|
||||
Exporter
|
||||
ZoneMinder::Base
|
||||
ZoneMinder::Config
|
||||
ZoneMinder::Logger
|
||||
ZoneMinder::General
|
||||
ZoneMinder::Database
|
||||
ZoneMinder::Memory
|
||||
);
|
||||
|
||||
# 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 = (
|
||||
'base' => [
|
||||
@ZoneMinder::Base::EXPORT_OK
|
||||
],
|
||||
'config' => [
|
||||
@ZoneMinder::Config::EXPORT_OK
|
||||
],
|
||||
'debug' => [
|
||||
@ZoneMinder::Logger::EXPORT_OK
|
||||
],
|
||||
'general' => [
|
||||
@ZoneMinder::General::EXPORT_OK
|
||||
],
|
||||
'database' => [
|
||||
@ZoneMinder::Database::EXPORT_OK
|
||||
],
|
||||
'memory' => [
|
||||
@ZoneMinder::Memory::EXPORT_OK
|
||||
],
|
||||
);
|
||||
push( @{$EXPORT_TAGS{all}}, @{$EXPORT_TAGS{$_}} ) foreach keys %EXPORT_TAGS;
|
||||
|
||||
our @EXPORT_OK = @{ $EXPORT_TAGS{'all'} };
|
||||
|
||||
our @EXPORT = ( @EXPORT_OK );
|
||||
|
||||
our $VERSION = $ZoneMinder::Base::VERSION;
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder - Container module for common ZoneMinder modules
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module is a convenience container module that uses the
|
||||
ZoneMinder::Base, ZoneMinder::Common, ZoneMinder::Logger,
|
||||
ZoneMinder::Database and ZoneMinder::Memory modules. It also
|
||||
exports by default all symbols provided by the 'all' tag of
|
||||
each of the modules.
|
||||
|
||||
Thus 'use'ing this module is equivalent to the following
|
||||
|
||||
use ZoneMinder::Base qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Database qw(:all);
|
||||
use ZoneMinder::Memory qw(:all);
|
||||
|
||||
but is somewhat easier.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
All symbols exported by the 'all' tag of each of the included
|
||||
modules.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
ZoneMinder::Base, ZoneMinder::Common, ZoneMinder::Logger,
|
||||
ZoneMinder::Database, ZoneMinder::Memory
|
||||
|
||||
http://www.zoneminder.com
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (C) 2005 by Philip Coombes
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.8.3 or,
|
||||
at your option, any later version of Perl 5 you may have available.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,92 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Base Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the common definitions and functions used by the rest
|
||||
# of the ZoneMinder scripts
|
||||
#
|
||||
package ZoneMinder::Base;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require Exporter;
|
||||
|
||||
our @ISA = qw(Exporter);
|
||||
|
||||
use constant ZM_VERSION => "1.28.1";
|
||||
|
||||
# Items to export into callers namespace by default. Note: do not export
|
||||
# names by default without a very good reason. Use EXPORT_OK instead.
|
||||
# Do not simply export all your public functions/methods/constants.
|
||||
|
||||
# This allows declaration use ZoneMinder ':all';
|
||||
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
|
||||
# will save memory.
|
||||
our %EXPORT_TAGS = ( 'all' => [ qw(ZM_VERSION) ] );
|
||||
|
||||
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
||||
|
||||
our @EXPORT = qw();
|
||||
|
||||
our $VERSION = "1.28.1";
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Base - Base perl module for ZoneMinder
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Base;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module is the base module for the rest of the ZoneMinder modules. It
|
||||
is included by each of the other modules but serves no purpose other than
|
||||
to propagate the perl module version amongst the other modules. You will
|
||||
never need to use this module directly but if you write new ZoneMinder
|
||||
modules they should include it.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
http://www.zoneminder.com
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,157 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Config Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the common definitions and functions used by the rest
|
||||
# of the ZoneMinder scripts
|
||||
#
|
||||
package ZoneMinder::Config;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require Exporter;
|
||||
require ZoneMinder::Base;
|
||||
|
||||
our @ISA = qw(Exporter ZoneMinder::Base);
|
||||
|
||||
use vars qw( %Config );
|
||||
# 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_CONFIG = qw( %Config ); # Get populated by BEGIN
|
||||
|
||||
our %EXPORT_TAGS = (
|
||||
'constants' => [ qw(
|
||||
ZM_PID
|
||||
) ]
|
||||
);
|
||||
push( @{$EXPORT_TAGS{config}}, @EXPORT_CONFIG );
|
||||
push( @{$EXPORT_TAGS{all}}, @{$EXPORT_TAGS{$_}} ) foreach keys %EXPORT_TAGS;
|
||||
|
||||
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
||||
|
||||
our @EXPORT = qw();
|
||||
|
||||
our $VERSION = $ZoneMinder::Base::VERSION;
|
||||
|
||||
use constant ZM_PID => "/var/run/zm/zm.pid"; # Path to the ZoneMinder run pid file
|
||||
use constant ZM_CONFIG => "/etc/zm/zm.conf"; # Path to the ZoneMinder config file
|
||||
|
||||
use Carp;
|
||||
|
||||
# Load the config from the database into the symbol table
|
||||
BEGIN
|
||||
{
|
||||
my $config_file = ZM_CONFIG;
|
||||
( my $local_config_file = $config_file ) =~ s|^.*/|./|;
|
||||
if ( -s $local_config_file and -r $local_config_file )
|
||||
{
|
||||
print( STDERR "Warning, overriding installed $local_config_file file with local copy\n" );
|
||||
$config_file = $local_config_file;
|
||||
}
|
||||
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 $dbh = DBI->connect( "DBI:mysql:database=".$Config{ZM_DB_NAME}
|
||||
.";host=".$Config{ZM_DB_HOST}
|
||||
, $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();
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Config - ZoneMinder configuration module.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Config qw(:all);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The ZoneMinder::Config module is used to import the ZoneMinder
|
||||
configuration from the database. It will do this at compile time in a BEGIN
|
||||
block and require access to the zm.conf file either in the current
|
||||
directory or in its defined location in order to determine database access
|
||||
details, configuration from this file will also be included. If the :all or
|
||||
:config tags are used then this configuration is exported into the
|
||||
namespace of the calling program or module.
|
||||
|
||||
Once the configuration has been imported then configuration variables are
|
||||
defined as constants and can be accessed directory by name, e.g.
|
||||
|
||||
$lang = $Config{ZM_LANG_DEFAULT};
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
The :constants tag will export the ZM_PID constant which details the location of the zm.pid file
|
||||
The :config tag will export all configuration from the database as well as any from the zm.conf file
|
||||
The :all tag will export all above symbols.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
http://www.zoneminder.com
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,276 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Config Admin Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the debug definitions and functions used by the rest
|
||||
# of the ZoneMinder scripts
|
||||
#
|
||||
package ZoneMinder::ConfigAdmin;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require Exporter;
|
||||
require ZoneMinder::Base;
|
||||
|
||||
our @ISA = qw(Exporter ZoneMinder::Base);
|
||||
|
||||
# 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(
|
||||
loadConfigFromDB
|
||||
saveConfigToDB
|
||||
) ]
|
||||
);
|
||||
push( @{$EXPORT_TAGS{all}}, @{$EXPORT_TAGS{$_}} ) foreach keys %EXPORT_TAGS;
|
||||
|
||||
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'functions'} } );
|
||||
|
||||
our @EXPORT = qw();
|
||||
|
||||
our $VERSION = $ZoneMinder::Base::VERSION;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Configuration Administration
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Config qw(:all);
|
||||
use ZoneMinder::ConfigData qw(:all);
|
||||
|
||||
use Carp;
|
||||
|
||||
sub loadConfigFromDB
|
||||
{
|
||||
print( "Loading config from DB\n" );
|
||||
my $dbh = DBI->connect( "DBI:mysql:database=".$Config{ZM_DB_NAME}
|
||||
.";host=".$Config{ZM_DB_HOST}
|
||||
,$Config{ZM_DB_USER}
|
||||
,$Config{ZM_DB_PASS}
|
||||
);
|
||||
|
||||
if ( !$dbh )
|
||||
{
|
||||
print( "Error: unable to load options from database: $DBI::errstr\n" );
|
||||
return( 0 );
|
||||
}
|
||||
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() );
|
||||
my $option_count = 0;
|
||||
while( my $config = $sth->fetchrow_hashref() )
|
||||
{
|
||||
my ( $name, $value ) = ( $config->{Name}, $config->{Value} );
|
||||
#print( "Name = '$name'\n" );
|
||||
my $option = $options_hash{$name};
|
||||
if ( !$option )
|
||||
{
|
||||
warn( "No option '$name' found, removing" );
|
||||
next;
|
||||
}
|
||||
#next if ( $option->{category} eq 'hidden' );
|
||||
if ( defined($value) )
|
||||
{
|
||||
if ( $option->{type} == $types{boolean} )
|
||||
{
|
||||
$option->{value} = $value?"yes":"no";
|
||||
}
|
||||
else
|
||||
{
|
||||
$option->{value} = $value;
|
||||
}
|
||||
}
|
||||
$option_count++;;
|
||||
}
|
||||
$sth->finish();
|
||||
$dbh->disconnect();
|
||||
return( $option_count );
|
||||
}
|
||||
|
||||
sub saveConfigToDB
|
||||
{
|
||||
print( "Saving config to DB\n" );
|
||||
my $dbh = DBI->connect( "DBI:mysql:database=".$Config{ZM_DB_NAME}
|
||||
.";host=".$Config{ZM_DB_HOST}
|
||||
,$Config{ZM_DB_USER}
|
||||
,$Config{ZM_DB_PASS}
|
||||
);
|
||||
|
||||
if ( !$dbh )
|
||||
{
|
||||
print( "Error: unable to save options to database: $DBI::errstr\n" );
|
||||
return( 0 );
|
||||
}
|
||||
|
||||
my $ac = $dbh->{AutoCommit};
|
||||
$dbh->{AutoCommit} = 0;
|
||||
|
||||
$dbh->do('LOCK TABLE Config WRITE')
|
||||
or croak( "Can't lock Config table: " . $dbh->errstr() );
|
||||
|
||||
my $sql = "delete from Config";
|
||||
my $res = $dbh->do( $sql )
|
||||
or croak( "Can't do '$sql': ".$dbh->errstr() );
|
||||
|
||||
$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 )
|
||||
{
|
||||
#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
|
||||
{
|
||||
$option->{db_value} = $option->{value};
|
||||
}
|
||||
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" )
|
||||
} @$requires
|
||||
);
|
||||
}
|
||||
else
|
||||
{
|
||||
}
|
||||
my $res = $sth->execute(
|
||||
$option->{id},
|
||||
$option->{name},
|
||||
$option->{db_value},
|
||||
$option->{db_type},
|
||||
$option->{default},
|
||||
$option->{db_hint},
|
||||
$option->{db_pattern},
|
||||
$option->{db_format},
|
||||
$option->{description},
|
||||
$option->{help},
|
||||
$option->{category},
|
||||
$option->{readonly} ? 1 : 0,
|
||||
$option->{db_requires}
|
||||
) or croak( "Can't execute: ".$sth->errstr() );
|
||||
}
|
||||
$sth->finish();
|
||||
|
||||
$dbh->do('UNLOCK TABLES');
|
||||
$dbh->{AutoCommit} = $ac;
|
||||
|
||||
$dbh->disconnect();
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::ConfigAdmin - ZoneMinder Configuration Administration module
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::ConfigAdmin;
|
||||
use ZoneMinder::ConfigAdmin qw(:all);
|
||||
|
||||
loadConfigFromDB();
|
||||
saveConfigToDB();
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The ZoneMinder:ConfigAdmin module contains the master definition of the
|
||||
ZoneMinder configuration options as well as helper methods. This module is
|
||||
intended for specialist confguration management and would not normally be
|
||||
used by end users.
|
||||
|
||||
The configuration held in this module, which was previously in zmconfig.pl,
|
||||
includes the name, default value, description, help text, type and category
|
||||
for each option, as well as a number of additional fields in a small number
|
||||
of cases.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item loadConfigFromDB ();
|
||||
|
||||
Loads existing configuration from the database (if any) and merges it with
|
||||
the definitions held in this module. This results in the merging of any new
|
||||
configuration and the removal of any deprecated configuration while
|
||||
preserving the existing values of every else.
|
||||
|
||||
=item saveConfigToDB ();
|
||||
|
||||
Saves configuration held in memory to the database. The act of loading and
|
||||
saving configuration is a convenient way to ensure that the configuration
|
||||
held in the database corresponds with the most recent definitions and that
|
||||
all components are using the same set of configuration.
|
||||
|
||||
=back
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
The :data tag will export the various configuration data structures
|
||||
The :functions tag will export the helper functions.
|
||||
The :all tag will export all above symbols.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
http://www.zoneminder.com
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,205 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Base Control Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the base class definitions for the camera control
|
||||
# protocol implementations
|
||||
#
|
||||
package ZoneMinder::Control;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
|
||||
our $VERSION = $ZoneMinder::Base::VERSION;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Base connection class
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Database qw(:all);
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
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" );
|
||||
}
|
||||
|
||||
sub getKey
|
||||
{
|
||||
my $self = shift;
|
||||
return( $self->{id} );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
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} );
|
||||
}
|
||||
|
||||
sub loadMonitor
|
||||
{
|
||||
my $self = shift;
|
||||
if ( !$self->{Monitor} )
|
||||
{
|
||||
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});
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub getParam
|
||||
{
|
||||
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'" );
|
||||
}
|
||||
|
||||
sub executeCommand
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
|
||||
$self->loadMonitor();
|
||||
|
||||
my $command = $params->{command};
|
||||
delete $params->{command};
|
||||
|
||||
#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} );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,606 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder 3S API Control Protocol Module, $Date: 2014-11-12 08:00:00 +0300 (Tue, 21 Jun 2011) $, $Revision: 1 $
|
||||
# Copyright (C) 2014 Juan Manuel Castro
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the implementation of the 3S camera control
|
||||
# protocol
|
||||
#Model: N5071
|
||||
#Hardware Version: 00
|
||||
#Firmware Version: V1.03_STD-1
|
||||
#Firmware Build Time: Jun 19 2012 15:28:17
|
||||
|
||||
package ZoneMinder::Control::3S;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Control;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Control);
|
||||
|
||||
our $VERSION = $ZoneMinder::Base::VERSION;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# 3S Control Protocol
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = ZoneMinder::Control->new( $id );
|
||||
bless( $self, $class );
|
||||
srand( time() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
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} );
|
||||
}
|
||||
Fatal( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
$self->loadMonitor();
|
||||
|
||||
use LWP::UserAgent;
|
||||
$self->{ua} = LWP::UserAgent->new;
|
||||
#$self->{ua}->agent( "ZoneMinder Control Agent/".ZM_VERSION );
|
||||
$self->{ua}->agent( "ZoneMinder Control Agent/" . ZoneMinder::Base::ZM_VERSION );
|
||||
$self->{state} = 'open';
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
Debug( $msg."[".$msg_len."]" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
printMsg( $cmd, "Tx" );
|
||||
|
||||
#print("http://".$self->{Monitor}->{ControlAddress}."/$cmd");
|
||||
my $req = HTTP::Request->new( GET=>"http://".$self->{Monitor}->{ControlAddress}."/$cmd" );
|
||||
my $res = $self->{ua}->request($req);
|
||||
|
||||
if ( $res->is_success )
|
||||
{
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Error check failed: '".$res->status_line()."'" );
|
||||
}
|
||||
|
||||
return( $result );
|
||||
}
|
||||
|
||||
sub cameraReset
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Camera Reset" );
|
||||
my $cmd = "/restart.cgi";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
#Custom#
|
||||
#Move X or Y Axis
|
||||
sub Up
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up" );
|
||||
my $cmd = "/ptz.cgi?move=up";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub Down
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down" );
|
||||
my $cmd = "/ptz.cgi?move=down";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub Left
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Left" );
|
||||
my $cmd = "/ptz.cgi?move=left";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub Right
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Right" );
|
||||
my $cmd = "/ptz.cgi?move=right";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
##Zoom
|
||||
sub Tele
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Zoom Tele" );
|
||||
my $cmd = "/ptz.cgi?rzoom=$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub Wide
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Zoom Wide" );
|
||||
my $cmd = "/ptz.cgi?rzoom=-$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
#Move X and Y Axis
|
||||
sub UpRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up/Right" );
|
||||
my $cmd = "/ptz.cgi?move=upright";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub UpLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up/Left" );
|
||||
my $cmd = "/ptz.cgi?move=upleft";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub DownRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down/Right" );
|
||||
my $cmd = "/ptz.cgi?move=downright";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub DownLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down/Left" );
|
||||
my $cmd = "/ptz.cgi?move=downleft";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
#Foco
|
||||
sub focusAuto
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Focus Auto" );
|
||||
my $cmd = "/ptz.cgi?Autofocus=on";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusMan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Focus Manual" );
|
||||
my $cmd = "/ptz.cgi?Autofocus=off";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub Near
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Focus Near" );
|
||||
my $cmd = "/ptz.cgi?rfocus=-$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub Far
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Focus Far" );
|
||||
my $cmd = "/ptz.cgi?rfocus=$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
#Iris
|
||||
sub Open
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Iris Open" );
|
||||
my $cmd = "/ptz.cgi?riris=$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub Close
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Iris Close" );
|
||||
my $cmd = "/ptz.cgi?riris=-$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
#Custom#
|
||||
|
||||
sub moveConUp
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up" );
|
||||
my $cmd = "/ptz.cgi?move=up";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConDown
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down" );
|
||||
my $cmd = "/ptz.cgi?move=down";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Left" );
|
||||
my $cmd = "/ptz.cgi?move=left";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Right" );
|
||||
my $cmd = "/ptz.cgi?move=right";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConUpRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up/Right" );
|
||||
my $cmd = "/ptz.cgi?move=upright";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConUpLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up/Left" );
|
||||
my $cmd = "/ptz.cgi?move=upleft";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConDownRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down/Right" );
|
||||
my $cmd = "/ptz.cgi?move=downright";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConDownLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down/Left" );
|
||||
my $cmd = "/ptz.cgi?move=downleft";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelUp
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'tiltstep' );
|
||||
Debug( "Step Up $step" );
|
||||
my $cmd = "/ptz.cgi?tilt=$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelDown
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'tiltstep' );
|
||||
Debug( "Step Down $step" );
|
||||
my $cmd = "/ptz.cgi?tilt=-$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'panstep' );
|
||||
Debug( "Step Left $step" );
|
||||
my $cmd = "/ptz.cgi?pan=-$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'panstep' );
|
||||
Debug( "Step Right $step" );
|
||||
my $cmd = "/ptz.cgi?pan=$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelUpRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panstep = $self->getParam( $params, 'panstep' );
|
||||
my $tiltstep = $self->getParam( $params, 'tiltstep' );
|
||||
Debug( "Step Up/Right $tiltstep/$panstep" );
|
||||
my $cmd = "/ptz.cgi?pan=$panstep&tilt=$tiltstep";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelUpLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panstep = $self->getParam( $params, 'panstep' );
|
||||
my $tiltstep = $self->getParam( $params, 'tiltstep' );
|
||||
Debug( "Step Up/Left $tiltstep/$panstep" );
|
||||
my $cmd = "/ptz.cgi?pan=-$panstep&tilt=$tiltstep";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelDownRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panstep = $self->getParam( $params, 'panstep' );
|
||||
my $tiltstep = $self->getParam( $params, 'tiltstep' );
|
||||
Debug( "Step Down/Right $tiltstep/$panstep" );
|
||||
my $cmd = "/ptz.cgi?pan=$panstep&tilt=-$tiltstep";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelDownLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panstep = $self->getParam( $params, 'panstep' );
|
||||
my $tiltstep = $self->getParam( $params, 'tiltstep' );
|
||||
Debug( "Step Down/Left $tiltstep/$panstep" );
|
||||
my $cmd = "/ptz.cgi?pan=-$panstep&tilt=-$tiltstep";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub zoomRelTele
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Zoom Tele" );
|
||||
my $cmd = "/ptz.cgi?rzoom=$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub zoomRelWide
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Zoom Wide" );
|
||||
my $cmd = "/ptz.cgi?rzoom=-$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusRelNear
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Focus Near" );
|
||||
my $cmd = "/ptz.cgi?rfocus=-$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusRelFar
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Focus Far" );
|
||||
my $cmd = "/ptz.cgi?rfocus=$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusAuto
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Focus Auto" );
|
||||
my $cmd = "/ptz.cgi?Autofocus=on";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusMan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Focus Manual" );
|
||||
my $cmd = "/ptz.cgi?Autofocus=off";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub irisRelOpen
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Iris Open" );
|
||||
my $cmd = "/ptz.cgi?riris=$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub irisRelClose
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Iris Close" );
|
||||
my $cmd = "/ptz.cgi?riris=-$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub irisAuto
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Iris Auto" );
|
||||
my $cmd = "/ptz.cgi?autoiris=on";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub irisMan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Iris Manual" );
|
||||
my $cmd = "/ptz.cgi?autoiris=off";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetClear
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Clear Preset $preset" );
|
||||
my $cmd = "/ptz.cgi?removeserverpresetno=$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Goto Preset $preset" );
|
||||
my $cmd = "/ptz.cgi?gotoserverpresetno=$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Home Preset" );
|
||||
my $cmd = "/ptz.cgi?move=home";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Juan Manuel Castro, E<lt>juanmanuel.castro@gmail.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (C) 2014 Juan Manuel Castro
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.8.3 or,
|
||||
at your option, any later version of Perl 5 you may have available.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,473 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Axis version 2 API Control Protocol Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the implementation of the Axis V2 API camera control
|
||||
# protocol
|
||||
#
|
||||
package ZoneMinder::Control::AxisV2;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Control;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Control);
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Axis V2 Control Protocol
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = ZoneMinder::Control->new( $id );
|
||||
bless( $self, $class );
|
||||
srand( time() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
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} );
|
||||
}
|
||||
Fatal( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
$self->loadMonitor();
|
||||
|
||||
use LWP::UserAgent;
|
||||
$self->{ua} = LWP::UserAgent->new;
|
||||
$self->{ua}->agent( "ZoneMinder Control Agent/".ZoneMinder::Base::ZM_VERSION );
|
||||
|
||||
$self->{state} = 'open';
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
Debug( $msg."[".$msg_len."]" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
printMsg( $cmd, "Tx" );
|
||||
|
||||
#print( "http://$address/$cmd\n" );
|
||||
my $req = HTTP::Request->new( GET=>"http://".$self->{Monitor}->{ControlAddress}."/$cmd" );
|
||||
my $res = $self->{ua}->request($req);
|
||||
|
||||
if ( $res->is_success )
|
||||
{
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Error check failed: '".$res->status_line()."'" );
|
||||
}
|
||||
|
||||
return( $result );
|
||||
}
|
||||
|
||||
sub cameraReset
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Camera Reset" );
|
||||
my $cmd = "/axis-cgi/admin/restart.cgi";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConUp
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=up";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConDown
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=down";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Left" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=left";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Right" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=right";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConUpRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up/Right" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=upright";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConUpLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up/Left" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=upleft";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConDownRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down/Right" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=downright";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConDownLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down/Left" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=downleft";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveMap
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $xcoord = $self->getParam( $params, 'xcoord' );
|
||||
my $ycoord = $self->getParam( $params, 'ycoord' );
|
||||
Debug( "Move Map to $xcoord,$ycoord" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?center=$xcoord,$ycoord&imagewidth=".$self->{Monitor}->{Width}."&imageheight=".$self->{Monitor}->{Height};
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelUp
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'tiltstep' );
|
||||
Debug( "Step Up $step" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rtilt=$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelDown
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'tiltstep' );
|
||||
Debug( "Step Down $step" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rtilt=-$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'panstep' );
|
||||
Debug( "Step Left $step" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=-$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'panstep' );
|
||||
Debug( "Step Right $step" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelUpRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panstep = $self->getParam( $params, 'panstep' );
|
||||
my $tiltstep = $self->getParam( $params, 'tiltstep' );
|
||||
Debug( "Step Up/Right $tiltstep/$panstep" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=$panstep&rtilt=$tiltstep";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelUpLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panstep = $self->getParam( $params, 'panstep' );
|
||||
my $tiltstep = $self->getParam( $params, 'tiltstep' );
|
||||
Debug( "Step Up/Left $tiltstep/$panstep" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=-$panstep&rtilt=$tiltstep";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelDownRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panstep = $self->getParam( $params, 'panstep' );
|
||||
my $tiltstep = $self->getParam( $params, 'tiltstep' );
|
||||
Debug( "Step Down/Right $tiltstep/$panstep" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=$panstep&rtilt=-$tiltstep";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelDownLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panstep = $self->getParam( $params, 'panstep' );
|
||||
my $tiltstep = $self->getParam( $params, 'tiltstep' );
|
||||
Debug( "Step Down/Left $tiltstep/$panstep" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=-$panstep&rtilt=-$tiltstep";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub zoomRelTele
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Zoom Tele" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rzoom=$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub zoomRelWide
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Zoom Wide" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rzoom=-$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusRelNear
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Focus Near" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rfocus=-$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusRelFar
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Focus Far" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rfocus=$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusAuto
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Focus Auto" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?autofocus=on";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusMan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Focus Manual" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?autofocus=off";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub irisRelOpen
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Iris Open" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?riris=$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub irisRelClose
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Iris Close" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?riris=-$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub irisAuto
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Iris Auto" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?autoiris=on";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub irisMan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Iris Manual" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?autoiris=off";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetClear
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Clear Preset $preset" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?removeserverpresetno=$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Set Preset $preset" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?setserverpresetno=$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Goto Preset $preset" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?gotoserverpresetno=$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Home Preset" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=home";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,708 @@
|
|||
# V1.0 ====================================================================================
|
||||
#
|
||||
# ZoneMinder FOSCAM version 1.0 API Control Protocol Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# V1.0 ====================================================================================
|
||||
#
|
||||
# This module FI8608W_Y2k.pm contains the implementation of API camera control
|
||||
# For FOSCAM FI8608W PT Camera (This cam support only H264 streaming)
|
||||
# V1.0 Le 13 AOUT 2013
|
||||
# If you wan't to contact me i understand French and English, precise ZoneMinder in subject
|
||||
# but i prefer via the ZoneMinder Forum
|
||||
# My name is Christophe DAPREMONT my email is christophe_y2k@yahoo.fr
|
||||
#
|
||||
# V1.0 ====================================================================================
|
||||
package ZoneMinder::Control::FI8608W_Y2k;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Control;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Control);
|
||||
# ===================================================================================================================================
|
||||
#
|
||||
# FI8608W FOSCAM PT H264 Control Protocol
|
||||
# with Firmware version V3.2.1.1.1-20120815 (latest at 13/08/2013)
|
||||
# based with the latest doc from FOSCAM ( http://foscam.us/forum/cgi-api-sdk-for-mjpeg-h-264-camera-t2986.html )
|
||||
# This IPCAM work under ZoneMinder V1.25 from alternative source of code
|
||||
# from this svn at https://svn.unixmedia.net/public/zum/trunk/zum/
|
||||
# Many Thanks to "MASTERTHEKNIFE" for the excellent speed optimisation ( http://www.zoneminder.com/forums/viewtopic.php?f=9&t=17652 )
|
||||
# And to "NEXTIME" for the recent source update and incredible plugins ( http://www.zoneminder.com/forums/viewtopic.php?f=9&t=20587 )
|
||||
# And all people helping ZoneMinder dev.
|
||||
#
|
||||
# -FUNCTIONALITIES:
|
||||
# -Move camera in 8 direction with arrow, the speed of movement is function
|
||||
# of the position of your mouse on the arrow.
|
||||
# Extremity of arrow equal to fastest speed of movement
|
||||
# Close the base of arrow to lowest speed of movement
|
||||
# for diagonaly you can click before the beginning of the arrow for low speed
|
||||
# In round center equal to stop to move and switch of latest OSD
|
||||
# -You can clic directly on the image that equal to click on arrow (for the left there is a bug in zoneminder speed is inverted)
|
||||
# -Zoom Tele switch ON InfraRed LED and stay to manual IR MODE
|
||||
# -Zoom Wide switch OFF InfraRed LED and stay to manual IR MODE
|
||||
# -Button WAKE switch to AUTO ON/OFF IR LED
|
||||
# -Button RESET to setup image at initial value
|
||||
# -8 Preset PTZ are implemented and functionnal
|
||||
# -This Script use for login "admin" this hardcoded and your password must setup in "Control Device" section
|
||||
# -This script is compatible with the basic authentification method used by mostly new camera based with hi3510 chipset
|
||||
# -AutoStop function is active and you must set up value (in sec example 0.7) under AutoStop section
|
||||
# or you can set up to 0 for disable it (in this case you need to click to the circle center for stop)
|
||||
# -"White In" to control Brightness, "auto" for restore the original value of Brightness
|
||||
# -"White Out" to control Contrast, "man" for restore the original value of Contrast
|
||||
# -"Iris Open" to control Saturation , "auto" for restore the original value of Saturation
|
||||
# -"Iris Close" to control Hue , "man" for restore the original value of Hue
|
||||
# -I use the OSD function of this cam for printing the command with the value
|
||||
# ===================================================================================================================================
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
# Set $osd to "off" if you wan't disabled OSD i need to place this variable in another script because
|
||||
# this script is reload at every command ,if i want the button on/off (Focus MAN) for OSD works...
|
||||
my $osd = "on";
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = ZoneMinder::Control->new( $id );
|
||||
bless( $self, $class );
|
||||
srand( time() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
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} );
|
||||
}
|
||||
Fatal( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
$self->loadMonitor();
|
||||
use LWP::UserAgent;
|
||||
$self->{ua} = LWP::UserAgent->new;
|
||||
$self->{ua}->agent( "ZoneMinder Control Agent/".ZoneMinder::Base::ZM_VERSION );
|
||||
$self->{state} = 'open';
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
Debug( $msg."[".$msg_len."]" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
my $result = undef;
|
||||
printMsg( $cmd, "Tx" );
|
||||
# I solve the authentification problem with recent Foscam
|
||||
# I use perl Basic Authentification method
|
||||
my $ua = LWP::UserAgent->new();
|
||||
my $req = HTTP::Request->new( GET =>"http://".$self->{Monitor}->{ControlAddress}."/web/cgi-bin/hi3510/".$cmd );
|
||||
$req->authorization_basic('admin', $self->{Monitor}->{ControlDevice} );
|
||||
my $res = $self->{ua}->request($req);
|
||||
if ( $res->is_success )
|
||||
{
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Error check failed: '".$res->status_line()."'" );
|
||||
}
|
||||
return( $result );
|
||||
}
|
||||
|
||||
sub reset
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Reset=Setup FI8608W" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Color RESET";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-brightness=0";
|
||||
$self->sendCmd( $cmd );
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-contrast=37";
|
||||
$self->sendCmd( $cmd );
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-hue=255";
|
||||
$self->sendCmd( $cmd );
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-saturation=94";
|
||||
$self->sendCmd( $cmd );
|
||||
my $cmd = "param.cgi?cmd=setinfra&-status=auto";
|
||||
$self->sendCmd( $cmd );
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-scene=auto";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveStop
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Stop" );
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=stop";
|
||||
$self->sendCmd( $cmd );
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=0&-name=.";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub autoStop
|
||||
{
|
||||
my $self = shift;
|
||||
my $autostop = shift;
|
||||
if( $autostop )
|
||||
{
|
||||
Debug( "Auto Stop" );
|
||||
usleep( $autostop );
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=stop";
|
||||
$self->sendCmd( $cmd );
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=0&-name=.";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConUp
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $tiltspeed > 100 ) {
|
||||
$tiltspeed = 128;
|
||||
}
|
||||
if ( $tiltspeed < 10 ) {
|
||||
$tiltspeed = 1;
|
||||
}
|
||||
Debug( "Move Up" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Move Up $tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=up";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( int(10000*$tiltspeed) );
|
||||
}
|
||||
|
||||
sub moveConDown
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $tiltspeed > 100 ) {
|
||||
$tiltspeed = 128;
|
||||
}
|
||||
if ( $tiltspeed < 10 ) {
|
||||
$tiltspeed = 1;
|
||||
}
|
||||
Debug( "Move Down" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Move Down $tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=down";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( int(10000*$tiltspeed) );
|
||||
}
|
||||
|
||||
sub moveConLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panspeed = $self->getParam( $params, 'panspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $panspeed > 100 ) {
|
||||
$panspeed = 128;
|
||||
}
|
||||
if ( $panspeed < 10 ) {
|
||||
$panspeed = 1;
|
||||
}
|
||||
# Algorithme pour inverser la table de valeur de la flèche gauche, (for invert the value) 63 ==> 1 et 1 ==> 63 ...
|
||||
$panspeed = abs($panspeed - 128) + 1;
|
||||
Debug( "Move Left" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Move Left $panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=left";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( int(10000*$panspeed) );
|
||||
}
|
||||
|
||||
sub moveConRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panspeed = $self->getParam( $params, 'panspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $panspeed > 100 ) {
|
||||
$panspeed = 128;
|
||||
}
|
||||
if ( $panspeed < 10 ) {
|
||||
$panspeed = 1;
|
||||
}
|
||||
Debug( "Move Right" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Move Right $panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=right";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( int(10000*$panspeed) );
|
||||
}
|
||||
|
||||
sub moveConUpLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $tiltspeed > 100 ) {
|
||||
$tiltspeed = 128;
|
||||
}
|
||||
if ( $tiltspeed < 10 ) {
|
||||
$tiltspeed = 1;
|
||||
}
|
||||
my $panspeed = $self->getParam( $params, 'panspeed' );
|
||||
# Standardization for incorrect value in the database
|
||||
if ( $panspeed > 100 ) {
|
||||
$panspeed = 128;
|
||||
}
|
||||
if ( $panspeed < 10 ) {
|
||||
$panspeed = 1;
|
||||
}
|
||||
Debug( "Move Con Up Left" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Up $tiltspeed Left $panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=up";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( int(10000*$tiltspeed) );
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=left";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( int(10000*$panspeed) );
|
||||
}
|
||||
|
||||
sub moveConUpRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $tiltspeed > 100 ) {
|
||||
$tiltspeed = 128;
|
||||
}
|
||||
if ( $tiltspeed < 10 ) {
|
||||
$tiltspeed = 1;
|
||||
}
|
||||
my $panspeed = $self->getParam( $params, 'panspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $panspeed > 100 ) {
|
||||
$panspeed = 128;
|
||||
}
|
||||
if ( $panspeed < 10 ) {
|
||||
$panspeed = 1;
|
||||
}
|
||||
Debug( "Move Con Up Right" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Up $tiltspeed Right $panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=up";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( int(10000*$tiltspeed) );
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=right";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( int(10000*$panspeed) );
|
||||
}
|
||||
|
||||
sub moveConDownLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $tiltspeed > 100 ) {
|
||||
$tiltspeed = 128;
|
||||
}
|
||||
if ( $tiltspeed < 10 ) {
|
||||
$tiltspeed = 1;
|
||||
}
|
||||
my $panspeed = $self->getParam( $params, 'panspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $panspeed > 100 ) {
|
||||
$panspeed = 128;
|
||||
}
|
||||
if ( $panspeed < 10 ) {
|
||||
$panspeed = 1;
|
||||
}
|
||||
Debug( "Move Con Down Left" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Down $tiltspeed Left $panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=down";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( int(10000*$tiltspeed) );
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=left";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( int(10000*$panspeed) );
|
||||
}
|
||||
|
||||
sub moveConDownRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $tiltspeed > 100 ) {
|
||||
$tiltspeed = 128;
|
||||
}
|
||||
if ( $tiltspeed < 10 ) {
|
||||
$tiltspeed = 1;
|
||||
}
|
||||
my $panspeed = $self->getParam( $params, 'panspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $panspeed > 100 ) {
|
||||
$panspeed = 128;
|
||||
}
|
||||
if ( $panspeed < 10 ) {
|
||||
$panspeed = 1;
|
||||
}
|
||||
Debug( "Move Con Down Right" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Down $tiltspeed Right $panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=down";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( int(10000*$tiltspeed) );
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=right";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( int(10000*$panspeed) );
|
||||
}
|
||||
|
||||
sub zoomConTele
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Zoom-Tele=MANU IR LED ON" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Manual IR LED ON";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "param.cgi?cmd=setinfra&-status=open";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub zoomConWide
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Zoom-Wide=MANU IR LED OFF" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Manual IR LED OFF";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "param.cgi?cmd=setinfra&-status=close";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub wake
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Wake=AUTO IR LED" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Auto IR LED Mode";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "param.cgi?cmd=setinfra&-status=auto";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub whiteConIn
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $speed > 255 ) {
|
||||
$speed = 255;
|
||||
}
|
||||
if ( $speed < 0 ) {
|
||||
$speed = 0;
|
||||
}
|
||||
Debug( "White ConIn=brightness" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Brightness $speed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-brightness=$speed";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub whiteConOut
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $speed > 255 ) {
|
||||
$speed = 255;
|
||||
}
|
||||
if ( $speed < 0 ) {
|
||||
$speed = 0;
|
||||
}
|
||||
Debug( "White ConOut=Contrast" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Contrast $speed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-contrast=$speed";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub whiteAuto
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "White Auto=Brightness Reset" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Brightness Reset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-brightness=0";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub whiteMan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "White Manuel=Contrast Reset" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Contrast Reset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-contrast=37";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub irisConOpen
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed' );
|
||||
# Standardization for incorrect value in the database
|
||||
if ( $speed > 255 ) {
|
||||
$speed = 255;
|
||||
}
|
||||
if ( $speed < 0 ) {
|
||||
$speed = 0;
|
||||
}
|
||||
Debug( "Iris ConOpen=Saturation" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Saturation $speed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-saturation=$speed";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub irisConClose
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed' );
|
||||
# Standardization for incorrect value in the database
|
||||
if ( $speed > 255 ) {
|
||||
$speed = 255;
|
||||
}
|
||||
if ( $speed < 0 ) {
|
||||
$speed = 0;
|
||||
}
|
||||
Debug( "Iris ConClose=Hue" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Hue $speed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-hue=$speed";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub irisAuto
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Iris Auto=Saturation Reset" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Saturation Reset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-saturation=94";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub irisMan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Iris Manuel=Hue Reset" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Hue Reset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-hue=255";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
if ( ( $preset >= 1 ) && ( $preset <= 8 ) ) {
|
||||
Debug( "Set Preset $preset" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=PresetSet $preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $preset = $preset - 1;
|
||||
my $cmd = "preset.cgi?-act=set&-status=1&-number=$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
if ( ( $preset >= 1 ) && ( $preset <= 8 ) ) {
|
||||
Debug( "Goto Preset $preset" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=PresetGoto $preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $preset = $preset - 1;
|
||||
my $cmd = "preset.cgi?-act=goto&-number=$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Control::FI-8608W - Perl extension for FOSCAM FI-8608W by Christophe_Y2k
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,784 @@
|
|||
# V1.1 ====================================================================================
|
||||
#
|
||||
# ZoneMinder FOSCAM version 1.0 API Control Protocol Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# V1.1 ====================================================================================
|
||||
#
|
||||
# This module FI8620_Y2k.pm contains the implementation of API camera control
|
||||
# For FOSCAM FI8620 Dome PTZ Camera (This cam support only H264 streaming)
|
||||
# V0.1b Le 01 JUIN 2013
|
||||
# V0.2b Le 11 JUILLET 2013
|
||||
# V0.5b Le 24 JUILLET 2013
|
||||
# V0.6b Le 01 AOUT 2013 -
|
||||
# V1.0 Le 04 AOUT 2013 - production usable if you do not use preset ptz
|
||||
# V1.1 Le 11 AOUT 2013 - put a cosmetic update source code
|
||||
# If you wan't to contact me i understand French and English, precise ZoneMinder in subject
|
||||
# My name is Christophe DAPREMONT my email is christophe_y2k@yahoo.fr
|
||||
#
|
||||
# V1.1 ====================================================================================
|
||||
package ZoneMinder::Control::FI8620_Y2k;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Control;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Control);
|
||||
# ===================================================================================================================================
|
||||
#
|
||||
# FI8620 FOSCAM Dome PTZ H264 Control Protocol
|
||||
# with Firmware version V3.2.2.2.1-20120815 (latest at 04/08/2013)
|
||||
# based with the latest buggy CGI doc from FOSCAM ( http://foscam.us/forum/cgi-api-sdk-for-mjpeg-h-264-camera-t2986.html )
|
||||
# This IPCAM work under ZoneMinder V1.25 from alternative source of code
|
||||
# from this svn at https://svn.unixmedia.net/public/zum/trunk/zum/
|
||||
# Many Thanks to "MASTERTHEKNIFE" for the excellent speed optimisation ( http://www.zoneminder.com/forums/viewtopic.php?f=9&t=17652 )
|
||||
# And to "NEXTIME" for the recent source update and incredible plugins ( http://www.zoneminder.com/forums/viewtopic.php?f=9&t=20587 )
|
||||
# And all people helping ZoneMinder dev.
|
||||
#
|
||||
# -FUNCTIONALITIES:
|
||||
# -Move camera in 8 direction with arrow, the speed of movement is function
|
||||
# of the position of your mouse on the arrow.
|
||||
# Extremity of arrow equal to fastest speed of movement
|
||||
# Close the base of arrow to lowest speed of movement
|
||||
# for diagonaly you can click before the beginning of the arrow for low speed
|
||||
# In round center equal to stop to move
|
||||
# -You can clic directly on the image that equal to click on arrow (for the left there is a bug in zoneminder speed is inverted)
|
||||
# -Zoom Tele/Wide with time control to simulate speed because speed value do not work (buggy firmware or not implemented on this cam)
|
||||
# -Focus Near/Far with time control to simulate speed because speed value do not work (buggy firmware or not implemented on this cam)
|
||||
# -Autofocus is automatic when you move again or can be setting by autofocus button
|
||||
# -8 Preset PTZ are implemented but the firmware is buggy and that do not work
|
||||
# You Need to configure ZoneMinder PANSPEED & TILTSEPPED & ZOOMSPEED 1 to 63 by 1 step
|
||||
# -This Script use for login "admin" this hardcoded and your password must setup in "Control Device" section
|
||||
# -This script is compatible with the basic authentification method used by mostly new camera
|
||||
# -AutoStop function is active and you must set up value (in sec example 0.5) under AutoStop section
|
||||
# or you can set up to 0 for disable it but the camera never stop to move and trust me, she can move all the night...
|
||||
# (you need to click to the center arrow for stop)
|
||||
# -"White In" to control Brightness, "auto" for restore the original value of Brightness
|
||||
# -"White Out" to control Contrast, "man" for restore the original value of Contrast
|
||||
# -"Iris Open" to control Saturation , "auto" for restore the original value of Saturation
|
||||
# -"Iris Close" to control Hue , "man" for restore the original value of Hue
|
||||
# -Another cool stuff i use the OSD function of this cam for printing the command with the value
|
||||
# The button of Focus "Man" is for enable or disable OSD but that do not work ( it's my bug... i'm very very new with perl )
|
||||
# ===================================================================================================================================
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
# Set $osd to "off" if you wan't disabled OSD i need to place this variable in another script because
|
||||
# this script is reload at every command ,if i want the button on/off (Focus MAN) for OSD works...
|
||||
my $osd = "on";
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = ZoneMinder::Control->new( $id );
|
||||
bless( $self, $class );
|
||||
srand( time() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
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} );
|
||||
}
|
||||
Fatal( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
$self->loadMonitor();
|
||||
use LWP::UserAgent;
|
||||
$self->{ua} = LWP::UserAgent->new;
|
||||
$self->{ua}->agent( "ZoneMinder Control Agent/".ZoneMinder::Base::ZM_VERSION );
|
||||
$self->{state} = 'open';
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
Debug( $msg."[".$msg_len."]" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
my $result = undef;
|
||||
printMsg( $cmd, "Tx" );
|
||||
# I solve the authentification problem with recent Foscam
|
||||
# I use perl Basic Authentification method
|
||||
my $ua = LWP::UserAgent->new();
|
||||
my $req = HTTP::Request->new( GET =>"http://".$self->{Monitor}->{ControlAddress}."/web/cgi-bin/hi3510/".$cmd );
|
||||
$req->authorization_basic('admin', $self->{Monitor}->{ControlDevice} );
|
||||
my $res = $self->{ua}->request($req);
|
||||
if ( $res->is_success )
|
||||
{
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Error check failed: '".$res->status_line()."'" );
|
||||
}
|
||||
return( $result );
|
||||
}
|
||||
|
||||
sub moveStop
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Stop" );
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=stop";
|
||||
$self->sendCmd( $cmd );
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=0&-name=.";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub autoStop
|
||||
{
|
||||
my $self = shift;
|
||||
my $autostop = shift;
|
||||
if( $autostop )
|
||||
{
|
||||
Debug( "Auto Stop" );
|
||||
usleep( $autostop );
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=stop";
|
||||
$self->sendCmd( $cmd );
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=0&-name=.";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConUp
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $tiltspeed > 59 ) {
|
||||
$tiltspeed = 63;
|
||||
}
|
||||
if ( $tiltspeed < 6 ) {
|
||||
$tiltspeed = 1;
|
||||
}
|
||||
Debug( "Move Up" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Move Up $tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=up&-speed=$tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub moveConDown
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $tiltspeed > 59 ) {
|
||||
$tiltspeed = 63;
|
||||
}
|
||||
if ( $tiltspeed < 6 ) {
|
||||
$tiltspeed = 1;
|
||||
}
|
||||
Debug( "Move Down" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Move Down $tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=down&-speed=$tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub moveConLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panspeed = $self->getParam( $params, 'panspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $panspeed > 59 ) {
|
||||
$panspeed = 63;
|
||||
}
|
||||
if ( $panspeed < 6 ) {
|
||||
$panspeed = 1;
|
||||
}
|
||||
# Algorithme pour inverser la table de valeur de la flèche gauche, (for invert the value) 63 ==> 1 et 1 ==> 63 ...
|
||||
$panspeed = abs($panspeed - 63) + 1;
|
||||
Debug( "Move Left" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Move Left $panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=left&-speed=$panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub moveConRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panspeed = $self->getParam( $params, 'panspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $panspeed > 59 ) {
|
||||
$panspeed = 63;
|
||||
}
|
||||
if ( $panspeed < 6 ) {
|
||||
$panspeed = 1;
|
||||
}
|
||||
Debug( "Move Right" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Move Right $panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=right&-speed=$panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub moveConUpLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $tiltspeed > 59 ) {
|
||||
$tiltspeed = 63;
|
||||
}
|
||||
if ( $tiltspeed < 6 ) {
|
||||
$tiltspeed = 1;
|
||||
}
|
||||
my $panspeed = $self->getParam( $params, 'panspeed' );
|
||||
# Standardization for incorrect value in the database
|
||||
if ( $panspeed > 59 ) {
|
||||
$panspeed = 63;
|
||||
}
|
||||
if ( $panspeed < 6 ) {
|
||||
$panspeed = 1;
|
||||
}
|
||||
Debug( "Move Con Up Left" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Up $tiltspeed Left $panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=up&-speed=$tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=left&-speed=$panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub moveConUpRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $tiltspeed > 59 ) {
|
||||
$tiltspeed = 63;
|
||||
}
|
||||
if ( $tiltspeed < 6 ) {
|
||||
$tiltspeed = 1;
|
||||
}
|
||||
my $panspeed = $self->getParam( $params, 'panspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $panspeed > 59 ) {
|
||||
$panspeed = 63;
|
||||
}
|
||||
if ( $panspeed < 6 ) {
|
||||
$panspeed = 1;
|
||||
}
|
||||
Debug( "Move Con Up Right" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Up $tiltspeed Right $panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=up&-speed=$tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=right&-speed=$panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub moveConDownLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $tiltspeed > 59 ) {
|
||||
$tiltspeed = 63;
|
||||
}
|
||||
if ( $tiltspeed < 6 ) {
|
||||
$tiltspeed = 1;
|
||||
}
|
||||
my $panspeed = $self->getParam( $params, 'panspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $panspeed > 59 ) {
|
||||
$panspeed = 63;
|
||||
}
|
||||
if ( $panspeed < 6 ) {
|
||||
$panspeed = 1;
|
||||
}
|
||||
Debug( "Move Con Down Left" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Down $tiltspeed Left $panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=down&-speed=$tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=left&-speed=$panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub moveConDownRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $tiltspeed > 59 ) {
|
||||
$tiltspeed = 63;
|
||||
}
|
||||
if ( $tiltspeed < 6 ) {
|
||||
$tiltspeed = 1;
|
||||
}
|
||||
my $panspeed = $self->getParam( $params, 'panspeed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $panspeed > 59 ) {
|
||||
$panspeed = 63;
|
||||
}
|
||||
if ( $panspeed < 6 ) {
|
||||
$panspeed = 1;
|
||||
}
|
||||
Debug( "Move Con Down Right" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Down $tiltspeed Right $panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=down&-speed=$tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=right&-speed=$panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub zoomConTele
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $speed > 59 ) {
|
||||
$speed = 63;
|
||||
}
|
||||
if ( $speed < 6 ) {
|
||||
$speed = 1;
|
||||
}
|
||||
Debug( "Zoom-Tele" );
|
||||
# I use OSD Function to send the speed used for determining the time before stop the order
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Zoom Tele $speed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=zoomin";
|
||||
$self->sendCmd( $cmd );
|
||||
# The variable speed does not work with zoom setting, so I used to set the duration of the order
|
||||
# the result is identical
|
||||
$self->autoStop( int(10000*$speed) );
|
||||
}
|
||||
|
||||
sub zoomConWide
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $speed > 59 ) {
|
||||
$speed = 63;
|
||||
}
|
||||
if ( $speed < 6 ) {
|
||||
$speed = 1;
|
||||
}
|
||||
Debug( "Zoom-Wide" );
|
||||
# I use the feature OSD (OnScreenDisplay). Variable speed as a basis for calculating the duration of the zoom order
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Zoom Wide $speed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=zoomout";
|
||||
$self->sendCmd( $cmd );
|
||||
# The variable speed does not work with zoom setting, so I used to set the duration of the order
|
||||
# the result is identical
|
||||
$self->autoStop( int(10000*$speed) );
|
||||
}
|
||||
|
||||
sub focusConNear
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $speed > 59 ) {
|
||||
$speed = 63;
|
||||
}
|
||||
if ( $speed < 6 ) {
|
||||
$speed = 1;
|
||||
}
|
||||
Debug( "Focus Near" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Focus Near $speed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=focusout&-speed=$speed";
|
||||
$self->sendCmd( $cmd );
|
||||
# The variable speed does not work with focus setting, so I used to set the duration of the order
|
||||
# the result is identical
|
||||
$self->autoStop( int(10000*$speed) );
|
||||
}
|
||||
|
||||
sub focusConFar
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $speed > 59 ) {
|
||||
$speed = 63;
|
||||
}
|
||||
if ( $speed < 6 ) {
|
||||
$speed = 1;
|
||||
}
|
||||
Debug( "Focus Far" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Focus Far $speed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-step=0&-act=focusin&-speed=$speed";
|
||||
$self->sendCmd( $cmd );
|
||||
# The variable speed does not work with focus setting, so I used to set the duration of the order
|
||||
# the result is identical
|
||||
$self->autoStop( int(10000*$speed) );
|
||||
}
|
||||
|
||||
sub focusAuto
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Focus Auto" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Focus Auto";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "ptzctrl.cgi?-act=auto&-step=1";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusMan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Focus Manu=OSD ON OFF" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
$osd = "off";
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=OSD $osd";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( int(1000000*0.5) );
|
||||
}
|
||||
if ( $osd eq "off" )
|
||||
{
|
||||
$osd = "on";
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=OSD $osd";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( int(1000000*0.5) );
|
||||
}
|
||||
}
|
||||
|
||||
sub whiteConIn
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $speed > 255 ) {
|
||||
$speed = 255;
|
||||
}
|
||||
if ( $speed < 0 ) {
|
||||
$speed = 0;
|
||||
}
|
||||
Debug( "White ConIn=brightness" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Brightness $speed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-brightness=$speed";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub whiteConOut
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed' );
|
||||
# Standardization for incorrect possible value in the database, and for realise at low and high speed an more precise moving
|
||||
if ( $speed > 255 ) {
|
||||
$speed = 255;
|
||||
}
|
||||
if ( $speed < 0 ) {
|
||||
$speed = 0;
|
||||
}
|
||||
Debug( "White ConOut=Contrast" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Contrast $speed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-contrast=$speed";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub whiteAuto
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "White Auto=Brightness Reset" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Brightness Reset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-brightness=120";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub whiteMan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "White Manuel=Contrast Reset" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Contrast Reset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-contrast=140";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub irisConOpen
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed' );
|
||||
# Standardization for incorrect value in the database
|
||||
if ( $speed > 255 ) {
|
||||
$speed = 255;
|
||||
}
|
||||
if ( $speed < 0 ) {
|
||||
$speed = 0;
|
||||
}
|
||||
Debug( "Iris ConOpen=Saturation" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Saturation $speed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-saturation=$speed";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub irisConClose
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed' );
|
||||
# Standardization for incorrect value in the database
|
||||
if ( $speed > 255 ) {
|
||||
$speed = 255;
|
||||
}
|
||||
if ( $speed < 0 ) {
|
||||
$speed = 0;
|
||||
}
|
||||
Debug( "Iris ConClose=Hue" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Hue $speed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-hue=$speed";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub irisAuto
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Iris Auto=Saturation Reset" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Saturation Reset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-saturation=150";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub irisMan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Iris Manuel=Hue Reset" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=Hue Reset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "param.cgi?cmd=setimageattr&-hue=255";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
if ( ( $preset >= 1 ) && ( $preset <= 8 ) ) {
|
||||
Debug( "Clear Preset $preset" );
|
||||
my $cmd = "preset.cgi?-act=set&-status=0&-number=$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
Debug( "Set Preset $preset" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=PresetSet $preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "preset.cgi?-act=set&-status=1&-number=$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
if ( ( $preset >= 1 ) && ( $preset <= 8 ) ) {
|
||||
Debug( "Goto Preset $preset" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "param.cgi?cmd=setoverlayattr&-region=1&-show=1&-name=PresetGoto $preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "preset.cgi?-act=goto&-number=$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Control::FI8620 - Perl extension for FOSCAM FI8620
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,236 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Foscam FI8908W / FI8918W IP Control Protocol Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
# Modified for use with Foscam FI8908W IP Camera by Dave Harris
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
package ZoneMinder::Control::FI8908W;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Control;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Control);
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Foscam FI8908W IP Control Protocol
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = ZoneMinder::Control->new( $id );
|
||||
bless( $self, $class );
|
||||
srand( time() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
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} );
|
||||
}
|
||||
Fatal( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
$self->loadMonitor();
|
||||
|
||||
use LWP::UserAgent;
|
||||
$self->{ua} = LWP::UserAgent->new;
|
||||
$self->{ua}->agent( "ZoneMinder Control Agent/".ZoneMinder::Base::ZM_VERSION );
|
||||
|
||||
$self->{state} = 'open';
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
Debug( $msg."[".$msg_len."]" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
my $result = undef;
|
||||
|
||||
my ($user, $password) = split /:/, $self->{Monitor}->{ControlDevice};
|
||||
|
||||
if ( !defined $password ) {
|
||||
# If value of "Control device" does not consist of two parts, then only password is given and we fallback to default user:
|
||||
$password = $user;
|
||||
$user = 'admin';
|
||||
}
|
||||
|
||||
$cmd .= "user=$user&pwd=$password";
|
||||
|
||||
printMsg( $cmd, "Tx" );
|
||||
|
||||
my $req = HTTP::Request->new( GET=>"http://".$self->{Monitor}->{ControlAddress}."/$cmd" );
|
||||
my $res = $self->{ua}->request($req);
|
||||
|
||||
if ( $res->is_success )
|
||||
{
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Error check failed: '".$res->status_line()."' for URL ".$req->uri() );
|
||||
}
|
||||
|
||||
return( $result );
|
||||
}
|
||||
|
||||
sub reset
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Camera Reset" );
|
||||
$self->sendCmd( 'reboot.cgi?' );
|
||||
}
|
||||
|
||||
#Up Arrow
|
||||
sub moveConUp
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up" );
|
||||
$self->sendCmd( 'decoder_control.cgi?command=0&' );
|
||||
}
|
||||
|
||||
#Down Arrow
|
||||
sub moveConDown
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down" );
|
||||
$self->sendCmd( 'decoder_control.cgi?command=2&' );
|
||||
}
|
||||
|
||||
#Left Arrow
|
||||
sub moveConLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Left" );
|
||||
$self->sendCmd( 'decoder_control.cgi?command=6&' );
|
||||
}
|
||||
|
||||
#Right Arrow
|
||||
sub moveConRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Right" );
|
||||
$self->sendCmd( 'decoder_control.cgi?command=4&' );
|
||||
}
|
||||
|
||||
#Diagonally Up Right Arrow
|
||||
sub moveConUpRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Diagonally Up Right" );
|
||||
$self->sendCmd( 'decoder_control.cgi?command=90&' );
|
||||
}
|
||||
|
||||
#Diagonally Down Right Arrow
|
||||
sub moveConDownRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Diagonally Down Right" );
|
||||
$self->sendCmd( 'decoder_control.cgi?command=92&' );
|
||||
}
|
||||
|
||||
#Diagonally Up Left Arrow
|
||||
sub moveConUpLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Diagonally Up Left" );
|
||||
$self->sendCmd( 'decoder_control.cgi?command=91&' );
|
||||
}
|
||||
|
||||
#Diagonally Down Left Arrow
|
||||
sub moveConDownLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Diagonally Down Left" );
|
||||
$self->sendCmd( 'decoder_control.cgi?command=93&' );
|
||||
}
|
||||
|
||||
#Stop
|
||||
sub moveStop
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Stop" );
|
||||
$self->sendCmd( 'decoder_control.cgi?command=1&' );
|
||||
}
|
||||
|
||||
#Move Camera to Home Position
|
||||
sub presetHome
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Home Preset" );
|
||||
$self->sendCmd( 'decoder_control.cgi?command=25&' );
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Control::FI8908W - Foscam FI8908W camera control
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains the implementation of the Foscam FI8908W / FI8918W IP
|
||||
camera control protocol.
|
||||
|
||||
The module uses "Control Device" value to retrieve user and password. User
|
||||
and password should be separated by colon, e.g. user:password. If colon is
|
||||
not provided, then "admin" is used as a fallback value for the user.
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,765 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder FOSCAM version 1.0 API Control Protocol Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# =========================================================================================
|
||||
#
|
||||
# This module FI8620_Y2k.pm contains the implementation of API camera control
|
||||
# For FOSCAM FI8620 Dome PTZ Camera (This cam support only H264 streaming)
|
||||
# V1.0 Le 09 AOUT 2013 - production usable for the script but not for the camera "reboot itself"
|
||||
# If you wan't to contact me i understand French and English, precise ZoneMinder in subject
|
||||
# My name is Christophe DAPREMONT my email is christophe_y2k@yahoo.fr
|
||||
#
|
||||
# =========================================================================================
|
||||
package ZoneMinder::Control::FI9821W_Y2k;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Control;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Control);
|
||||
# ===================================================================================================================================
|
||||
#
|
||||
# FI9821 FOSCAM PT H264 Control Protocol
|
||||
# with Firmware version V1.2.1.1 (latest at 09/08/2013)
|
||||
# based with the latest buggy CGI doc from FOSCAM ( http://foscam.us/forum/cgi-sdk-for-hd-camera-t6045.html )
|
||||
# This IPCAM work under ZoneMinder V1.25 from alternative source of code
|
||||
# from this svn at https://svn.unixmedia.net/public/zum/trunk/zum/
|
||||
# Many Thanks to "MASTERTHEKNIFE" for the excellent speed optimisation ( http://www.zoneminder.com/forums/viewtopic.php?f=9&t=17652 )
|
||||
# And to "NEXTIME" for the recent source update and incredible plugins ( http://www.zoneminder.com/forums/viewtopic.php?f=9&t=20587 )
|
||||
# And all people helping ZoneMinder dev.
|
||||
#
|
||||
# -FUNCTION: display on OSD
|
||||
# speed is progressive in function of where you click on arrow ========>
|
||||
# speed low=/ \=speed high
|
||||
# ===================================================================================================================================
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
# Set $osd to "off" if you wan't disabled OSD i need to place this variable in another script because
|
||||
# this script is reload at every command ,if i want the button on/off (Focus MAN) for OSD works...
|
||||
my $osd = "on";
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = ZoneMinder::Control->new( $id );
|
||||
bless( $self, $class );
|
||||
srand( time() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
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} );
|
||||
}
|
||||
Fatal( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
$self->loadMonitor();
|
||||
use LWP::UserAgent;
|
||||
$self->{ua} = LWP::UserAgent->new;
|
||||
$self->{ua}->agent( "ZoneMinder Control Agent/".ZoneMinder::Base::ZM_VERSION );
|
||||
$self->{state} = 'open';
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
Debug( $msg."[".$msg_len."]" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
my $result = undef;
|
||||
|
||||
my ($user, $password) = split /:/, $self->{Monitor}->{ControlDevice};
|
||||
if ( ! $password ) {
|
||||
$password = $user;
|
||||
$user = 'admin';
|
||||
}
|
||||
$user = 'admin' if ! $user;
|
||||
$password = 'pwd' if ! $password;
|
||||
|
||||
$cmd .= "&usr=$user&pwd=$password";
|
||||
|
||||
printMsg( $cmd, "Tx" );
|
||||
my $url;
|
||||
if ( $self->{Monitor}->{ControlAddress} =~ /^http/ ) {
|
||||
$url = $self->{Monitor}->{ControlAddress};
|
||||
} else {
|
||||
$url = "http://".$self->{Monitor}->{ControlAddress};
|
||||
}
|
||||
$url .= "/cgi-bin/CGIProxy.fcgi?cmd=$cmd%26".time;
|
||||
printMsg( $url, "Tx" );
|
||||
|
||||
my $req = HTTP::Request->new( GET=>$url );
|
||||
my $res = $self->{ua}->request($req);
|
||||
if ( $res->is_success )
|
||||
{
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Error check failed: '".$res->status_line()."'" );
|
||||
}
|
||||
return( $result );
|
||||
}
|
||||
|
||||
sub reset
|
||||
{ my $self = shift;
|
||||
Debug ( "Reset = setup camera FI9821W" );
|
||||
# Setup OSD
|
||||
my $cmd = "setOSDSetting%26isEnableTimeStamp%3D0%26isEnableDevName%3D1%26dispPos%3D0%26isEnabledOSDMask%3D0";
|
||||
$self->sendCmd( $cmd );
|
||||
# Setup For Stream=0 Resolution=720p Bandwidth=4M FPS=30 KeyFrameInterval/GOP=100 VBR=ON
|
||||
$cmd = "setVideoStreamParam%26streamType%3D0%26resolution%3D0%26bitRate%3D4194304%26frameRate%3D30%26GOP%3D100%26isVBR%3D1";
|
||||
$self->sendCmd( $cmd );
|
||||
# Setup For Infrared AUTO
|
||||
$cmd = "setInfraLedConfig%26Mode%3D1";
|
||||
$self->sendCmd( $cmd );
|
||||
# Reset image settings
|
||||
$cmd = "resetImageSetting";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveStop
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Stop" );
|
||||
my $cmd = "ptzStopRun";
|
||||
$self->sendCmd( $cmd );
|
||||
$cmd = "setDevName%26devName%3D.";
|
||||
$self->sendCmd( $cmd );
|
||||
$cmd = "setOSDSetting%26isEnableDevName%3D1";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub autoStop
|
||||
{
|
||||
my $self = shift;
|
||||
my $autostop = shift;
|
||||
if( $autostop )
|
||||
{
|
||||
Debug( "Auto Stop" );
|
||||
usleep( $autostop );
|
||||
my $cmd = "ptzStopRun";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConUp
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
|
||||
# speed inverter 4-->0 , 3-->1 , 2-->2 , 1-->3 , 0-->4
|
||||
$tiltspeed = abs($tiltspeed - 4);
|
||||
# Normalisation en cas de valeur erronée dans la base de données
|
||||
if ( $tiltspeed > 4 ) {
|
||||
$tiltspeed = 4;
|
||||
}
|
||||
if ( $tiltspeed < 0 ) {
|
||||
$tiltspeed = 0;
|
||||
}
|
||||
Debug( "Move Up" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DMove Up $tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setPTZSpeed%26speed%3D$tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
$cmd = "ptzMoveUp";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub moveConDown
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
|
||||
# speed inverter 4-->0 , 3-->1 , 2-->2 , 1-->3 , 0-->4
|
||||
$tiltspeed = abs($tiltspeed - 4);
|
||||
# Normalization
|
||||
if ( $tiltspeed > 4 ) {
|
||||
$tiltspeed = 4;
|
||||
}
|
||||
if ( $tiltspeed < 0 ) {
|
||||
$tiltspeed = 0;
|
||||
}
|
||||
Debug( "Move Down" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DMove Down $tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setPTZSpeed%26speed%3D$tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
$cmd = "ptzMoveDown";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub moveConLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panspeed = $self->getParam( $params, 'panspeed' );
|
||||
# Normalisation en cas de valeur erronée dans la base de données
|
||||
if ( $panspeed > 4 ) {
|
||||
$panspeed = 4;
|
||||
}
|
||||
if ( $panspeed < 0 ) {
|
||||
$panspeed = 0;
|
||||
}
|
||||
Debug( "Move Left" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DMove Left $panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setPTZSpeed%26speed%3D$panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
$cmd = "ptzMoveLeft";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
|
||||
sub moveConRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panspeed = $self->getParam( $params, 'panspeed' );
|
||||
# speed inverter 4-->0 , 3-->1 , 2-->2 , 1-->3 , 0-->4
|
||||
$panspeed = abs($panspeed - 4);
|
||||
# Normalisation en cas de valeur erronée dans la base de données
|
||||
if ( $panspeed > 4 ) {
|
||||
$panspeed = 4;
|
||||
}
|
||||
if ( $panspeed < 0 ) {
|
||||
$panspeed = 0;
|
||||
}
|
||||
Debug( "Move Right" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DMove Right $panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setPTZSpeed%26speed%3D$panspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
$cmd = "ptzMoveRight";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub moveConUpLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
|
||||
# speed inverter 4-->0 , 3-->1 , 2-->2 , 1-->3 , 0-->4
|
||||
$tiltspeed = abs($tiltspeed - 4);
|
||||
# Normalisation en cas de valeur erronée dans la base de données
|
||||
if ( $tiltspeed > 4 ) {
|
||||
$tiltspeed = 4;
|
||||
}
|
||||
if ( $tiltspeed < 0 ) {
|
||||
$tiltspeed = 0;
|
||||
}
|
||||
Debug( "Move Con Up Left" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DMove Up Left $tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setPTZSpeed%26speed%3D$tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
$cmd = "ptzMoveTopLeft";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub moveConUpRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
|
||||
# speed inverter 4-->0 , 3-->1 , 2-->2 , 1-->3 , 0-->4
|
||||
$tiltspeed = abs($tiltspeed - 4);
|
||||
# Normalisation en cas de valeur erronée dans la base de données
|
||||
if ( $tiltspeed > 4 ) {
|
||||
$tiltspeed = 4;
|
||||
}
|
||||
if ( $tiltspeed < 0 ) {
|
||||
$tiltspeed = 0;
|
||||
}
|
||||
Debug( "Move Con Up Right" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DMove Up Right $tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setPTZSpeed%26speed%3D$tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
$cmd = "ptzMoveTopRight";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub moveConDownLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
|
||||
# speed inverter 4-->0 , 3-->1 , 2-->2 , 1-->3 , 0-->4
|
||||
$tiltspeed = abs($tiltspeed - 4);
|
||||
# Normalisation en cas de valeur erronée dans la base de données
|
||||
if ( $tiltspeed > 4 ) {
|
||||
$tiltspeed = 4;
|
||||
}
|
||||
if ( $tiltspeed < 0 ) {
|
||||
$tiltspeed = 0;
|
||||
}
|
||||
Debug( "Move Con Down Left" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DMove Down Left $tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setPTZSpeed%26speed%3D$tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
$cmd = "ptzMoveBottomLeft";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub moveConDownRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
|
||||
# speed inverter 4-->0 , 3-->1 , 2-->2 , 1-->3 , 0-->4
|
||||
$tiltspeed = abs($tiltspeed - 4);
|
||||
# Normalisation en cas de valeur erronée dans la base de données
|
||||
if ( $tiltspeed > 4 ) {
|
||||
$tiltspeed = 4;
|
||||
}
|
||||
if ( $tiltspeed < 0 ) {
|
||||
$tiltspeed = 0;
|
||||
}
|
||||
Debug( "Move Con Down Right" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DMove Down Right $tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setPTZSpeed%26speed%3D$tiltspeed";
|
||||
$self->sendCmd( $cmd );
|
||||
$cmd = "ptzMoveBottomRight";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub zoomConTele
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Zoom-Tele=MANU IR LED ON" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DManual IR LED Switch ON";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setInfraLedConfig%26mode%3D1";
|
||||
$self->sendCmd( $cmd );
|
||||
$cmd = "openInfraLed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub zoomConWide
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Zoom-Wide=MANU IR LED OFF" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DManual IR LED Switch OFF";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setInfraLedConfig%26mode%3D1";
|
||||
$self->sendCmd( $cmd );
|
||||
$cmd = "closeInfraLed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub wake
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Wake=AUTO IR LED" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DAuto IR LED Mode";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setInfraLedConfig%26mode%3D0";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusConNear
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed' );
|
||||
# Normalisation en cas de valeur erronée dans la base de données
|
||||
if ( $speed > 100 ) {
|
||||
$speed = 100;
|
||||
}
|
||||
if ( $speed < 0 ) {
|
||||
$speed = 0;
|
||||
}
|
||||
Debug( "Focus Near=Sharpness" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DSharpness $speed";
|
||||
$self->sendCmd( $cmd );
|
||||
$cmd = "setOSDSetting%26isEnableDevName%3D1";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setSharpness%26sharpness%3D$speed";
|
||||
$self->sendCmd( $cmd );
|
||||
# La variable speed ne fonctionne pas en paramètre du focus, alors je l'utilise pour définir la durée de la commande
|
||||
# le résulat est identique
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub focusConFar
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed' );
|
||||
# Normalisation en cas de valeur erronée dans la base de données
|
||||
if ( $speed > 100 ) {
|
||||
$speed = 100;
|
||||
}
|
||||
if ( $speed < 0 ) {
|
||||
$speed = 0;
|
||||
}
|
||||
Debug( "Focus Far" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DSharpness $speed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setSharpness%26sharpness%3D$speed";
|
||||
$self->sendCmd( $cmd );
|
||||
# La variable speed ne fonctionne pas en paramètre du focus alors je l'utilise pour définir la durée de la commande
|
||||
# le résulat est identique
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub focusAuto
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Focus Auto=Reset Sharpness" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DReset Sharpness";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setSharpness%26sharpness%3D10";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub focusMan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Focus Manu=Reset Sharpness" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DFOSCAM FI9821W Script V1.0 By Christophe_y2k";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
}
|
||||
|
||||
sub whiteConIn
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed' );
|
||||
# Normalisation en cas de valeur erronée dans la base de données
|
||||
if ( $speed > 100 ) {
|
||||
$speed = 100;
|
||||
}
|
||||
if ( $speed < 0 ) {
|
||||
$speed = 0;
|
||||
}
|
||||
Debug( "White ConIn=brightness" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DBrightness $speed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setBrightness%26brightness%3D$speed";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub whiteConOut
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed' );
|
||||
# Normalisation en cas de valeur erronée dans la base de données
|
||||
if ( $speed > 100 ) {
|
||||
$speed = 100;
|
||||
}
|
||||
if ( $speed < 0 ) {
|
||||
$speed = 0;
|
||||
}
|
||||
Debug( "White ConOut=Contrast" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DContrast $speed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setContrast%26constrast%3D$speed";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub whiteAuto
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "White Auto=Brightness Reset" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DBrightness Reset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setBrightness%26brightness%3D50";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub whiteMan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "White Manuel=Contrast Reset" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DContrast Reset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setContrast%26constrast%3D44";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub irisConOpen
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed' );
|
||||
# Normalisation en cas de valeur erronée dans la base de données
|
||||
if ( $speed > 100 ) {
|
||||
$speed = 100;
|
||||
}
|
||||
if ( $speed < 0 ) {
|
||||
$speed = 0;
|
||||
}
|
||||
Debug( "Iris ConOpen=Saturation" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DSaturation $speed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setSaturation%26saturation%3D$speed";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub irisConClose
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed' );
|
||||
# Normalisation en cas de valeur erronée dans la base de données
|
||||
if ( $speed > 100 ) {
|
||||
$speed = 100;
|
||||
}
|
||||
if ( $speed < 0 ) {
|
||||
$speed = 0;
|
||||
}
|
||||
Debug( "Iris ConClose=Hue" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DHue $speed";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setHue%26hue%3D$speed";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub irisAuto
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Iris Auto=Saturation Reset" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DSaturation Reset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setSaturation%26saturation%3D30";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub irisMan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Iris Manuel=Hue Reset" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DHue Reset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setHue%26hue%3D6";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
if ( ( $preset >= 1 ) && ( $preset <= 16 ) ) {
|
||||
Debug( "Clear Preset $preset" );
|
||||
my $cmd = "ptzDeletePresetPoint%26name%3D$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
Debug( "Set Preset $preset" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DSet Preset $preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
$cmd = "ptzAddPresetPoint%26name%3D$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
if ( ( $preset >= 1 ) && ( $preset <= 16 ) ) {
|
||||
Debug( "Goto Preset $preset" );
|
||||
if ( $osd eq "on" )
|
||||
{
|
||||
my $cmd = "setDevName%26devName%3DGoto Preset $preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
my $cmd = "setPTZSpeed%26speed%3D0";
|
||||
$self->sendCmd( $cmd );
|
||||
$cmd = "ptzGotoPresetPoint%26name%3D$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Control::FI9821W - Perl extension for FOSCAM FI9821W
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
||||
|
|
@ -0,0 +1,416 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Loftek Sentinel IP Control Protocol Module, $Date: 2009-11-25 09:20:00 +0000 (Wed, 04 Nov 2009) $, $Revision: 0001 $
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
# Original modification for use with Foscam FI8908W IP Camera by Dave Harris
|
||||
# Updated by Ivan Francolin Martinez
|
||||
# Converted for use with Loftek Sentinal IP Camera by Andrew Bauer (knnniggett@users.sourceforge.net)
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the implementation of the Loftek Sentinel IP camera control
|
||||
# protocol
|
||||
#
|
||||
package ZoneMinder::Control::LoftekSentinel;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Control;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Control);
|
||||
|
||||
our %CamParams = ();
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Loftek Sentinel IP Control Protocol
|
||||
#
|
||||
# On ControlAddress use the format :
|
||||
# USERNAME:PASSWORD@ADDRESS:PORT
|
||||
# eg : admin:@10.1.2.1:80
|
||||
# zoneminder:zonepass@10.0.100.1:40000
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
sub new
|
||||
{
|
||||
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = ZoneMinder::Control->new( $id );
|
||||
my $logindetails = "";
|
||||
bless( $self, $class );
|
||||
srand( time() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
sub AUTOLOAD
|
||||
{
|
||||
my $self = shift;
|
||||
my $class = ref( ) || croak( "$self not object" );
|
||||
my $name = $AUTOLOAD;
|
||||
$name =~ s/.*://;
|
||||
if ( exists($self->{$name}) )
|
||||
{
|
||||
return( $self->{$name} );
|
||||
}
|
||||
Fatal( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
$self->loadMonitor();
|
||||
|
||||
use LWP::UserAgent;
|
||||
$self->{ua} = LWP::UserAgent->new;
|
||||
$self->{ua}->agent( "ZoneMinder Control Agent/".ZoneMinder::Base::ZM_VERSION );
|
||||
|
||||
$self->{state} = 'open';
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
Debug( $msg."[".$msg_len."]" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
my $result = undef;
|
||||
printMsg( $cmd, "Tx" );
|
||||
|
||||
my $req = HTTP::Request->new( GET=>"http://".$self->{Monitor}->{ControlAddress}."/$cmd" );
|
||||
my $res = $self->{ua}->request($req);
|
||||
|
||||
if ( $res->is_success )
|
||||
{
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Error check failed:'".$res->status_line()."'" );
|
||||
}
|
||||
|
||||
return( $result );
|
||||
}
|
||||
|
||||
sub getCamParams
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
my $req = HTTP::Request->new( GET=>"http://".$self->{Monitor}->{ControlAddress}."/get_camera_params.cgi" );
|
||||
my $res = $self->{ua}->request($req);
|
||||
|
||||
if ( $res->is_success )
|
||||
{
|
||||
# Parse results setting values in %FCParams
|
||||
my $content = $res->decoded_content;
|
||||
|
||||
while ($content =~ s/var\s+([^=]+)=([^;]+);//ms) {
|
||||
$CamParams{$1} = $2;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Error check failed:'".$res->status_line()."'" );
|
||||
}
|
||||
}
|
||||
|
||||
#autoStop
|
||||
#This makes use of the ZoneMinder Auto Stop Timeout on the Control Tab
|
||||
sub autoStop
|
||||
{
|
||||
my $self = shift;
|
||||
my $stop_command = shift;
|
||||
my $autostop = shift;
|
||||
if( $stop_command && $autostop)
|
||||
{
|
||||
Debug( "Auto Stop" );
|
||||
usleep( $autostop );
|
||||
my $cmd = "decoder_control.cgi?command=".$stop_command;
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
# Reset the Camera
|
||||
sub reset
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Camera Reset" );
|
||||
my $cmd = "reboot.cgi?";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
#Up Arrow
|
||||
sub moveConUp
|
||||
{
|
||||
my $self = shift;
|
||||
my $stop_command = "1";
|
||||
Debug( "Move Up" );
|
||||
my $cmd = "decoder_control.cgi?command=0";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $stop_command, $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
#Down Arrow
|
||||
sub moveConDown
|
||||
{
|
||||
my $self = shift;
|
||||
my $stop_command = "3";
|
||||
Debug( "Move Down" );
|
||||
my $cmd = "decoder_control.cgi?command=2";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $stop_command, $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
#Left Arrow
|
||||
sub moveConLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $stop_command = "5";
|
||||
Debug( "Move Left" );
|
||||
my $cmd = "decoder_control.cgi?command=4";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $stop_command, $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
#Right Arrow
|
||||
sub moveConRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $stop_command = "7";
|
||||
Debug( "Move Right" );
|
||||
my $cmd = "decoder_control.cgi?command=6";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $stop_command, $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
#Zoom In
|
||||
sub zoomConTele
|
||||
{
|
||||
my $self = shift;
|
||||
my $stop_command = "17";
|
||||
Debug( "Zoom Tele" );
|
||||
my $cmd = "decoder_control.cgi?command=18";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $stop_command, $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
#Zoom Out
|
||||
sub zoomConWide
|
||||
{
|
||||
my $self = shift;
|
||||
my $stop_command = "19";
|
||||
Debug( "Zoom Wide" );
|
||||
my $cmd = "decoder_control.cgi?command=16";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $stop_command, $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
#Diagonally Up Right Arrow
|
||||
#This camera does not have builtin diagonal commands so we emulate them
|
||||
sub moveConUpRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Diagonally Up Right" );
|
||||
$self->moveConUp( );
|
||||
$self->moveConRight( );
|
||||
}
|
||||
|
||||
#Diagonally Down Right Arrow
|
||||
#This camera does not have builtin diagonal commands so we emulate them
|
||||
sub moveConDownRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Diagonally Down Right" );
|
||||
$self->moveConDown( );
|
||||
$self->moveConRight( );
|
||||
}
|
||||
|
||||
#Diagonally Up Left Arrow
|
||||
#This camera does not have builtin diagonal commands so we emulate them
|
||||
sub moveConUpLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Diagonally Up Left" );
|
||||
$self->moveConUp( );
|
||||
$self->moveConLeft( );
|
||||
}
|
||||
|
||||
#Diagonally Down Left Arrow
|
||||
#This camera does not have builtin diagonal commands so we emulate them
|
||||
sub moveConDownLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Diagonally Down Left" );
|
||||
$self->moveConDown( );
|
||||
$self->moveConLeft( );
|
||||
}
|
||||
|
||||
#Stop
|
||||
sub moveStop
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Stop" );
|
||||
my $cmd = "decoder_control.cgi?command=1";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
#Set Camera Preset
|
||||
#Presets must be translated into values internal to the camera
|
||||
#Those values are: 30,32,34,36,38,40,42,44 for presets 1-8 respectively
|
||||
sub presetSet
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Set Preset $preset" );
|
||||
|
||||
if (( $preset >= 1 ) && ( $preset <= 8 )) {
|
||||
my $cmd = "decoder_control.cgi?command=".(($preset*2) + 28);
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
}
|
||||
|
||||
#Recall Camera Preset
|
||||
#Presets must be translated into values internal to the camera
|
||||
#Those values are: 31,33,35,37,39,41,43,45 for presets 1-8 respectively
|
||||
sub presetGoto
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Goto Preset $preset" );
|
||||
|
||||
if (( $preset >= 1 ) && ( $preset <= 8 )) {
|
||||
my $cmd = "decoder_control.cgi?command=".(($preset*2) + 29);
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
if ( $preset == 9 ) {
|
||||
$self->horizontalPatrol();
|
||||
}
|
||||
|
||||
if ( $preset == 10 ) {
|
||||
$self->horizontalPatrolStop();
|
||||
}
|
||||
}
|
||||
|
||||
#Horizontal Patrol - Vertical Patrols are not supported
|
||||
sub horizontalPatrol
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Horizontal Patrol" );
|
||||
my $cmd = "decoder_control.cgi?command=20";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
#Horizontal Patrol Stop
|
||||
sub horizontalPatrolStop
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Horizontal Patrol Stop" );
|
||||
my $cmd = "decoder_control.cgi?command=21";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
# Increase Brightness
|
||||
sub irisAbsOpen
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
$self->getCamParams() unless($CamParams{'brightness'});
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
|
||||
$CamParams{'brightness'} += $step;
|
||||
$CamParams{'brightness'} = 255 if ($CamParams{'brightness'} > 255);
|
||||
Debug( "Iris $CamParams{'brightness'}" );
|
||||
my $cmd = "camera_control.cgi?param=1&value=".$CamParams{'brightness'};
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
# Decrease Brightness
|
||||
sub irisAbsClose
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
$self->getCamParams() unless($CamParams{'brightness'});
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
|
||||
$CamParams{'brightness'} -= $step;
|
||||
$CamParams{'brightness'} = 0 if ($CamParams{'brightness'} < 0);
|
||||
Debug( "Iris $CamParams{'brightness'}" );
|
||||
my $cmd = "camera_control.cgi?param=1&value=".$CamParams{'brightness'};
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
# Increase Contrast
|
||||
sub whiteAbsIn
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
$self->getCamParams() unless($CamParams{'contrast'});
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
|
||||
$CamParams{'contrast'} += $step;
|
||||
$CamParams{'contrast'} = 6 if ($CamParams{'contrast'} > 6);
|
||||
Debug( "Iris $CamParams{'contrast'}" );
|
||||
my $cmd = "camera_control.cgi?param=2&value=".$CamParams{'contrast'};
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
# Decrease Contrast
|
||||
sub whiteAbsOut
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
$self->getCamParams() unless($CamParams{'contrast'});
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
|
||||
$CamParams{'contrast'} -= $step;
|
||||
$CamParams{'contrast'} = 0 if ($CamParams{'contrast'} < 0);
|
||||
Debug( "Iris $CamParams{'contrast'}" );
|
||||
my $cmd = "camera_control.cgi?param=2&value=".$CamParams{'contrast'};
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
|
@ -0,0 +1,483 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder M8640 API Control Protocol Module, $Date$, $Revision$
|
||||
# Copyright (C) 2014 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the implementation of the M8640 API camera control
|
||||
# protocol
|
||||
# URL's are as follows:
|
||||
# /cgi-bin/getLed.cgi
|
||||
# /cgi-bin/setGPIO.cgi command:6, duration: 0|1 for led on/off
|
||||
# /cgi-bin/reboot.cgi
|
||||
# /cgi-bin/restore.cgi
|
||||
#
|
||||
package ZoneMinder::Control::M8640;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Control;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Control);
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Axis V2 Control Protocol
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
|
||||
use Time::HiRes qw( usleep );
|
||||
use URI::Encode qw();
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = ZoneMinder::Control->new( $id );
|
||||
bless( $self, $class );
|
||||
srand( time() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
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} );
|
||||
}
|
||||
Fatal( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub open {
|
||||
my $self = shift;
|
||||
|
||||
$self->loadMonitor();
|
||||
|
||||
use LWP::UserAgent;
|
||||
$self->{ua} = LWP::UserAgent->new;
|
||||
$self->{ua}->agent( "ZoneMinder Control Agent/".$ZoneMinder::Base::VERSION );
|
||||
|
||||
$self->{state} = 'open';
|
||||
}
|
||||
|
||||
sub close {
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
}
|
||||
|
||||
sub printMsg {
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
Debug( $msg."[".$msg_len."]" );
|
||||
}
|
||||
|
||||
sub sendCmd {
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
printMsg( $cmd, "Tx" );
|
||||
#print( "http://$address/$cmd\n" );
|
||||
#my $req = HTTP::Request->new( GET=>"http://".$self->{Monitor}->{ControlAddress}."/$cmd" );
|
||||
|
||||
my $url;
|
||||
if ( $self->{Monitor}->{ControlAddress} =~ /^http/ ) {
|
||||
$url = $self->{Monitor}->{ControlAddress}
|
||||
.'/cgi-bin/setGPIO.cgi?preventCache='.time
|
||||
;
|
||||
} else {
|
||||
$url = 'http://'.$self->{Monitor}->{ControlAddress}
|
||||
.'/cgi-bin/setGPIO.cgi?preventCache='.time
|
||||
;
|
||||
} # en dif
|
||||
Error("Url: $url $cmd");
|
||||
my $uri = URI::Encode->new( { encode_reserved => 0 } );
|
||||
my $encoded = $uri->encode( $cmd );
|
||||
my $res = $self->{ua}->post( $url, Content=>"data=$encoded" );
|
||||
|
||||
if ( $res->is_success ) {
|
||||
Debug("Success (" . $res->as_string . ') code: ' . $res->code );
|
||||
$result = !undef;
|
||||
} else {
|
||||
Error( "Error check failed: '".$res->status_line()."'" );
|
||||
}
|
||||
|
||||
return( $result );
|
||||
}
|
||||
|
||||
sub cameraReset {
|
||||
my $self = shift;
|
||||
Debug( "Camera Reset" );
|
||||
my $cmd = "/axis-cgi/admin/restart.cgi";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub Up
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up" );
|
||||
$self->sendCmd( '{"command":1,"duration":250}' );
|
||||
}
|
||||
|
||||
sub Down
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down" );
|
||||
$self->sendCmd( '{"command":2,"duration":250}' );
|
||||
}
|
||||
|
||||
sub Left
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Left" );
|
||||
$self->sendCmd( '{"command":4,"duration":250}' );
|
||||
}
|
||||
|
||||
sub Right
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Right" );
|
||||
$self->sendCmd( '{"command":3,"duration":250}' );
|
||||
}
|
||||
|
||||
sub UpRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up/Right" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=upright";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub UpLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up/Left" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=upleft";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub DownRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down/Right" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=downright";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub DownLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down/Left" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=downleft";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveMap
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $xcoord = $self->getParam( $params, 'xcoord' );
|
||||
my $ycoord = $self->getParam( $params, 'ycoord' );
|
||||
Debug( "Move Map to $xcoord,$ycoord" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?center=$xcoord,$ycoord&imagewidth="
|
||||
.$self->{Monitor}->{Width}
|
||||
."&imageheight="
|
||||
.$self->{Monitor}->{Height}
|
||||
;
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelUp
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'tiltstep' );
|
||||
Debug( "Step Up $step" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rtilt=$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelDown
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'tiltstep' );
|
||||
Debug( "Step Down $step" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rtilt=-$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'panstep' );
|
||||
Debug( "Step Left $step" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=-$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'panstep' );
|
||||
Debug( "Step Right $step" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelUpRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panstep = $self->getParam( $params, 'panstep' );
|
||||
my $tiltstep = $self->getParam( $params, 'tiltstep' );
|
||||
Debug( "Step Up/Right $tiltstep/$panstep" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=$panstep&rtilt=$tiltstep";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelUpLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panstep = $self->getParam( $params, 'panstep' );
|
||||
my $tiltstep = $self->getParam( $params, 'tiltstep' );
|
||||
Debug( "Step Up/Left $tiltstep/$panstep" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=-$panstep&rtilt=$tiltstep";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelDownRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panstep = $self->getParam( $params, 'panstep' );
|
||||
my $tiltstep = $self->getParam( $params, 'tiltstep' );
|
||||
Debug( "Step Down/Right $tiltstep/$panstep" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=$panstep&rtilt=-$tiltstep";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelDownLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panstep = $self->getParam( $params, 'panstep' );
|
||||
my $tiltstep = $self->getParam( $params, 'tiltstep' );
|
||||
Debug( "Step Down/Left $tiltstep/$panstep" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=-$panstep&rtilt=-$tiltstep";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub zoomRelTele
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Zoom Tele" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rzoom=$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub zoomRelWide
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Zoom Wide" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rzoom=-$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusRelNear
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Focus Near" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rfocus=-$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusRelFar
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Focus Far" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rfocus=$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusAuto
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Focus Auto" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?autofocus=on";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusMan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Focus Manual" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?autofocus=off";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub irisRelOpen
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Iris Open" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?riris=$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub irisRelClose
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Iris Close" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?riris=-$step";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub irisAuto
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Iris Auto" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?autoiris=on";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub irisMan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Iris Manual" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?autoiris=off";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetClear
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Clear Preset $preset" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?removeserverpresetno=$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Set Preset $preset" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?setserverpresetno=$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Goto Preset $preset" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?gotoserverpresetno=$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Home Preset" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=home";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,239 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Neu-Fusion Control Protocol Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the implementation of the Neu-Fusion NCS370 IP camera
|
||||
# control protocol
|
||||
#
|
||||
package ZoneMinder::Control::Ncs370;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Control;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Control);
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Ncs370 IP Control Protocol
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = ZoneMinder::Control->new( $id );
|
||||
bless( $self, $class );
|
||||
srand( time() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
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} );
|
||||
}
|
||||
Fatal( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
$self->loadMonitor();
|
||||
|
||||
use LWP::UserAgent;
|
||||
$self->{ua} = LWP::UserAgent->new;
|
||||
$self->{ua}->agent( "ZoneMinder Control Agent/".ZoneMinder::Base::ZM_VERSION );
|
||||
|
||||
$self->{state} = 'open';
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
Debug( $msg."[".$msg_len."]" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
printMsg( $cmd, "Tx" );
|
||||
|
||||
my $req = HTTP::Request->new( POST=>"http://".$self->{Monitor}->{ControlAddress}."/PANTILTCONTROL.CGI" );
|
||||
my $res = $self->{ua}->request($req);
|
||||
|
||||
if ( $res->is_success )
|
||||
{
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Error check failed: '".$res->status_line()."'" );
|
||||
}
|
||||
|
||||
return( $result );
|
||||
}
|
||||
|
||||
sub moveConUp
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up" );
|
||||
my $cmd = "PanSingleMoveDegree=1\nTiltSingleMoveDegree=1\nPanTiltSingleMove=1";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConDown
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down" );
|
||||
my $cmd = "PanSingleMoveDegree=1\nTiltSingleMoveDegree=1\nPanTiltSingleMove=7";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Left" );
|
||||
my $cmd = "PanSingleMoveDegree=1\nTiltSingleMoveDegree=1\nPanTiltSingleMove=3";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Right" );
|
||||
my $cmd = "PanSingleMoveDegree=1\nTiltSingleMoveDegree=1\nPanTiltSingleMove=5";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConUpRight
|
||||
{
|
||||
moveConUp();
|
||||
moveConRight();
|
||||
}
|
||||
|
||||
sub moveConUpLeft
|
||||
{
|
||||
moveConUp();
|
||||
moveConLeft();
|
||||
}
|
||||
|
||||
sub moveConDownRight
|
||||
{
|
||||
moveConDown();
|
||||
moveConRight();
|
||||
}
|
||||
|
||||
sub moveConDownLeft
|
||||
{
|
||||
moveConDown();
|
||||
moveConLeft();
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Home Preset" );
|
||||
my $cmd = "PanSingleMoveDegree=1\nTiltSingleMoveDegree=1\nPanTiltSingleMove=4";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,320 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Panasonic IP Control Protocol Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the implementation of the Panasonic IP camera control
|
||||
# protocol
|
||||
#
|
||||
package ZoneMinder::Control::PanasonicIP;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Control;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Control);
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Panasonic IP Control Protocol
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = ZoneMinder::Control->new( $id );
|
||||
bless( $self, $class );
|
||||
srand( time() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
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} );
|
||||
}
|
||||
Fatal( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
$self->loadMonitor();
|
||||
|
||||
use LWP::UserAgent;
|
||||
$self->{ua} = LWP::UserAgent->new;
|
||||
$self->{ua}->agent( "ZoneMinder Control Agent/".ZoneMinder::Base::ZM_VERSION );
|
||||
|
||||
$self->{state} = 'open';
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
Debug( $msg."[".$msg_len."]" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
printMsg( $cmd, "Tx" );
|
||||
|
||||
my $req = HTTP::Request->new( GET=>"http://".$self->{Monitor}->{ControlAddress}."/$cmd" );
|
||||
my $res = $self->{ua}->request($req);
|
||||
|
||||
if ( $res->is_success )
|
||||
{
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Error check failed: '".$res->status_line()."'" );
|
||||
}
|
||||
|
||||
return( $result );
|
||||
}
|
||||
|
||||
sub cameraReset
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Camera Reset" );
|
||||
my $cmd = "nphRestart?PAGE=Restart&Restart=OK";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConUp
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up" );
|
||||
my $cmd = "nphControlCamera?Direction=TiltUp";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConDown
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down" );
|
||||
my $cmd = "nphControlCamera?Direction=TiltDown";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Left" );
|
||||
my $cmd = "nphControlCamera?Direction=PanLeft";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Right" );
|
||||
my $cmd = "nphControlCamera?Direction=PanRight";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveMap
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $xcoord = $self->getParam( $params, 'xcoord' );
|
||||
my $ycoord = $self->getParam( $params, 'ycoord' );
|
||||
Debug( "Move Map to $xcoord,$ycoord" );
|
||||
my $cmd = "nphControlCamera?Direction=Direct&NewPosition.x=$xcoord&NewPosition.y=$ycoord&Width=".$self->{Monitor}->{Width}."&Height=".$self->{Monitor}->{Height};
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub zoomConTele
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Zoom Tele" );
|
||||
my $cmd = "nphControlCamera?Direction=ZoomTele";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub zoomConWide
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Zoom Wide" );
|
||||
my $cmd = "nphControlCamera?Direction=ZoomWide";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusConNear
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Focus Near" );
|
||||
my $cmd = "nphControlCamera?Direction=FocusNear";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusConFar
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
Debug( "Focus Far" );
|
||||
my $cmd = "nphControlCamera?Direction=FocusFar";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusAuto
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Focus Auto" );
|
||||
my $cmd = "nphControlCamera?Direction=FocusAuto";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusMan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Focus Manual" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?autofocus=off";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetClear
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Clear Preset $preset" );
|
||||
my $cmd = "nphPresetNameCheck?Data=$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Set Preset $preset" );
|
||||
my $cmd = "nphPresetNameCheck?PresetName=$preset&Data=$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Goto Preset $preset" );
|
||||
my $cmd = "nphControlCamera?Direction=Preset&PresetOperation=Move&Data=$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Home Preset" );
|
||||
my $cmd = "nphControlCamera?Direction=HomePosition";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,733 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Pelco-D Control Protocol Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the implementation of the Pelco-D camera control
|
||||
# protocol
|
||||
#
|
||||
package ZoneMinder::Control::PelcoD;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Control;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Control);
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Pelco-D Control Protocol
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
use constant SYNC => 0xff;
|
||||
use constant COMMAND_GAP => 100000; # In ms
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = ZoneMinder::Control->new( $id );
|
||||
bless( $self, $class );
|
||||
srand( time() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
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} );
|
||||
}
|
||||
Fatal( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
$self->loadMonitor();
|
||||
|
||||
use Device::SerialPort;
|
||||
$self->{port} = new Device::SerialPort( $self->{Monitor}->{ControlDevice} );
|
||||
$self->{port}->baudrate(2400);
|
||||
$self->{port}->databits(8);
|
||||
$self->{port}->parity('none');
|
||||
$self->{port}->stopbits(1);
|
||||
$self->{port}->handshake('none');
|
||||
|
||||
$self->{port}->read_const_time(50);
|
||||
$self->{port}->read_char_time(10);
|
||||
|
||||
$self->{state} = 'open';
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
$self->{port}->close();
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
if ( logDebugging() )
|
||||
{
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $prefix = shift || "";
|
||||
$prefix = $prefix.": " if ( $prefix );
|
||||
|
||||
my $line_length = 16;
|
||||
my $msg_len = int(@$msg);
|
||||
|
||||
my $msg_str = $prefix;
|
||||
for ( my $i = 0; $i < $msg_len; $i++ )
|
||||
{
|
||||
if ( ($i > 0) && ($i%$line_length == 0) && ($i != ($msg_len-1)) )
|
||||
{
|
||||
$msg_str .= sprintf( "\n%*s", length($prefix), "" );
|
||||
}
|
||||
$msg_str .= sprintf( "%02x ", $msg->[$i] );
|
||||
}
|
||||
$msg_str .= "[".$msg_len."]";
|
||||
Debug( $msg_str );
|
||||
}
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
my $ack = shift || 0;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
my $checksum = 0x00;
|
||||
for ( my $i = 1; $i < int(@$cmd); $i++ )
|
||||
{
|
||||
$checksum += $cmd->[$i];
|
||||
$checksum &= 0xff;
|
||||
}
|
||||
push( @$cmd, $checksum );
|
||||
|
||||
$self->printMsg( $cmd, "Tx" );
|
||||
my $id = $cmd->[0] & 0xf;
|
||||
|
||||
my $tx_msg = pack( "C*", @$cmd );
|
||||
|
||||
#print( "Tx: ".length( $tx_msg )." bytes\n" );
|
||||
my $n_bytes = $self->{port}->write( $tx_msg );
|
||||
if ( !$n_bytes )
|
||||
{
|
||||
Error( "Write failed: $!" );
|
||||
}
|
||||
if ( $n_bytes != length($tx_msg) )
|
||||
{
|
||||
Error( "Incomplete write, only ".$n_bytes." of ".length($tx_msg)." written: $!" );
|
||||
}
|
||||
|
||||
if ( $ack )
|
||||
{
|
||||
Debug( "Waiting for ack" );
|
||||
my $max_wait = 3;
|
||||
my $now = time();
|
||||
while( 1 )
|
||||
{
|
||||
my ( $count, $rx_msg ) = $self->{port}->read(4);
|
||||
|
||||
if ( $count )
|
||||
{
|
||||
#print( "Rx1: ".$count." bytes\n" );
|
||||
my @resp = unpack( "C*", $rx_msg );
|
||||
printMsg( \@resp, "Rx" );
|
||||
|
||||
if ( $resp[0] = 0x80 + ($id<<4) )
|
||||
{
|
||||
if ( ($resp[1] & 0xf0) == 0x40 )
|
||||
{
|
||||
my $socket = $resp[1] & 0x0f;
|
||||
Debug( "Got ack for socket $socket" );
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Got bogus response" );
|
||||
}
|
||||
last;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Got message for camera ".(($resp[0]-0x80)>>4) );
|
||||
}
|
||||
}
|
||||
if ( (time() - $now) > $max_wait )
|
||||
{
|
||||
Warning( "Response timeout" );
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub remoteReset
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Remote Reset" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x0f, 0x00, 0x00 );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub resetDefaults
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Reset Defaults" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x29, 0x00, 0x00 );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub cameraOff
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Camera Off" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x08, 0x00, 0x00, 0x00 );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub cameraOn
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Camera On" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x88, 0x00, 0x00, 0x00 );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub autoScan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Auto Scan" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x90, 0x00, 0x00, 0x00 );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub manScan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Manual Scan" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x10, 0x00, 0x00, 0x00 );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub stop
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Stop" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x00, 0x00, 0x00 );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveConUp
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'tiltspeed' );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Up" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x08, 0x00, $speed );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop( $params );
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConDown
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'tiltspeed' );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Down" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x10, 0x00, $speed );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'panspeed' );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Left" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x04, $speed, 0x00 );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'panspeed' );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Right" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x02, $speed, 0x00 );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConUpLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panspeed = $self->getParam( $params, 'panspeed', 0x3f );
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed', 0x3f );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Up/Left" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x0c, $panspeed, $tiltspeed );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConUpRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panspeed = $self->getParam( $params, 'panspeed', 0x3f );
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed', 0x3f );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Up/Right" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x0a, $panspeed, $tiltspeed );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConDownLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panspeed = $self->getParam( $params, 'panspeed', 0x3f );
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed', 0x3f );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Down/Left" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x14, $panspeed, $tiltspeed );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConDownRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panspeed = $self->getParam( $params, 'panspeed', 0x3f );
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed', 0x3f );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Down/Right" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x12, $panspeed, $tiltspeed );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveStop
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Stop" );
|
||||
$self->stop();
|
||||
}
|
||||
|
||||
sub flip180
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Flip 180" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x07, 0x00, 0x21 );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub zeroPan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Zero Pan" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x07, 0x00, 0x22 );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub _setZoomSpeed
|
||||
{
|
||||
my $self = shift;
|
||||
my $speed = shift;
|
||||
Debug( "Set Zoom Speed $speed" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x25, 0x00, $speed );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub zoomStop
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Zoom Stop" );
|
||||
$self->stop();
|
||||
$self->_setZoomSpeed( 0 );
|
||||
}
|
||||
|
||||
sub zoomConTele
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed', 0x01 );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Zoom Tele" );
|
||||
$self->_setZoomSpeed( $speed );
|
||||
usleep( COMMAND_GAP );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x20, 0x00, 0x00 );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->zoomStop();
|
||||
}
|
||||
}
|
||||
|
||||
sub zoomConWide
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed', 0x01 );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Zoom Wide" );
|
||||
$self->_setZoomSpeed( $speed );
|
||||
usleep( COMMAND_GAP );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x40, 0x00, 0x00 );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->zoomStop();
|
||||
}
|
||||
}
|
||||
|
||||
sub _setFocusSpeed
|
||||
{
|
||||
my $self = shift;
|
||||
my $speed = shift;
|
||||
Debug( "Set Focus Speed $speed" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x27, 0x00, $speed );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusConNear
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed', 0x03 );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Focus Near" );
|
||||
$self->_setFocusSpeed( $speed );
|
||||
usleep( COMMAND_GAP );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x01, 0x00, 0x00, 0x00 );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->_setFocusSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub focusConFar
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed', 0x03 );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Focus Far" );
|
||||
$self->_setFocusSpeed( $speed );
|
||||
usleep( COMMAND_GAP );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x80, 0x00, 0x00 );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->_setFocusSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub focusStop
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Focus Stop" );
|
||||
$self->stop();
|
||||
$self->_setFocusSpeed( 0 );
|
||||
}
|
||||
|
||||
sub focusAuto
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Focus Auto" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x2b, 0x00, 0x00 );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusMan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Focus Man" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x2b, 0x00, 0x02 );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub _setIrisSpeed
|
||||
{
|
||||
my $self = shift;
|
||||
my $speed = shift;
|
||||
Debug( "Set Iris Speed $speed" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x27, 0x00, $speed );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub irisConClose
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Iris Close" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x04, 0x00, 0x00, 0x00 );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->_setIrisSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub irisConOpen
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Iris Open" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x02, 0x80, 0x00, 0x00 );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->_setIrisSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub irisStop
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Iris Stop" );
|
||||
$self->stop();
|
||||
$self->_setIrisSpeed( 0 );
|
||||
}
|
||||
|
||||
sub irisAuto
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Iris Auto" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x2d, 0x00, 0x00 );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub irisMan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Iris Man" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x2d, 0x00, 0x02 );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub writeScreen
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $string = $self->getParam( $params, 'string' );
|
||||
Debug( "Writing '$string' to screen" );
|
||||
|
||||
my @chars = unpack( "C*", $string );
|
||||
for ( my $i = 0; $i < length($string); $i++ )
|
||||
{
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x15, $i, $chars[$i] );
|
||||
$self->sendCmd( \@msg );
|
||||
usleep( COMMAND_GAP );
|
||||
}
|
||||
}
|
||||
|
||||
sub clearScreen
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Clear Screen" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x17, 0x00, 0x00 );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub clearPreset
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset', 1 );
|
||||
Debug( "Clear Preset $preset" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x05, 0x00, $preset );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset', 1 );
|
||||
Debug( "Set Preset $preset" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x03, 0x00, $preset );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset', 1 );
|
||||
Debug( "Goto Preset $preset" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x07, 0x00, $preset );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Home Preset" );
|
||||
my @msg = ( SYNC, $self->{Monitor}->{ControlAddress}, 0x00, 0x07, 0x00, 0x22 );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub reset
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Reset" );
|
||||
$self->remoteReset();
|
||||
$self->resetDefaults();
|
||||
}
|
||||
|
||||
sub wake
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Wake" );
|
||||
$self->cameraOn();
|
||||
}
|
||||
|
||||
sub sleep
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Sleep" );
|
||||
$self->cameraOff();
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,734 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Pelco-P Control Protocol Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the implementation of the Pelco-P camera control
|
||||
# protocol
|
||||
#
|
||||
package ZoneMinder::Control::PelcoP;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Control;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Control);
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Pelco-P Control Protocol
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
use constant STX => 0xa0;
|
||||
use constant ETX => 0xaf;
|
||||
use constant COMMAND_GAP => 100000; # In ms
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = ZoneMinder::Control->new( $id );
|
||||
bless( $self, $class );
|
||||
srand( time() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
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} );
|
||||
}
|
||||
Fatal( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
$self->loadMonitor();
|
||||
|
||||
use Device::SerialPort;
|
||||
$self->{port} = new Device::SerialPort( $self->{Monitor}->{ControlDevice} );
|
||||
$self->{port}->baudrate(4800);
|
||||
$self->{port}->databits(8);
|
||||
$self->{port}->parity('none');
|
||||
$self->{port}->stopbits(1);
|
||||
$self->{port}->handshake('none');
|
||||
|
||||
$self->{port}->read_const_time(50);
|
||||
$self->{port}->read_char_time(10);
|
||||
|
||||
$self->{state} = 'open';
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
$self->{port}->close();
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
if ( logDebugging() )
|
||||
{
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $prefix = shift || "";
|
||||
$prefix = $prefix.": " if ( $prefix );
|
||||
|
||||
my $line_length = 16;
|
||||
my $msg_len = int(@$msg);
|
||||
|
||||
my $msg_str = $prefix;
|
||||
for ( my $i = 0; $i < $msg_len; $i++ )
|
||||
{
|
||||
if ( ($i > 0) && ($i%$line_length == 0) && ($i != ($msg_len-1)) )
|
||||
{
|
||||
$msg_str .= sprintf( "\n%*s", length($prefix), "" );
|
||||
}
|
||||
$msg_str .= sprintf( "%02x ", $msg->[$i] );
|
||||
}
|
||||
$msg_str .= "[".$msg_len."]";
|
||||
Debug( $msg_str );
|
||||
}
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
my $ack = shift || 0;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
my $checksum = 0x00;
|
||||
for ( my $i = 1; $i < int(@$cmd); $i++ )
|
||||
{
|
||||
$checksum ^= $cmd->[$i];
|
||||
}
|
||||
$checksum &= 0xff;
|
||||
push( @$cmd, $checksum );
|
||||
|
||||
$self->printMsg( $cmd, "Tx" );
|
||||
my $id = $cmd->[0] & 0xf;
|
||||
|
||||
my $tx_msg = pack( "C*", @$cmd );
|
||||
|
||||
#print( "Tx: ".length( $tx_msg )." bytes\n" );
|
||||
my $n_bytes = $self->{port}->write( $tx_msg );
|
||||
if ( !$n_bytes )
|
||||
{
|
||||
Error( "Write failed: $!" );
|
||||
}
|
||||
if ( $n_bytes != length($tx_msg) )
|
||||
{
|
||||
Error( "Incomplete write, only ".$n_bytes." of ".length($tx_msg)." written: $!" );
|
||||
}
|
||||
|
||||
if ( $ack )
|
||||
{
|
||||
Debug( "Waiting for ack" );
|
||||
my $max_wait = 3;
|
||||
my $now = time();
|
||||
while( 1 )
|
||||
{
|
||||
my ( $count, $rx_msg ) = $self->{port}->read(4);
|
||||
|
||||
if ( $count )
|
||||
{
|
||||
#print( "Rx1: ".$count." bytes\n" );
|
||||
my @resp = unpack( "C*", $rx_msg );
|
||||
printMsg( \@resp, "Rx" );
|
||||
|
||||
if ( $resp[0] = 0x80 + ($id<<4) )
|
||||
{
|
||||
if ( ($resp[1] & 0xf0) == 0x40 )
|
||||
{
|
||||
my $socket = $resp[1] & 0x0f;
|
||||
Debug( "Got ack for socket $socket" );
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Got bogus response" );
|
||||
}
|
||||
last;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Got message for camera ".(($resp[0]-0x80)>>4) );
|
||||
}
|
||||
}
|
||||
if ( (time() - $now) > $max_wait )
|
||||
{
|
||||
Warning( "Response timeout" );
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub remoteReset
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Remote Reset" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x0f, 0x00, 0x00, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub resetDefaults
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Reset Defaults" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x29, 0x00, 0x00, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub cameraOff
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Camera Off" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x08, 0x00, 0x00, 0x00, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub cameraOn
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Camera On" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x88, 0x00, 0x00, 0x00, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub autoScan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Auto Scan" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x90, 0x00, 0x00, 0x00, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub manScan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Manual Scan" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x10, 0x00, 0x00, 0x00, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub stop
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Stop" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x00, 0x00, 0x00, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveConUp
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'tiltspeed' );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Up" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x08, 0x00, $speed, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop( $params );
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConDown
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'tiltspeed' );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Down" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x10, 0x00, $speed, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'panspeed' );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Left" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x04, $speed, 0x00, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'panspeed' );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Right" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x02, $speed, 0x00, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConUpLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panspeed = $self->getParam( $params, 'panspeed', 0x3f );
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed', 0x3f );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Up/Left" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x0c, $panspeed, $tiltspeed, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConUpRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panspeed = $self->getParam( $params, 'panspeed', 0x3f );
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed', 0x3f );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Up/Right" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x0a, $panspeed, $tiltspeed, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConDownLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panspeed = $self->getParam( $params, 'panspeed', 0x3f );
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed', 0x3f );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Down/Left" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x14, $panspeed, $tiltspeed, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConDownRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panspeed = $self->getParam( $params, 'panspeed', 0x3f );
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed', 0x3f );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Down/Right" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x12, $panspeed, $tiltspeed, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveStop
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Stop" );
|
||||
$self->stop();
|
||||
}
|
||||
|
||||
sub flip180
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Flip 180" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x07, 0x00, 0x21, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub zeroPan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Zero Pan" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x07, 0x00, 0x22, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub _setZoomSpeed
|
||||
{
|
||||
my $self = shift;
|
||||
my $speed = shift;
|
||||
Debug( "Set Zoom Speed $speed" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x25, 0x00, $speed, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub zoomStop
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Zoom Stop" );
|
||||
$self->stop();
|
||||
$self->_setZoomSpeed( 0 );
|
||||
}
|
||||
|
||||
sub zoomConTele
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed', 0x01 );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Zoom Tele" );
|
||||
$self->_setZoomSpeed( $speed );
|
||||
usleep( COMMAND_GAP );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x20, 0x00, 0x00, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->zoomStop();
|
||||
}
|
||||
}
|
||||
|
||||
sub zoomConWide
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed', 0x01 );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Zoom Wide" );
|
||||
$self->_setZoomSpeed( $speed );
|
||||
usleep( COMMAND_GAP );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x40, 0x00, 0x00, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->zoomStop();
|
||||
}
|
||||
}
|
||||
|
||||
sub _setFocusSpeed
|
||||
{
|
||||
my $self = shift;
|
||||
my $speed = shift;
|
||||
Debug( "Set Focus Speed $speed" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x27, 0x00, $speed, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusConNear
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed', 0x03 );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Focus Near" );
|
||||
$self->_setFocusSpeed( $speed );
|
||||
usleep( COMMAND_GAP );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x01, 0x00, 0x00, 0x00, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->_setFocusSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub focusConFar
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed', 0x03 );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Focus Far" );
|
||||
$self->_setFocusSpeed( $speed );
|
||||
usleep( COMMAND_GAP );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x80, 0x00, 0x00, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->_setFocusSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub focusStop
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Focus Stop" );
|
||||
$self->stop();
|
||||
$self->_setFocusSpeed( 0 );
|
||||
}
|
||||
|
||||
sub focusAuto
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Focus Auto" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x2b, 0x00, 0x00, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusMan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Focus Man" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x2b, 0x00, 0x02, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub _setIrisSpeed
|
||||
{
|
||||
my $self = shift;
|
||||
my $speed = shift;
|
||||
Debug( "Set Iris Speed $speed" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x27, 0x00, $speed, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub irisConClose
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Iris Close" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x04, 0x00, 0x00, 0x00, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->_setIrisSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub irisConOpen
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Iris Open" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x02, 0x80, 0x00, 0x00, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->_setIrisSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub irisStop
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Iris Stop" );
|
||||
$self->stop();
|
||||
$self->_setIrisSpeed( 0 );
|
||||
}
|
||||
|
||||
sub irisAuto
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Iris Auto" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x2d, 0x00, 0x00, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub irisMan
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Iris Man" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x2d, 0x00, 0x02, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub writeScreen
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $string = $self->getParam( $params, 'string' );
|
||||
Debug( "Writing '$string' to screen" );
|
||||
|
||||
my @chars = unpack( "C*", $string );
|
||||
for ( my $i = 0; $i < length($string); $i++ )
|
||||
{
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x15, $i, $chars[$i], ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
usleep( COMMAND_GAP );
|
||||
}
|
||||
}
|
||||
|
||||
sub clearScreen
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Clear Screen" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x17, 0x00, 0x00, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub clearPreset
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset', 1 );
|
||||
Debug( "Clear Preset $preset" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x05, 0x00, $preset, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset', 1 );
|
||||
Debug( "Set Preset $preset" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x03, 0x00, $preset, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset', 1 );
|
||||
Debug( "Goto Preset $preset" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x07, 0x00, $preset, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Home Preset" );
|
||||
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x07, 0x00, 0x22, ETX );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub reset
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Reset" );
|
||||
$self->remoteReset();
|
||||
$self->resetDefaults();
|
||||
}
|
||||
|
||||
sub wake
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Wake" );
|
||||
$self->cameraOn();
|
||||
}
|
||||
|
||||
sub sleep
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Sleep" );
|
||||
$self->cameraOff();
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,322 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Airlink SkyIPCam AICN747/AICN747W Control Protocol Module, $Date: 2008-09-13 17:30:29 +0000 (Sat, 13 Sept 2008) $, $Revision: 2229 $
|
||||
# Copyright (C) 2008 Brian Rudy (brudyNO@SPAMpraecogito.com)
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the implementation of the Airlink SkyIPCam
|
||||
# AICN747/AICN747W, TrendNet TV-IP410/TV-IP410W and other OEM versions of the
|
||||
# Fitivision CS-130A/CS-131A camera control protocol.
|
||||
#
|
||||
package ZoneMinder::Control::SkyIPCam7xx;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Control;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Control);
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Airlink SkyIPCam AICN747/AICN747W Control Protocol
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = ZoneMinder::Control->new( $id );
|
||||
bless( $self, $class );
|
||||
srand( time() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
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} );
|
||||
}
|
||||
Fatal( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
$self->loadMonitor();
|
||||
|
||||
use LWP::UserAgent;
|
||||
$self->{ua} = LWP::UserAgent->new;
|
||||
$self->{ua}->agent( "ZoneMinder Control Agent/".ZoneMinder::Base::ZM_VERSION );
|
||||
|
||||
$self->{state} = 'open';
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
Debug( $msg."[".$msg_len."]" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
printMsg( $cmd, "Tx" );
|
||||
|
||||
my $url;
|
||||
if ( $self->{Monitor}->{ControlAddress} =~ /^http/ ) {
|
||||
$url = $self->{Monitor}->{ControlAddress}.$cmd;
|
||||
} else {
|
||||
$url = 'http://'.$self->{Monitor}->{ControlAddress}.$cmd;
|
||||
} # en dif
|
||||
my $req = HTTP::Request->new( GET=>$url );
|
||||
|
||||
my $res = $self->{ua}->request($req);
|
||||
|
||||
if ( $res->is_success )
|
||||
{
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Error check failed: '".$res->status_line()."'" );
|
||||
}
|
||||
|
||||
return( $result );
|
||||
}
|
||||
|
||||
sub reset
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Camera Reset" );
|
||||
my $cmd = "/admin/ptctl.cgi?move=reset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveMap
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $xcoord = $self->getParam( $params, 'xcoord' );
|
||||
my $ycoord = $self->getParam( $params, 'ycoord' );
|
||||
|
||||
my $hor = $xcoord * 100 / $self->{Monitor}->{Width};
|
||||
my $ver = $ycoord * 100 / $self->{Monitor}->{Height};
|
||||
|
||||
my $maxver = 8;
|
||||
my $maxhor = 30;
|
||||
|
||||
my $horDir = "right";
|
||||
my $verDir = "up";
|
||||
my $horSteps = 0;
|
||||
my $verSteps = 0;
|
||||
|
||||
# Horizontal movement
|
||||
if ($hor < 50) {
|
||||
# left
|
||||
$horSteps = ((50 - $hor) / 50) * $maxhor;
|
||||
$horDir = "left";
|
||||
}
|
||||
elsif ($hor > 50) {
|
||||
# right
|
||||
$horSteps = (($hor - 50) / 50) * $maxhor;
|
||||
$horDir = "right";
|
||||
}
|
||||
|
||||
# Vertical movement
|
||||
if ($ver < 50) {
|
||||
# up
|
||||
$verSteps = ((50 - $ver) / 50) * $maxver;
|
||||
$verDir = "up";
|
||||
}
|
||||
elsif ($ver > 50) {
|
||||
# down
|
||||
$verSteps = (($ver - 50) / 50) * $maxver;
|
||||
$verDir = "down";
|
||||
}
|
||||
|
||||
my $v = int($verSteps);
|
||||
my $h = int($horSteps);
|
||||
|
||||
Debug( "Move Map to $xcoord,$ycoord, hor=$h $horDir, ver=$v $verDir");
|
||||
my $cmd = "/cgi/admin/ptctrl.cgi?action=movedegree&Cmd=$horDir&Degree=$h";
|
||||
$self->sendCmd( $cmd );
|
||||
$cmd = "/cgi/admin/ptctrl.cgi?action=movedegree&Cmd=$verDir&Degree=$v";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelUp
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'tiltstep' );
|
||||
Debug( "Step Up $step" );
|
||||
my $cmd = "/admin/ptctl.cgi?move=up";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelDown
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'tiltstep' );
|
||||
Debug( "Step Down $step" );
|
||||
my $cmd = "/admin/ptctl.cgi?move=down";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'panstep' );
|
||||
Debug( "Step Left $step" );
|
||||
my $cmd = "/admin/ptctl.cgi?move=left";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'panstep' );
|
||||
Debug( "Step Right $step" );
|
||||
my $cmd = "/admin/ptctl.cgi?move=right";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetClear
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Clear Preset $preset" );
|
||||
#my $cmd = "/axis-cgi/com/ptz.cgi?removeserverpresetno=$preset";
|
||||
#$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Set Preset $preset" );
|
||||
my $cmd = "/admin/ptctl.cgi?position=" . ($preset - 1) . "&positionname=zm$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Goto Preset $preset" );
|
||||
my $cmd = "/admin/ptctl.cgi?move=p" . ($preset - 1);
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Home Preset" );
|
||||
my $cmd = "/admin/ptctl.cgi?move=h";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
Brian Rudy, E<lt>brudyNO@SPAMpraecogito.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (C) 2008 by Brian Rudy
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.8.3 or,
|
||||
at your option, any later version of Perl 5 you may have available.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,511 @@
|
|||
# =========================================================================
|
||||
#
|
||||
# ZoneMinder Trendnet TV-IP862IC IP Control Protocol Module, $Date: $, $Revision: $
|
||||
# Copyright (C) 2014 Vincent Giovannone
|
||||
#
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the implementation of the Trendnet TV-IP672PI IP camera control
|
||||
# protocol. Also works or TV-IP862IC
|
||||
#
|
||||
# For Zoneminder 1.26+
|
||||
#
|
||||
# Under control capability:
|
||||
#
|
||||
# * Main: name it (suggest TVIP672PI), type is FFMPEG (or remote if you're using MJPEG), protocol is TVIP672PI
|
||||
# * Main (more): Can wake, can sleep, can reset
|
||||
# * Move: Can move, can move diagonally, can move mapped, can move relative
|
||||
# * Pan: Can pan
|
||||
# * Tilt: Can tilt
|
||||
# * Presets: Has presets, num presets 20, has home preset (don't set presets via camera's web server, only set via ZM.)
|
||||
#
|
||||
# Under control tab in the monitor itself:
|
||||
#
|
||||
# * Controllable
|
||||
# * Control type is the name you gave it in control capability above
|
||||
# * Control device is the password you use to authenticate to the camera (see further below if you need to change the username from "admin")
|
||||
# * Control address is the camera's ip address AND web port. example: 192.168.1.1:80
|
||||
#
|
||||
#
|
||||
# If using with anything but a TV-IP672PI (ex: TV-IP672WI), YOU MUST MATCH THE REALM TO MATCH YOUR CAMERA FURTHER DOWN!
|
||||
#
|
||||
#
|
||||
# Due to how the TVIP672 represents presets internally, you MUST define the presets in order... i.e. 1,2,3,4... not 1,10,3,4.
|
||||
# (see much further down for why, if you care...)
|
||||
#
|
||||
|
||||
|
||||
package ZoneMinder::Control::TVIP862;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Control;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Control);
|
||||
|
||||
#
|
||||
# ******** YOU MUST CHANGE THE FOLLOWING LINES TO MATCH YOUR CAMERA! **********
|
||||
#
|
||||
# I assume that "TV-IP672WI" would work for the TV-IP672WI, but can't test since I don't own one.
|
||||
#
|
||||
# TV-IP672PI works for the PI version, of course.
|
||||
#
|
||||
# Finally, the username is the username you'd like to authenticate as.
|
||||
#
|
||||
our $REALM = 'TV-IP862IC';
|
||||
our $USERNAME = 'admin';
|
||||
our $PASSWORD = '';
|
||||
our $ADDRESS = '';
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Trendnet TV-IP672PI Control Protocol
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = ZoneMinder::Control->new( $id );
|
||||
bless( $self, $class );
|
||||
srand( time() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
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} );
|
||||
}
|
||||
Fatal( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
$self->loadMonitor();
|
||||
|
||||
my ( $protocol, $username, $password, $address )
|
||||
= $self->{Monitor}->{ControlAddress} =~ /^(https?:\/\/)?([^:]+):([^\/@]+)@(.*)$/;
|
||||
if ( $username ) {
|
||||
$USERNAME = $username;
|
||||
$PASSWORD = $password;
|
||||
$ADDRESS = $address;
|
||||
} else {
|
||||
Error( "Failed to parse auth from address");
|
||||
$ADDRESS = $self->{Monitor}->{ControlAddress};
|
||||
}
|
||||
if ( ! $ADDRESS =~ /:/ ) {
|
||||
Error( "You generally need to also specify the port. I will append :80" );
|
||||
$ADDRESS .= ':80';
|
||||
}
|
||||
|
||||
use LWP::UserAgent;
|
||||
$self->{ua} = LWP::UserAgent->new;
|
||||
$self->{ua}->agent( "ZoneMinder Control Agent/".$ZoneMinder::Base::ZM_VERSION );
|
||||
$self->{state} = 'open';
|
||||
# credentials: ("ip:port" (no prefix!), realm (string), username (string), password (string)
|
||||
Debug ( "sendCmd credentials control address:'".$ADDRESS
|
||||
."' realm:'" . $REALM
|
||||
. "' username:'" . $USERNAME
|
||||
. "' password:'".$PASSWORD
|
||||
."'"
|
||||
);
|
||||
$self->{ua}->credentials($ADDRESS,$REALM,$USERNAME,$PASSWORD);
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
Debug( $msg."[".$msg_len."]" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
|
||||
# This routine is used for all moving, which are all GET commands...
|
||||
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
my $url = "http://".$ADDRESS."/cgi/ptdc.cgi?command=".$cmd;
|
||||
my $req = HTTP::Request->new( GET=>$url );
|
||||
|
||||
Debug ("sendCmd command: " . $url );
|
||||
|
||||
my $res = $self->{ua}->request($req);
|
||||
|
||||
if ( $res->is_success ) {
|
||||
$result = !undef;
|
||||
} else {
|
||||
if ( $res->status_line() eq '401 Unauthorized' ) {
|
||||
Error( "Error check failed, trying again: USERNAME: $USERNAME realm: $REALM password: " . $PASSWORD );
|
||||
Error("Content was " . $res->content() );
|
||||
my $res = $self->{ua}->request($req);
|
||||
if ( $res->is_success ) {
|
||||
$result = !undef;
|
||||
} else {
|
||||
Error("Content was " . $res->content() );
|
||||
}
|
||||
}
|
||||
if ( ! $result ) {
|
||||
Error( "Error check failed: '".$res->status_line()."' cmd:'".$cmd."'" );
|
||||
}
|
||||
}
|
||||
|
||||
return( $result );
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub sendCmdPost
|
||||
{
|
||||
|
||||
#
|
||||
# This routine is used for setting/clearing presets and IR commands, which are POST commands...
|
||||
#
|
||||
|
||||
my $self = shift;
|
||||
my $url = shift;
|
||||
my $cmd = shift;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
if ($url eq undef)
|
||||
{
|
||||
Error ("url passed to sendCmdPost is undefined.");
|
||||
return(-1);
|
||||
}
|
||||
|
||||
Debug ("sendCmdPost url: " . $url . " cmd: " . $cmd);
|
||||
|
||||
my $req = HTTP::Request->new(POST => "http://".$ADDRESS.$url);
|
||||
$req->content_type('application/x-www-form-urlencoded');
|
||||
$req->content($cmd);
|
||||
|
||||
Debug ( "sendCmdPost credentials control address:'".$ADDRESS."' realm:'" . $REALM . "' username:'" . $USERNAME . "' password:'".$PASSWORD."'");
|
||||
|
||||
my $res = $self->{ua}->request($req);
|
||||
|
||||
if ( $res->is_success )
|
||||
{
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "sendCmdPost Error check failed: '".$res->status_line()."' cmd:'".$cmd."'" );
|
||||
if ( $res->status_line() eq '401 Unauthorized' ) {
|
||||
Error( "sendCmdPost Error check failed: USERNAME: $USERNAME realm: $REALM password: " . $PASSWORD );
|
||||
} else {
|
||||
Error( "sendCmdPost Error check failed: USERNAME: $USERNAME realm: $REALM password: " . $PASSWORD );
|
||||
} # endif
|
||||
}
|
||||
|
||||
return( $result );
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub move
|
||||
{
|
||||
my $self = shift;
|
||||
my $panSteps = shift;
|
||||
my $tiltSteps = shift;
|
||||
|
||||
my $cmd = "set_relative_pos&posX=$panSteps&posY=$tiltSteps";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelUpLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up Left" );
|
||||
$self->move(-3, 3);
|
||||
}
|
||||
|
||||
sub moveRelUp
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up" );
|
||||
$self->move(0, 3);
|
||||
}
|
||||
|
||||
sub moveRelUpRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up Right" );
|
||||
$self->move(3, 3);
|
||||
}
|
||||
|
||||
sub moveRelLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Left" );
|
||||
$self->move(-3, 0);
|
||||
}
|
||||
|
||||
sub moveRelRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Right" );
|
||||
$self->move(3, 0);
|
||||
}
|
||||
|
||||
sub moveRelDownLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down Left" );
|
||||
$self->move(-3, -3);
|
||||
}
|
||||
|
||||
sub moveRelDown
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down" );
|
||||
$self->move(0, -3);
|
||||
}
|
||||
|
||||
sub moveRelDownRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down Right" );
|
||||
$self->move(3, -3);
|
||||
}
|
||||
|
||||
|
||||
# moves the camera to center on the point that the user clicked on in the video image.
|
||||
# This isn't mega accurate but good enough for most purposes
|
||||
|
||||
sub moveMap
|
||||
{
|
||||
|
||||
# If the camera moves too much, increase hscale and vscale. (...if it doesn't move enough, try decreasing!)
|
||||
# They scale the movement and are here to compensate for manufacturing variation.
|
||||
# It's never going to be perfect, so just get somewhere in the ballpark and call it a day.
|
||||
# (Don't forget to kill the zmcontrol process while tweaking!)
|
||||
|
||||
# 1280x800
|
||||
my $hscale = 31;
|
||||
my $vscale = 25;
|
||||
|
||||
# 1280x800 with fisheye
|
||||
#my $hscale = 15;
|
||||
#my $vscale = 15;
|
||||
|
||||
# 640x400
|
||||
#my $hscale = 14;
|
||||
#my $vscale = 12;
|
||||
|
||||
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $xcoord = $self->getParam( $params, 'xcoord' );
|
||||
my $ycoord = $self->getParam( $params, 'ycoord' );
|
||||
|
||||
my $hor = ($xcoord - ($self->{Monitor}->{Width} / 2))/$hscale;
|
||||
my $ver = ($ycoord - ($self->{Monitor}->{Height} / 2))/$vscale;
|
||||
|
||||
$hor = int($hor);
|
||||
$ver = -1 * int($ver);
|
||||
|
||||
Debug( "Move Map to $xcoord,$ycoord, hor=$hor, ver=$ver" );
|
||||
$self->move( $hor, $ver );
|
||||
}
|
||||
|
||||
|
||||
# **** PRESETS ****
|
||||
#
|
||||
# OK, presets work a little funky but they DO work, provided you define them in order and don't skip any.
|
||||
#
|
||||
# The problem is that when you load the web page for this camera, it gives a list of preset names tied to index numbers.
|
||||
# So let's say you have four presets... A, B, C, and D, and defined them in that order.
|
||||
# So A is index 0, B is index 1, C is index 2, D is index 3. When you tell the camera to go to a preset, you actually tell it by number, not by name.
|
||||
# (So "Go to D" is really "go to index 3".)
|
||||
#
|
||||
# Now let's say somebody deletes C via the camera's web GUI. The camera re-numbers the existing presets A=0, B=1, D=2.
|
||||
# There's really no easy way for ZM to discover this re-numbering, so zoneminder would still send "go to preset 3" thinking
|
||||
# it's telling the camera to go to point D. In actuality it's telling the camera to go to a preset that no longer exists.
|
||||
#
|
||||
# As long as you define your presets in order (i.e. define preset 1, then preset 2, then preset 3, etc.) everything will work just
|
||||
# fine in ZoneMinder.
|
||||
#
|
||||
# (Home preset needs to be set via the camera's web gui, and is unaffected by any of this.)
|
||||
#
|
||||
# So that's the limitation: DEFINE YOUR PRESETS IN ORDER THROUGH (and only through!) ZM AND DON'T SKIP ANY.
|
||||
#
|
||||
|
||||
|
||||
sub presetClear
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
my $cmd = "presetName=$preset&command=del";
|
||||
my $url = "/eng/admin/cam_control.cgi";
|
||||
Debug ("presetClear: " . $preset . " cmd: " . $cmd);
|
||||
$self->sendCmdPost($url,$cmd);
|
||||
}
|
||||
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
my $cmd = "presetName=$preset&command=add";
|
||||
my $url = "/eng/admin/cam_control.cgi";
|
||||
Debug ("presetSet " . $preset . " cmd: " . $cmd);
|
||||
$self->sendCmdPost ($url,$cmd);
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
$preset = $preset - 1;
|
||||
Debug( "Goto Preset $preset" );
|
||||
my $cmd = "goto_preset_position&index=$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Home Preset" );
|
||||
my $cmd = "go_home";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# **** IR CONTROLS ****
|
||||
#
|
||||
#
|
||||
# Wake: Force IR on, always. (always night mode)
|
||||
#
|
||||
# Sleep: Force IR off, always. (always day mode)
|
||||
#
|
||||
# Reset: Automatic IR mode. (day/night mode determined by camera)
|
||||
#
|
||||
|
||||
|
||||
sub wake
|
||||
{
|
||||
# force IR on ("always night mode")
|
||||
|
||||
my $self = shift;
|
||||
my $url = "/eng/admin/adv_audiovideo.cgi";
|
||||
my $cmd = "irMode=3";
|
||||
|
||||
Debug("Wake -- IR on");
|
||||
|
||||
$self->sendCmdPost ($url,$cmd);
|
||||
}
|
||||
|
||||
sub sleep
|
||||
{
|
||||
# force IR off ("always day mode")
|
||||
|
||||
my $self=shift;
|
||||
my $url = "/eng/admin/adv_audiovideo.cgi";
|
||||
my $cmd = "irMode=2";
|
||||
|
||||
Debug("Sleep -- IR off");
|
||||
|
||||
$self->sendCmdPost ($url,$cmd);
|
||||
}
|
||||
|
||||
sub reset
|
||||
{
|
||||
# IR auto
|
||||
|
||||
my $self=shift;
|
||||
my $url = "/eng/admin/adv_audiovideo.cgi";
|
||||
my $cmd = "irMode=0";
|
||||
|
||||
Debug("Reset -- IR auto");
|
||||
|
||||
$self->sendCmdPost ($url,$cmd);
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for Trendnet TVIP672
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
stuff this in /usr/share/perl5/ZoneMinder/Control , then eat a sandwich
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for Trendnet TVIP672, created by Vince.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Read the comments at the beginning of this file to see the usage for zoneminder 1.25.0
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Vincent Giovannone, I'd rather you not email me.
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (C) 2014 by Vincent Giovannone
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.8.3 or,
|
||||
at your option, any later version of Perl 5 you may have available.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,257 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Toshiba IK WB11A IP Camera Control Protocol Module,
|
||||
# Copyright (C) 2013 Tim Craig (timcraigNO@SPAMsonic.net)
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the implementation of the Airlink SkyIPCam
|
||||
# AICN747/AICN747W, TrendNet TV-IP410/TV-IP410W and other OEM versions of the
|
||||
# Fitivision CS-130A/CS-131A camera control protocol.
|
||||
#
|
||||
package ZoneMinder::Control::Toshiba_IK_WB11A;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Control;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Control);
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Toshiba IK-WB11A IP Camera Control Protocol
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = ZoneMinder::Control->new( $id );
|
||||
bless( $self, $class );
|
||||
srand( time() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
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} );
|
||||
}
|
||||
Fatal( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
$self->loadMonitor();
|
||||
|
||||
use LWP::UserAgent;
|
||||
$self->{ua} = LWP::UserAgent->new;
|
||||
$self->{ua}->agent( "ZoneMinder Control Agent/".ZoneMinder::Base::ZM_VERSION );
|
||||
|
||||
$self->{state} = 'open';
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
Debug( $msg."[".$msg_len."]" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
|
||||
#my $result = undef;
|
||||
|
||||
printMsg( $cmd, "Tx" );
|
||||
|
||||
my $req = HTTP::Request->new( GET=>"http://".$self->{Monitor}->{ControlAddress}."$cmd" );
|
||||
my $res = $self->{ua}->request($req);
|
||||
return( !undef );
|
||||
}
|
||||
|
||||
sub reset
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Camera Reset" );
|
||||
my $cmd = "/control.cgi?cont_2=16";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveMap
|
||||
{
|
||||
Debug("MoveMap");
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $xcoord = $self->getParam( $params, 'xcoord' );
|
||||
my $ycoord = $self->getParam( $params, 'ycoord' );
|
||||
|
||||
my $hor = $xcoord / $self->{Monitor}->{Width};
|
||||
my $ver = $ycoord / $self->{Monitor}->{Height};
|
||||
|
||||
my $maxver = 10;
|
||||
my $maxhor = 10;
|
||||
|
||||
my $horSteps = 0;
|
||||
my $verSteps = 0;
|
||||
|
||||
$horSteps = $hor * $maxhor;
|
||||
$verSteps = $ver * $maxver;
|
||||
|
||||
my $v = int($verSteps);
|
||||
my $h = int($horSteps);
|
||||
|
||||
Debug( "Move Map to $xcoord,$ycoord, hor=$h, ver=$v");
|
||||
my $cmd = "/cont.cgi?contptpoint_".$h."_".$v."=1";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelUp
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Step Up" );
|
||||
my $cmd = "/control.cgi?cont_2=4";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelDown
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Step Down" );
|
||||
my $cmd = "/control.cgi?cont_2=8";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Step Left" );
|
||||
my $cmd = "/control.cgi?cont_2=1";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Step Right" );
|
||||
my $cmd = "/control.cgi?cont_2=2";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetClear
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Clear Preset $preset" );
|
||||
my $cmdNum = 3 << 8 | $preset;
|
||||
my $cmd = "/control.cgi?cont_4=$cmdNum";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Set Preset $preset" );
|
||||
my $cmdNum = 2 << 8 | $preset;
|
||||
my $cmd = "/control.cgi?cont_4=$cmdNum";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Goto Preset $preset" );
|
||||
my $cmdNum = 1 << 8 | $preset;
|
||||
my $cmd = "/control.cgi?cont_4=$cmdNum";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Control::Toshiba_IK_WB11A - Zoneminder PTZ control module the Toshiba IK-WB11A IP Camera
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Control::Toshiba_IK_WB11A;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is for Zoneminder PTZ control module for the Toshib_IK_WB11A camera.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
www.zoneminder.com
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
Tim Craig, E<lt>timcraigNO@SPAMsonic.netE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (C) 2013 by Tim Craig
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.8.3 or,
|
||||
at your option, any later version of Perl 5 you may have available.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,666 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Visca Control Protocol Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the implementation of the Visca camera control
|
||||
# protocol
|
||||
#
|
||||
package ZoneMinder::Control::Visca;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Control;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Control);
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Visca Control Protocol
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
use constant SYNC => 0xff;
|
||||
use constant COMMAND_GAP => 100000; # In ms
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = ZoneMinder::Control->new( $id );
|
||||
bless( $self, $class );
|
||||
srand( time() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
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} );
|
||||
}
|
||||
Fatal( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
$self->loadMonitor();
|
||||
|
||||
use Device::SerialPort;
|
||||
$self->{port} = new Device::SerialPort( $self->{Monitor}->{ControlDevice} );
|
||||
$self->{port}->baudrate(9600);
|
||||
$self->{port}->databits(8);
|
||||
$self->{port}->parity('none');
|
||||
$self->{port}->stopbits(1);
|
||||
$self->{port}->handshake('rts');
|
||||
$self->{port}->stty_echo(0);
|
||||
|
||||
#$self->{port}->read_const_time(250);
|
||||
$self->{port}->read_char_time(2);
|
||||
|
||||
$self->{state} = 'open';
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
$self->{port}->close();
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
if ( logDebugging() )
|
||||
{
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $prefix = shift || "";
|
||||
$prefix = $prefix.": " if ( $prefix );
|
||||
|
||||
my $line_length = 16;
|
||||
my $msg_len = int(@$msg);
|
||||
|
||||
my $msg_str = $prefix;
|
||||
for ( my $i = 0; $i < $msg_len; $i++ )
|
||||
{
|
||||
if ( ($i > 0) && ($i%$line_length == 0) && ($i != ($msg_len-1)) )
|
||||
{
|
||||
$msg_str .= sprintf( "\n%*s", length($prefix), "" );
|
||||
}
|
||||
$msg_str .= sprintf( "%02x ", $msg->[$i] );
|
||||
}
|
||||
$msg_str .= "[".$msg_len."]";
|
||||
Debug( $msg_str );
|
||||
}
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
my $ack = shift || 0;
|
||||
my $cmp = shift || 0;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
$self->printMsg( $cmd, "Tx" );
|
||||
my $id = $cmd->[0] & 0xf;
|
||||
|
||||
my $tx_msg = pack( "C*", @$cmd );
|
||||
|
||||
#print( "Tx: ".length( $tx_msg )." bytes\n" );
|
||||
my $n_bytes = $self->{port}->write( $tx_msg );
|
||||
if ( !$n_bytes )
|
||||
{
|
||||
Error( "Write failed: $!" );
|
||||
}
|
||||
if ( $n_bytes != length($tx_msg) )
|
||||
{
|
||||
Error( "Incomplete write, only ".$n_bytes." of ".length($tx_msg)." written: $!" );
|
||||
}
|
||||
|
||||
if ( $ack )
|
||||
{
|
||||
Debug( "Waiting for ack" );
|
||||
my $max_wait = 3;
|
||||
my $now = time();
|
||||
while( 1 )
|
||||
{
|
||||
my ( $count, $rx_msg ) = $self->{port}->read(4);
|
||||
|
||||
if ( $count )
|
||||
{
|
||||
#print( "Rx1: ".$count." bytes\n" );
|
||||
my @resp = unpack( "C*", $rx_msg );
|
||||
$self->printMsg( \@resp, "Rx" );
|
||||
|
||||
if ( $resp[0] = 0x80 + ($id<<4) )
|
||||
{
|
||||
if ( ($resp[1] & 0xf0) == 0x40 )
|
||||
{
|
||||
my $socket = $resp[1] & 0x0f;
|
||||
Debug( "Got ack for socket $socket" );
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Got bogus response" );
|
||||
}
|
||||
last;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Got message for camera ".(($resp[0]-0x80)>>4) );
|
||||
}
|
||||
}
|
||||
if ( (time() - $now) > $max_wait )
|
||||
{
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cmp )
|
||||
{
|
||||
Debug( "Waiting for command complete" );
|
||||
my $max_wait = 10;
|
||||
my $now = time();
|
||||
while( 1 )
|
||||
{
|
||||
#print( "Waiting\n" );
|
||||
my ( $count, $rx_msg ) = $self->{port}->read(16);
|
||||
|
||||
if ( $count )
|
||||
{
|
||||
#print( "Rx1: ".$count." bytes\n" );
|
||||
my @resp = unpack( "C*", $rx_msg );
|
||||
$self->printMsg( \@resp, "Rx" );
|
||||
|
||||
if ( $resp[0] = 0x80 + ($id<<4) )
|
||||
{
|
||||
if ( ($resp[1] & 0xf0) == 0x50 )
|
||||
{
|
||||
Debug( "Got command complete" );
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Got bogus response" );
|
||||
}
|
||||
last;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Got message for camera ".(($resp[0]-0x80)>>4) );
|
||||
}
|
||||
}
|
||||
if ( (time() - $now) > $max_wait )
|
||||
{
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
return( $result );
|
||||
}
|
||||
|
||||
sub cameraOff
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Camera Off\n" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x04, 0x00, 0x0, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub cameraOn
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Camera On\n" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x04, 0x00, 0x2, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub stop
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Stop\n" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x06, 0x01, 0x00, 0x00, 0x03, 0x03, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveConUp
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'tiltspeed', 0x40 );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Up" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x06, 0x01, 0x00, $speed, 0x03, 0x01, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop( $params );
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConDown
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'tiltspeed', 0x40 );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Down" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x06, 0x01, 0x00, $speed, 0x03, 0x02, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop( $params );
|
||||
}
|
||||
}
|
||||
|
||||
sub movConLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'panspeed', 0x40 );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Left" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x06, 0x01, $speed, 0x00, 0x01, 0x03, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop( $params );
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'panspeed', 0x40 );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Right" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x06, 0x01, $speed, 0x00, 0x02, 0x03, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop( $params );
|
||||
}
|
||||
}
|
||||
|
||||
sub moveUpLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panspeed = $self->getParam( $params, 'panspeed', 0x40 );
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed', 0x40 );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Up/Left" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x01, 0x01, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop( $params );
|
||||
}
|
||||
}
|
||||
|
||||
sub moveUpRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panspeed = $self->getParam( $params, 'panspeed', 0x40 );
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed', 0x40 );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Up/Right" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x02, 0x01, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop( $params );
|
||||
}
|
||||
}
|
||||
|
||||
sub moveDownLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panspeed = $self->getParam( $params, 'panspeed', 0x40 );
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed', 0x40 );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Down/Left" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x01, 0x02, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop( $params );
|
||||
}
|
||||
}
|
||||
|
||||
sub moveDownRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panspeed = $self->getParam( $params, 'panspeed', 0x40 );
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed', 0x40 );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Move Down/Right" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x02, 0x02, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->stop( $params );
|
||||
}
|
||||
}
|
||||
|
||||
sub moveRelUp
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'tiltstep' );
|
||||
my $speed = $self->getParam( $params, 'tiltspeed', 0x40 );
|
||||
Debug( "Step Up" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x06, 0x03, 0x00, $speed, 0x00, 0x00, 0x00, 0x00, ($step&0xf000)>>12, ($step&0x0f00)>>8, ($step&0x00f0)>>4, ($step&0x000f)>>0, SYNC );
|
||||
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveRelDown
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = -$self->getParam( $params, 'tiltstep' );
|
||||
my $speed = $self->getParam( $params, 'tiltspeed', 0x40 );
|
||||
Debug( "Step Down" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x06, 0x03, 0x00, $speed, 0x00, 0x00, 0x00, 0x00, ($step&0xf000)>>12, ($step&0x0f00)>>8, ($step&0x00f0)>>4, ($step&0x000f)>>0, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveRelLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = -$self->getParam( $params, 'panstep' );
|
||||
my $speed = $self->getParam( $params, 'panspeed', 0x40 );
|
||||
Debug( "Step Left" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x06, 0x03, $speed, 0x00, ($step&0xf000)>>12, ($step&0x0f00)>>8, ($step&0x00f0)>>4, ($step&0x000f)>>0, 0x00, 0x00, 0x00, 0x00, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveRelRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'panstep' );
|
||||
my $speed = $self->getParam( $params, 'panspeed', 0x40 );
|
||||
Debug( "Step Right" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x06, 0x03, $speed, 0x00, ($step&0xf000)>>12, ($step&0x0f00)>>8, ($step&0x00f0)>>4, ($step&0x000f)>>0, 0x00, 0x00, 0x00, 0x00, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveRelUpLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panstep = -$self->getParam( $params, 'panstep' );
|
||||
my $tiltstep = $self->getParam( $params, 'tiltstep' );
|
||||
my $panspeed = $self->getParam( $params, 'panspeed', 0x40 );
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed', 0x40 );
|
||||
Debug( "Step Up/Left" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x06, 0x03, $panspeed, $tiltspeed, ($panstep&0xf000)>>12, ($panstep&0x0f00)>>8, ($panstep&0x00f0)>>4, ($panstep&0x000f)>>0, ($tiltstep&0xf000)>>12, ($tiltstep&0x0f00)>>8, ($tiltstep&0x00f0)>>4, ($tiltstep&0x000f)>>0, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveRelUpRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panstep = $self->getParam( $params, 'panstep' );
|
||||
my $tiltstep = $self->getParam( $params, 'tiltstep' );
|
||||
my $panspeed = $self->getParam( $params, 'panspeed', 0x40 );
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed', 0x40 );
|
||||
Debug( "Step Up/Right" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x06, 0x03, $panspeed, $tiltspeed, ($panstep&0xf000)>>12, ($panstep&0x0f00)>>8, ($panstep&0x00f0)>>4, ($panstep&0x000f)>>0, ($tiltstep&0xf000)>>12, ($tiltstep&0x0f00)>>8, ($tiltstep&0x00f0)>>4, ($tiltstep&0x000f)>>0, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveRelDownLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panstep = -$self->getParam( $params, 'panstep' );
|
||||
my $tiltstep = -$self->getParam( $params, 'tiltstep' );
|
||||
my $panspeed = $self->getParam( $params, 'panspeed', 0x40 );
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed', 0x40 );
|
||||
Debug( "Step Down/Left" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x06, 0x03, $panspeed, $tiltspeed, ($panstep&0xf000)>>12, ($panstep&0x0f00)>>8, ($panstep&0x00f0)>>4, ($panstep&0x000f)>>0, ($tiltstep&0xf000)>>12, ($tiltstep&0x0f00)>>8, ($tiltstep&0x00f0)>>4, ($tiltstep&0x000f)>>0, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveRelDownRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $panstep = $self->getParam( $params, 'panstep' );
|
||||
my $tiltstep = -$self->getParam( $params, 'tiltstep' );
|
||||
my $panspeed = $self->getParam( $params, 'panspeed', 0x40 );
|
||||
my $tiltspeed = $self->getParam( $params, 'tiltspeed', 0x40 );
|
||||
Debug( "Step Down/Right" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x06, 0x03, $panspeed, $tiltspeed, ($panstep&0xf000)>>12, ($panstep&0x0f00)>>8, ($panstep&0x00f0)>>4, ($panstep&0x000f)>>0, ($tiltstep&0xf000)>>12, ($tiltstep&0x0f00)>>8, ($tiltstep&0x00f0)>>4, ($tiltstep&0x000f)>>0, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub zoomConTele
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed', 0x06 );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Zoom Tele" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x04, 0x07, 0x20|$speed, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->zoomStop();
|
||||
}
|
||||
}
|
||||
|
||||
sub zoomWide
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $speed = $self->getParam( $params, 'speed', 0x06 );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
Debug( "Zoom Wide" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x04, 0x07, 0x30|$speed, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->zoomStop();
|
||||
}
|
||||
}
|
||||
|
||||
sub zoomStop
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
Debug( "Zoom Stop" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x04, 0x07, 0x00, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusConNear
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
Debug( "Focus Near" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x04, 0x08, 0x03, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusConFar
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
Debug( "Focus Far" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x04, 0x08, 0x02, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusStop
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
Debug( "Focus Stop" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x04, 0x08, 0x00, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusAuto
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
Debug( "Focus Auto" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x04, 0x38, 0x02, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusMan
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
Debug( "Focus Man" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x04, 0x38, 0x03, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetClear
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset', 1 );
|
||||
Debug( "Clear Preset $preset" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x04, 0x3f, 0x00, $preset, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset', 1 );
|
||||
Debug( "Set Preset $preset" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x04, 0x3f, 0x01, $preset, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset', 1 );
|
||||
Debug( "Goto Preset $preset" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x04, 0x3f, 0x02, $preset, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
Debug( "Home Preset" );
|
||||
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x06, 0x04, SYNC );
|
||||
$self->sendCmd( \@msg );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,502 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Wanscam Control Protocol Module, $Date: 2009-11-25 09:20:00 +0000 (Wed, 04 Nov 2009) $, $Revision: 0001 $
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
# Modified for use with Foscam FI8918W IP Camera by Dave Harris
|
||||
# Modified Feb 2011 by Howard Durdle (http://durdl.es/x) to:
|
||||
# fix horizontal panning, add presets and IR on/off
|
||||
# use Control Device field to pass username and password
|
||||
# Modified June 5th, 2012 by Chris Bagwell to:
|
||||
# Rename to IPCAM since its common protocol with wide range of cameras.
|
||||
# Work with Logger module instead of Debug module.
|
||||
# Fix off-by-1 preset bug.
|
||||
# Support optional autostop timeout.
|
||||
# Add Zoom, Brightness, and Contrast support.
|
||||
# Modified July 7th, 2012 by Patrik Brander to:
|
||||
# Rename to Wanscam
|
||||
# Pan Left/Right switched
|
||||
# IR On/Off switched
|
||||
# Brightness Increase/Decrease in 16 steps
|
||||
#
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the implementation of the Wanscam camera control
|
||||
# protocol.
|
||||
#
|
||||
# This is a protocol shared by a wide range of affordable cameras that
|
||||
# appear to share similar reference design and software. Examples
|
||||
# include Foscam, Agasio, Wansview, etc.
|
||||
#
|
||||
# The basis for CGI based API can be found on internet by searching for
|
||||
# "IPCAM CGI SDK 2.1". Here is sample site that also developes replacement
|
||||
# firmware for some hardware versions.
|
||||
#
|
||||
# http://www.openipcam.com/files/Manuals/IPCAM%20CGI%20SDK%202.1.pdf
|
||||
#
|
||||
package ZoneMinder::Control::Wanscam;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Control;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Control);
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Wanscam Control Protocol
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = ZoneMinder::Control->new( $id );
|
||||
my $logindetails = "";
|
||||
bless( $self, $class );
|
||||
srand( time() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
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} );
|
||||
}
|
||||
Fatal( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
$self->loadMonitor();
|
||||
|
||||
use LWP::UserAgent;
|
||||
$self->{ua} = LWP::UserAgent->new;
|
||||
$self->{ua}->agent( "ZoneMinder Control Agent/".ZoneMinder::Base::ZM_VERSION );
|
||||
|
||||
$self->{state} = 'open';
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
Debug( $msg."[".$msg_len."]" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
my $result = undef;
|
||||
printMsg( $cmd, "Tx" );
|
||||
|
||||
my $req = HTTP::Request->new( GET=>"http://".$self->{Monitor}->{ControlAddress}."/$cmd".$self->{Monitor}->{ControlDevice} );
|
||||
my $res = $self->{ua}->request($req);
|
||||
|
||||
if ( $res->is_success )
|
||||
{
|
||||
$result = $res->decoded_content;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Error check failed:'".$res->status_line()."'" );
|
||||
}
|
||||
|
||||
return( $result );
|
||||
}
|
||||
|
||||
# Turn IO on (can be internally wired to IR's)
|
||||
sub wake
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Wake - IO on" );
|
||||
my $cmd = "decoder_control.cgi?command=94&";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
# Turn IO off (can be internally wired to IR's)
|
||||
sub sleep
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Sleep - IO off" );
|
||||
my $cmd = "decoder_control.cgi?command=95&";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub reset
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Camera Reset" );
|
||||
my $cmd = "reboot.cgi?";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConUp
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
Debug( "Move Up" );
|
||||
my $cmd = "decoder_control.cgi?command=0&";
|
||||
$self->sendCmd( $cmd );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
if ( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->moveStop( $params );
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConDown
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
Debug( "Move Down" );
|
||||
my $cmd = "decoder_control.cgi?command=2&";
|
||||
$self->sendCmd( $cmd );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
if ( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->moveStop( $params );
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
Debug( "Move Right" );
|
||||
my $cmd = "decoder_control.cgi?command=4&";
|
||||
$self->sendCmd( $cmd );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
if ( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->moveStop( $params );
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
Debug( "Move Left" );
|
||||
my $cmd = "decoder_control.cgi?command=6&";
|
||||
$self->sendCmd( $cmd );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
if ( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->moveStop( $params );
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConUpLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
Debug( "Move Diagonally Up Left" );
|
||||
my $cmd = "decoder_control.cgi?command=91&";
|
||||
$self->sendCmd( $cmd );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
if ( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->moveStop( $params );
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConDownLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
Debug( "Move Diagonally Down Left" );
|
||||
my $cmd = "decoder_control.cgi?command=93&";
|
||||
$self->sendCmd( $cmd );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
if ( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->moveStop( $params );
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConUpRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
Debug( "Move Diagonally Up Right" );
|
||||
my $cmd = "decoder_control.cgi?command=90&";
|
||||
$self->sendCmd( $cmd );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
if ( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->moveStop( $params );
|
||||
}
|
||||
}
|
||||
|
||||
sub moveConDownRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
Debug( "Move Diagonally Down Right" );
|
||||
my $cmd = "decoder_control.cgi?command=92&";
|
||||
$self->sendCmd( $cmd );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
if ( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->moveStop( $params );
|
||||
}
|
||||
}
|
||||
|
||||
# command=1 is technically Up Stop but seems to work for all stops.
|
||||
sub moveStop
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Stop" );
|
||||
print("autostop\n");
|
||||
my $cmd = "decoder_control.cgi?command=1&";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub zoomConTele
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
Debug( "Zoom Tele" );
|
||||
my $cmd = "decoder_control.cgi?command=16&";
|
||||
$self->sendCmd( $cmd );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
if ( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$cmd = "decoder_control.cgi?command=17&";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
}
|
||||
|
||||
sub zoomConWide
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
Debug( "Zoom Wide" );
|
||||
my $cmd = "decoder_control.cgi?command=18&";
|
||||
$self->sendCmd( $cmd );
|
||||
my $autostop = $self->getParam( $params, 'autostop', 0 );
|
||||
if ( $autostop && $self->{Monitor}->{AutoStopTimeout} )
|
||||
{
|
||||
usleep( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$cmd = "decoder_control.cgi?command=19&";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
}
|
||||
|
||||
sub zoomConStop
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
Debug( "Zoom Stop" );
|
||||
my $cmd = "decoder_control.cgi?command=17&";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
# Increase Brightness
|
||||
sub irisAbsOpen
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
my $brightness = 100;
|
||||
|
||||
my $cmd = "get_camera_params.cgi?";
|
||||
my $resp = $self->sendCmd( $cmd );
|
||||
|
||||
$brightness = int($1) if ( $resp =~ m/var brightness=([0-9]*);/ );
|
||||
$brightness += $step * 16;
|
||||
$brightness = 255 if ($brightness > 255);
|
||||
Debug( "Iris Open $brightness" );
|
||||
$cmd = "camera_control.cgi?param=1&value=".$brightness."&";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
# Decrease Brightness
|
||||
sub irisAbsClose
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
my $brightness = 100;
|
||||
|
||||
my $cmd = "get_camera_params.cgi?";
|
||||
my $resp = $self->sendCmd( $cmd );
|
||||
|
||||
$brightness = int($1) if ( $resp =~ m/var brightness=([0-9]*);/ );
|
||||
$brightness -= $step * 16;
|
||||
$brightness = 0 if ($brightness < 0);
|
||||
Debug( "Iris Close $brightness" );
|
||||
$cmd = "camera_control.cgi?param=1&value=".$brightness."&";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
# Increase Contrast
|
||||
sub whiteAbsIn
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
my $contrast = 5;
|
||||
|
||||
my $cmd = "get_camera_params.cgi?";
|
||||
my $resp = $self->sendCmd( $cmd );
|
||||
|
||||
$contrast = int($1) if ( $resp =~ m/var contrast=([0-9]*);/ );
|
||||
$contrast += $step;
|
||||
$contrast = 6 if ($contrast > 6);
|
||||
Debug( "White In $contrast" );
|
||||
$cmd = "camera_control.cgi?param=2&value=".$contrast."&";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
# Decrease Contrast
|
||||
sub whiteAbsOut
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
my $contrast = 5;
|
||||
|
||||
my $cmd = "get_camera_params.cgi?";
|
||||
my $resp = $self->sendCmd( $cmd );
|
||||
|
||||
$contrast = int($1) if ( $resp =~ m/var contrast=([0-9]*);/ );
|
||||
$contrast -= $step;
|
||||
$contrast = 0 if ($contrast < 0);
|
||||
Debug( "White Out $contrast" );
|
||||
$cmd = "camera_control.cgi?param=2&value=".$contrast."&";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Home Preset" );
|
||||
my $cmd = "decoder_control.cgi?command=25&";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
my $presetCmd = 30 + (($preset-1)*2);
|
||||
Debug( "Set Preset $preset with cmd $presetCmd" );
|
||||
my $cmd = "decoder_control.cgi?command=$presetCmd&";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
my $presetCmd = 31 + (($preset-1)*2);
|
||||
Debug( "Goto Preset $preset with cmd $presetCmd" );
|
||||
my $cmd = "decoder_control.cgi?command=$presetCmd&";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Control::Wanscam
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, <philip.coombes@zoneminder.com>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,250 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder mjpg STreamer Control Protocol Module, $Date: 2007-11-04 17:30:29 +0000 (Sun, 04 Nov 2007) $, $Revision: 2229 $
|
||||
# Copyright (C) 2003, 2004, 2005, 2006 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the implementation of the mjpg streamer camera control
|
||||
# protocol
|
||||
#
|
||||
package ZoneMinder::Control::mjpgStreamer;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Control;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Control);
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# mjpgSTreamer Control Protocol
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = ZoneMinder::Control->new( $id );
|
||||
Debug( "Camera New" );
|
||||
bless( $self, $class );
|
||||
srand( time() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
sub AUTOLOAD
|
||||
{
|
||||
my $self = shift;
|
||||
my $class = ref($self) || croak( "$self not object" );
|
||||
my $name = $AUTOLOAD;
|
||||
Debug( "Camera AUTOLOAD" );
|
||||
$name =~ s/.*://;
|
||||
if ( exists($self->{$name}) )
|
||||
{
|
||||
return( $self->{$name} );
|
||||
}
|
||||
Fatal( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
$self->loadMonitor();
|
||||
Debug( "Camera open" );
|
||||
use LWP::UserAgent;
|
||||
$self->{ua} = LWP::UserAgent->new;
|
||||
$self->{ua}->agent( "ZoneMinder Control Agent/".ZoneMinder::Base::ZM_VERSION );
|
||||
|
||||
$self->{state} = 'open';
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
Debug( $msg."[".$msg_len."]" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
printMsg( $cmd, "Tx" );
|
||||
|
||||
my $req = HTTP::Request->new( GET=>"http://".$self->{Monitor}->{ControlAddress}."/$cmd" );
|
||||
my $res = $self->{ua}->request($req);
|
||||
|
||||
if ( $res->is_success )
|
||||
{
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Error check failed: '".$res->status_line()."'" );
|
||||
}
|
||||
|
||||
return( $result );
|
||||
}
|
||||
|
||||
sub Up
|
||||
{
|
||||
my $self = shift;
|
||||
$self->moveConUp();
|
||||
}
|
||||
|
||||
sub Down
|
||||
{
|
||||
my $self = shift;
|
||||
$self->moveConDown();
|
||||
}
|
||||
|
||||
sub Left
|
||||
{
|
||||
my $self = shift;
|
||||
$self->moveConLeft();
|
||||
}
|
||||
|
||||
sub Right
|
||||
{
|
||||
my $self = shift;
|
||||
$self->moveConRight();
|
||||
}
|
||||
|
||||
|
||||
sub reset
|
||||
{
|
||||
my $self = shift;
|
||||
$self->cameraReset();
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub cameraReset
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Camera Reset" );
|
||||
my $cmd = "?action=command&command=reset_pan_tilt";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConUp
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up" );
|
||||
my $cmd = "?action=command&command=tilt_minus";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConDown
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down" );
|
||||
my $cmd = "?action=command&command=tilt_plus";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Left" );
|
||||
my $cmd = "?action=command&command=pan_plus";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveConRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Right" );
|
||||
my $cmd = "?action=command&command=pan_minus";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (C) 2005 by Philip Coombes
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.8.3 or,
|
||||
at your option, any later version of Perl 5 you may have available.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,411 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder ONVIF Control Protocol Module
|
||||
# Copyright (C) Jan M. Hochstein
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the implementation of the ONVIF device control protocol
|
||||
#
|
||||
package ZoneMinder::Control::onvif;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Control;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Control);
|
||||
|
||||
our %CamParams = ();
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# ONVIF Control Protocol
|
||||
#
|
||||
# On ControlAddress use the format :
|
||||
# USERNAME:PASSWORD@ADDRESS:PORT
|
||||
# eg : admin:@10.1.2.1:80
|
||||
# zoneminder:zonepass@10.0.100.1:40000
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
sub new
|
||||
{
|
||||
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = ZoneMinder::Control->new( $id );
|
||||
my $logindetails = "";
|
||||
bless( $self, $class );
|
||||
srand( time() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
sub AUTOLOAD
|
||||
{
|
||||
my $self = shift;
|
||||
my $class = ref( ) || croak( "$self not object" );
|
||||
my $name = $AUTOLOAD;
|
||||
$name =~ s/.*://;
|
||||
if ( exists($self->{$name}) )
|
||||
{
|
||||
return( $self->{$name} );
|
||||
}
|
||||
Fatal( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
$self->loadMonitor();
|
||||
|
||||
use LWP::UserAgent;
|
||||
$self->{ua} = LWP::UserAgent->new;
|
||||
$self->{ua}->agent( "ZoneMinder Control Agent/".ZoneMinder::Base::ZM_VERSION );
|
||||
|
||||
$self->{state} = 'open';
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
Debug( $msg."[".$msg_len."]" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
my $result = undef;
|
||||
printMsg( $cmd, "Tx" );
|
||||
|
||||
my $req = HTTP::Request->new( GET=>"http://".$self->{Monitor}->{ControlAddress}."/$cmd" );
|
||||
my $res = $self->{ua}->request($req);
|
||||
|
||||
if ( $res->is_success )
|
||||
{
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Error check failed:'".$res->status_line()."'" );
|
||||
}
|
||||
|
||||
return( $result );
|
||||
}
|
||||
|
||||
sub getCamParams
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
my $req = HTTP::Request->new( GET=>"http://".$self->{Monitor}->{ControlAddress}."/get_camera_params.cgi" );
|
||||
my $res = $self->{ua}->request($req);
|
||||
|
||||
if ( $res->is_success )
|
||||
{
|
||||
# Parse results setting values in %FCParams
|
||||
my $content = $res->decoded_content;
|
||||
|
||||
while ($content =~ s/var\s+([^=]+)=([^;]+);//ms) {
|
||||
$CamParams{$1} = $2;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Error check failed:'".$res->status_line()."'" );
|
||||
}
|
||||
}
|
||||
|
||||
#autoStop
|
||||
#This makes use of the ZoneMinder Auto Stop Timeout on the Control Tab
|
||||
sub autoStop
|
||||
{
|
||||
my $self = shift;
|
||||
my $stop_command = shift;
|
||||
my $autostop = shift;
|
||||
if( $stop_command && $autostop)
|
||||
{
|
||||
Debug( "Auto Stop" );
|
||||
usleep( $autostop );
|
||||
my $cmd = "decoder_control.cgi?command=".$stop_command;
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
# Reset the Camera
|
||||
sub reset
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Camera Reset" );
|
||||
my $cmd = "reboot.cgi?";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
#Up Arrow
|
||||
sub moveConUp
|
||||
{
|
||||
my $self = shift;
|
||||
my $stop_command = "1";
|
||||
Debug( "Move Up" );
|
||||
my $cmd = "decoder_control.cgi?command=0";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $stop_command, $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
#Down Arrow
|
||||
sub moveConDown
|
||||
{
|
||||
my $self = shift;
|
||||
my $stop_command = "3";
|
||||
Debug( "Move Down" );
|
||||
my $cmd = "decoder_control.cgi?command=2";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $stop_command, $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
#Left Arrow
|
||||
sub moveConLeft
|
||||
{
|
||||
my $self = shift;
|
||||
my $stop_command = "5";
|
||||
Debug( "Move Left" );
|
||||
my $cmd = "decoder_control.cgi?command=4";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $stop_command, $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
#Right Arrow
|
||||
sub moveConRight
|
||||
{
|
||||
my $self = shift;
|
||||
my $stop_command = "7";
|
||||
Debug( "Move Right" );
|
||||
my $cmd = "decoder_control.cgi?command=6";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $stop_command, $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
#Zoom In
|
||||
sub zoomConTele
|
||||
{
|
||||
my $self = shift;
|
||||
my $stop_command = "17";
|
||||
Debug( "Zoom Tele" );
|
||||
my $cmd = "decoder_control.cgi?command=18";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $stop_command, $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
#Zoom Out
|
||||
sub zoomConWide
|
||||
{
|
||||
my $self = shift;
|
||||
my $stop_command = "19";
|
||||
Debug( "Zoom Wide" );
|
||||
my $cmd = "decoder_control.cgi?command=16";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->autoStop( $stop_command, $self->{Monitor}->{AutoStopTimeout} );
|
||||
}
|
||||
|
||||
#Diagonally Up Right Arrow
|
||||
#This camera does not have builtin diagonal commands so we emulate them
|
||||
sub moveConUpRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Diagonally Up Right" );
|
||||
$self->moveConUp( );
|
||||
$self->moveConRight( );
|
||||
}
|
||||
|
||||
#Diagonally Down Right Arrow
|
||||
#This camera does not have builtin diagonal commands so we emulate them
|
||||
sub moveConDownRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Diagonally Down Right" );
|
||||
$self->moveConDown( );
|
||||
$self->moveConRight( );
|
||||
}
|
||||
|
||||
#Diagonally Up Left Arrow
|
||||
#This camera does not have builtin diagonal commands so we emulate them
|
||||
sub moveConUpLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Diagonally Up Left" );
|
||||
$self->moveConUp( );
|
||||
$self->moveConLeft( );
|
||||
}
|
||||
|
||||
#Diagonally Down Left Arrow
|
||||
#This camera does not have builtin diagonal commands so we emulate them
|
||||
sub moveConDownLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Diagonally Down Left" );
|
||||
$self->moveConDown( );
|
||||
$self->moveConLeft( );
|
||||
}
|
||||
|
||||
#Stop
|
||||
sub moveStop
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Stop" );
|
||||
my $cmd = "decoder_control.cgi?command=1";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
#Set Camera Preset
|
||||
#Presets must be translated into values internal to the camera
|
||||
#Those values are: 30,32,34,36,38,40,42,44 for presets 1-8 respectively
|
||||
sub presetSet
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Set Preset $preset" );
|
||||
|
||||
if (( $preset >= 1 ) && ( $preset <= 8 )) {
|
||||
my $cmd = "decoder_control.cgi?command=".(($preset*2) + 28);
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
}
|
||||
|
||||
#Recall Camera Preset
|
||||
#Presets must be translated into values internal to the camera
|
||||
#Those values are: 31,33,35,37,39,41,43,45 for presets 1-8 respectively
|
||||
sub presetGoto
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Goto Preset $preset" );
|
||||
|
||||
if (( $preset >= 1 ) && ( $preset <= 8 )) {
|
||||
my $cmd = "decoder_control.cgi?command=".(($preset*2) + 29);
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
if ( $preset == 9 ) {
|
||||
$self->horizontalPatrol();
|
||||
}
|
||||
|
||||
if ( $preset == 10 ) {
|
||||
$self->horizontalPatrolStop();
|
||||
}
|
||||
}
|
||||
|
||||
#Horizontal Patrol - Vertical Patrols are not supported
|
||||
sub horizontalPatrol
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Horizontal Patrol" );
|
||||
my $cmd = "decoder_control.cgi?command=20";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
#Horizontal Patrol Stop
|
||||
sub horizontalPatrolStop
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Horizontal Patrol Stop" );
|
||||
my $cmd = "decoder_control.cgi?command=21";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
# Increase Brightness
|
||||
sub irisAbsOpen
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
$self->getCamParams() unless($CamParams{'brightness'});
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
|
||||
$CamParams{'brightness'} += $step;
|
||||
$CamParams{'brightness'} = 255 if ($CamParams{'brightness'} > 255);
|
||||
Debug( "Iris $CamParams{'brightness'}" );
|
||||
my $cmd = "camera_control.cgi?param=1&value=".$CamParams{'brightness'};
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
# Decrease Brightness
|
||||
sub irisAbsClose
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
$self->getCamParams() unless($CamParams{'brightness'});
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
|
||||
$CamParams{'brightness'} -= $step;
|
||||
$CamParams{'brightness'} = 0 if ($CamParams{'brightness'} < 0);
|
||||
Debug( "Iris $CamParams{'brightness'}" );
|
||||
my $cmd = "camera_control.cgi?param=1&value=".$CamParams{'brightness'};
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
# Increase Contrast
|
||||
sub whiteAbsIn
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
$self->getCamParams() unless($CamParams{'contrast'});
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
|
||||
$CamParams{'contrast'} += $step;
|
||||
$CamParams{'contrast'} = 6 if ($CamParams{'contrast'} > 6);
|
||||
Debug( "Iris $CamParams{'contrast'}" );
|
||||
my $cmd = "camera_control.cgi?param=2&value=".$CamParams{'contrast'};
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
# Decrease Contrast
|
||||
sub whiteAbsOut
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
$self->getCamParams() unless($CamParams{'contrast'});
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
|
||||
$CamParams{'contrast'} -= $step;
|
||||
$CamParams{'contrast'} = 0 if ($CamParams{'contrast'} < 0);
|
||||
Debug( "Iris $CamParams{'contrast'}" );
|
||||
my $cmd = "camera_control.cgi?param=2&value=".$CamParams{'contrast'};
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
|
@ -0,0 +1,257 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Database Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the common definitions and functions used by the rest
|
||||
# of the ZoneMinder scripts
|
||||
#
|
||||
package ZoneMinder::Database;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require Exporter;
|
||||
require ZoneMinder::Base;
|
||||
|
||||
our @ISA = qw(Exporter ZoneMinder::Base);
|
||||
|
||||
# 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(
|
||||
zmDbConnect
|
||||
zmDbDisconnect
|
||||
zmDbGetMonitors
|
||||
zmDbGetMonitor
|
||||
zmDbGetMonitorAndControl
|
||||
) ]
|
||||
);
|
||||
push( @{$EXPORT_TAGS{all}}, @{$EXPORT_TAGS{$_}} ) foreach keys %EXPORT_TAGS;
|
||||
|
||||
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
||||
|
||||
our @EXPORT = qw();
|
||||
|
||||
our $VERSION = $ZoneMinder::Base::VERSION;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Database Access
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
|
||||
use Carp;
|
||||
|
||||
our $dbh = undef;
|
||||
|
||||
sub zmDbConnect
|
||||
{
|
||||
my $force = shift;
|
||||
if ( $force )
|
||||
{
|
||||
zmDbDisconnect();
|
||||
}
|
||||
if ( !defined( $dbh ) )
|
||||
{
|
||||
my ( $host, $port ) = ( $Config{ZM_DB_HOST} =~ /^([^:]+)(?::(.+))?$/ );
|
||||
|
||||
if ( defined($port) )
|
||||
{
|
||||
$dbh = DBI->connect( "DBI:mysql:database=".$Config{ZM_DB_NAME}
|
||||
.";host=".$host
|
||||
.";port=".$port
|
||||
, $Config{ZM_DB_USER}
|
||||
, $Config{ZM_DB_PASS}
|
||||
);
|
||||
}
|
||||
else
|
||||
{
|
||||
$dbh = DBI->connect( "DBI:mysql:database=".$Config{ZM_DB_NAME}
|
||||
.";host=".$Config{ZM_DB_HOST}
|
||||
, $Config{ZM_DB_USER}
|
||||
, $Config{ZM_DB_PASS}
|
||||
);
|
||||
}
|
||||
$dbh->trace( 0 );
|
||||
}
|
||||
return( $dbh );
|
||||
}
|
||||
|
||||
sub zmDbDisconnect
|
||||
{
|
||||
if ( defined( $dbh ) )
|
||||
{
|
||||
$dbh->disconnect();
|
||||
$dbh = undef;
|
||||
}
|
||||
}
|
||||
|
||||
use constant DB_MON_ALL => 0; # All monitors
|
||||
use constant DB_MON_CAPT => 1; # All monitors that are capturing
|
||||
use constant DB_MON_ACTIVE => 2; # All monitors that are active
|
||||
use constant DB_MON_MOTION => 3; # All monitors that are doing motion detection
|
||||
use constant DB_MON_RECORD => 4; # All monitors that are doing unconditional recording
|
||||
use constant DB_MON_PASSIVE => 5; # All monitors that are in nodect state
|
||||
|
||||
sub zmDbGetMonitors
|
||||
{
|
||||
zmDbConnect();
|
||||
|
||||
my $function = shift || DB_MON_ALL;
|
||||
my $sql = "select * from Monitors";
|
||||
|
||||
if ( $function )
|
||||
{
|
||||
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'";
|
||||
}
|
||||
}
|
||||
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();
|
||||
|
||||
my $id = shift;
|
||||
|
||||
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();
|
||||
|
||||
return( $monitor );
|
||||
}
|
||||
|
||||
sub zmDbGetMonitorAndControl
|
||||
{
|
||||
zmDbConnect();
|
||||
|
||||
my $id = shift;
|
||||
|
||||
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 $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 );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,831 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder General Utility Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the common definitions and functions used by the rest
|
||||
# of the ZoneMinder scripts
|
||||
#
|
||||
package ZoneMinder::General;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require Exporter;
|
||||
require ZoneMinder::Base;
|
||||
|
||||
our @ISA = qw(Exporter ZoneMinder::Base);
|
||||
|
||||
# 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(
|
||||
executeShellCommand
|
||||
getCmdFormat
|
||||
runCommand
|
||||
setFileOwner
|
||||
getEventPath
|
||||
createEventPath
|
||||
createEvent
|
||||
deleteEventFiles
|
||||
makePath
|
||||
jsonEncode
|
||||
jsonDecode
|
||||
) ]
|
||||
);
|
||||
push( @{$EXPORT_TAGS{all}}, @{$EXPORT_TAGS{$_}} ) foreach keys %EXPORT_TAGS;
|
||||
|
||||
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
||||
|
||||
our @EXPORT = qw();
|
||||
|
||||
our $VERSION = $ZoneMinder::Base::VERSION;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# General Utility Functions
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Config qw(:all);
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Database qw(:all);
|
||||
|
||||
use POSIX;
|
||||
|
||||
# For running general shell commands
|
||||
sub executeShellCommand
|
||||
{
|
||||
my $command = shift;
|
||||
my $output = qx( $command );
|
||||
my $status = $? >> 8;
|
||||
if ( $status || logDebugging() )
|
||||
{
|
||||
Debug( "Command: $command\n" );
|
||||
chomp( $output );
|
||||
Debug( "Output: $output\n" );
|
||||
}
|
||||
return( $status );
|
||||
}
|
||||
|
||||
sub getCmdFormat
|
||||
{
|
||||
Debug( "Testing valid shell syntax\n" );
|
||||
|
||||
my ( $name ) = getpwuid( $> );
|
||||
if ( $name eq $Config{ZM_WEB_USER} )
|
||||
{
|
||||
Debug( "Running as '$name', su commands not needed\n" );
|
||||
return( "" );
|
||||
}
|
||||
|
||||
my $null_command = "true";
|
||||
|
||||
my $prefix = "sudo -u ".$Config{ZM_WEB_USER}." ";
|
||||
my $suffix = "";
|
||||
my $command = $prefix.$null_command.$suffix;
|
||||
Debug( "Testing \"$command\"\n" );
|
||||
$command .= " > /dev/null 2>&1";
|
||||
my $output = qx($command);
|
||||
my $status = $? >> 8;
|
||||
if ( !$status )
|
||||
{
|
||||
Debug( "Test ok, using format \"$prefix<command>$suffix\"\n" );
|
||||
return( $prefix, $suffix );
|
||||
}
|
||||
else
|
||||
{
|
||||
chomp( $output );
|
||||
Debug( "Test failed, '$output'\n" );
|
||||
|
||||
$prefix = "su ".$Config{ZM_WEB_USER}." --shell=/bin/sh --command='";
|
||||
$suffix = "'";
|
||||
$command = $prefix.$null_command.$suffix;
|
||||
Debug( "Testing \"$command\"\n" );
|
||||
my $output = qx($command);
|
||||
my $status = $? >> 8;
|
||||
if ( !$status )
|
||||
{
|
||||
Debug( "Test ok, using format \"$prefix<command>$suffix\"\n" );
|
||||
return( $prefix, $suffix );
|
||||
}
|
||||
else
|
||||
{
|
||||
chomp( $output );
|
||||
Debug( "Test failed, '$output'\n" );
|
||||
|
||||
$prefix = "su ".$Config{ZM_WEB_USER}." -c '";
|
||||
$suffix = "'";
|
||||
$command = $prefix.$null_command.$suffix;
|
||||
Debug( "Testing \"$command\"\n" );
|
||||
$output = qx($command);
|
||||
$status = $? >> 8;
|
||||
if ( !$status )
|
||||
{
|
||||
Debug( "Test ok, using format \"$prefix<command>$suffix\"\n" );
|
||||
return( $prefix, $suffix );
|
||||
}
|
||||
else
|
||||
{
|
||||
chomp( $output );
|
||||
Debug( "Test failed, '$output'\n" );
|
||||
}
|
||||
}
|
||||
}
|
||||
Error( "Unable to find valid 'su' syntax\n" );
|
||||
exit( -1 );
|
||||
}
|
||||
|
||||
our $testedShellSyntax = 0;
|
||||
our ( $cmdPrefix, $cmdSuffix );
|
||||
|
||||
# For running ZM daemons etc
|
||||
sub runCommand
|
||||
{
|
||||
if ( !$testedShellSyntax )
|
||||
{
|
||||
# Determine the appropriate syntax for the su command
|
||||
( $cmdPrefix, $cmdSuffix ) = getCmdFormat();
|
||||
$testedShellSyntax = !undef;
|
||||
}
|
||||
|
||||
my $command = shift;
|
||||
$command = $Config{ZM_PATH_BIN}."/".$command;
|
||||
if ( $cmdPrefix )
|
||||
{
|
||||
$command = $cmdPrefix.$command.$cmdSuffix;
|
||||
}
|
||||
Debug( "Command: $command\n" );
|
||||
my $output = qx($command);
|
||||
my $status = $? >> 8;
|
||||
chomp( $output );
|
||||
if ( $status || logDebugging() )
|
||||
{
|
||||
if ( $status )
|
||||
{
|
||||
Error( "Unable to run \"$command\", output is \"$output\"\n" );
|
||||
exit( -1 );
|
||||
}
|
||||
else
|
||||
{
|
||||
Debug( "Output: $output\n" );
|
||||
}
|
||||
}
|
||||
return( $output );
|
||||
}
|
||||
|
||||
sub getEventPath
|
||||
{
|
||||
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}
|
||||
;
|
||||
}
|
||||
|
||||
if ( index($Config{ZM_DIR_EVENTS},'/') != 0 ){
|
||||
$event_path = $Config{ZM_PATH_WEB}
|
||||
.'/'.$event_path
|
||||
;
|
||||
}
|
||||
return( $event_path );
|
||||
}
|
||||
|
||||
sub createEventPath
|
||||
{
|
||||
#
|
||||
# WARNING assumes running from events directory
|
||||
#
|
||||
my $event = shift;
|
||||
my $eventRootPath = ($Config{ZM_DIR_EVENTS}=~m|/|)
|
||||
? $Config{ZM_DIR_EVENTS}
|
||||
: ($Config{ZM_PATH_WEB}.'/'.$Config{ZM_DIR_EVENTS});
|
||||
my $eventPath = $eventRootPath.'/'.$event->{MonitorId};
|
||||
|
||||
if ( $Config{ZM_USE_DEEP_STORAGE} )
|
||||
{
|
||||
my @startTime = localtime( $event->{StartTime} );
|
||||
|
||||
my @datetimeParts = ();
|
||||
$datetimeParts[0] = sprintf( "%02d", $startTime[5]-100 );
|
||||
$datetimeParts[1] = sprintf( "%02d", $startTime[4]+1 );
|
||||
$datetimeParts[2] = sprintf( "%02d", $startTime[3] );
|
||||
$datetimeParts[3] = sprintf( "%02d", $startTime[2] );
|
||||
$datetimeParts[4] = sprintf( "%02d", $startTime[1] );
|
||||
$datetimeParts[5] = sprintf( "%02d", $startTime[0] );
|
||||
|
||||
my $datePath = join('/',@datetimeParts[0..2]);
|
||||
my $timePath = join('/',@datetimeParts[3..5]);
|
||||
|
||||
makePath( $datePath, $eventPath );
|
||||
$eventPath .= '/'.$datePath;
|
||||
|
||||
# Create event id symlink
|
||||
my $idFile = sprintf( "%s/.%d", $eventPath, $event->{Id} );
|
||||
symlink( $timePath, $idFile )
|
||||
or Fatal( "Can't symlink $idFile -> $eventPath: $!" );
|
||||
|
||||
makePath( $timePath, $eventPath );
|
||||
$eventPath .= '/'.$timePath;
|
||||
setFileOwner( $idFile ); # Must come after directory has been created
|
||||
|
||||
# Create empty id tag file
|
||||
$idFile = sprintf( "%s/.%d", $eventPath, $event->{Id} );
|
||||
open( my $ID_FP, ">", $idFile )
|
||||
or Fatal( "Can't open $idFile: $!" );
|
||||
close( $ID_FP );
|
||||
setFileOwner( $idFile );
|
||||
}
|
||||
else
|
||||
{
|
||||
makePath( $event->{Id}, $eventPath );
|
||||
$eventPath .= '/'.$event->{Id};
|
||||
|
||||
my $idFile = sprintf( "%s/.%d", $eventPath, $event->{Id} );
|
||||
open( my $ID_FP, ">", $idFile )
|
||||
or Fatal( "Can't open $idFile: $!" );
|
||||
close( $ID_FP );
|
||||
setFileOwner( $idFile );
|
||||
}
|
||||
return( $eventPath );
|
||||
}
|
||||
|
||||
use Data::Dumper;
|
||||
|
||||
our $_setFileOwner = undef;
|
||||
our ( $_ownerUid, $_ownerGid );
|
||||
|
||||
sub _checkProcessOwner
|
||||
{
|
||||
if ( !defined($_setFileOwner) )
|
||||
{
|
||||
my ( $processOwner ) = getpwuid( $> );
|
||||
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 )
|
||||
= getpwnam( $Config{ZM_WEB_USER} )
|
||||
or Fatal( "Can't get user details for web user '"
|
||||
.$Config{ZM_WEB_USER}."': $!"
|
||||
);
|
||||
$_setFileOwner = 1;
|
||||
}
|
||||
else
|
||||
{
|
||||
$_setFileOwner = 0;
|
||||
}
|
||||
}
|
||||
return( $_setFileOwner );
|
||||
}
|
||||
|
||||
sub setFileOwner
|
||||
{
|
||||
my $file = shift;
|
||||
|
||||
if ( _checkProcessOwner() )
|
||||
{
|
||||
chown( $_ownerUid, $_ownerGid, $file )
|
||||
or Fatal( "Can't change ownership of file '$file' to '"
|
||||
.$Config{ZM_WEB_USER}.":".$Config{ZM_WEB_GROUP}."': $!"
|
||||
);
|
||||
}
|
||||
}
|
||||
|
||||
our $_hasImageInfo = undef;
|
||||
|
||||
sub _checkForImageInfo
|
||||
{
|
||||
if ( !defined($_hasImageInfo) )
|
||||
{
|
||||
my $result = eval
|
||||
{
|
||||
require Image::Info;
|
||||
Image::Info->import();
|
||||
};
|
||||
$_hasImageInfo = $@?0:1;
|
||||
}
|
||||
return( $_hasImageInfo );
|
||||
}
|
||||
|
||||
sub createEvent
|
||||
{
|
||||
my $event = shift;
|
||||
|
||||
Debug( "Creating event" );
|
||||
#print( Dumper( $event )."\n" );
|
||||
|
||||
_checkForImageInfo();
|
||||
|
||||
my $dbh = zmDbConnect();
|
||||
|
||||
if ( $event->{monitor} )
|
||||
{
|
||||
$event->{MonitorId} = $event->{monitor}->{Id};
|
||||
}
|
||||
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() );
|
||||
my $res = $sth->execute( $event->{MonitorId} )
|
||||
or Fatal( "Can't execute sql '$sql': ".$sth->errstr() );
|
||||
$event->{monitor} = $sth->fetchrow_hashref()
|
||||
or Fatal( "Unable to create event, can't load monitor with id '"
|
||||
.$event->{MonitorId}."'"
|
||||
);
|
||||
$sth->finish();
|
||||
}
|
||||
else
|
||||
{
|
||||
Fatal( "Unable to create event, no monitor or monitor id supplied" );
|
||||
}
|
||||
$event->{Name} = "New Event" unless( $event->{Name} );
|
||||
$event->{Frames} = int(@{$event->{frames}});
|
||||
$event->{TotScore} = $event->{MaxScore} = 0;
|
||||
|
||||
my $lastTimestamp = 0.0;
|
||||
foreach my $frame ( @{$event->{frames}} )
|
||||
{
|
||||
if ( !$event->{Width} )
|
||||
{
|
||||
if ( $_hasImageInfo )
|
||||
{
|
||||
my $imageInfo = Image::Info::image_info( $frame->{imagePath} );
|
||||
if ( $imageInfo->{error} )
|
||||
{
|
||||
Error( "Unable to extract image info from '"
|
||||
.$frame->{imagePath}."': ".$imageInfo->{error}
|
||||
);
|
||||
}
|
||||
else
|
||||
{
|
||||
( $event->{Width}, $event->{Height} ) = Image::Info::dim( $imageInfo );
|
||||
}
|
||||
}
|
||||
}
|
||||
$frame->{Type} = $frame->{Score}>0?'Alarm':'Normal' unless( $frame->{Type} );
|
||||
$frame->{Delta} = $lastTimestamp?($frame->{TimeStamp}-$lastTimestamp):0.0;
|
||||
$event->{StartTime} = $frame->{TimeStamp} unless ( $event->{StartTime} );
|
||||
$event->{TotScore} += $frame->{Score};
|
||||
$event->{MaxScore} = $frame->{Score} if ( $frame->{Score} > $event->{MaxScore} );
|
||||
$event->{AlarmFrames}++ if ( $frame->{Type} eq 'Alarm' );
|
||||
$event->{EndTime} = $frame->{TimeStamp};
|
||||
$lastTimestamp = $frame->{TimeStamp};
|
||||
}
|
||||
$event->{Width} = $event->{monitor}->{Width} unless( $event->{Width} );
|
||||
$event->{Height} = $event->{monitor}->{Height} unless( $event->{Height} );
|
||||
$event->{AvgScore} = $event->{TotScore}/int($event->{AlarmFrames});
|
||||
$event->{Length} = $event->{EndTime} - $event->{StartTime};
|
||||
|
||||
my %formats = (
|
||||
StartTime => 'from_unixtime(?)',
|
||||
EndTime => 'from_unixtime(?)',
|
||||
);
|
||||
|
||||
my ( @fields, @formats, @values );
|
||||
while ( my ( $field, $value ) = each( %$event ) )
|
||||
{
|
||||
next unless $field =~ /^[A-Z]/;
|
||||
push( @fields, $field );
|
||||
push( @formats, ($formats{$field} or '?') );
|
||||
push( @values, $event->{$field} );
|
||||
}
|
||||
|
||||
my $sql = "INSERT INTO Events (".join(',',@fields)
|
||||
.") VALUES (".join(',',@formats).")"
|
||||
;
|
||||
my $sth = $dbh->prepare_cached( $sql )
|
||||
or Fatal( "Can't prepare sql '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute( @values )
|
||||
or Fatal( "Can't execute sql '$sql': ".$sth->errstr() );
|
||||
$event->{Id} = $dbh->{mysql_insertid};
|
||||
Info( "Created event ".$event->{Id} );
|
||||
|
||||
if ( $event->{EndTime} )
|
||||
{
|
||||
$event->{Name} = $event->{monitor}->{EventPrefix}.$event->{Id}
|
||||
if ( $event->{Name} eq 'New Event' );
|
||||
my $sql = "update Events set Name = ? where Id = ?";
|
||||
my $sth = $dbh->prepare_cached( $sql )
|
||||
or Fatal( "Can't prepare sql '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute( $event->{Name}, $event->{Id} )
|
||||
or Fatal( "Can't execute sql '$sql': ".$sth->errstr() );
|
||||
}
|
||||
|
||||
my $eventPath = createEventPath( $event );
|
||||
|
||||
my %frameFormats = (
|
||||
TimeStamp => 'from_unixtime(?)',
|
||||
);
|
||||
my $frameId = 1;
|
||||
foreach my $frame ( @{$event->{frames}} )
|
||||
{
|
||||
$frame->{EventId} = $event->{Id};
|
||||
$frame->{FrameId} = $frameId++;
|
||||
|
||||
my ( @fields, @formats, @values );
|
||||
while ( my ( $field, $value ) = each( %$frame ) )
|
||||
{
|
||||
next unless $field =~ /^[A-Z]/;
|
||||
push( @fields, $field );
|
||||
push( @formats, ($frameFormats{$field} or '?') );
|
||||
push( @values, $frame->{$field} );
|
||||
}
|
||||
|
||||
my $sql = "insert into Frames (".join(',',@fields)
|
||||
.") values (".join(',',@formats).")"
|
||||
;
|
||||
my $sth = $dbh->prepare_cached( $sql )
|
||||
or Fatal( "Can't prepare sql '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute( @values )
|
||||
or Fatal( "Can't execute sql '$sql': ".$sth->errstr() );
|
||||
#$frame->{FrameId} = $dbh->{mysql_insertid};
|
||||
if ( $frame->{imagePath} )
|
||||
{
|
||||
$frame->{capturePath} = sprintf(
|
||||
"%s/%0".$Config{ZM_EVENT_IMAGE_DIGITS}
|
||||
."d-capture.jpg"
|
||||
, $eventPath
|
||||
, $frame->{FrameId}
|
||||
);
|
||||
rename( $frame->{imagePath}, $frame->{capturePath} )
|
||||
or Fatal( "Can't copy ".$frame->{imagePath}
|
||||
." to ".$frame->{capturePath}.": $!"
|
||||
);
|
||||
setFileOwner( $frame->{capturePath} );
|
||||
if ( 0 && $Config{ZM_CREATE_ANALYSIS_IMAGES} )
|
||||
{
|
||||
$frame->{analysePath} = sprintf(
|
||||
"%s/%0".$Config{ZM_EVENT_IMAGE_DIGITS}
|
||||
."d-analyse.jpg"
|
||||
, $eventPath
|
||||
, $frame->{FrameId}
|
||||
);
|
||||
link( $frame->{capturePath}, $frame->{analysePath} )
|
||||
or Fatal( "Can't link ".$frame->{capturePath}
|
||||
." to ".$frame->{analysePath}.": $!"
|
||||
);
|
||||
setFileOwner( $frame->{analysePath} );
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub addEventImage
|
||||
{
|
||||
my $event = shift;
|
||||
my $frame = shift;
|
||||
|
||||
# TBD
|
||||
}
|
||||
|
||||
sub updateEvent
|
||||
{
|
||||
my $event = shift;
|
||||
|
||||
if ( !$event->{EventId} )
|
||||
{
|
||||
Error( "Unable to update event, no event id supplied" );
|
||||
return( 0 );
|
||||
}
|
||||
|
||||
my $dbh = zmDbConnect();
|
||||
|
||||
$event->{Name} = $event->{monitor}->{EventPrefix}.$event->{Id}
|
||||
if ( $event->{Name} eq 'New Event' );
|
||||
|
||||
my %formats = (
|
||||
StartTime => 'from_unixtime(?)',
|
||||
EndTime => 'from_unixtime(?)',
|
||||
);
|
||||
|
||||
my ( @values, @sets );
|
||||
while ( my ( $field, $value ) = each( %$event ) )
|
||||
{
|
||||
next if ( $field eq 'Id' );
|
||||
push( @values, $event->{$field} );
|
||||
push( @sets, $field." = ".($formats{$field} or '?') );
|
||||
}
|
||||
my $sql = "update Events set ".join(',',@sets)." where Id = ?";
|
||||
push( @values, $event->{Id} );
|
||||
|
||||
my $sth = $dbh->prepare_cached( $sql )
|
||||
or Fatal( "Can't prepare sql '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute( @values )
|
||||
or Fatal( "Can't execute sql '$sql': ".$sth->errstr() );
|
||||
}
|
||||
|
||||
sub deleteEventFiles
|
||||
{
|
||||
#
|
||||
# WARNING assumes running from events directory
|
||||
#
|
||||
my $event_id = shift;
|
||||
my $monitor_id = shift;
|
||||
$monitor_id = '*' if ( !defined($monitor_id) );
|
||||
|
||||
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 )
|
||||
{
|
||||
( $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" );
|
||||
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( $delete_path."/*" );
|
||||
#Debug( "HF1:".$has_files[0] ) if ( @has_files );
|
||||
last if ( @has_files );
|
||||
@has_files = glob( $delete_path."/.[0-9]*" );
|
||||
#Debug( "HF2:".$has_files[0] ) if ( @has_files );
|
||||
last if ( @has_files );
|
||||
my $command = "/bin/rm -rf ".$delete_path;
|
||||
executeShellCommand( $command );
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
my $command = "/bin/rm -rf $monitor_id/$event_id";
|
||||
executeShellCommand( $command );
|
||||
}
|
||||
}
|
||||
|
||||
sub makePath
|
||||
{
|
||||
my $path = shift;
|
||||
my $root = shift;
|
||||
$root = (( $path =~ m|^/| )?'':'.' ) unless( $root );
|
||||
|
||||
Debug( "Creating path '$path' in $root'\n" );
|
||||
my @parts = split( '/', $path );
|
||||
my $fullPath = $root;
|
||||
foreach my $dir ( @parts )
|
||||
{
|
||||
$fullPath .= '/'.$dir;
|
||||
if ( !-d $fullPath )
|
||||
{
|
||||
if ( -e $fullPath )
|
||||
{
|
||||
Fatal( "Can't create '$fullPath', already exists as non directory" );
|
||||
}
|
||||
else
|
||||
{
|
||||
Debug( "Creating '$fullPath'\n" );
|
||||
mkdir( $fullPath, 0755 ) or Fatal( "Can't mkdir '$fullPath': $!" );
|
||||
setFileOwner( $fullPath );
|
||||
}
|
||||
}
|
||||
}
|
||||
return( $fullPath );
|
||||
}
|
||||
|
||||
our $testedJSON = 0;
|
||||
our $hasJSONAny = 0;
|
||||
|
||||
sub _testJSON
|
||||
{
|
||||
return if ( $testedJSON );
|
||||
my $result = eval
|
||||
{
|
||||
require JSON::Any;
|
||||
JSON::Any->import();
|
||||
};
|
||||
$testedJSON = 1;
|
||||
$hasJSONAny = 1 if ( $result );
|
||||
}
|
||||
|
||||
sub _getJSONType
|
||||
{
|
||||
my $value = shift;
|
||||
return( 'null' ) unless( defined($value) );
|
||||
return( 'integer' ) if ( $value =~ /^\d+$/ );
|
||||
return( 'double' ) if ( $value =~ /^\d+$/ );
|
||||
return( 'hash' ) if ( ref($value) eq 'HASH' );
|
||||
return( 'array' ) if ( ref($value) eq 'ARRAY' );
|
||||
return( 'string' );
|
||||
}
|
||||
|
||||
sub jsonEncode;
|
||||
|
||||
sub jsonEncode
|
||||
{
|
||||
my $value = shift;
|
||||
|
||||
_testJSON();
|
||||
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' )
|
||||
{
|
||||
return( $value );
|
||||
}
|
||||
elsif ( $type eq 'boolean' )
|
||||
{
|
||||
return( $value?'true':'false' );
|
||||
}
|
||||
elsif ( $type eq 'string' )
|
||||
{
|
||||
$value =~ s|(["\\/])|\\$1|g;
|
||||
$value =~ s|\r?\n|\n|g;
|
||||
return( '"'.$value.'"' );
|
||||
}
|
||||
elsif ( $type eq 'null' )
|
||||
{
|
||||
return( 'null' );
|
||||
}
|
||||
elsif ( $type eq 'array' )
|
||||
{
|
||||
return( '['.join( ',', map { jsonEncode( $_ ) } @$value ).']' );
|
||||
}
|
||||
elsif ( $type eq 'hash' )
|
||||
{
|
||||
my $result = '{';
|
||||
while ( my ( $subKey=>$subValue ) = each( %$value ) )
|
||||
{
|
||||
$result .= ',' if ( $result ne '{' );
|
||||
$result .= '"'.$subKey.'":'.jsonEncode( $subValue );
|
||||
}
|
||||
return( $result.'}' );
|
||||
}
|
||||
else
|
||||
{
|
||||
Fatal( "Unexpected type '$type'" );
|
||||
}
|
||||
}
|
||||
|
||||
sub jsonDecode
|
||||
{
|
||||
my $value = shift;
|
||||
|
||||
_testJSON();
|
||||
if ( $hasJSONAny )
|
||||
{
|
||||
my $object = eval { JSON::Any->jsonToObj( $value ) };
|
||||
Fatal( "Unable to decode JSON string '$value': $@" ) unless( $object );
|
||||
return( $object );
|
||||
}
|
||||
|
||||
my $comment = 0;
|
||||
my $unescape = 0;
|
||||
my $out = '';
|
||||
my @chars = split( //, $value );
|
||||
for ( my $i = 0; $i < @chars; $i++ )
|
||||
{
|
||||
if ( !$comment )
|
||||
{
|
||||
if ( $chars[$i] eq ':' )
|
||||
{
|
||||
$out .= '=>';
|
||||
}
|
||||
else
|
||||
{
|
||||
$out .= $chars[$i];
|
||||
}
|
||||
}
|
||||
elsif ( !$unescape )
|
||||
{
|
||||
if ( $chars[$i] eq '\\' )
|
||||
{
|
||||
$unescape = 1;
|
||||
}
|
||||
else
|
||||
{
|
||||
$out .= $chars[$i];
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
if ( $chars[$i] ne '/' )
|
||||
{
|
||||
$out .= '\\';
|
||||
}
|
||||
$out .= $chars[$i];
|
||||
$unescape = 0;
|
||||
}
|
||||
if ( $chars[$i] eq '"' )
|
||||
{
|
||||
$comment = !$comment;
|
||||
}
|
||||
}
|
||||
$out =~ s/=>true/=>1/g;
|
||||
$out =~ s/=>false/=>0/g;
|
||||
$out =~ s/=>null/=>undef/g;
|
||||
$out =~ s/`/'/g;
|
||||
$out =~ s/qx/qq/g;
|
||||
( $out ) = $out =~ m/^({.+})$/; # Detaint and check it's a valid object syntax
|
||||
my $result = eval $out;
|
||||
Fatal( $@ ) if ( $@ );
|
||||
return( $result );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,939 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Logger Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the debug definitions and functions used by the rest
|
||||
# of the ZoneMinder scripts
|
||||
#
|
||||
package ZoneMinder::Logger;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require Exporter;
|
||||
require ZoneMinder::Base;
|
||||
|
||||
our @ISA = qw(Exporter ZoneMinder::Base);
|
||||
|
||||
# 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 = (
|
||||
'constants' => [ qw(
|
||||
DEBUG
|
||||
INFO
|
||||
WARNING
|
||||
ERROR
|
||||
FATAL
|
||||
PANIC
|
||||
NOLOG
|
||||
) ],
|
||||
'functions' => [ qw(
|
||||
logInit
|
||||
logReinit
|
||||
logTerm
|
||||
logSetSignal
|
||||
logClearSignal
|
||||
logDebugging
|
||||
logLevel
|
||||
logTermLevel
|
||||
logDatabaseLevel
|
||||
logFileLevel
|
||||
logSyslogLevel
|
||||
Mark
|
||||
Dump
|
||||
Debug
|
||||
Info
|
||||
Warning
|
||||
Error
|
||||
Fatal
|
||||
Panic
|
||||
) ]
|
||||
);
|
||||
push( @{$EXPORT_TAGS{all}}, @{$EXPORT_TAGS{$_}} ) foreach keys %EXPORT_TAGS;
|
||||
|
||||
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
||||
|
||||
our @EXPORT = qw();
|
||||
|
||||
our $VERSION = $ZoneMinder::Base::VERSION;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Logger Facilities
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Config qw(:all);
|
||||
|
||||
use DBI;
|
||||
use Carp;
|
||||
use POSIX;
|
||||
use IO::Handle;
|
||||
use Data::Dumper;
|
||||
use Time::HiRes qw/gettimeofday/;
|
||||
use Sys::Syslog;
|
||||
|
||||
use constant {
|
||||
DEBUG => 1,
|
||||
INFO => 0,
|
||||
WARNING => -1,
|
||||
ERROR => -2,
|
||||
FATAL => -3,
|
||||
PANIC => -4,
|
||||
NOLOG => -5
|
||||
};
|
||||
|
||||
our %codes = (
|
||||
&DEBUG => "DBG",
|
||||
&INFO => "INF",
|
||||
&WARNING => "WAR",
|
||||
&ERROR => "ERR",
|
||||
&FATAL => "FAT",
|
||||
&PANIC => "PNC",
|
||||
&NOLOG => "OFF"
|
||||
);
|
||||
|
||||
our %priorities = (
|
||||
&DEBUG => "debug",
|
||||
&INFO => "info",
|
||||
&WARNING => "warning",
|
||||
&ERROR => "err",
|
||||
&FATAL => "err",
|
||||
&PANIC => "err"
|
||||
);
|
||||
|
||||
our $logger;
|
||||
our $LOGFILE;
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $this = {};
|
||||
|
||||
$this->{initialised} = undef;
|
||||
|
||||
#$this->{id} = "zmundef";
|
||||
( $this->{id} ) = $0 =~ m|^(?:.*/)?([^/]+?)(?:\.[^/.]+)?$|;
|
||||
$this->{idRoot} = $this->{id};
|
||||
$this->{idArgs} = "";
|
||||
|
||||
$this->{level} = INFO;
|
||||
$this->{termLevel} = NOLOG;
|
||||
$this->{databaseLevel} = NOLOG;
|
||||
$this->{fileLevel} = NOLOG;
|
||||
$this->{syslogLevel} = NOLOG;
|
||||
$this->{effectiveLevel} = INFO;
|
||||
|
||||
$this->{autoFlush} = 1;
|
||||
$this->{hasTerm} = -t STDERR;
|
||||
|
||||
( $this->{fileName} = $0 ) =~ s|^.*/||;
|
||||
$this->{logPath} = $Config{ZM_PATH_LOGS};
|
||||
$this->{logFile} = $this->{logPath}."/".$this->{id}.".log";
|
||||
|
||||
$this->{trace} = 0;
|
||||
|
||||
bless( $this, $class );
|
||||
return $this;
|
||||
}
|
||||
|
||||
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})') )
|
||||
{
|
||||
no strict 'subs';
|
||||
no strict 'refs';
|
||||
my %dbgConfig = (
|
||||
ZM_LOG_LEVEL_DATABASE => 0,
|
||||
ZM_LOG_LEVEL_FILE => 0,
|
||||
ZM_LOG_LEVEL_SYSLOG => 0,
|
||||
ZM_LOG_DEBUG => 0,
|
||||
ZM_LOG_DEBUG_TARGET => "",
|
||||
ZM_LOG_DEBUG_LEVEL => 1,
|
||||
ZM_LOG_DEBUG_FILE => ""
|
||||
);
|
||||
while ( my ( $name, $value ) = each( %dbgConfig ) )
|
||||
{
|
||||
*{$name} = sub { $value };
|
||||
}
|
||||
use strict 'subs';
|
||||
use strict 'refs';
|
||||
}
|
||||
}
|
||||
|
||||
sub DESTROY
|
||||
{
|
||||
my $this = shift;
|
||||
$this->terminate();
|
||||
}
|
||||
|
||||
sub initialise( @ )
|
||||
{
|
||||
my $this = shift;
|
||||
my %options = @_;
|
||||
|
||||
$this->{id} = $options{id} if ( defined($options{id}) );
|
||||
|
||||
$this->{logPath} = $options{logPath} if ( defined($options{logPath}) );
|
||||
|
||||
my $tempLogFile;
|
||||
$tempLogFile = $this->{logPath}."/".$this->{id}.".log";
|
||||
$tempLogFile = $options{logFile} if ( defined($options{logFile}) );
|
||||
if ( my $logFile = $this->getTargettedEnv('LOG_FILE') )
|
||||
{
|
||||
$tempLogFile = $logFile;
|
||||
}
|
||||
|
||||
my $tempLevel = INFO;
|
||||
my $tempTermLevel = $this->{termLevel};
|
||||
my $tempDatabaseLevel = $this->{databaseLevel};
|
||||
my $tempFileLevel = $this->{fileLevel};
|
||||
my $tempSyslogLevel = $this->{syslogLevel};
|
||||
|
||||
$tempTermLevel = $options{termLevel} if ( defined($options{termLevel}) );
|
||||
if ( defined($options{databaseLevel}) )
|
||||
{
|
||||
$tempDatabaseLevel = $options{databaseLevel};
|
||||
}
|
||||
else
|
||||
{
|
||||
$tempDatabaseLevel = $Config{ZM_LOG_LEVEL_DATABASE};
|
||||
}
|
||||
if ( defined($options{fileLevel}) )
|
||||
{
|
||||
$tempFileLevel = $options{fileLevel};
|
||||
}
|
||||
else
|
||||
{
|
||||
$tempFileLevel = $Config{ZM_LOG_LEVEL_FILE};
|
||||
}
|
||||
if ( defined($options{syslogLevel}) )
|
||||
{
|
||||
$tempSyslogLevel = $options{syslogLevel};
|
||||
}
|
||||
else
|
||||
{
|
||||
$tempSyslogLevel = $Config{ZM_LOG_LEVEL_SYSLOG};
|
||||
}
|
||||
|
||||
if ( defined($ENV{'LOG_PRINT'}) )
|
||||
{
|
||||
$tempTermLevel = $ENV{'LOG_PRINT'}? DEBUG : NOLOG;
|
||||
}
|
||||
|
||||
my $level;
|
||||
$tempLevel = $level if ( defined($level = $this->getTargettedEnv('LOG_LEVEL')) );
|
||||
|
||||
$tempTermLevel = $level if ( defined($level = $this->getTargettedEnv('LOG_LEVEL_TERM')) );
|
||||
$tempDatabaseLevel = $level if ( defined($level = $this->getTargettedEnv('LOG_LEVEL_DATABASE')) );
|
||||
$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 ( $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 )
|
||||
{
|
||||
$tempLevel = $this->limit( $Config{ZM_LOG_DEBUG_LEVEL} );
|
||||
if ( $Config{ZM_LOG_DEBUG_FILE} ne "" )
|
||||
{
|
||||
$tempLogFile = $Config{ZM_LOG_DEBUG_FILE};
|
||||
$tempFileLevel = $tempLevel;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
$this->logFile( $tempLogFile );
|
||||
|
||||
$this->termLevel( $tempTermLevel );
|
||||
$this->databaseLevel( $tempDatabaseLevel );
|
||||
$this->fileLevel( $tempFileLevel );
|
||||
$this->syslogLevel( $tempSyslogLevel );
|
||||
|
||||
$this->level( $tempLevel );
|
||||
|
||||
$this->{trace} = $options{trace} if ( defined($options{trace}) );
|
||||
|
||||
$this->{autoFlush} = $ENV{'LOG_FLUSH'}?1:0 if ( defined($ENV{'LOG_FLUSH'}) );
|
||||
|
||||
$this->{initialised} = !undef;
|
||||
|
||||
Debug( "LogOpts: level=".$codes{$this->{level}}
|
||||
."/".$codes{$this->{effectiveLevel}}
|
||||
.", screen=".$codes{$this->{termLevel}}
|
||||
.", database=".$codes{$this->{databaseLevel}}
|
||||
.", logfile=".$codes{$this->{fileLevel}}
|
||||
."->".$this->{logFile}
|
||||
.", syslog=".$codes{$this->{syslogLevel}}
|
||||
);
|
||||
}
|
||||
|
||||
sub terminate
|
||||
{
|
||||
my $this = shift;
|
||||
return unless ( $this->{initialised} );
|
||||
$this->syslogLevel( NOLOG );
|
||||
$this->fileLevel( NOLOG );
|
||||
$this->databaseLevel( NOLOG );
|
||||
$this->termLevel( NOLOG );
|
||||
}
|
||||
|
||||
sub reinitialise
|
||||
{
|
||||
my $this = shift;
|
||||
|
||||
return unless ( $this->{initialised} );
|
||||
|
||||
# Bit of a nasty hack to reopen connections to log files and the DB
|
||||
my $syslogLevel = $this->syslogLevel();
|
||||
$this->syslogLevel( NOLOG );
|
||||
my $logfileLevel = $this->fileLevel();
|
||||
$this->fileLevel( NOLOG );
|
||||
my $databaseLevel = $this->databaseLevel();
|
||||
$this->databaseLevel( NOLOG );
|
||||
my $screenLevel = $this->termLevel();
|
||||
$this->termLevel( NOLOG );
|
||||
|
||||
$this->syslogLevel( $syslogLevel ) if ( $syslogLevel > NOLOG );
|
||||
$this->fileLevel( $logfileLevel ) if ( $logfileLevel > NOLOG );
|
||||
$this->databaseLevel( $databaseLevel ) if ( $databaseLevel > NOLOG );
|
||||
$this->databaseLevel( $databaseLevel ) if ( $databaseLevel > NOLOG );
|
||||
}
|
||||
|
||||
sub limit
|
||||
{
|
||||
my $this = shift;
|
||||
my $level = shift;
|
||||
return( DEBUG ) if ( $level > DEBUG );
|
||||
return( NOLOG ) if ( $level < NOLOG );
|
||||
return( $level );
|
||||
}
|
||||
|
||||
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} )
|
||||
{
|
||||
$envName = $name."_".$this->{idRoot};
|
||||
$value = $ENV{$envName} if ( defined($ENV{$envName}) );
|
||||
}
|
||||
if ( !defined($value) )
|
||||
{
|
||||
$value = $ENV{$name} if ( defined($ENV{$name}) );
|
||||
}
|
||||
if ( defined($value) )
|
||||
{
|
||||
( $value ) = $value =~ m/(.*)/;
|
||||
}
|
||||
return( $value );
|
||||
}
|
||||
|
||||
sub fetch
|
||||
{
|
||||
if ( !$logger )
|
||||
{
|
||||
$logger = ZoneMinder::Logger->new();
|
||||
$logger->initialise( 'syslogLevel'=>INFO, 'databaseLevel'=>INFO );
|
||||
}
|
||||
return( $logger );
|
||||
}
|
||||
|
||||
sub id
|
||||
{
|
||||
my $this = shift;
|
||||
my $id = shift;
|
||||
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 )
|
||||
{
|
||||
$this->{id} = $this->{idRoot} = $id;
|
||||
if ( $id =~ /^([^_]+)_(.+)$/ )
|
||||
{
|
||||
$this->{idRoot} = $1;
|
||||
$this->{idArgs} = $2;
|
||||
}
|
||||
}
|
||||
}
|
||||
return( $this->{id} );
|
||||
}
|
||||
|
||||
sub level
|
||||
{
|
||||
my $this = shift;
|
||||
my $level = shift;
|
||||
if ( defined($level) )
|
||||
{
|
||||
$this->{level} = $this->limit( $level );
|
||||
$this->{effectiveLevel} = NOLOG;
|
||||
$this->{effectiveLevel} = $this->{termLevel} if ( $this->{termLevel} > $this->{effectiveLevel} );
|
||||
$this->{effectiveLevel} = $this->{databaseLevel} if ( $this->{databaseLevel} > $this->{effectiveLevel} );
|
||||
$this->{effectiveLevel} = $this->{fileLevel} if ( $this->{fileLevel} > $this->{effectiveLevel} );
|
||||
$this->{effectiveLevel} = $this->{syslogLevel} if ( $this->{syslogLevel} > $this->{level} );
|
||||
$this->{effectiveLevel} = $this->{level} if ( $this->{effectiveLevel} > $this->{level} );
|
||||
}
|
||||
return( $this->{level} );
|
||||
}
|
||||
|
||||
sub debugOn
|
||||
{
|
||||
my $this = shift;
|
||||
return( $this->{effectiveLevel} >= DEBUG );
|
||||
}
|
||||
|
||||
sub trace
|
||||
{
|
||||
my $this = shift;
|
||||
$this->{trace} = $_[0] if ( @_ );
|
||||
return( $this->{trace} );
|
||||
}
|
||||
|
||||
sub termLevel
|
||||
{
|
||||
my $this = shift;
|
||||
my $termLevel = shift;
|
||||
if ( defined($termLevel) )
|
||||
{
|
||||
$termLevel = NOLOG if ( !$this->{hasTerm} );
|
||||
$termLevel = $this->limit( $termLevel );
|
||||
if ( $this->{termLevel} != $termLevel )
|
||||
{
|
||||
$this->{termLevel} = $termLevel;
|
||||
}
|
||||
}
|
||||
return( $this->{termLevel} );
|
||||
}
|
||||
|
||||
sub databaseLevel
|
||||
{
|
||||
my $this = shift;
|
||||
my $databaseLevel = shift;
|
||||
if ( defined($databaseLevel) )
|
||||
{
|
||||
$databaseLevel = $this->limit( $databaseLevel );
|
||||
if ( $this->{databaseLevel} != $databaseLevel )
|
||||
{
|
||||
if ( $databaseLevel > NOLOG && $this->{databaseLevel} <= NOLOG )
|
||||
{
|
||||
if ( !$this->{dbh} )
|
||||
{
|
||||
my ( $host, $port ) = ( $Config{ZM_DB_HOST} =~ /^([^:]+)(?::(.+))?$/ );
|
||||
|
||||
if ( defined($port) )
|
||||
{
|
||||
$this->{dbh} = DBI->connect( "DBI:mysql:database=".$Config{ZM_DB_NAME}
|
||||
.";host=".$host
|
||||
.";port=".$port
|
||||
, $Config{ZM_DB_USER}
|
||||
, $Config{ZM_DB_PASS}
|
||||
);
|
||||
}
|
||||
else
|
||||
{
|
||||
$this->{dbh} = DBI->connect( "DBI:mysql:database=".$Config{ZM_DB_NAME}
|
||||
.";host=".$Config{ZM_DB_HOST}
|
||||
, $Config{ZM_DB_USER}
|
||||
, $Config{ZM_DB_PASS}
|
||||
);
|
||||
}
|
||||
if ( !$this->{dbh} )
|
||||
{
|
||||
$databaseLevel = NOLOG;
|
||||
Error( "Unable to write log entries to DB, can't connect to database '"
|
||||
.$Config{ZM_DB_NAME}
|
||||
."' on host '"
|
||||
.$Config{ZM_DB_HOST}
|
||||
."'"
|
||||
);
|
||||
}
|
||||
else
|
||||
{
|
||||
$this->{dbh}->{AutoCommit} = 1;
|
||||
Fatal( "Can't set AutoCommit on in database connection" )
|
||||
unless( $this->{dbh}->{AutoCommit} );
|
||||
$this->{dbh}->{mysql_auto_reconnect} = 1;
|
||||
Fatal( "Can't set mysql_auto_reconnect on in database connection" )
|
||||
unless( $this->{dbh}->{mysql_auto_reconnect} );
|
||||
$this->{dbh}->trace( 0 );
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif ( $databaseLevel <= NOLOG && $this->{databaseLevel} > NOLOG )
|
||||
{
|
||||
if ( $this->{dbh} )
|
||||
{
|
||||
$this->{dbh}->disconnect();
|
||||
undef($this->{dbh});
|
||||
}
|
||||
}
|
||||
$this->{databaseLevel} = $databaseLevel;
|
||||
}
|
||||
}
|
||||
return( $this->{databaseLevel} );
|
||||
}
|
||||
|
||||
sub fileLevel
|
||||
{
|
||||
my $this = shift;
|
||||
my $fileLevel = shift;
|
||||
if ( defined($fileLevel) )
|
||||
{
|
||||
$fileLevel = $this->limit($fileLevel);
|
||||
if ( $this->{fileLevel} != $fileLevel )
|
||||
{
|
||||
$this->closeFile() if ( $this->{fileLevel} > NOLOG );
|
||||
$this->{fileLevel} = $fileLevel;
|
||||
$this->openFile() if ( $this->{fileLevel} > NOLOG );
|
||||
}
|
||||
}
|
||||
return( $this->{fileLevel} );
|
||||
}
|
||||
|
||||
sub syslogLevel
|
||||
{
|
||||
my $this = shift;
|
||||
my $syslogLevel = shift;
|
||||
if ( defined($syslogLevel) )
|
||||
{
|
||||
$syslogLevel = $this->limit($syslogLevel);
|
||||
if ( $this->{syslogLevel} != $syslogLevel )
|
||||
{
|
||||
$this->closeSyslog() if ( $syslogLevel <= NOLOG && $this->{syslogLevel} > NOLOG );
|
||||
$this->openSyslog() if ( $syslogLevel > NOLOG && $this->{syslogLevel} <= NOLOG );
|
||||
$this->{syslogLevel} = $syslogLevel;
|
||||
}
|
||||
}
|
||||
return( $this->{syslogLevel} );
|
||||
}
|
||||
|
||||
sub openSyslog
|
||||
{
|
||||
my $this = shift;
|
||||
openlog( $this->{id}, "pid", "local1" );
|
||||
}
|
||||
|
||||
sub closeSyslog
|
||||
{
|
||||
my $this = shift;
|
||||
#closelog();
|
||||
}
|
||||
|
||||
sub logFile
|
||||
{
|
||||
my $this = shift;
|
||||
my $logFile = shift;
|
||||
if ( $logFile =~ /^(.+)\+$/ )
|
||||
{
|
||||
$this->{logFile} = $1.'.'.$$;
|
||||
}
|
||||
else
|
||||
{
|
||||
$this->{logFile} = $logFile;
|
||||
}
|
||||
}
|
||||
|
||||
sub openFile
|
||||
{
|
||||
my $this = shift;
|
||||
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 )
|
||||
{
|
||||
chown( $webUid, $webGid, $this->{logFile} )
|
||||
or Fatal( "Can't change permissions on log file '"
|
||||
.$this->{logFile}."': $!"
|
||||
)
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
$this->fileLevel( NOLOG );
|
||||
Error( "Can't open log file '".$this->{logFile}."': $!" );
|
||||
}
|
||||
}
|
||||
|
||||
sub closeFile
|
||||
{
|
||||
my $this = shift;
|
||||
close( $LOGFILE ) if ( fileno($LOGFILE) );
|
||||
}
|
||||
|
||||
sub logPrint
|
||||
{
|
||||
my $this = shift;
|
||||
my $level = shift;
|
||||
my $string = shift;
|
||||
|
||||
if ( $level <= $this->{effectiveLevel} )
|
||||
{
|
||||
$string =~ s/[\r\n]+$//g;
|
||||
|
||||
my $code = $codes{$level};
|
||||
|
||||
my ($seconds, $microseconds) = gettimeofday();
|
||||
my $message = sprintf(
|
||||
"%s.%06d %s[%d].%s [%s]"
|
||||
, strftime( "%x %H:%M:%S"
|
||||
,localtime( $seconds )
|
||||
)
|
||||
, $microseconds
|
||||
, $this->{id}
|
||||
, $$
|
||||
, $code
|
||||
, $string
|
||||
);
|
||||
if ( $this->{trace} )
|
||||
{
|
||||
$message = Carp::shortmess( $message );
|
||||
}
|
||||
else
|
||||
{
|
||||
$message = $message."\n";
|
||||
}
|
||||
syslog( $priorities{$level}, $code." [%s]", $string )
|
||||
if ( $level <= $this->{syslogLevel} );
|
||||
print( $LOGFILE $message ) if ( $level <= $this->{fileLevel} );
|
||||
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} )
|
||||
{
|
||||
$this->{databaseLevel} = NOLOG;
|
||||
Fatal( "Can't prepare log entry '$sql': ".$this->{dbh}->errstr() );
|
||||
}
|
||||
my $res = $this->{sth}->execute( $seconds+($microseconds/1000000.0)
|
||||
, $this->{id}
|
||||
, $$
|
||||
, $level
|
||||
, $code
|
||||
, $string
|
||||
, $this->{fileName}
|
||||
);
|
||||
if ( !$res )
|
||||
{
|
||||
$this->{databaseLevel} = NOLOG;
|
||||
Fatal( "Can't execute log entry '$sql': ".$this->{sth}->errstr() );
|
||||
}
|
||||
}
|
||||
print( STDERR $message ) if ( $level <= $this->{termLevel} );
|
||||
}
|
||||
}
|
||||
|
||||
sub logInit( ;@ )
|
||||
{
|
||||
my %options = @_ ? @_ : ();
|
||||
$logger = ZoneMinder::Logger->new() if ( !$logger );
|
||||
$logger->initialise( %options );
|
||||
}
|
||||
|
||||
sub logReinit
|
||||
{
|
||||
fetch()->reinitialise();
|
||||
}
|
||||
|
||||
sub logTerm
|
||||
{
|
||||
return unless ( $logger );
|
||||
$logger->terminate();
|
||||
$logger = undef;
|
||||
}
|
||||
|
||||
sub logHupHandler
|
||||
{
|
||||
my $savedErrno = $!;
|
||||
return unless( $logger );
|
||||
fetch()->reinitialise();
|
||||
logSetSignal();
|
||||
$! = $savedErrno;
|
||||
}
|
||||
|
||||
sub logSetSignal
|
||||
{
|
||||
$SIG{HUP} = \&logHupHandler;
|
||||
}
|
||||
|
||||
sub logClearSignal
|
||||
{
|
||||
$SIG{HUP} = 'DEFAULT';
|
||||
}
|
||||
|
||||
sub logLevel
|
||||
{
|
||||
return( fetch()->level( @_ ) );
|
||||
}
|
||||
|
||||
sub logDebugging
|
||||
{
|
||||
return( fetch()->debugOn() );
|
||||
}
|
||||
|
||||
sub logTermLevel
|
||||
{
|
||||
return( fetch()->termLevel( @_ ) );
|
||||
}
|
||||
|
||||
sub logDatabaseLevel
|
||||
{
|
||||
return( fetch()->databaseLevel( @_ ) );
|
||||
}
|
||||
|
||||
sub logFileLevel
|
||||
{
|
||||
return( fetch()->fileLevel( @_ ) );
|
||||
}
|
||||
|
||||
sub logSyslogLevel
|
||||
{
|
||||
return( fetch()->syslogLevel( @_ ) );
|
||||
}
|
||||
|
||||
sub Mark
|
||||
{
|
||||
my $level = shift;
|
||||
$level = DEBUG unless( defined($level) );
|
||||
my $tag = "Mark";
|
||||
fetch()->logPrint( $level, $tag );
|
||||
}
|
||||
|
||||
sub Dump
|
||||
{
|
||||
my $var = shift;
|
||||
my $label = shift;
|
||||
$label = "VAR" unless( defined($label) );
|
||||
fetch()->logPrint( DEBUG, Data::Dumper->Dump( [ $var ], [ $label ] ) );
|
||||
}
|
||||
|
||||
sub Debug( @ )
|
||||
{
|
||||
fetch()->logPrint( DEBUG, @_ );
|
||||
}
|
||||
|
||||
sub Info( @ )
|
||||
{
|
||||
fetch()->logPrint( INFO, @_ );
|
||||
}
|
||||
|
||||
sub Warning( @ )
|
||||
{
|
||||
fetch()->logPrint( WARNING, @_ );
|
||||
}
|
||||
|
||||
sub Error( @ )
|
||||
{
|
||||
fetch()->logPrint( ERROR, @_ );
|
||||
}
|
||||
|
||||
sub Fatal( @ )
|
||||
{
|
||||
fetch()->logPrint( FATAL, @_ );
|
||||
exit( -1 );
|
||||
}
|
||||
|
||||
sub Panic( @ )
|
||||
{
|
||||
fetch()->logPrint( PANIC, @_ );
|
||||
confess( $_[0] );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Logger - ZoneMinder Logger module
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Logger;
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
|
||||
logInit( "myproc", DEBUG );
|
||||
|
||||
Debug( "This is what is happening" );
|
||||
Info( "Something interesting is happening" );
|
||||
Warning( "Something might be going wrong." );
|
||||
Error( "Something has gone wrong!!" );
|
||||
Fatal( "Something has gone badly wrong, gotta stop!!" );
|
||||
Panic( "Something fundamental has gone wrong, die with stack trace );
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The ZoneMinder:Logger module contains the common debug and error reporting
|
||||
routines used by the ZoneMinder scripts.
|
||||
|
||||
To use debug in your scripts you need to include this module, and call
|
||||
logInit. Thereafter you can sprinkle Debug or Error calls etc throughout
|
||||
the code safe in the knowledge that they will be reported to your error
|
||||
log, and possibly the syslogger, in a meaningful and consistent format.
|
||||
|
||||
Debug is discussed in terms of levels where 1 and above (currently only 1
|
||||
for scripts) is considered debug, 0 is considered as informational, -1 is a
|
||||
warning, -2 is an error and -3 is a fatal error or panic. Where levels are
|
||||
mentioned below as thresholds the value given and anything with a lower
|
||||
level (ie. more serious) will be included.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item logInit ( $id, %options );
|
||||
|
||||
Initialises the debug and prepares the logging for forthcoming operations.
|
||||
If not called explicitly it will be called by the first debug call in your
|
||||
script, but with default (and probably meaningless) options. The only
|
||||
compulsory arguments are $id which must be a string that will identify
|
||||
debug coming from this script in mixed logs. Other options may be provided
|
||||
as below,
|
||||
|
||||
Option Default Description
|
||||
--------- --------- -----------
|
||||
level INFO The initial debug level which defines which statements are output and which are ignored
|
||||
trace 0 Whether to use the Carp::shortmess format in debug statements to identify where the debug was emitted from
|
||||
termLevel NOLOG At what level debug is written to terminal standard error, 0 is no, 1 is yes, 2 is write only if terminal
|
||||
databaseLevel INFO At what level debug is written to the Log table in the database;
|
||||
fileLevel NOLOG At what level debug is written to a log file of the format of <id>.log in the standard log directory.
|
||||
syslogLevel INFO At what level debug is written to syslog.
|
||||
|
||||
To disable any of these action entirely set to NOLOG
|
||||
|
||||
=item logTerm ();
|
||||
|
||||
Used to end the debug session and close any logs etc. Not usually necessary.
|
||||
|
||||
=item $id = logId ( [$id] );
|
||||
|
||||
=item $level = logLevel ( [$level] );
|
||||
|
||||
=item $trace = logTrace ( [$trace] );
|
||||
|
||||
=item $level = logLevel ( [$level] );
|
||||
|
||||
=item $termLevel = logTermLevel ( [$termLevel] );
|
||||
|
||||
=item $databaseLevel = logDatabaseLevel ( [$databaseLevel] );
|
||||
|
||||
=item $fileLevel = logFileLevel ( [$fileLevel] );
|
||||
|
||||
=item $syslogLevel = logSyslogLevel ( [$syslogLevel] );
|
||||
|
||||
These methods can be used to get and set the current settings as defined in logInit.
|
||||
|
||||
=item Debug( $string );
|
||||
|
||||
This method will output a debug message if the current debug level permits
|
||||
it, otherwise does nothing. This message will be tagged with the DBG string
|
||||
in the logs.
|
||||
|
||||
=item Info( $string );
|
||||
|
||||
This method will output an informational message if the current debug level
|
||||
permits it, otherwise does nothing. This message will be tagged with the
|
||||
INF string in the logs.
|
||||
|
||||
=item Warning( $string );
|
||||
|
||||
This method will output a warning message if the current debug level
|
||||
permits it, otherwise does nothing. This message will be tagged with the
|
||||
WAR string in the logs.
|
||||
|
||||
=item Error( $string );
|
||||
|
||||
This method will output an error message if the current debug level permits
|
||||
it, otherwise does nothing. This message will be tagged with the ERR string
|
||||
in the logs.
|
||||
|
||||
=item Fatal( $string );
|
||||
|
||||
This method will output a fatal error message and then die if the current
|
||||
debug level permits it, otherwise does nothing. This message will be tagged
|
||||
with the FAT string in the logs.
|
||||
|
||||
=item Panic( $string );
|
||||
|
||||
This method will output a panic error message and then die with a stack
|
||||
trace if the current debug level permits it, otherwise does nothing. This
|
||||
message will be tagged with the PNC string in the logs.
|
||||
|
||||
=back
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
The :constants tag will export the debug constants which define the various levels of debug
|
||||
The :variables tag will export variables containing the current debug id and level
|
||||
The :functions tag will export the debug functions. This or :all is what you would normally use.
|
||||
The :all tag will export all above symbols.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Carp
|
||||
Sys::Syslog
|
||||
|
||||
The ZoneMinder README file Troubleshooting section for an extended
|
||||
discussion on the use and configuration of syslog with ZoneMinder.
|
||||
|
||||
http://www.zoneminder.com
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,201 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Mapped Memory Access Module, $Date: 2008-02-25 10:13:13 +0000 (Mon, 25 Feb 2008) $, $Revision: 2323 $
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the definitions and functions used when accessing mapped memory
|
||||
#
|
||||
package ZoneMinder::Memory::Mapped;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require Exporter;
|
||||
require ZoneMinder::Base;
|
||||
|
||||
our @ISA = qw(Exporter ZoneMinder::Base);
|
||||
|
||||
# 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(
|
||||
zmMemKey
|
||||
zmMemAttach
|
||||
zmMemDetach
|
||||
zmMemGet
|
||||
zmMemPut
|
||||
zmMemClean
|
||||
) ],
|
||||
);
|
||||
push( @{$EXPORT_TAGS{all}}, @{$EXPORT_TAGS{$_}} ) foreach keys %EXPORT_TAGS;
|
||||
|
||||
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
||||
|
||||
our @EXPORT = @EXPORT_OK;
|
||||
|
||||
our $VERSION = $ZoneMinder::Base::VERSION;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Mapped Memory Facilities
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Config qw(:all);
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
|
||||
use Sys::Mmap;
|
||||
|
||||
sub zmMemKey
|
||||
{
|
||||
my $monitor = shift;
|
||||
return( defined($monitor->{MMapAddr})?$monitor->{MMapAddr}:undef );
|
||||
}
|
||||
|
||||
sub zmMemAttach
|
||||
{
|
||||
my ( $monitor, $size ) = @_;
|
||||
if ( ! $size ) {
|
||||
Error( "No size passed to zmMemAttach for monitor $$monitor{Id}\n" );
|
||||
return( undef );
|
||||
}
|
||||
if ( !defined($monitor->{MMapAddr}) )
|
||||
{
|
||||
|
||||
my $mmap_file = $Config{ZM_PATH_MAP}."/zm.mmap.".$monitor->{Id};
|
||||
if ( ! -e $mmap_file ) {
|
||||
Error( sprintf( "Memory map file '%s' does not exist. zmc might not be running."
|
||||
, $mmap_file
|
||||
)
|
||||
);
|
||||
return ( undef );
|
||||
}
|
||||
|
||||
my $mmap_file_size = -s $mmap_file;
|
||||
|
||||
if ( $mmap_file_size < $size ) {
|
||||
Error( sprintf( "Memory map file '%s' should have been %d but was instead %d"
|
||||
, $mmap_file
|
||||
, $size
|
||||
, $mmap_file_size
|
||||
)
|
||||
);
|
||||
return ( undef );
|
||||
}
|
||||
if ( !open( MMAP, "+<", $mmap_file ) )
|
||||
{
|
||||
Error( sprintf( "Can't open memory map file '%s': $!\n", $mmap_file ) );
|
||||
return( undef );
|
||||
}
|
||||
my $mmap = undef;
|
||||
my $mmap_addr = mmap( $mmap, $size, PROT_READ|PROT_WRITE, MAP_SHARED, \*MMAP );
|
||||
if ( !$mmap_addr || !$mmap )
|
||||
{
|
||||
Error( sprintf( "Can't mmap to file '%s': $!\n", $mmap_file ) );
|
||||
close( MMAP );
|
||||
return( undef );
|
||||
}
|
||||
$monitor->{MMapHandle} = \*MMAP;
|
||||
$monitor->{MMapAddr} = $mmap_addr;
|
||||
$monitor->{MMap} = \$mmap;
|
||||
}
|
||||
return( !undef );
|
||||
}
|
||||
|
||||
sub zmMemDetach
|
||||
{
|
||||
my $monitor = shift;
|
||||
|
||||
if ( $monitor->{MMap} )
|
||||
{
|
||||
if ( ! munmap( ${$monitor->{MMap}} ) ) {
|
||||
Warn( "Unable to munmap for monitor $$monitor{Id}\n");
|
||||
}
|
||||
delete $monitor->{MMap};
|
||||
}
|
||||
if ( $monitor->{MMapAddr} )
|
||||
{
|
||||
delete $monitor->{MMapAddr};
|
||||
}
|
||||
if ( $monitor->{MMapHandle} )
|
||||
{
|
||||
close( $monitor->{MMapHandle} );
|
||||
delete $monitor->{MMapHandle};
|
||||
}
|
||||
}
|
||||
|
||||
sub zmMemGet
|
||||
{
|
||||
my $monitor = shift;
|
||||
my $offset = shift;
|
||||
my $size = shift;
|
||||
|
||||
my $mmap = $monitor->{MMap};
|
||||
if ( !$mmap || !$$mmap )
|
||||
{
|
||||
Error( sprintf( "Can't read from mapped memory for monitor '%d', gone away?"
|
||||
, $monitor->{Id}
|
||||
)
|
||||
);
|
||||
return( undef );
|
||||
}
|
||||
my $data = substr( $$mmap, $offset, $size );
|
||||
return( $data );
|
||||
}
|
||||
|
||||
sub zmMemPut
|
||||
{
|
||||
my $monitor = shift;
|
||||
my $offset = shift;
|
||||
my $size = shift;
|
||||
my $data = shift;
|
||||
|
||||
my $mmap = $monitor->{MMap};
|
||||
if ( !$mmap || !$$mmap )
|
||||
{
|
||||
Error( sprintf( "Can't write mapped memory for monitor '%d', gone away?"
|
||||
, $monitor->{Id}
|
||||
)
|
||||
);
|
||||
return( undef );
|
||||
}
|
||||
substr( $$mmap, $offset, $size ) = $data;
|
||||
return( !undef );
|
||||
}
|
||||
|
||||
sub zmMemClean
|
||||
{
|
||||
Debug( "Removing memory map files\n" );
|
||||
my $mapPath = $Config{ZM_PATH_MAP}."/zm.mmap.*";
|
||||
foreach my $mapFile( glob( $mapPath ) )
|
||||
{
|
||||
( $mapFile ) = $mapFile =~ /^(.+)$/;
|
||||
Debug( "Removing memory map file '$mapFile'\n" );
|
||||
unlink( $mapFile );
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
|
@ -0,0 +1,179 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Shared Memory Access Module, $Date: 2007-08-29 19:11:09 +0100 (Wed, 29 Aug 2007) $, $Revision: 2175 $
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the common definitions and functions used by the rest
|
||||
# of the ZoneMinder scripts
|
||||
#
|
||||
package ZoneMinder::Memory::Shared;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require Exporter;
|
||||
require ZoneMinder::Base;
|
||||
|
||||
our @ISA = qw(Exporter ZoneMinder::Base);
|
||||
|
||||
eval 'sub IPC_CREAT {0001000}' unless defined &IPC_CREAT;
|
||||
|
||||
# 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(
|
||||
zmMemKey
|
||||
zmMemAttach
|
||||
zmMemDetach
|
||||
zmMemGet
|
||||
zmMemPut
|
||||
zmMemClean
|
||||
) ],
|
||||
);
|
||||
push( @{$EXPORT_TAGS{all}}, @{$EXPORT_TAGS{$_}} ) foreach keys %EXPORT_TAGS;
|
||||
|
||||
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
||||
|
||||
our @EXPORT = @EXPORT_OK;
|
||||
|
||||
our $VERSION = $ZoneMinder::Base::VERSION;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Shared Memory Facilities
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Config qw(:all);
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
|
||||
sub zmMemKey
|
||||
{
|
||||
my $monitor = shift;
|
||||
return( defined($monitor->{ShmKey})?$monitor->{ShmKey}:undef );
|
||||
}
|
||||
|
||||
sub zmMemAttach
|
||||
{
|
||||
my $monitor = shift;
|
||||
my $size = shift;
|
||||
if ( !defined($monitor->{ShmId}) )
|
||||
{
|
||||
my $shm_key = (hex($Config{ZM_SHM_KEY})&0xffff0000)|$monitor->{Id};
|
||||
my $shm_id = shmget( $shm_key, $size, &IPC_CREAT | 0777 );
|
||||
if ( !defined($shm_id) )
|
||||
{
|
||||
Error( sprintf( "Can't get shared memory id '%x', %d: $!\n"
|
||||
, $shm_key
|
||||
, $monitor->{Id}
|
||||
)
|
||||
);
|
||||
return( undef );
|
||||
}
|
||||
$monitor->{ShmKey} = $shm_key;
|
||||
$monitor->{ShmId} = $shm_id;
|
||||
}
|
||||
return( !undef );
|
||||
}
|
||||
|
||||
sub zmMemDetach
|
||||
{
|
||||
my $monitor = shift;
|
||||
|
||||
delete $monitor->{ShmId};
|
||||
}
|
||||
|
||||
sub zmMemGet
|
||||
{
|
||||
my $monitor = shift;
|
||||
my $offset = shift;
|
||||
my $size = shift;
|
||||
|
||||
my $shm_key = $monitor->{ShmKey};
|
||||
my $shm_id = $monitor->{ShmId};
|
||||
|
||||
my $data;
|
||||
if ( !shmread( $shm_id, $data, $offset, $size ) )
|
||||
{
|
||||
Error( sprintf( "Can't read from shared memory '%x/%d': $!"
|
||||
, $shm_key
|
||||
, $shm_id
|
||||
)
|
||||
);
|
||||
return( undef );
|
||||
}
|
||||
return( $data );
|
||||
}
|
||||
|
||||
sub zmMemPut
|
||||
{
|
||||
my $monitor = shift;
|
||||
my $offset = shift;
|
||||
my $size = shift;
|
||||
my $data = shift;
|
||||
|
||||
my $shm_key = $monitor->{ShmKey};
|
||||
my $shm_id = $monitor->{ShmId};
|
||||
|
||||
if ( !shmwrite( $shm_id, $data, $offset, $size ) )
|
||||
{
|
||||
Error( sprintf( "Can't write to shared memory '%x/%d': $!"
|
||||
, $shm_key
|
||||
, $shm_id
|
||||
)
|
||||
);
|
||||
return( undef );
|
||||
}
|
||||
return( !undef );
|
||||
}
|
||||
|
||||
sub zmMemClean
|
||||
{
|
||||
Debug( "Removing shared memory\n" );
|
||||
# Find ZoneMinder shared memory
|
||||
my $command = "ipcs -m | grep '^"
|
||||
.substr( sprintf( "0x%x", hex($Config{ZM_SHM_KEY}) ), 0, -2 )
|
||||
."'"
|
||||
;
|
||||
Debug( "Checking for shared memory with '$command'\n" );
|
||||
open( my $CMD, '<', "$command |" )
|
||||
or Fatal( "Can't execute '$command': $!" );
|
||||
while( <$CMD> )
|
||||
{
|
||||
chomp;
|
||||
my ( $key, $id ) = split( /\s+/ );
|
||||
if ( $id =~ /^(\d+)/ )
|
||||
{
|
||||
$id = $1;
|
||||
$command = "ipcrm shm $id";
|
||||
Debug( "Removing shared memory with '$command'\n" );
|
||||
qx( $command );
|
||||
}
|
||||
}
|
||||
close( $CMD );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
|
@ -0,0 +1,166 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Trigger Channel Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the base class definition of the trigger channel
|
||||
# class tree
|
||||
#
|
||||
package ZoneMinder::Trigger::Channel;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
|
||||
our $VERSION = $ZoneMinder::Base::VERSION;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Database Access
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
|
||||
use Carp;
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $self = {};
|
||||
$self->{readable} = !undef;
|
||||
$self->{writeable} = !undef;
|
||||
$self->{selectable} = undef;
|
||||
$self->{state} = 'closed';
|
||||
bless( $self, $class );
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub clone
|
||||
{
|
||||
my $self = shift;
|
||||
my $clone = { %$self };
|
||||
bless $clone, ref $self;
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
my $class = ref($self) or croak( "Can't get class for non object $self" );
|
||||
croak( "Abstract base class method called for object of class $class" );
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
my $class = ref($self) or croak( "Can't get class for non object $self" );
|
||||
croak( "Abstract base class method called for object of class $class" );
|
||||
}
|
||||
|
||||
sub getState
|
||||
{
|
||||
my $self = shift;
|
||||
return( $self->{state} );
|
||||
}
|
||||
|
||||
sub isOpen
|
||||
{
|
||||
my $self = shift;
|
||||
return( $self->{state} eq "open" );
|
||||
}
|
||||
|
||||
sub isConnected
|
||||
{
|
||||
my $self = shift;
|
||||
return( $self->{state} eq "connected" );
|
||||
}
|
||||
|
||||
sub DESTROY
|
||||
{
|
||||
}
|
||||
|
||||
sub AUTOLOAD
|
||||
{
|
||||
my $self = shift;
|
||||
my $class = ref($self) || croak( "$self not object" );
|
||||
my $name = $AUTOLOAD;
|
||||
$name =~ s/.*://;
|
||||
if ( !exists($self->{$name}) )
|
||||
{
|
||||
croak( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
return( $self->{$name} );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,121 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Trigger Channel Handle Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the class definition of the simple file based trigger
|
||||
# channel class
|
||||
#
|
||||
package ZoneMinder::Trigger::Channel::File;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Trigger::Channel::Handle;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Trigger::Channel::Handle);
|
||||
|
||||
our $VERSION = $ZoneMinder::Base::VERSION;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Simple file based trigger channel
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
|
||||
use Carp;
|
||||
use Fcntl;
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my %params = @_;
|
||||
my $self = ZoneMinder::Trigger::Channel::Handle->new;
|
||||
$self->{path} = $params{path};
|
||||
bless( $self, $class );
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
local *sfh;
|
||||
#sysopen( *sfh, $conn->{path}, O_NONBLOCK|O_RDONLY ) or croak( "Can't sysopen: $!" );
|
||||
#open( *sfh, "<".$conn->{path} ) or croak( "Can't open: $!" );
|
||||
open( *sfh, "+<", $self->{path} ) or croak( "Can't open: $!" );
|
||||
$self->{state} = 'open';
|
||||
$self->{handle} = *sfh;
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,160 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Trigger Channel Handle Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the class definition of the handle based trigger channel
|
||||
# class
|
||||
#
|
||||
package ZoneMinder::Trigger::Channel::Handle;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Trigger::Channel;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Trigger::Channel);
|
||||
|
||||
our $VERSION = $ZoneMinder::Base::VERSION;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Base class for handle based trigger channels
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use POSIX;
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $port = shift;
|
||||
my $self = ZoneMinder::Trigger::Channel->new();
|
||||
$self->{handle} = undef;
|
||||
bless( $self, $class );
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub spawns
|
||||
{
|
||||
return( undef );
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
close( $self->{handle} );
|
||||
$self->{state} = 'closed';
|
||||
$self->{handle} = undef;
|
||||
}
|
||||
|
||||
sub read
|
||||
{
|
||||
my $self = shift;
|
||||
my $buffer;
|
||||
my $nbytes = sysread( $self->{handle}, $buffer, POSIX::BUFSIZ );
|
||||
if ( !$nbytes )
|
||||
{
|
||||
return( undef );
|
||||
}
|
||||
Debug( "Read '$buffer' ($nbytes bytes)\n" );
|
||||
return( $buffer );
|
||||
}
|
||||
|
||||
sub write
|
||||
{
|
||||
my $self = shift;
|
||||
my $buffer = shift;
|
||||
my $nbytes = syswrite( $self->{handle}, $buffer );
|
||||
if ( !defined( $nbytes) || $nbytes < length($buffer) )
|
||||
{
|
||||
Error( "Unable to write buffer '".$buffer
|
||||
.", expected "
|
||||
.length($buffer)
|
||||
." bytes, sent "
|
||||
.($nbytes?$nbytes:'undefined')
|
||||
.": $!\n"
|
||||
);
|
||||
return( undef );
|
||||
}
|
||||
Debug( "Wrote '$buffer' ($nbytes bytes)\n" );
|
||||
return( !undef );
|
||||
}
|
||||
|
||||
sub fileno
|
||||
{
|
||||
my $self = shift;
|
||||
return( defined($self->{handle})?fileno($self->{handle}):-1 );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Trigger::Channel::Handle - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Trigger::Channel::Handle;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,143 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Trigger Channel Handle Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the class definition of the tcp socket based trigger
|
||||
# channel class
|
||||
#
|
||||
package ZoneMinder::Trigger::Channel::Inet;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Trigger::Channel::Spawning;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Trigger::Channel::Spawning);
|
||||
|
||||
our $VERSION = $ZoneMinder::Base::VERSION;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Internet (TCP) based trigger channel
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
|
||||
use Carp;
|
||||
use Socket;
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my %params = @_;
|
||||
my $self = ZoneMinder::Trigger::Channel::Spawning->new();
|
||||
$self->{selectable} = !undef;
|
||||
$self->{port} = $params{port};
|
||||
bless( $self, $class );
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
local *sfh;
|
||||
my $saddr = sockaddr_in( $self->{port}, INADDR_ANY );
|
||||
socket( *sfh, PF_INET, SOCK_STREAM, getprotobyname('tcp') )
|
||||
or croak( "Can't open socket: $!" );
|
||||
setsockopt( *sfh, SOL_SOCKET, SO_REUSEADDR, 1 );
|
||||
bind( *sfh, $saddr ) or croak( "Can't bind: $!" );
|
||||
listen( *sfh, SOMAXCONN ) or croak( "Can't listen: $!" );
|
||||
$self->{state} = 'open';
|
||||
$self->{handle} = *sfh;
|
||||
}
|
||||
|
||||
sub _spawn
|
||||
{
|
||||
my $self = shift;
|
||||
my $new_handle = shift;
|
||||
my $clone = $self->clone();
|
||||
$clone->{handle} = $new_handle;
|
||||
$clone->{state} = 'connected';
|
||||
return( $clone );
|
||||
}
|
||||
|
||||
sub accept
|
||||
{
|
||||
my $self = shift;
|
||||
local *cfh;
|
||||
my $paddr = accept( *cfh, $self->{handle} );
|
||||
return( $self->_spawn( *cfh ) );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,172 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Trigger Channel Handle Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the class definition of the serial port trigger channel
|
||||
# class
|
||||
#
|
||||
package ZoneMinder::Trigger::Channel::Serial;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Trigger::Channel;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Trigger::Channel);
|
||||
|
||||
our $VERSION = $ZoneMinder::Base::VERSION;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Serial access trigger channel
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use Device::SerialPort;
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my %params = @_;
|
||||
my $self = ZoneMinder::Trigger::Channel->new;
|
||||
$self->{path} = $params{path};
|
||||
bless( $self, $class );
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
my $device = new Device::SerialPort( $self->{path} );
|
||||
if ( ! $device )
|
||||
{
|
||||
Error( "Unable to open $$self{path}: $!" );
|
||||
$self->{state} = 'closed';
|
||||
return;
|
||||
}
|
||||
$device->baudrate(9600);
|
||||
$device->databits(8);
|
||||
$device->parity('none');
|
||||
$device->stopbits(1);
|
||||
$device->handshake('none');
|
||||
|
||||
$device->read_const_time(50);
|
||||
$device->read_char_time(10);
|
||||
|
||||
$self->{device} = $device;
|
||||
$self->{state} = 'open';
|
||||
$self->{state} = 'connected';
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{device}->close();
|
||||
$self->{state} = 'closed';
|
||||
}
|
||||
|
||||
sub read
|
||||
{
|
||||
my $self = shift;
|
||||
my $buffer = $self->{device}->lookfor();
|
||||
if ( !$buffer || !length($buffer) )
|
||||
{
|
||||
return( undef );
|
||||
}
|
||||
Debug( "Read '$buffer' (".length($buffer)." bytes)\n" );
|
||||
return( $buffer );
|
||||
}
|
||||
|
||||
sub write
|
||||
{
|
||||
my $self = shift;
|
||||
my $buffer = shift;
|
||||
my $nbytes = $self->{device}->write( $buffer );
|
||||
$self->{device}->write_drain();
|
||||
if ( !defined( $nbytes) || $nbytes < length($buffer) )
|
||||
{
|
||||
Error( "Unable to write buffer '".$buffer
|
||||
.", expected "
|
||||
.length($buffer)
|
||||
." bytes, sent "
|
||||
.$nbytes
|
||||
.": $!\n"
|
||||
);
|
||||
return( undef );
|
||||
}
|
||||
Debug( "Wrote '$buffer' ($nbytes bytes)\n" );
|
||||
return( !undef );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,112 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Trigger Channel Handle Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the class definition of the handle based trigger channel
|
||||
# classes that spawn new connections when connected.
|
||||
#
|
||||
package ZoneMinder::Trigger::Channel::Spawning;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Trigger::Channel::Handle;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Trigger::Channel::Handle);
|
||||
|
||||
our $VERSION = $ZoneMinder::Base::VERSION;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Base class for handle based triggers that spawn new connections
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $port = shift;
|
||||
my $self = ZoneMinder::Trigger::Channel::Handle->new();
|
||||
$self->{spawns} = !undef;
|
||||
bless( $self, $class );
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub spawns
|
||||
{
|
||||
return( !undef );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,141 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Trigger Channel Handle Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the class definition of the unix socket based trigger
|
||||
# channel class
|
||||
#
|
||||
package ZoneMinder::Trigger::Channel::Unix;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Trigger::Channel::Spawning;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Trigger::Channel::Spawning);
|
||||
|
||||
our $VERSION = $ZoneMinder::Base::VERSION;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Unix socket based trigger channel
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
|
||||
use Carp;
|
||||
use Socket;
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my %params = @_;
|
||||
my $self = ZoneMinder::Trigger::Channel->new;
|
||||
$self->{selectable} = !undef;
|
||||
$self->{path} = $params{path};
|
||||
bless( $self, $class );
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
local *sfh;
|
||||
unlink( $self->{path} );
|
||||
my $saddr = sockaddr_un( $self->{path} );
|
||||
socket( *sfh, PF_UNIX, SOCK_STREAM, 0 ) or croak( "Can't open socket: $!" );
|
||||
bind( *sfh, $saddr ) or croak( "Can't bind: $!" );
|
||||
listen( *sfh, SOMAXCONN ) or croak( "Can't listen: $!" );
|
||||
$self->{handle} = *sfh;
|
||||
}
|
||||
|
||||
sub _spawn
|
||||
{
|
||||
my $self = shift;
|
||||
my $new_handle = shift;
|
||||
my $clone = $self->clone();
|
||||
$clone->{handle} = $new_handle;
|
||||
$clone->{state} = 'connected';
|
||||
return( $clone );
|
||||
}
|
||||
|
||||
sub accept
|
||||
{
|
||||
my $self = shift;
|
||||
local *cfh;
|
||||
my $paddr = accept( *cfh, $self->{handle} );
|
||||
return( $self->_spawn( *cfh ) );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,245 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Trigger Connection Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the base class definition of the trigger connection
|
||||
# class tree
|
||||
#
|
||||
package ZoneMinder::Trigger::Connection;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
|
||||
our $VERSION = $ZoneMinder::Base::VERSION;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Base connection class
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
|
||||
use Carp;
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my %params = @_;
|
||||
my $self = {};
|
||||
$self->{name} = $params{name};
|
||||
$self->{channel} = $params{channel};
|
||||
$self->{input} = $params{mode} =~ /r/i;
|
||||
$self->{output} = $params{mode} =~ /w/i;
|
||||
bless( $self, $class );
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub clone
|
||||
{
|
||||
my $self = shift;
|
||||
my $clone = { %$self };
|
||||
bless $clone, ref $self;
|
||||
return( $clone );
|
||||
}
|
||||
|
||||
sub spawns
|
||||
{
|
||||
my $self = shift;
|
||||
return( $self->{channel}->spawns() );
|
||||
}
|
||||
|
||||
sub _spawn
|
||||
{
|
||||
my $self = shift;
|
||||
my $new_channel = shift;
|
||||
my $clone = $self->clone();
|
||||
$clone->{channel} = $new_channel;
|
||||
return( $clone );
|
||||
}
|
||||
|
||||
sub accept
|
||||
{
|
||||
my $self = shift;
|
||||
my $new_channel = $self->{channel}->accept();
|
||||
return( $self->_spawn( $new_channel ) );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
return( $self->{channel}->open() );
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
return( $self->{channel}->close() );
|
||||
}
|
||||
|
||||
sub fileno
|
||||
{
|
||||
my $self = shift;
|
||||
return( $self->{channel}->fileno() );
|
||||
}
|
||||
|
||||
sub isOpen
|
||||
{
|
||||
my $self = shift;
|
||||
return( $self->{channel}->isOpen() );
|
||||
}
|
||||
|
||||
sub isConnected
|
||||
{
|
||||
my $self = shift;
|
||||
return( $self->{channel}->isConnected() );
|
||||
}
|
||||
|
||||
sub canRead
|
||||
{
|
||||
my $self = shift;
|
||||
return( $self->{input} && $self->isConnected() );
|
||||
}
|
||||
|
||||
sub canWrite
|
||||
{
|
||||
my $self = shift;
|
||||
return( $self->{output} && $self->isConnected() );
|
||||
}
|
||||
|
||||
sub getMessages
|
||||
{
|
||||
my $self = shift;
|
||||
my $buffer = $self->{channel}->read();
|
||||
|
||||
return( undef ) if ( !defined($buffer) );
|
||||
|
||||
my @messages = split( /\r?\n/, $buffer );
|
||||
return( \@messages );
|
||||
}
|
||||
|
||||
sub putMessages
|
||||
{
|
||||
my $self = shift;
|
||||
my $messages = shift;
|
||||
|
||||
if ( @$messages )
|
||||
{
|
||||
my $buffer = join( "\n", @$messages );
|
||||
$buffer .= "\n";
|
||||
if ( !$self->{channel}->write( $buffer ) )
|
||||
{
|
||||
Error( "Unable to write buffer '".$buffer
|
||||
." to connection "
|
||||
.$self->{name}
|
||||
." ("
|
||||
.$self->fileno()
|
||||
.")\n"
|
||||
);
|
||||
}
|
||||
}
|
||||
return( undef );
|
||||
}
|
||||
|
||||
sub timedActions
|
||||
{
|
||||
}
|
||||
|
||||
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} );
|
||||
}
|
||||
elsif ( defined($self->{channel}) )
|
||||
{
|
||||
if ( exists($self->{channel}->{$name}) )
|
||||
{
|
||||
return( $self->{channel}->{$name} );
|
||||
}
|
||||
}
|
||||
croak( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,134 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Trigger Channel Handle Module, $Date$, $Revision$
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU General Public License
|
||||
# as published by the Free Software Foundation; either version 2
|
||||
# of the License, or (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains an example overriden trigger connection class
|
||||
#
|
||||
package ZoneMinder::Trigger::Connection::Example;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Trigger::Connection;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Trigger::Connection);
|
||||
|
||||
our $VERSION = $ZoneMinder::Base::VERSION;
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Example overridden connection class
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $path = shift;
|
||||
my $self = ZoneMinder::Trigger::Connection->new( @_ );
|
||||
bless( $self, $class );
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub getMessages
|
||||
{
|
||||
my $self = shift;
|
||||
my $buffer = $self->{channel}->read();
|
||||
|
||||
return( undef ) if ( !defined($buffer) );
|
||||
|
||||
Debug( "Handling buffer '$buffer'\n" );
|
||||
my @messages = grep { s/-/|/g; 1; } split( /\r?\n/, $buffer );
|
||||
return( \@messages );
|
||||
}
|
||||
|
||||
sub putMessages
|
||||
{
|
||||
my $self = shift;
|
||||
my $messages = shift;
|
||||
|
||||
if ( @$messages )
|
||||
{
|
||||
my $buffer = join( "\n", grep{ s/\|/-/; 1; } @$messages );
|
||||
$buffer .= "\n";
|
||||
if ( !$self->{channel}->write( $buffer ) )
|
||||
{
|
||||
Error( "Unable to write buffer '".$buffer." to connection ".$self->{name}." (".$self->fileno().")\n" );
|
||||
}
|
||||
}
|
||||
return( undef );
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for blah blah blah
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
blah blah blah
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for ZoneMinder, created by h2xs. It looks like the
|
||||
author of the extension was negligent enough to leave the stub
|
||||
unedited.
|
||||
|
||||
Blah blah blah.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Mention other useful documentation such as the documentation of
|
||||
related modules or operating system documentation (such as man pages
|
||||
in UNIX), or any relevant external documentation such as RFCs or
|
||||
standards.
|
||||
|
||||
If you have a mailing list set up for your module, mention it here.
|
||||
|
||||
If you have a web site set up for your module, mention it here.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
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.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
[type: gettext/rfc822deb] zoneminder-core.templates
|
||||
[type: gettext/rfc822deb] zoneminder-database.templates
|
||||
[type: gettext/rfc822deb] zoneminder-ui-base.templates
|
||||
|
|
@ -0,0 +1,252 @@
|
|||
# debconf french translation file for ZoneMinder.
|
||||
# Copyright (C) 2001-2008 Philip Coombes
|
||||
# This file is distributed under the same license as the zoneminder package.
|
||||
# First author: Emmanuel Papin <manupap01@gmail.com>, 2014.
|
||||
#
|
||||
msgid ""
|
||||
msgstr ""
|
||||
"Project-Id-Version: zoneminder\n"
|
||||
"Report-Msgid-Bugs-To: zoneminder@packages.debian.org\n"
|
||||
"POT-Creation-Date: 2014-12-16 12:34+0100\n"
|
||||
"PO-Revision-Date: 2014-12-07 00:40+0100\n"
|
||||
"Last-Translator: Emmanuel Papin <manupap01@gmail.com>\n"
|
||||
"Language-Team: French <debian-l10n-french@lists.debian.org>\n"
|
||||
"Language: fr\n"
|
||||
"MIME-Version: 1.0\n"
|
||||
"Content-Type: text/plain; charset=UTF-8\n"
|
||||
"Content-Transfer-Encoding: 8bit\n"
|
||||
|
||||
#. Type: boolean
|
||||
#. Description
|
||||
#: ../zoneminder-core.templates:1001
|
||||
msgid "Delete this non empty directory?"
|
||||
msgstr "Supprimer ce répertoire non vide ?"
|
||||
|
||||
#. Type: boolean
|
||||
#. Description
|
||||
#: ../zoneminder-core.templates:1001
|
||||
msgid ""
|
||||
"A purge of the ZoneMinder package is performed but the directory '/var/cache/"
|
||||
"zoneminder' is not empty so it will not be deleted."
|
||||
msgstr ""
|
||||
"Une purge du paquet ZoneMinder est en cours mais le répertoire '/var/cache/"
|
||||
"zoneminder' n'est pas vide et sera donc conservé."
|
||||
|
||||
#. Type: boolean
|
||||
#. Description
|
||||
#: ../zoneminder-core.templates:1001
|
||||
msgid ""
|
||||
"Please consider that this directory is designed to contain data resulting "
|
||||
"from event detection. Therefore, \"proof of evidence\" could be lost!\""
|
||||
msgstr ""
|
||||
"Veuillez considérer que ce répertoire est conçu pour contenir des données "
|
||||
"résultants de la détection d'événements. Par conséquent, des preuves "
|
||||
"pourraient être perdues !"
|
||||
|
||||
#. Type: boolean
|
||||
#. Description
|
||||
#: ../zoneminder-core.templates:1001
|
||||
msgid ""
|
||||
"If you are not sure of your decision, please do not delete this directory "
|
||||
"but perform a manual checkup."
|
||||
msgstr ""
|
||||
"Si vous n'êtes pas sûr de votre décision, veuillez conserver ce répertoire "
|
||||
"et effectuer une vérification manuelle."
|
||||
|
||||
#. Type: boolean
|
||||
#. Description
|
||||
#: ../zoneminder-core.templates:2001
|
||||
msgid "Deletion confirmed?"
|
||||
msgstr "Supression confirmée ?"
|
||||
|
||||
#. Type: boolean
|
||||
#. Description
|
||||
#: ../zoneminder-core.templates:2001
|
||||
msgid ""
|
||||
"You have allowed the deletion of directory '/var/cache/zoneminder' although "
|
||||
"it may contain critical data."
|
||||
msgstr ""
|
||||
"Vous avez autorisé la suppression du répertoire '/var/cache/zoneminder' bien "
|
||||
"qu'il puisse contenir des données critiques."
|
||||
|
||||
#. Type: select
|
||||
#. Choices
|
||||
#: ../zoneminder-database.templates:1001
|
||||
msgid "local"
|
||||
msgstr "local"
|
||||
|
||||
#. Type: select
|
||||
#. Choices
|
||||
#: ../zoneminder-database.templates:1001
|
||||
msgid "remote"
|
||||
msgstr "distant"
|
||||
|
||||
#. Type: select
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:1002
|
||||
msgid "Database location:"
|
||||
msgstr "Emplacement de la base de donnée :"
|
||||
|
||||
#. Type: select
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:1002
|
||||
msgid ""
|
||||
"A database server is required to run ZoneMinder. The database can be "
|
||||
"installed either locally or remotely on a machine of your network."
|
||||
msgstr ""
|
||||
"Un serveur de base de données est requis pour ZoneMinder. La base de donnée "
|
||||
"peut être installée localement ou à distance sur une machine de votre réseau."
|
||||
|
||||
#. Type: select
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:1002
|
||||
msgid ""
|
||||
"If you choose a remote location, you will have to select the 'tcp/ip' "
|
||||
"connection method and enter the hostname or ip address of the remote machine "
|
||||
"in the next configuration screens."
|
||||
msgstr ""
|
||||
"Si vous choisissez un emplacement distant, vous devrez sélectionner la "
|
||||
"méthode de connexion 'tcp/ip' et entrer le nom réseau ou l'adresse ip de la "
|
||||
"machine distante dans les écrans de configuration suivants."
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:2001
|
||||
msgid "No local database server is available:"
|
||||
msgstr "Aucun serveur local de base de données n'est disponible :"
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:2001
|
||||
msgid ""
|
||||
"Currently ZoneMinder supports mysql or mariadb database server but none of "
|
||||
"them appears to be installed on this machine."
|
||||
msgstr ""
|
||||
"Actuellement ZoneMinder supporte les serveurs de base de données mysql et "
|
||||
"mariadb mais aucun d'entre eux n'est installé sur cette machine."
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:2001
|
||||
msgid ""
|
||||
"In order to complete ZoneMinder's installation, after ending of this "
|
||||
"assistant, please install a compatible database server and then restart the "
|
||||
"assistant by invoking:"
|
||||
msgstr ""
|
||||
"Afin de compléter l'installation de ZoneMinder, après la fermeture de cet "
|
||||
"assitant, veuillez installer un serveur de base de données compatible et "
|
||||
"ensuite redémarrez l'assistant en invoquant :"
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:2001 ../zoneminder-database.templates:3001
|
||||
msgid "$ sudo dpkg-reconfigure zoneminder"
|
||||
msgstr "$ sudo dpkg-reconfigure zoneminder"
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:3001
|
||||
msgid "Remote database servers are not allowed:"
|
||||
msgstr "Les serveurs de base de données distants ne sont pas autorisés :"
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:3001
|
||||
msgid ""
|
||||
"The current configuration of dbconfig-common does not allow installation of "
|
||||
"a database on remote servers."
|
||||
msgstr ""
|
||||
"La configuration actuelle de dbconfig-common ne permet pas l'installation de "
|
||||
"bases de données sur des serveurs distants."
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:3001
|
||||
msgid ""
|
||||
"In order to reconfigure dbconfig-common, please invoke the following command "
|
||||
"after ending of this assistant:"
|
||||
msgstr ""
|
||||
"Afin de reconfigurer dbconfig-common, veuillez invoquer la commande suivante "
|
||||
"après la fermeture de cet assitant :"
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:3001
|
||||
msgid "$ sudo dpkg-reconfigure dbconfig-common"
|
||||
msgstr "$ sudo dpkg-reconfigure dbconfig-common"
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:3001
|
||||
msgid ""
|
||||
"Then, to complete ZoneMinder's installation, please restart this assistant "
|
||||
"by invoking:"
|
||||
msgstr ""
|
||||
"Ensuite, pour compléter l'installation de ZoneMinder, veuillez redémarrer "
|
||||
"cet assistant en invoquant :"
|
||||
|
||||
#. Type: password
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:4001
|
||||
msgid "New password for the ZoneMinder 'admin' user:"
|
||||
msgstr "Nouveau mot de passe pour le compte 'admin' de ZoneMinder :"
|
||||
|
||||
#. Type: password
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:4001
|
||||
msgid "Please enter the password of the default administrative user."
|
||||
msgstr "Veuillez entrer le mot de passe du compte administrateur par défaut."
|
||||
|
||||
#. Type: password
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:4001
|
||||
msgid ""
|
||||
"While not mandatory, it is highly recommended that you set a custom password "
|
||||
"for the administrative 'admin' user."
|
||||
msgstr ""
|
||||
"Bien que cela ne soit pas obligatoire, il est fortement recommandé de "
|
||||
"fournir un mot de passe personnalisé pour le compte administrateur 'admin'."
|
||||
|
||||
#. Type: password
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:4001
|
||||
msgid "If this field is left blank, the password will not be changed."
|
||||
msgstr "Si le champ est laissé vide, le mot de passe ne sera pas changé."
|
||||
|
||||
#. Type: password
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:5001
|
||||
msgid "Repeat password for the ZoneMinder 'admin' user:"
|
||||
msgstr "Répéter le mot de passe pour le compte 'admin' de ZoneMinder :"
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:6001
|
||||
msgid "Password input error"
|
||||
msgstr "Erreur de mot de passe"
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:6001
|
||||
msgid "The two passwords you entered were not the same. Please try again."
|
||||
msgstr ""
|
||||
"Les deux mots de passe saisis ne sont pas les mêmes. Veuillez essayer à "
|
||||
"nouveau."
|
||||
|
||||
#. Type: multiselect
|
||||
#. Description
|
||||
#: ../zoneminder-ui-base.templates:1001
|
||||
msgid "Web server to reconfigure automatically:"
|
||||
msgstr "Serveur web à reconfigurer automatiquement :"
|
||||
|
||||
#. Type: multiselect
|
||||
#. Description
|
||||
#: ../zoneminder-ui-base.templates:1001
|
||||
msgid ""
|
||||
"Please choose the web server that should be automatically configured for "
|
||||
"ZoneMinder's web portal access."
|
||||
msgstr ""
|
||||
"Veuillez choisir le serveur web à reconfigurer automatiquement pour l'accès "
|
||||
"au portail web de ZoneMinder."
|
||||
|
|
@ -0,0 +1,222 @@
|
|||
# SOME DESCRIPTIVE TITLE.
|
||||
# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER
|
||||
# This file is distributed under the same license as the PACKAGE package.
|
||||
# FIRST AUTHOR <EMAIL@ADDRESS>, YEAR.
|
||||
#
|
||||
#, fuzzy
|
||||
msgid ""
|
||||
msgstr ""
|
||||
"Project-Id-Version: zoneminder\n"
|
||||
"Report-Msgid-Bugs-To: zoneminder@packages.debian.org\n"
|
||||
"POT-Creation-Date: 2014-12-16 12:34+0100\n"
|
||||
"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
|
||||
"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
|
||||
"Language-Team: LANGUAGE <LL@li.org>\n"
|
||||
"Language: \n"
|
||||
"MIME-Version: 1.0\n"
|
||||
"Content-Type: text/plain; charset=CHARSET\n"
|
||||
"Content-Transfer-Encoding: 8bit\n"
|
||||
|
||||
#. Type: boolean
|
||||
#. Description
|
||||
#: ../zoneminder-core.templates:1001
|
||||
msgid "Delete this non empty directory?"
|
||||
msgstr ""
|
||||
|
||||
#. Type: boolean
|
||||
#. Description
|
||||
#: ../zoneminder-core.templates:1001
|
||||
msgid ""
|
||||
"A purge of the ZoneMinder package is performed but the directory '/var/cache/"
|
||||
"zoneminder' is not empty so it will not be deleted."
|
||||
msgstr ""
|
||||
|
||||
#. Type: boolean
|
||||
#. Description
|
||||
#: ../zoneminder-core.templates:1001
|
||||
msgid ""
|
||||
"Please consider that this directory is designed to contain data resulting "
|
||||
"from event detection. Therefore, \"proof of evidence\" could be lost!\""
|
||||
msgstr ""
|
||||
|
||||
#. Type: boolean
|
||||
#. Description
|
||||
#: ../zoneminder-core.templates:1001
|
||||
msgid ""
|
||||
"If you are not sure of your decision, please do not delete this directory "
|
||||
"but perform a manual checkup."
|
||||
msgstr ""
|
||||
|
||||
#. Type: boolean
|
||||
#. Description
|
||||
#: ../zoneminder-core.templates:2001
|
||||
msgid "Deletion confirmed?"
|
||||
msgstr ""
|
||||
|
||||
#. Type: boolean
|
||||
#. Description
|
||||
#: ../zoneminder-core.templates:2001
|
||||
msgid ""
|
||||
"You have allowed the deletion of directory '/var/cache/zoneminder' although "
|
||||
"it may contain critical data."
|
||||
msgstr ""
|
||||
|
||||
#. Type: select
|
||||
#. Choices
|
||||
#: ../zoneminder-database.templates:1001
|
||||
msgid "local"
|
||||
msgstr ""
|
||||
|
||||
#. Type: select
|
||||
#. Choices
|
||||
#: ../zoneminder-database.templates:1001
|
||||
msgid "remote"
|
||||
msgstr ""
|
||||
|
||||
#. Type: select
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:1002
|
||||
msgid "Database location:"
|
||||
msgstr ""
|
||||
|
||||
#. Type: select
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:1002
|
||||
msgid ""
|
||||
"A database server is required to run ZoneMinder. The database can be "
|
||||
"installed either locally or remotely on a machine of your network."
|
||||
msgstr ""
|
||||
|
||||
#. Type: select
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:1002
|
||||
msgid ""
|
||||
"If you choose a remote location, you will have to select the 'tcp/ip' "
|
||||
"connection method and enter the hostname or ip address of the remote machine "
|
||||
"in the next configuration screens."
|
||||
msgstr ""
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:2001
|
||||
msgid "No local database server is available:"
|
||||
msgstr ""
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:2001
|
||||
msgid ""
|
||||
"Currently ZoneMinder supports mysql or mariadb database server but none of "
|
||||
"them appears to be installed on this machine."
|
||||
msgstr ""
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:2001
|
||||
msgid ""
|
||||
"In order to complete ZoneMinder's installation, after ending of this "
|
||||
"assistant, please install a compatible database server and then restart the "
|
||||
"assistant by invoking:"
|
||||
msgstr ""
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:2001 ../zoneminder-database.templates:3001
|
||||
msgid "$ sudo dpkg-reconfigure zoneminder"
|
||||
msgstr ""
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:3001
|
||||
msgid "Remote database servers are not allowed:"
|
||||
msgstr ""
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:3001
|
||||
msgid ""
|
||||
"The current configuration of dbconfig-common does not allow installation of "
|
||||
"a database on remote servers."
|
||||
msgstr ""
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:3001
|
||||
msgid ""
|
||||
"In order to reconfigure dbconfig-common, please invoke the following command "
|
||||
"after ending of this assistant:"
|
||||
msgstr ""
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:3001
|
||||
msgid "$ sudo dpkg-reconfigure dbconfig-common"
|
||||
msgstr ""
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:3001
|
||||
msgid ""
|
||||
"Then, to complete ZoneMinder's installation, please restart this assistant "
|
||||
"by invoking:"
|
||||
msgstr ""
|
||||
|
||||
#. Type: password
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:4001
|
||||
msgid "New password for the ZoneMinder 'admin' user:"
|
||||
msgstr ""
|
||||
|
||||
#. Type: password
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:4001
|
||||
msgid "Please enter the password of the default administrative user."
|
||||
msgstr ""
|
||||
|
||||
#. Type: password
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:4001
|
||||
msgid ""
|
||||
"While not mandatory, it is highly recommended that you set a custom password "
|
||||
"for the administrative 'admin' user."
|
||||
msgstr ""
|
||||
|
||||
#. Type: password
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:4001
|
||||
msgid "If this field is left blank, the password will not be changed."
|
||||
msgstr ""
|
||||
|
||||
#. Type: password
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:5001
|
||||
msgid "Repeat password for the ZoneMinder 'admin' user:"
|
||||
msgstr ""
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:6001
|
||||
msgid "Password input error"
|
||||
msgstr ""
|
||||
|
||||
#. Type: error
|
||||
#. Description
|
||||
#: ../zoneminder-database.templates:6001
|
||||
msgid "The two passwords you entered were not the same. Please try again."
|
||||
msgstr ""
|
||||
|
||||
#. Type: multiselect
|
||||
#. Description
|
||||
#: ../zoneminder-ui-base.templates:1001
|
||||
msgid "Web server to reconfigure automatically:"
|
||||
msgstr ""
|
||||
|
||||
#. Type: multiselect
|
||||
#. Description
|
||||
#: ../zoneminder-ui-base.templates:1001
|
||||
msgid ""
|
||||
"Please choose the web server that should be automatically configured for "
|
||||
"ZoneMinder's web portal access."
|
||||
msgstr ""
|
||||
|
|
@ -0,0 +1,164 @@
|
|||
#!/usr/bin/make -f
|
||||
# -*- makefile -*-
|
||||
# Sample debian/rules that uses debhelper.
|
||||
# This file was originally written by Joey Hess and Craig Small.
|
||||
# As a special exception, when this file is copied by dh-make into a
|
||||
# dh-make output file, you may use that output file without restriction.
|
||||
# This special exception was added by Craig Small in version 0.37 of dh-make.
|
||||
|
||||
# Uncomment this to turn on verbose mode.
|
||||
#export DH_VERBOSE=1
|
||||
|
||||
# These are used for cross-compiling and for saving the configure script
|
||||
# from having to guess our platform (since we know it already)
|
||||
DEB_HOST_GNU_TYPE ?= $(shell dpkg-architecture -qDEB_HOST_GNU_TYPE)
|
||||
DEB_BUILD_GNU_TYPE ?= $(shell dpkg-architecture -qDEB_BUILD_GNU_TYPE)
|
||||
|
||||
CFLAGS = -Wall
|
||||
CPPFLAGS = -D__STDC_CONSTANT_MACROS
|
||||
CXXFLAGS = -DHAVE_LIBCRYPTO
|
||||
|
||||
ifneq (,$(findstring debug,$(DEB_BUILD_OPTIONS)))
|
||||
DEBOPT = --enable-debug
|
||||
CFLAGS += -g
|
||||
CXXFLAGS += -g
|
||||
else
|
||||
DEBOPT =
|
||||
endif
|
||||
|
||||
ifneq (,$(findstring noopt,$(DEB_BUILD_OPTIONS)))
|
||||
CFLAGS += -O0
|
||||
else
|
||||
CFLAGS += -O2
|
||||
endif
|
||||
|
||||
INSTDIR = debian/tmp
|
||||
|
||||
# These are used to get the most recent version of the original sources from github
|
||||
UURL = $(shell git config --get remote.origin.url)
|
||||
BRANCH = $(shell git rev-parse --abbrev-ref HEAD)
|
||||
HEAD = $(shell git rev-parse HEAD)
|
||||
PKD = $(abspath $(dir $(MAKEFILE_LIST)))
|
||||
PKG = $(word 2,$(shell dpkg-parsechangelog -l$(PKD)/changelog | grep ^Source))
|
||||
VER ?= $(shell dpkg-parsechangelog -l$(PKD)/changelog | perl -ne 'print $$1 if m{^Version:\s+(?:\d+:)?(\d.*)(?:\-|\+nmu\d+.*)};')
|
||||
DTYPE =
|
||||
TARBALL = ../$(PKG)_$(VER)$(DTYPE).orig.tar.xz
|
||||
|
||||
%:
|
||||
dh $@ --buildsystem=cmake --parallel
|
||||
|
||||
override_dh_auto_configure:
|
||||
CFLAGS="$(CFLAGS)" CXXFLAGS="$(CXXFLAGS)" dh_auto_configure -- \
|
||||
-DCMAKE_INSTALL_PREFIX=/usr \
|
||||
-DCMAKE_SKIP_RPATH=ON \
|
||||
-DCMAKE_VERBOSE_MAKEFILE=OFF \
|
||||
-DCMAKE_COLOR_MAKEFILE=ON \
|
||||
-DZM_RUNDIR=/var/run/zm \
|
||||
-DZM_SOCKDIR=/var/run/zm \
|
||||
-DZM_TMPDIR=/var/tmp/zm \
|
||||
-DZM_LOGDIR=/var/log/zm \
|
||||
-DZM_WEBDIR=/usr/share/zoneminder \
|
||||
-DZM_CONTENTDIR=/var/cache/zoneminder \
|
||||
-DZM_CGIDIR=/usr/lib/cgi-bin \
|
||||
-DZM_WEB_USER=www-data \
|
||||
-DZM_WEB_GROUP=www-data \
|
||||
-DCMAKE_INSTALL_SYSCONFDIR=etc/zm
|
||||
|
||||
override_dh_auto_test:
|
||||
# do not run tests...
|
||||
|
||||
|
||||
override_dh_clean:
|
||||
# Add here commands to clean up after the build process.
|
||||
[ ! -f Makefile ] || $(MAKE) distclean
|
||||
dh_clean src/zm_config_defines.h
|
||||
#
|
||||
# Delete remaining auto-generated Makefile if Makefile.in exists
|
||||
find $(CURDIR)/ -type f -name "Makefile" | while read file; do \
|
||||
[ -f $$file.in ] && rm -f $$file; \
|
||||
done || true
|
||||
#
|
||||
# Delete remaining auto-generated Makefile.in if Makefile.am exists
|
||||
find $(CURDIR)/ -type f -name "Makefile.in" | while read filein; do \
|
||||
fileam=`echo $$filein | sed 's/\(.*\)\.in/\1\.am/'`; \
|
||||
[ -f $$fileam ] && rm -f $$filein; \
|
||||
done || true
|
||||
|
||||
override_dh_install:
|
||||
dh_install --fail-missing
|
||||
#
|
||||
# NOTE: This is a short-term kludge; hopefully changes in the next
|
||||
# upstream version will render this unnecessary.
|
||||
rm -rf debian/zoneminder/usr/share/zoneminder/events
|
||||
rm -rf debian/zoneminder/usr/share/zoneminder/images
|
||||
rm -rf debian/zoneminder/usr/share/zoneminder/temp
|
||||
# The link stuff for these folders has been moved to
|
||||
# zoneminder-core.links file
|
||||
#
|
||||
# This is a slightly lesser kludge; moving the cgi stuff to
|
||||
# /usr/share/zoneminder/cgi-bin breaks one set of behavior,
|
||||
# having it just in /usr/lib/cgi-bin breaks another bit of
|
||||
# behavior.
|
||||
# The link stuff for /usr/share/zoneminder/cgi-bin has been moved to
|
||||
# zoneminder-ui-base.links file
|
||||
|
||||
override_dh_installinit:
|
||||
dh_installinit --package=zoneminder-core --name=zoneminder
|
||||
|
||||
override_dh_systemd_start:
|
||||
dh_systemd_start --package=zoneminder-core --name=zoneminder \
|
||||
--restart-after-upgrade
|
||||
|
||||
override_dh_systemd_enable:
|
||||
dh_systemd_enable --package=zoneminder-core --name=zoneminder
|
||||
|
||||
override_dh_fixperms:
|
||||
dh_fixperms
|
||||
#
|
||||
# As requested by the Debian Webapps Policy Manual §3.2.1
|
||||
chown root:www-data debian/zoneminder-core/etc/zm/zm.conf
|
||||
chmod 640 debian/zoneminder-core/etc/zm/zm.conf
|
||||
|
||||
.PHONY: override_dh_strip
|
||||
override_dh_strip:
|
||||
dh_strip --dbg-package=zoneminder-core-dbg
|
||||
|
||||
# Inspired by https://wiki.debian.org/onlyjob/get-orig-source
|
||||
.PHONY: get-orig-source
|
||||
get-orig-source: $(TARBALL) $(info I: $(PKG)_$(VER)$(DTYPE))
|
||||
@
|
||||
|
||||
$(TARBALL):
|
||||
$(if $(wildcard $(PKG)-$(VER)),$(error folder '$(PKG)-$(VER)' exists, aborting...))
|
||||
@echo "# Cloning origin repository..."; \
|
||||
if ! git clone $(UURL) $(PKG)-$(VER); then \
|
||||
$(RM) -r $(PKG)-$(VER); \
|
||||
echo "failed to clone repository, aborting..."; \
|
||||
false; \
|
||||
fi
|
||||
@if [ $(BRANCH) != "master" ]; then \
|
||||
cd $(PKG)-$(VER); \
|
||||
echo "# Not on master branch, fetching origin branch '$(BRANCH)'..."; \
|
||||
git fetch origin $(BRANCH):$(BRANCH) || false; \
|
||||
echo "# Switching to branch '$(BRANCH)'..."; \
|
||||
git checkout $(BRANCH) || false; \
|
||||
fi
|
||||
@echo "# Checking local source..."
|
||||
@if [ $$(cd $(PKG)-$(VER) && git rev-parse HEAD) = $(HEAD) ]; then \
|
||||
echo "even with origin, ok"; \
|
||||
true; \
|
||||
else \
|
||||
echo "not even with origin, aborting..."; \
|
||||
false; \
|
||||
fi
|
||||
@echo "# Setting times..."
|
||||
@cd $(PKG)-$(VER) \
|
||||
&& for F in $$(git ls-tree -r --name-only HEAD | sed -e "s/\s/\*/g"); do \
|
||||
touch --no-dereference -d "$$(git log -1 --format="%ai" -- $$F)" "$$F"; \
|
||||
done
|
||||
@echo "# Cleaning-up..."
|
||||
cd $(PKG)-$(VER) && $(RM) -r .git
|
||||
@echo "# Packing file '$(TARBALL)'..."
|
||||
@find -L "$(PKG)-$(VER)" -xdev -type f -print | sort \
|
||||
| XZ_OPT="-6v" tar -caf "$(TARBALL)" -T- --owner=root --group=root --mode=a+rX \
|
||||
&& $(RM) -r "$(PKG)-$(VER)"
|
||||
|
|
@ -0,0 +1 @@
|
|||
3.0 (native)
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue