File Coverage

lib/Asterisk/Zapata.pm
Criterion Covered Total %
statement 15 57 26.3
branch 3 32 9.3
condition 1 3 33.3
subroutine 3 8 37.5
pod 0 6 0.0
total 22 106 20.7


line stmt bran cond sub pod time code
1             package Asterisk::Zapata;
2              
3             require 5.004;
4              
5             =head1 NAME
6              
7             Asterisk::Zapata - Zapata stuff
8              
9             =head1 SYNOPSIS
10              
11             stuff goes here
12              
13             =head1 DESCRIPTION
14              
15             description
16              
17             =over 4
18              
19             =cut
20              
21 1     1   629 use Asterisk;
  1         2  
  1         636  
22              
23             $VERSION = '0.01';
24              
25             $DEBUG = 5;
26              
27 0     0 0 0 sub version { $VERSION; }
28              
29             sub new {
30 1     1 0 662 my ($class, %args) = @_;
31 1         2 my $self = {};
32 1         2 $self->{'configfile'} = undef;
33 1         1 $self->{'vars'} = {};
34 1         1 $self->{'channel'} = {};
35              
36 1   33     7 bless $self, ref $class || $class;
37             # while (my ($key,$value) = each %args) { $self->set($key,$value); }
38 1         2 return $self;
39             }
40              
41       0     sub DESTROY { }
42              
43             sub configfile {
44 2     2 0 727 my ($self, $configfile) = @_;
45              
46 2 100       6 if (defined($configfile)) {
47 1         1 $self->{'configfile'} = $configfile;
48             } else {
49 1 50       5 $self->{'configfile'} = '/etc/asterisk/zapata.conf' if (!defined($self->{'configfile'}));
50             }
51              
52 2         8 return $self->{'configfile'};
53             }
54              
55             sub setvar {
56 0     0 0   my ($self, $context, $var, $val) = @_;
57              
58 0           $self->{'vars'}{$context}{$var} = $val;
59             }
60              
61             sub channels {
62 0     0 0   my ($self, $context, $channels) = @_;
63              
64 0           my @chans = ();
65 0           my $channel = '';
66 0           my $x;
67              
68 0 0         if ($channels =~ /(\d+)\-(\d+)/) {
    0          
    0          
69 0           my $beg = $1; my $end = $2;
  0            
70 0 0         if ($end > $beg) {
71 0           for ($x = $beg; $x <= $end; $x++) {
72 0           push(@chans, $x);
73             }
74             }
75             } elsif ($channels =~ /^(\d+)$/) {
76 0           push(@chans, $channels);
77             } elsif ($channels =~ /^\d+,/) {
78 0           push(@chans, split(/,/, $channels));
79             } else {
80 0 0         print STDERR "channels got here: $channels\n" if ($DEBUG);
81             }
82              
83 0           foreach $channel (@chans) {
84              
85 0           $self->{'channel'}{$channel}{'channel'} = $channel;
86 0           foreach $var (keys %{$self->{'vars'}{$context}}) {
  0            
87 0           $self->{'channel'}{$channel}{$var} = $self->{'vars'}{$context}{$var};
88             }
89             }
90              
91             }
92              
93             sub readconfig {
94 0     0 0   my ($self) = @_;
95              
96 0           my $context = '';
97 0           my $line = '';
98              
99 0           my $configfile = $self->configfile();
100              
101 0 0         open(CF, "<$configfile") || die "Error loading $configfile: $!\n";
102 0           while ($line = ) {
103 0           chop($line);
104              
105 0           $line =~ s/;.*$//;
106 0           $line =~ s/\s*$//;
107              
108 0 0         if ($line =~ /^;/) {
    0          
    0          
    0          
    0          
109 0           next;
110             } elsif ($line =~ /^\s*$/) {
111 0           next;
112             } elsif ($line =~ /^\[(\w+)\]$/) {
113 0           $context = $1;
114 0 0         print STDERR "Context: $context\n" if ($DEBUG>3);
115             } elsif ($line =~ /^channel\s*[=>]+\s*(.*)$/) {
116 0           $channel = $1;
117 0           $self->channels($context, $1);
118 0 0         print STDERR "Channel: $channel\n" if ($DEBUG>3);
119             } elsif ($line =~ /^(\w+)\s*[=>]+\s*(.*)/) {
120 0           $self->setvar($context, $1, $2);
121             } else {
122 0 0         print STDERR "Unknown line: $line\n" if ($DEBUG);
123             }
124              
125             }
126 0           close(CF);
127              
128 0           return 1;
129             }
130              
131             1;