[Pkg-voip-commits] r2444 - in libasterisk-perl/trunk: . debian
lib/Asterisk
Tzafrir Cohen
tzafrir-guest at costa.debian.org
Wed Sep 27 22:09:58 UTC 2006
Author: tzafrir-guest
Date: 2006-09-27 22:09:56 +0000 (Wed, 27 Sep 2006)
New Revision: 2444
Added:
libasterisk-perl/trunk/debian/
libasterisk-perl/trunk/debian/changelog
libasterisk-perl/trunk/debian/compat
libasterisk-perl/trunk/debian/control
libasterisk-perl/trunk/debian/copyright
libasterisk-perl/trunk/debian/docs
libasterisk-perl/trunk/debian/libasterisk-perl.examples
libasterisk-perl/trunk/debian/rules
Modified:
libasterisk-perl/trunk/lib/Asterisk/Manager.pm
Log:
Load newtrunk into libasterisk-perl/trunk.
Added: libasterisk-perl/trunk/debian/changelog
===================================================================
--- libasterisk-perl/trunk/debian/changelog (rev 0)
+++ libasterisk-perl/trunk/debian/changelog 2006-09-27 22:09:56 UTC (rev 2444)
@@ -0,0 +1,25 @@
+libasterisk-perl (0.09-1) unstable; urgency=high
+
+ * New upstream release.
+ * Finally legal
+
+ -- Tzafrir Cohen <tzafrir.cohen at xorcom.com> Thu, 28 Sep 2006 00:52:58 +0300
+
+libasterisk-perl (0.08-3) unstable; urgency=low
+
+ * Fixed some "uninitilized value" warnings
+
+ -- Tzafrir Cohen <tzafrir.cohen at xorcom.com> Tue, 7 Jun 2005 14:54:50 +0300
+
+libasterisk-perl (0.08-2) unstable; urgency=low
+
+ * A proper separate .orig tarball
+
+ -- Tzafrir Cohen <tzafrir.cohen at xorcom.com> Tue, 7 Jun 2005 14:54:50 +0300
+
+libasterisk-perl (0.08-1) unstable; urgency=low
+
+ * Initial Release.
+
+ -- Tzafrir Cohen <tzafrir.cohen at xorcom.com> Thu, 11 Nov 2004 13:57:49 +0200
+
Added: libasterisk-perl/trunk/debian/compat
===================================================================
--- libasterisk-perl/trunk/debian/compat (rev 0)
+++ libasterisk-perl/trunk/debian/compat 2006-09-27 22:09:56 UTC (rev 2444)
@@ -0,0 +1 @@
+4
Added: libasterisk-perl/trunk/debian/control
===================================================================
--- libasterisk-perl/trunk/debian/control (rev 0)
+++ libasterisk-perl/trunk/debian/control 2006-09-27 22:09:56 UTC (rev 2444)
@@ -0,0 +1,15 @@
+Source: libasterisk-perl
+Section: perl
+Priority: optional
+Build-Depends: debhelper (>= 4.0.2)
+Build-Depends-Indep: perl (>= 5.8.0-7)
+Maintainer: Tzafrir Cohen <tzafrir.cohen at xorcom.com>
+Standards-Version: 3.6.1
+
+Package: libasterisk-perl
+Architecture: all
+Depends: ${perl:Depends}, ${misc:Depends},
+Description: Asterisk Manager Interface
+ This module provides a simple interface to the asterisk manager interface.
+ .
+ This description was automagically extracted from the module by dh-make-perl.
Added: libasterisk-perl/trunk/debian/copyright
===================================================================
--- libasterisk-perl/trunk/debian/copyright (rev 0)
+++ libasterisk-perl/trunk/debian/copyright 2006-09-27 22:09:56 UTC (rev 2444)
@@ -0,0 +1,12 @@
+This is the debian package for the asterisk-perl module.
+It was created by Tzafrir Cohen <tzafrir.cohen at xorcom.com> .
+
+Copyright (C) 2002--2006 by James Golovich <james at gnuinter.net>
+The source was downloaded from http://asterisk.gnuinter.net/files/
+
+You may freely use and distribute this program under the terms of the
+Artistic License.
+
+In Debian systems, a copy of the Artistic License may be found at
+/usr/share/common-licenses/Artistic
+
Added: libasterisk-perl/trunk/debian/docs
===================================================================
--- libasterisk-perl/trunk/debian/docs (rev 0)
+++ libasterisk-perl/trunk/debian/docs 2006-09-27 22:09:56 UTC (rev 2444)
@@ -0,0 +1 @@
+README
Added: libasterisk-perl/trunk/debian/libasterisk-perl.examples
===================================================================
--- libasterisk-perl/trunk/debian/libasterisk-perl.examples (rev 0)
+++ libasterisk-perl/trunk/debian/libasterisk-perl.examples 2006-09-27 22:09:56 UTC (rev 2444)
@@ -0,0 +1 @@
+examples/*
Added: libasterisk-perl/trunk/debian/rules
===================================================================
--- libasterisk-perl/trunk/debian/rules (rev 0)
+++ libasterisk-perl/trunk/debian/rules 2006-09-27 22:09:56 UTC (rev 2444)
@@ -0,0 +1,87 @@
+#!/usr/bin/make -f
+# This debian/rules file is provided as a template for normal perl
+# packages. It was created by Marc Brockschmidt <marc at dch-faq.de> for
+# the Debian Perl Group (http://pkg-perl.alioth.debian.org/) but may
+# be used freely wherever it is useful.
+
+# Uncomment this to turn on verbose mode.
+#export DH_VERBOSE=1
+
+# If set to a true value then MakeMaker's prompt function will
+# always return the default without waiting for user input.
+export PERL_MM_USE_DEFAULT=1
+
+PACKAGE=$(shell dh_listpackages)
+
+ifndef PERL
+PERL = /usr/bin/perl
+endif
+
+TMP =$(CURDIR)/debian/$(PACKAGE)
+
+# Allow disabling build optimation by setting noopt in
+# $DEB_BUILD_OPTIONS
+CFLAGS = -Wall -g
+ifneq (,$(findstring noopt,$(DEB_BUILD_OPTIONS)))
+ CFLAGS += -O0
+else
+ CFLAGS += -O2
+endif
+
+build: build-stamp
+build-stamp:
+ dh_testdir
+
+ # Add commands to compile the package here
+ $(PERL) Makefile.PL INSTALLDIRS=vendor
+ $(MAKE) OPTIMIZE="$(CFLAGS)"
+
+ touch build-stamp
+
+clean:
+ dh_testdir
+ dh_testroot
+
+ # Add commands to clean up after the build process here
+ -$(MAKE) distclean
+
+ dh_clean build-stamp install-stamp
+
+install: install-stamp
+install-stamp: build-stamp
+ dh_testdir
+ dh_testroot
+ dh_clean -k
+
+ $(MAKE) test
+ $(MAKE) install DESTDIR=$(TMP) PREFIX=/usr
+
+ # As this is a architecture independent package, we are not supposed to install
+ # stuff to /usr/lib. MakeMaker creates the dirs, we delete them from the deb:
+ rmdir --ignore-fail-on-non-empty --parents $(TMP)/usr/lib/perl5
+
+ touch install-stamp
+
+binary-arch:
+# We have nothing to do by default.
+
+binary-indep: build install
+ dh_testdir
+ dh_testroot
+# dh_installcron
+# dh_installmenu
+ dh_installexamples
+ dh_installdocs
+ dh_installchangelogs CHANGES
+ dh_perl
+ dh_link
+ dh_strip
+ dh_compress
+ dh_fixperms
+ dh_installdeb
+ dh_gencontrol
+ dh_md5sums
+ dh_builddeb
+
+binary: binary-indep binary-arch
+.PHONY: build clean binary-indep binary-arch binary
Property changes on: libasterisk-perl/trunk/debian/rules
___________________________________________________________________
Name: svn:executable
+ *
Modified: libasterisk-perl/trunk/lib/Asterisk/Manager.pm
===================================================================
--- libasterisk-perl/trunk/lib/Asterisk/Manager.pm 2006-09-27 22:09:11 UTC (rev 2443)
+++ libasterisk-perl/trunk/lib/Asterisk/Manager.pm 2006-09-27 22:09:56 UTC (rev 2444)
@@ -15,19 +15,48 @@
=head1 SYNOPSIS
-use Asterisk::Manager;
+ use Asterisk::Manager;
-my $astman = new Asterisk::Manager;
+ my $astman = new Asterisk::Manager;
-$astman->user('username');
+ $astman->user('username');
-$astman->secret('test');
+ $astman->secret('test');
-$astman->host('localhost');
+ #$astman->host('pbx-box'); # default: localhost
+
+ #$astman->port(5039); # default: 5038
-$astman->connect || die "Could not connect to " . $astman->host . "!\n";
+ $astman->connect ||
+ die "Could not connect to " . $astman->host . "!\n";
-$astman->disconnect;
+ $astman->setcallback('Hangup', \&hangup_callback);
+ $astman->setcallback('DEFAULT', \&default_callback);
+
+ print STDERR $astman->command('show uptime');
+
+ print STDERR $astman->sendcommand( {Action => 'IAXPeers'});
+
+ print STDERR $astman->sendcommand( {Action => 'Originate',
+ Channel => 'Zap/7', Exten => '500', Context => 'default',
+ Priority => '1'} );
+
+ $astman->eventloop;
+
+ $astman->disconnect;
+
+ sub hangup_callback {
+ print STDERR "hangup callback\n";
+ }
+
+ sub default_callback {
+ my (%stuff) = @_;
+ foreach (keys %stuff) {
+ print STDERR "$_: ". $stuff{$_} . "\n";
+ }
+ print STDERR "\n";
+ }
+
=head1 DESCRIPTION
@@ -42,6 +71,20 @@
sub version { $VERSION; }
+
+=head1 new
+
+Creates a new manager object. Accepts now parameters and thus a newly
+created object should typically be configured using B<user> , B<secret>
+and maybe also B<host> and B<port>.
+
+By default The user and secret are undefined, host is I<localhost> and port
+is 5038.
+
+Returns: A manager object. Should not fail.
+
+=cut
+
sub new {
my ($class, %args) = @_;
@@ -62,6 +105,15 @@
sub DESTROY { }
+
+=head1 user
+
+Parameter: string. Username to be used to connect to the manager interface.
+
+Returns: The new username that has been set.
+
+=cut
+
sub user {
my ($self, $user) = @_;
@@ -72,6 +124,16 @@
return $self->{_USER};
}
+
+=head1 secret
+
+Parameter: string. Secret (password) to be used to connect to the manager
+interface.
+
+Returns: The new secret that has been set.
+
+=cut
+
sub secret {
my ($self, $secret) = @_;
@@ -82,6 +144,16 @@
return $self->{_SECRET};
}
+
+=head1 host
+
+Parameter: string. Host where the the asterisk with the manager inetrface
+will be running.
+
+Returns: The new hostname that has been set.
+
+=cut
+
sub host {
my ($self, $host) = @_;
@@ -92,6 +164,15 @@
return $self->{_HOST};
}
+
+=head1 port
+
+Parameter: number. TCP port on which the manager interface will listen.
+
+Returns: The new port number that has been set.
+
+=cut
+
sub port {
my ($self, $port) = @_;
@@ -166,6 +247,16 @@
return wantarray ? @response : $response[0];
}
+
+=head1 connect
+
+Establish a connection to an Asterisk manager interface.
+
+Returns: or undef on error. Sets the error string. On success returns
+the new socket (B<IO::Socket::INET>).
+
+=cut
+
sub connect {
my ($self) = @_;
@@ -192,15 +283,16 @@
my ($manager, $version) = split('/', $input);
if ($manager !~ /Asterisk Call Manager/) {
- return $self->error("Unknown Protocol\n");
+ $self->error("Unknown Protocol\n");
+ return undef;
}
$self->{_PROTOVERS} = $version;
$self->connfd($conn);
# check if the remote host supports MD5 Challenge authentication
- my %authresp = $self->sendcommand( Action => 'Challenge',
- AuthType => 'MD5'
+ my %authresp = $self->sendcommand( {Action => 'Challenge',
+ AuthType => 'MD5'}
);
if (($authresp{Response} eq 'Success')) {
@@ -209,16 +301,16 @@
$md5->add($authresp{Challenge});
$md5->add($secret);
my $digest = $md5->hexdigest;
- %resp = $self->sendcommand( Action => 'Login',
+ %resp = $self->sendcommand( {Action => 'Login',
AuthType => 'MD5',
Username => $user,
- Key => $digest
+ Key => $digest}
);
} else {
# do plain text login
- %resp = $self->sendcommand( Action => 'Login',
+ %resp = $self->sendcommand( {Action => 'Login',
Username => $user,
- Secret => $secret
+ Secret => $secret}
);
}
@@ -259,19 +351,54 @@
return %thash;
}
-#$want is how you want the data returned
-#$want = 0 (default) returns the results in a hash
-#$want = 1 returns the results in a large string
-#$want = 2 returns the results in an array
+
+=head1 sendcommand
+
+Sends a manager interface command.
+
+Parameters: B<want>, B<command>
+
+Returns: the manager's response.
+
+B<command>: Hash reference. Keys are manager interface action fields:
+
+=over 4
+
+=item Action
+
+(required) The action name. Other fields are action-dependent.
+
+=back
+
+B<want>: Number. is how you want the data returned:
+
+=over 4
+
+=item 0
+
+(default) returns the results in a hash
+
+=item 1
+
+returns the results in a large string
+
+=item 2
+
+returns the results in an array
+
+=back
+
+=cut
+
sub sendcommand {
- my ($self, %command, $want) = @_;
+ my ($self,$command,$want) = @_;
if (!defined($want)) {
$want = 0;
}
my $conn = $self->connfd || return;
- my $cstring = $self->astman_h2s(%command);
+ my $cstring = $self->astman_h2s(%$command);
$conn->send("$cstring$EOL");
@@ -289,6 +416,17 @@
}
}
+
+=head1 setcallback
+
+Parameters: B<$event>: string, as defined in the manager interface,
+B<$function>: a function reference.
+
+Orders the manager to notify in case of B<$event>. Will call
+B<$function> then.
+
+=cut
+
sub setcallback {
my ($self, $event, $function) = @_;
@@ -316,6 +454,13 @@
return &{$callback}(%resp);
}
+
+=head1 eventloop
+
+A simple, blocking, main loop.
+
+=cut
+
sub eventloop {
my ($self) = @_;
@@ -352,21 +497,41 @@
}
}
+
+=head1 command
+
+Parameter: A CLI command (string).
+
+Run a CLI command and return its result.
+
+Returns: The result string or 0 if the command is not given/undefined.
+
+=cut
+
sub command {
my ($self, $command) = @_;
return if (!$command);
- return $self->sendcommand('Action' => 'Command',
- 'Command' => $command, 1 );
+ return $self->sendcommand(
+ {'Action' => 'Command', 'Command' => $command},
+ 1
+ );
}
+
+=head1 disconnect
+
+Logoff from the manager.
+
+=cut
+
sub disconnect {
my ($self) = @_;
my $conn = $self->connfd;
- my %resp = $self->sendcommand('Action' => 'Logoff');
+ my %resp = $self->sendcommand({'Action' => 'Logoff'});
if ($resp{Response} eq 'Goodbye') {
More information about the Pkg-voip-commits
mailing list