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

#!/usr/bin/perl -w
package Polycom::Config::File;
use warnings;
use strict;

use Encode;
use File::Spec;
use IO::File;
use XML::Twig;

our $VERSION = 0.04;

######################################
# Overloaded Operators
######################################
use overload (
    '==' => sub { $_[0]->equals($_[1]) },
    '!=' => sub { !$_[0]->equals($_[1]) },
);

###################
# Constructors
###################
sub new
{
    my ($class, $file) = @_;

    my $self = {};

    if ($file)
    {
        if ($file =~ /\/>|<\//)
        {
            $self->{xml} = $file;
        }
        elsif (ref $file)
        {
            binmode($file, ':utf8');
            $self->{xml} = do { local $/; <$file> };
        }
        elsif (-e $file)
        {
            my $fh = IO::File->new($file, '<');
            $fh->binmode(':utf8');
            $self->{xml} = do { local $/; <$fh> };
            $self->{path} = File::Spec->rel2abs($file);
        }
        else
        {
            die "Cannot open '$file'";
        }

        if (!utf8::is_utf8($self->{xml}))
        {
            $self->{xml} = Encode::decode('utf8', $self->{xml});
        }
    }

    return bless $self, $class;
}

################################################################################
# Public methods
################################################################################
sub equals
{
    my ($self, $other) = @_;

    # Both files must contain the same number of parameters
    my $num_params  = keys %{$self->params};
    my $num_params2 = keys %{$other->params};
    return if ($num_params != $num_params2);

    # Each param must be present and equal in both configs
    while (my ($key, $value) = each %{$self->params})
    {
        my $other_value = $other->params->{$key};
        return if (!defined $other_value || $value != $other_value)
    }

    return 1;
}

sub path
{
    return $_[0]->{path};
}

sub save
{
    my ($self, $new_filename) = @_;
    $new_filename ||= $self->{path};
    if (!defined $new_filename)
    {
        die "No filename specified for save()";
    }
    $new_filename = File::Spec->rel2abs($new_filename);

    my $fh = new IO::File($new_filename, '>:utf8');
    my $xml = $self->to_xml;
    print $fh $xml;
    $fh->close;
    undef $fh;

    $self->{path} = $new_filename;
    return 1;
}

sub to_xml
{
    my ($self) = @_;

    # These are the config's key => value pairs
    my %parameters = %{$self->params};

    # Add comments, if present
    my $comment = $parameters{_comment} || 'Generated by Polycom::Config::File';
    delete $parameters{_comment};

    # Output the XML based on the idea that attribute names are of the
    # form element.subelement.attributeName. The root element will
    # always be called 'sip', but it could be anything.
    my $root = XML::Twig::Elt->new('sip');
    while (my ($key, $value) = each %parameters)
    {
        # Determine the path to the key in the XML structure
        my @path = split(/\./, $key);

        # Ensure all elements of @path are valid XML element names
        @path = map {__nospace($_)}          # Names can't contain spaces
                grep {$_ =~ /^[^\d\W]\w*/i}  # or start with punc or number
                grep {$_ !~ /^xml/i} @path;  # or start with xml

        # Remove the last name from the path, as it will not be considered
        # as part of the containing XML path. It is specific to the attribute only
        pop @path;

        # The second-to-last name is the name of the element to put the attribute in
        my $last_name = pop @path;

        # Other names in the path correspond to more nested elements
        my $parent = $root;
        foreach my $name (@path)
        {
            my $element;
            if ($parent->has_child($name))
            {
                $element = $parent->first_descendant($name);
            }
            else
            {
                $element = XML::Twig::Elt->new($name);
                $element->paste($parent);
            }
            $parent = $element;
        }

        # The last name in the path must have the attribute set in it
        my $last_element;
        if (!defined $last_name)
        {
           $parent->set_att($key, $parameters{$key});
        }
        # Use an existing element if possible
        elsif ($parent->has_child($last_name))
        {
            $last_element = $parent->first_descendant($last_name);
            $last_element->set_att($key, $parameters{$key});
        }
        # Otherwise create a new element to put the attribute in
        else
        {
            $last_element = XML::Twig::Elt->new($last_name);
            $last_element->set_att($key, $parameters{$key});
            $last_element->paste($parent);
        }
    }

    return "\n" . $root->toString;
}

sub params
{
    my ($self) = @_;

    # If we've already read the file's contents, we need not do it again
    if (!defined $self->{params})
    {
        $self->{params} = {};
        if ((defined $self->{path} && -e $self->{path}) || defined $self->{xml})
        {
            # If this is an invalid XML file, we want it to throw an exception
            # that we can catch elsewhere
            eval
            {
                my $twig = XML::Twig->new(
                    start_tag_handlers => {
                        '_all_' => sub {
                            my( $t, $element) = @_;

                            while (my ($k, $v) = each %{ $element->{att} })
                            {
                                $self->{params}->{$k} = $v;
                            }

                            return 1;
                        }
                    }
                );

                if (defined $self->{path})
                {
                    $twig->parsefile($self->{path});
                }
                else
                {
                    $twig->parse($self->{xml});
                    undef $self->{xml};
                }
            };
            if ($@)
            {
                die "Cannot parse XML in $self->{path}: $@";
            }
        }
    }

    return $self->{params};
}

################################################################################
# Private helper functions
################################################################################
sub __nospace
{
    my ($str) = @_;
    $str =~ s/\s*//g;
    return $str;
}

'Together. Great things happen.';

=head1 NAME

Polycom::Config::File - Parser for Polycom VoIP phone config files.

=head1 SYNOPSIS

  use Polycom::Config::File;

  # Load an existing config file
  my $cfg = Polycom::Config::File->new('0004f21ac123-regLine.cfg');

  # Read the 'dialplan.digitmap' parameter
  my $digitmap = $cfg->params->{'dialplan.digitmap'};

  # Modify the 'voIpProt.server.1.address' parameter
  $cfg->params->{'voIpProt.server.1.address'} = 'test.example.com';

  # Save the file
  $cfg->save('0004f21ac123-regLine.cfg');

=head1 DESCRIPTION

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.

Configuration files enable administrators to configure phone parameters ranging from line registrations, to preferred codecs, to background images.

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.





  dialplan.digitmap="[2-9]11|0T|011xxx.T|[0-1][2-9]xxxxxxxxx|604xxxxxxx|
  778xxxxxxx|[2-4]xxx"/>


For more information about managing configuration files on Polycom SoundPoint IP, SoundStation IP, or VVX VoIP phones, see the "I" document at L.

For a detailed list of available configuration parameters, consult the "I" document at L.

=head1 CONSTRUCTOR

=head2 new

  # Create a new empty config file
  my $cfg = Polycom::Config::File->new();

  # Load a directory from a filename or file handle
  my $cfg2 = Polycom::Config::File->new('0004f21ac123-sip.cfg');
  my $cfg3 = Polycom::Config::File->new($fh);

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.

=head1 METHODS

=head2 params

  # Read the 'dialplan.digitmap' parameter
  my $dialmap = $cfg->params->{'dialplan.digitmap'};

  # Modify the 'voIpProt.server.1.address' parameter
  $cfg->params->{'voIpProt.server.1.address'} = 'test.example.com';

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.

=head2 path

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.

=head2 equals ( $cfg2 )

  if ($cfg1->equals($cfg2))
  {
    print "The config files are equal\n";
  }

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).

Because the I<==> and I operators have also been overloaded for C, it is equivalent to compare two config files using:

  if ($cfg1 == $cfg2)
  {
    print "The config files are equal\n";
  }

=head2 save ( $filename )

  $dir->save('0004f21acabf-directory.xml');

Writes the configuration parameters to the specified file.

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.

=head2 to_xml

  my $xml = $cfg->to_xml;

Returns the XML representation of the config. It is exactly this XML representation that the C method writes to the config file.

=head1 SEE ALSO

=over

=item C - parses the XML-based local contact directory files used by Polycom SoundPoint IP, SoundStation IP, and VVX VoIP phones.

=item I - L

=item I - L

=back

=head1 AUTHOR

Zachary Blair, [e-mail]

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2010 by Polycom Canada

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.

=cut