libropkg-perl 0.4-1.2 / usr / share / perl5 / RoPkg / Rsync / ConfFile.pm

############################################################################
##      Copyright (C) 2006 Subredu Manuel  <diablo@iasi.roedu.net>.        #
##                                                                         #
## This program is free software; you can redistribute it and/or modify    #
## it under the terms of the GNU General Public License as published by    #
## the Free Software Foundation; either version 2 of the License, or       #
## (at your option) any later version.                                     #
##                                                                         #
## This program is distributed in the hope that it will be useful,         #
## but WITHOUT ANY WARRANTY; without even the implied warranty of          #
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the           #
## GNU General Public License for more details.                            #
##                                                                         #
## You should have received a copy of the GNU General Public License       #
## along with this program; if not, write to the Free Software             #
## Foundation, Inc., 59 Temple Place - Suite 330, Boston,                  #
## MA 02111-1307,USA.                                                      #
############################################################################

package RoPkg::Rsync::ConfFile;

use strict;
use warnings;

use Scalar::Util qw(blessed);
use English      qw( -no_match_vars );

use RoPkg::Exceptions;
use RoPkg::Rsync::Node;
use RoPkg::Rsync::Atom;

use vars qw($VERSION);
$VERSION = '0.2';

sub new {
  my ($class, %opt) = @_;
  my $self;

  $self = bless { %opt }, $class;

  $self->{_nodes} = ();
  $self->{_main_node} = new RoPkg::Rsync::Node(node_name => '_main_node');

  if ( $self->{filename} ) {
    $self->Parse($self->{filename});
  }

  return $self;
}

sub ToString {
  my ($self) = @_;
  my $result = q{};

  if ( !blessed($self) ) {
    OutsideClass->throw('Called outside class instance');
  }

  $result = $self->{_main_node}->ToString(0, 0);
  foreach(@{ $self->{_nodes} }) {
    my $ob = $_;
    
    if ( ref($ob) eq 'RoPkg::Rsync::Atom' ) {
      $result .= $ob->ToString(0) . $RS;
    }
    else {
      $result .= $ob->ToString(1);
    }
  }
  return $result;
}

#########################
## Atoms stuff - BEGIN ##
#########################

sub AddParam {
  my ($self, $pname, $pval) = @_;

  if ( !blessed($self) ) {
    OutsideClass->throw('Called outside class instance');
  }

  return $self->{_main_node}->AddParam($pname, $pval);
}

sub AddComment {
  my ($self, $pval) = @_;

  if ( !blessed($self) ) {
    OutsideClass->throw('Called outside class instance');
  }

  return $self->{_main_node}->AddComment($pval);
}
sub AddBlank {
  my ($self, $bval) = @_;

  if ( !blessed($self) ) {
    OutsideClass->throw('Called outside class instance');
  }

  return $self->{_main_node}->AddBlank($bval);
}

#########################
##  Atoms stuff -  END ##
#########################

#########################
## Nodes stuff - BEGIN ##
#########################

sub HasNode {
  my ($self, $name) = @_;

  if ( !blessed($self) ) {
    OutsideClass->throw('Called outside class instance');
  }

  foreach(@{ $self->{_nodes} }) {
    return 1 if ( $_->Name eq $name );
  }

  return 0;
}

sub AddNode {
  my ($self, $node) = @_;

  if ( !blessed($self) ) {
    OutsideClass->throw('Called outside class instance');
  }

  if ( ref($node) ne 'RoPkg::Rsync::Node' ) {
    Param::Wrong->throw('$node is not a RoPkg::Rsync::Node object');
  }

  return 0 if ( $self->HasNode($node->Name));

  push @{ $self->{_nodes} }, $node;

  return scalar(@{ $self->{_nodes} });
}

sub DelNode {
  my ($self, $name) = @_;
  my ($node_index, $nodes_no, $i);

  if ( !blessed($self) ) {
    OutsideClass->throw('Called outside class instance');
  }

  $i = 0;
  $nodes_no = -1;

  #find node index in the list
  foreach(@{ $self->{_nodes} }) {
    if ( $_->Name eq $name ) {
      $node_index = $i;
      last;
    }
    $i++;
  }

  return -1 if ($node_index == -1);

  delete $self->{_nodes}->[$node_index];
  $nodes_no = scalar(@{ $self->{_nodes} });
  
  for($i=$node_index; $i < $nodes_no; $i++) {
    $self->{_nodes}->[$i] = $self->{_nodes}->[$i+1];
  }

  delete $self->{_nodes}->[$node_index-1];
  return ($nodes_no-1);
}

#########################
##  Nodes stuff -  END ##
#########################

##################################
### Config file parser - BEGIN ###
##################################

sub Parse {
  my ($self, $filename) = @_;
  my $fh;

  if ( !blessed($self) ) {
    OutsideClass->throw('Called outside class instance');
  }

  if ( !$filename ) {
    Param::Missing->throw('No filename found in parameters list');
  }

  if ( ! -f $filename ) {
    File::NotFound->throw("File $filename not found");
  }

  if ( ! open($fh, '<', $filename) ) {
    File::Open->throw("Could not open $filename $RS $EVAL_ERROR $OS_ERROR");
  }
  else {
    close($fh);
  }

  return $self->_parse_rsync_config($filename);
}

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

  if ( !blessed($self) ) { 
    OutsideClass->throw('Called outside class instance');
  }

  $self->{_nodes}     = ();
  $self->{_main_node} = ();

  return 1;
}

