File Coverage

blib/lib/Net/Peep/Peck.pm

Criterion	Covered	Total	%
statement	51	61	83.6
branch	3	10	30.0
condition	4	12	33.3
subroutine	13	16	81.2
pod	0	4	0.0
total	71	103	68.9

package Net::Peep::Peck;

require 5.00503;
use strict;
# use warnings; # commented out for 5.005 compatibility
use Carp;
use Getopt::Long;
use Socket;
use Net::Peep::Client;
use Net::Peep::BC;

require Exporter;

use vars qw{ @ISA %EXPORT_TAGS @EXPORT_OK @EXPORT $VERSION };

@ISA = qw(Exporter);
%EXPORT_TAGS = ( 'all' => [ qw( ) ] );
@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
@EXPORT = qw( );
$VERSION = do { my @r = (q$Revision: 1.4 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };

use constant PROT_MAJORVER => 1;
use constant PROT_MINORVER => 0;
use constant PROT_CLIENTEVENT => 4;
use constant PORT => '1999';

sub new {

	my $self = shift;
	my $class = ref($self) || $self;
	my $this = {};
	bless $this, $class;
	$this;

} # end sub new

sub peck {

	my $self = shift;

	my $client = new Net::Peep::Client;
	$client->name('peck');

	my ($type,$sound,$location,$volume,$priority,$dither,$autodiscovery)
		= (0,0,0,255,128,255,0);

	my %options = (
		'type=s' => \$type,
		'sound=s' => \$sound,
		'location=s' => \$location,
		'volume=s' => \$volume,
		'priority=s' => \$priority,
		'dither=s' => \$dither,
		'autodiscovery!' => \$autodiscovery, # override Net::Peep::Client's default
		);

	$client->initialize(%options) || $client->pods();

	$client->parser( sub { } );

	my $conf = $client->configure();

	if ($conf->getOption('autodiscovery')) {
		die "Error:  Autodiscovery is not supported by the peck client.";
	} else {
		unless ($conf->optionExists('server') && $conf->getOption('server') &&
		        $conf->optionExists('port') && $conf->getOption('port')) {
			$client->pods("Error:  You must provide a server and port option.");
		}
	}
	my $broadcast = new Net::Peep::BC ('peck',$conf);

	$broadcast->send(
		'peck',
		type => $type,
		location => $location,
		priority => $priority,
		volume => $volume,
		dither => $dither,
		sound => $sound
	);

	return 1;

} # end sub peck

# returns a logging object
sub logger {

	my $self = shift;
	if ( ! exists $self->{'__LOGGER'} ) { $self->{'__LOGGER'} = new Net::Peep::Log }
	return $self->{'__LOGGER'};

} # end sub logger

sub pecker {

    # tee hee
    my $self = shift;
    $self->{"__PECKER"} = Net::Peep::BC->new() unless exists $self->{"__PECKER"};
    return $self->{"__PECKER"};

} # end sub pecker

1;

__END__