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

  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');

  <?xml version="1.0" standalone="yes"?>
  <localcfg>
     <server voIpProt.server.1.address="test.example.com"/>
     <digitmap
  dialplan.digitmap="[2-9]11|0T|011xxx.T|[0-1][2-9]xxxxxxxxx|604xxxxxxx|
  778xxxxxxx|[2-4]xxx"/>
  </localcfg>

  # 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);

  # 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';

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

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

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

  my $xml = $cfg->to_xml;

#!/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.03;

######################################
# 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 "<!-- $comment -->\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.';