sub _parse_rsync_config {
  my ($self, $filename) = @_;
  my ($inside, $fh, $node);

  $self->Clean();
  $inside = 0;
  $node = new RoPkg::Rsync::Node(node_name => '_main_node');

  open($fh, '<', $filename);
  while( my $line = <$fh> ) {
    chomp($line);

    if ( $line =~ m{^(\s*)$}xm ) {
      $node->AddBlank($1);
      next;
    }

    if ( $line =~ m{^\s*(\#.*)$}xm ) {
      my $cval = $1;
      $line =~ s{^\s*}{}xm;
      $node->AddComment($cval);
      next;
    }
    
    #we have found a new node
    if ( $line =~ m{^ \s* \[ ([\w \_ \- \.]+) \] \s* $}xm ) {

      if ( $inside ) {
        push @{ $self->{_nodes} }, $node;
      }
      else {
        $self->{_main_node} = $node;
      }

      $node = new RoPkg::Rsync::Node( node_name => $1 );
      $inside = 1;
      next;
    }

    if ( $line =~ m{^\s* (\w+\s*\w*) \s* = \s* (.*) \s*$}xm ) {
      my ($opt_name, $opt_value) = ($1, $2);
      
      $opt_name =~ s{\s+$}{}xm;
      $node->AddParam($opt_name, $opt_value);
    }
  }
  close($fh);

  #add the last item to the list
  push @{ $self->{_nodes}}, $node;
      
  return $self;
}

##################################
### Config file parser -   END ###
##################################

####################
## Others - BEGIN ##
####################

sub Write {
  my ($self, $path) = @_;
  my $fh;

  if ( !blessed($self) ) {
    OutsideClass->throw('Called outside class instance');
  }

  open($fh, '>', $path)
    or File::Create->throw('Could not create ' . $path . $RS . $ERRNO . $RS);
  print $fh $self->ToString();
  close($fh);

  return 1;
}

####################
##  Others -  END ##
####################

1;

__END__

=head1 NAME

RoPkg::Rsync::ConfFile

=head1 DESCRIPTION

RoPkg::Rsync::ConfFile is a class used to manipulate
rsync configuration files. Is capable to maintaine the
order of the modules, and even keep your comments
and empty lines intact.

=head1 SYNOPSIS

 #!/usr/bin/perl
 
 use warnings;
 use strict;

 sub main {
   my $cf = new RoPkg::Rsync::ConfFile(filename => '/etc/rsyncd.conf');

   $cf->Write('/tmp/new_rsyncd.conf');
   return 0;
 }

 main();

=head1 METHODS

All methods, throw the I<OutsideClass> exception,
if you use them as class methods.  Besides 
I<OutsideClass> the methods are throwing other 
exceptions as well. Refer to each method documentation
for more information.

=head2 new(%hash)

The class constructor. Accepts a hash as parameter. At this
moment only one parameter can be specified inside the hash:
B<filename> . If this parameter is present, the file specified
is parsed and loaded into the object.

=head2 AddParam($pname, $pvalue)

Add a new global parameter named B<$pname> with value B<$value>.

=head2 AddComment($pval)

Add a new global comment with value B<$pval>

=head2 AddBlank($bval)

Add a new global blank line with value B<$bval>

=head2 AddNode($node)

Adds a new RoPkg::Rsync::Node object to the current object.
Before the node is added, the nodes list is checked for duplicates
of the object. If a duplicate is found, the method does nothing.
 
B<Exceptions>:
 
If $node is not a instance of RoPkg::Rsync::Node, I<Param::Wrong>
exception is raised.

=head2 DelNode($node_name)

Removes a node from the nodes list. The nodes are searched by their
names. Returns -1 if the node was not found, the new number of nodes
otherwise.

=head2 HasNode($node_name)

Returns 1 if the node with name B<$node_name> was found in the nodes
list, 0 otherwise.

=head2 Clean()

Clean the object. Removes all information (the nodes list, statistics, etc).
Always returns 1.

=head2 Parse($filename)

Parse the configuration file B<$filename> and returns the number
of nodes. If B<$filename> is not defined I<Param::Missing> exception
is raised. If the path does not point to a existing file, I<File::NotFound>
exception is raised. If the file could not be opened, I<File::Open> exception
is raised.

=head2 Write($path)

Write the configuration into the file specified by path B<$path>.

=head2 ToString()

Returns the string representation of the configuration file.

=head1 PREREQUISITES

perl 5.008 (or later) is required. Besides perl, you must have the following:

=over 3

=item *) RoPkg::Exceptions

=item *) Scalar::Util

=item *) English

=back

=head1 SEE ALSO

L<RoPkg::Rsync::Atom> L<RoPkg::Rsync::ConfFile> L<RoPkg::Exceptions>

=head1 AUTHOR

Subredu Manuel <diablo@iasi.roedu.net>

=head1 LICENSE

Copyright (C) 2005 Subredu Manuel.  All Rights Reserved.
This module is free software; you can redistribute it 
and/or modify it under the same terms as Perl itself.
The LICENSE file contains the full text of the license.

=cut