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


line stmt bran cond sub pod time code
1             package Net::Peep::Peck;
2              
3             require 5.00503;
4 2     2   1275 use strict;
  2         4  
  2         69  
5             # use warnings; # commented out for 5.005 compatibility
6 2     2   10 use Carp;
  2         2  
  2         111  
7 2     2   2523 use Getopt::Long;
  2         28013  
  2         16  
8 2     2   2519 use Socket;
  2         9099  
  2         1520  
9 2     2   1945 use Net::Peep::Client;
  2         8  
  2         109  
10 2     2   11 use Net::Peep::BC;
  2         4  
  2         85  
11              
12             require Exporter;
13              
14 2     2   11 use vars qw{ @ISA %EXPORT_TAGS @EXPORT_OK @EXPORT $VERSION };
  2         3  
  2         312  
15              
16             @ISA = qw(Exporter);
17             %EXPORT_TAGS = ( 'all' => [ qw( ) ] );
18             @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
19             @EXPORT = qw( );
20             $VERSION = do { my @r = (q$Revision: 1.4 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
21              
22 2     2   12 use constant PROT_MAJORVER => 1;
  2         3  
  2         103  
23 2     2   9 use constant PROT_MINORVER => 0;
  2         4  
  2         74  
24 2     2   10 use constant PROT_CLIENTEVENT => 4;
  2         4  
  2         86  
25 2     2   12 use constant PORT => '1999';
  2         5  
  2         813  
26              
27             sub new {
28              
29 2     2 0 440 my $self = shift;
30 2   33     16 my $class = ref($self) || $self;
31 2         6 my $this = {};
32 2         7 bless $this, $class;
33 2         9 $this;
34              
35             } # end sub new
36              
37             sub peck {
38              
39 3     3 0 492 my $self = shift;
40              
41 3         38 my $client = new Net::Peep::Client;
42 3         19 $client->name('peck');
43              
44 3         12 my ($type,$sound,$location,$volume,$priority,$dither,$autodiscovery)
45             = (0,0,0,255,128,255,0);
46              
47 3         34 my %options = (
48             'type=s' => \$type,
49             'sound=s' => \$sound,
50             'location=s' => \$location,
51             'volume=s' => \$volume,
52             'priority=s' => \$priority,
53             'dither=s' => \$dither,
54             'autodiscovery!' => \$autodiscovery, # override Net::Peep::Client's default
55             );
56              
57 3 50       49 $client->initialize(%options) || $client->pods();
58              
59 3     0   38 $client->parser( sub { } );
  0         0  
60              
61 3         17 my $conf = $client->configure();
62              
63 3 50       14 if ($conf->getOption('autodiscovery')) {
64 0         0 die "Error: Autodiscovery is not supported by the peck client.";
65             } else {
66 3 50 33     41 unless ($conf->optionExists('server') && $conf->getOption('server') &&
      33        
      33        
67             $conf->optionExists('port') && $conf->getOption('port')) {
68 0         0 $client->pods("Error: You must provide a server and port option.");
69             }
70             }
71 3         32 my $broadcast = new Net::Peep::BC ('peck',$conf);
72              
73 3         31 $broadcast->send(
74             'peck',
75             type => $type,
76             location => $location,
77             priority => $priority,
78             volume => $volume,
79             dither => $dither,
80             sound => $sound
81             );
82              
83 3         87 return 1;
84              
85             } # end sub peck
86              
87             # returns a logging object
88             sub logger {
89              
90 0     0 0   my $self = shift;
91 0 0         if ( ! exists $self->{'__LOGGER'} ) { $self->{'__LOGGER'} = new Net::Peep::Log }
  0            
92 0           return $self->{'__LOGGER'};
93              
94             } # end sub logger
95              
96             sub pecker {
97              
98             # tee hee
99 0     0 0   my $self = shift;
100 0 0         $self->{"__PECKER"} = Net::Peep::BC->new() unless exists $self->{"__PECKER"};
101 0           return $self->{"__PECKER"};
102              
103             } # end sub pecker
104              
105             1;
106              
107             __END__