File Coverage

blib/lib/Polycom/Config/File.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2             package Polycom::Config::File;
3 3     3   102044 use warnings;
  3         7  
  3         113  
4 3     3   17 use strict;
  3         5  
  3         112  
5            
6 3     3   3414 use Encode;
  3         40933  
  3         318  
7 3     3   29 use File::Spec;
  3         4  
  3         69  
8 3     3   2648 use IO::File;
  3         41462  
  3         491  
9 3     3   1570 use XML::Twig;
  0            
  0            
10            
11             our $VERSION = 0.04;
12            
13             ######################################
14             # Overloaded Operators
15             ######################################
16             use overload (
17             '==' => sub { $_[0]->equals($_[1]) },
18             '!=' => sub { !$_[0]->equals($_[1]) },
19             );
20            
21             ###################
22             # Constructors
23             ###################
24             sub new
25             {
26             my ($class, $file) = @_;
27            
28             my $self = {};
29            
30             if ($file)
31             {
32             if ($file =~ /\/>|<\//)
33             {
34             $self->{xml} = $file;
35             }
36             elsif (ref $file)
37             {
38             binmode($file, ':utf8');
39             $self->{xml} = do { local $/; <$file> };
40             }
41             elsif (-e $file)
42             {
43             my $fh = IO::File->new($file, '<');
44             $fh->binmode(':utf8');
45             $self->{xml} = do { local $/; <$fh> };
46             $self->{path} = File::Spec->rel2abs($file);
47             }
48             else
49             {
50             die "Cannot open '$file'";
51             }
52            
53             if (!utf8::is_utf8($self->{xml}))
54             {
55             $self->{xml} = Encode::decode('utf8', $self->{xml});
56             }
57             }
58            
59             return bless $self, $class;
60             }
61            
62             ################################################################################
63             # Public methods
64             ################################################################################
65             sub equals
66             {
67             my ($self, $other) = @_;
68            
69             # Both files must contain the same number of parameters
70             my $num_params = keys %{$self->params};
71             my $num_params2 = keys %{$other->params};
72             return if ($num_params != $num_params2);
73            
74             # Each param must be present and equal in both configs
75             while (my ($key, $value) = each %{$self->params})
76             {
77             my $other_value = $other->params->{$key};
78             return if (!defined $other_value || $value != $other_value)
79             }
80            
81             return 1;
82             }
83            
84             sub path
85             {
86             return $_[0]->{path};
87             }
88            
89             sub save
90             {
91             my ($self, $new_filename) = @_;
92             $new_filename ||= $self->{path};
93             if (!defined $new_filename)
94             {
95             die "No filename specified for save()";
96             }
97             $new_filename = File::Spec->rel2abs($new_filename);
98            
99             my $fh = new IO::File($new_filename, '>:utf8');
100             my $xml = $self->to_xml;
101             print $fh $xml;
102             $fh->close;
103             undef $fh;
104            
105             $self->{path} = $new_filename;
106             return 1;
107             }
108            
109             sub to_xml
110             {
111             my ($self) = @_;
112            
113             # These are the config's key => value pairs
114             my %parameters = %{$self->params};
115            
116             # Add comments, if present
117             my $comment = $parameters{_comment} || 'Generated by Polycom::Config::File';
118             delete $parameters{_comment};
119            
120             # Output the XML based on the idea that attribute names are of the
121             # form element.subelement.attributeName. The root element will
122             # always be called 'sip', but it could be anything.
123             my $root = XML::Twig::Elt->new('sip');
124             while (my ($key, $value) = each %parameters)
125             {
126             # Determine the path to the key in the XML structure
127             my @path = split(/\./, $key);
128            
129             # Ensure all elements of @path are valid XML element names
130             @path = map {__nospace($_)} # Names can't contain spaces
131             grep {$_ =~ /^[^\d\W]\w*/i} # or start with punc or number
132             grep {$_ !~ /^xml/i} @path; # or start with xml
133            
134             # Remove the last name from the path, as it will not be considered
135             # as part of the containing XML path. It is specific to the attribute only
136             pop @path;
137            
138             # The second-to-last name is the name of the element to put the attribute in
139             my $last_name = pop @path;
140            
141             # Other names in the path correspond to more nested elements
142             my $parent = $root;
143             foreach my $name (@path)
144             {
145             my $element;
146             if ($parent->has_child($name))
147             {
148             $element = $parent->first_descendant($name);
149             }
150             else
151             {
152             $element = XML::Twig::Elt->new($name);
153             $element->paste($parent);
154             }
155             $parent = $element;
156             }
157            
158             # The last name in the path must have the attribute set in it
159             my $last_element;
160             if (!defined $last_name)
161             {
162             $parent->set_att($key, $parameters{$key});
163             }
164             # Use an existing element if possible
165             elsif ($parent->has_child($last_name))
166             {
167             $last_element = $parent->first_descendant($last_name);
168             $last_element->set_att($key, $parameters{$key});
169             }
170             # Otherwise create a new element to put the attribute in
171             else
172             {
173             $last_element = XML::Twig::Elt->new($last_name);
174             $last_element->set_att($key, $parameters{$key});
175             $last_element->paste($parent);
176             }
177             }
178            
179             return "\n" . $root->toString;
180             }
181            
182             sub params
183             {
184             my ($self) = @_;
185            
186             # If we've already read the file's contents, we need not do it again
187             if (!defined $self->{params})
188             {
189             $self->{params} = {};
190             if ((defined $self->{path} && -e $self->{path}) || defined $self->{xml})
191             {
192             # If this is an invalid XML file, we want it to throw an exception
193             # that we can catch elsewhere
194             eval
195             {
196             my $twig = XML::Twig->new(
197             start_tag_handlers => {
198             '_all_' => sub {
199             my( $t, $element) = @_;
200            
201             while (my ($k, $v) = each %{ $element->{att} })
202             {
203             $self->{params}->{$k} = $v;
204             }
205            
206             return 1;
207             }
208             }
209             );
210            
211             if (defined $self->{path})
212             {
213             $twig->parsefile($self->{path});
214             }
215             else
216             {
217             $twig->parse($self->{xml});
218             undef $self->{xml};
219             }
220             };
221             if ($@)
222             {
223             die "Cannot parse XML in $self->{path}: $@";
224             }
225             }
226             }
227            
228             return $self->{params};
229             }
230            
231             ################################################################################
232             # Private helper functions
233             ################################################################################
234             sub __nospace
235             {
236             my ($str) = @_;
237             $str =~ s/\s*//g;
238             return $str;
239             }
240            
241             'Together. Great things happen.';
242            
243             =head1 NAME
244            
245             Polycom::Config::File - Parser for Polycom VoIP phone config files.
246            
247             =head1 SYNOPSIS
248            
249             use Polycom::Config::File;
250            
251             # Load an existing config file
252             my $cfg = Polycom::Config::File->new('0004f21ac123-regLine.cfg');
253            
254             # Read the 'dialplan.digitmap' parameter
255             my $digitmap = $cfg->params->{'dialplan.digitmap'};
256            
257             # Modify the 'voIpProt.server.1.address' parameter
258             $cfg->params->{'voIpProt.server.1.address'} = 'test.example.com';
259            
260             # Save the file
261             $cfg->save('0004f21ac123-regLine.cfg');
262            
263             =head1 DESCRIPTION
264            
265             This module can be used to read, modify, or create config files for Polycom's SoundPoint IP, SoundStation IP, and VVX series of VoIP phones.
266            
267             Configuration files enable administrators to configure phone parameters ranging from line registrations, to preferred codecs, to background images.
268            
269             The files are structured using XML, where each attribute is named after a configuration parameter. For instance, the XML below would constitute a valid configuration file that specifies a SIP registration server and a dial plan digit map.
270            
271            
272            
273            
274            
275             dialplan.digitmap="[2-9]11|0T|011xxx.T|[0-1][2-9]xxxxxxxxx|604xxxxxxx|
276             778xxxxxxx|[2-4]xxx"/>
277            
278            
279             For more information about managing configuration files on Polycom SoundPoint IP, SoundStation IP, or VVX VoIP phones, see the "I" document at L.
280            
281             For a detailed list of available configuration parameters, consult the "I" document at L.
282            
283             =head1 CONSTRUCTOR
284            
285             =head2 new
286            
287             # Create a new empty config file
288             my $cfg = Polycom::Config::File->new();
289            
290             # Load a directory from a filename or file handle
291             my $cfg2 = Polycom::Config::File->new('0004f21ac123-sip.cfg');
292             my $cfg3 = Polycom::Config::File->new($fh);
293            
294             If you have already slurped the contents of a config file into a scalar, you can also pass that scalar to C to parse those XML contents.
295            
296             =head1 METHODS
297            
298             =head2 params
299            
300             # Read the 'dialplan.digitmap' parameter
301             my $dialmap = $cfg->params->{'dialplan.digitmap'};
302            
303             # Modify the 'voIpProt.server.1.address' parameter
304             $cfg->params->{'voIpProt.server.1.address'} = 'test.example.com';
305            
306             Returns a reference to a hash containing all of the config parameters in the config file. If you modify this hash, your changes will be written to the file when you call C.
307            
308             =head2 path
309            
310             If this object was created by passing a file path to C, then this function will return that file path. Otherwise, C simply returns I.
311            
312             =head2 equals ( $cfg2 )
313            
314             if ($cfg1->equals($cfg2))
315             {
316             print "The config files are equal\n";
317             }
318            
319             Returns true if both config files are equal (i.e. they contain the same config parameters, and all of those config parameters have the same value).
320            
321             Because the I<==> and I operators have also been overloaded for C, it is equivalent to compare two config files using:
322            
323             if ($cfg1 == $cfg2)
324             {
325             print "The config files are equal\n";
326             }
327            
328             =head2 save ( $filename )
329            
330             $dir->save('0004f21acabf-directory.xml');
331            
332             Writes the configuration parameters to the specified file.
333            
334             For the phone to load the parameters in the file, you will need to place the file on the phone's boot server and add its filename to the I field in I<>.cfg, as described in the "I" document listed at the bottom of this page. The phone must then be restarted for it to pick up the changes to its configuration.
335            
336             =head2 to_xml
337            
338             my $xml = $cfg->to_xml;
339            
340             Returns the XML representation of the config. It is exactly this XML representation that the C method writes to the config file.
341            
342             =head1 SEE ALSO
343            
344             =over
345            
346             =item C - parses the XML-based local contact directory files used by Polycom SoundPoint IP, SoundStation IP, and VVX VoIP phones.
347            
348             =item I - L
349            
350             =item I - L
351            
352             =back
353            
354             =head1 AUTHOR
355            
356             Zachary Blair, Ezblair@cpan.orgE
357            
358             =head1 COPYRIGHT AND LICENSE
359            
360             Copyright (C) 2010 by Polycom Canada
361            
362             This library is free software; you can redistribute it and/or modify
363             it under the same terms as Perl itself, either Perl version 5.8.8 or,
364             at your option, any later version of Perl 5 you may have available.
365            
366             =cut
367            
368            
369            
370