libconfig-augeas-perl 1.000-1build1 / usr / lib / perl5 / Config / Augeas.pm

#    Copyright (c) 2008-2010 Dominique Dumont.
#    Copyright (c) 2011-2012 Raphaël Pinson.
#
#    This library is free software; you can redistribute it and/or
#    modify it under the terms of the GNU Lesser Public License as
#    published by the Free Software Foundation; either version 2.1 of
#    the License, or (at your option) any later version.
#
#    Config-Model 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
#    Lesser Public License for more details.
#
#    You should have received a copy of the GNU Lesser Public License
#    along with Config-Model; if not, write to the Free Software
#    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
#    02110-1301 USA

package Config::Augeas;

use strict;
use warnings;
use Carp;
use IO::File ;

our $VERSION = '1.000';

require XSLoader;
XSLoader::load('Config::Augeas', $VERSION);

=head1 NAME

Config::Augeas - Edit configuration files through Augeas C library

=head1 SYNOPSIS

  use Config::Augeas;

  my $aug = Config::Augeas->new( root => $aug_root ) ;

  my $ret = $aug->get("/files/etc/hosts/1/ipaddr") ;
  $aug->set("/files/etc/hosts/2/ipaddr","192.168.0.1") ;

  my @a = $aug->match("/files/etc/hosts/") ;

  my $nb = $aug->count_match("/files/etc/hosts/") ;

  $aug->save ;

=head1 DESCRIPTION

=for comment
Description snatched from Augeas README

Augeas is a library and command line tool that focuses on the most
basic problem in handling Linux configurations programmatically:
editing actual configuration files in a controlled manner.

To that end, Augeas exposes a tree of all configuration settings
(well, all the ones it knows about) and a simple local API for
manipulating the tree. Augeas then modifies underlying configuration
files according to the changes that have been made to the tree; it
does as little modeling of configurations as possible, and focuses
exclusively on transforming the tree-oriented syntax of its public API
to the myriad syntaxes of individual configuration files.

This module provides an object oriented Perl interface for Augeas
configuration edition library with a more "perlish" API than Augeas C
counterpart.

=head1 Constructor

=head1 new ( ... )

Creates a new Config::Augeas object. Optional parameters are:

=over

=item loadpath

a colon-spearated list of directories that lenses should be searched
in. This is in addition to the standard load path and the directories
in specified C<AUGEAS_LENS_LIB> environment variable.

=item root

Use C<root> as the filesystem root. If not specified, use the value of
the environment variable C<AUGEAS_ROOT>. If that doesn't exist either,
use "C</>".

=item save => backup | newfile | noop

Specify how to save the configuration file. Either create a newfile
(with extension C<.augnew>, and do not overwrite the original file) or
move the original file into a backup file (C<.augsave> extension).
C<noop> make saves a no-op process, just record what would have
changed

=item type_check => 1

Typecheck lenses; since it can be very expensive it is not done by
default.

=item no_std_inc

Do not use the builtin load path for modules

=item no_load

Do not load the tree from AUG_INIT

=back

=cut

sub new {
    my $type = shift ;
    my $self = {} ;
    my %args = @_ ;
    my $flags = 0 ;
    my $loadpath = delete $args{loadpath} || '';
    my $root  = delete $args{root} || '';

    my $save = delete $args{save} || '';
    if    ($save eq 'backup')  { $flags |= &AUG_SAVE_BACKUP }
    elsif ($save eq 'newfile') { $flags |= &AUG_SAVE_NEWFILE }
    elsif ($save =~ 'noop')    { $flags |= &AUG_SAVE_NOOP }
    elsif ($save) { 
	croak  __PACKAGE__," new: unexpected save value: $save. ",
	  "Expected backup or newfile";
    }

    $flags |= &AUG_TYPE_CHECK  if ( delete $args{type_check}  || 0 );
    $flags |= &AUG_NO_STDINC   if ( delete $args{no_std_inc}  || 0 ) ;
    $flags |= &AUG_NO_LOAD     if ( delete $args{no_load}     || 0 ) ;
    $flags |= &AUG_ENABLE_SPAN if ( delete $args{enable_span} || 0 ) ;

    croak  __PACKAGE__," new: unexpected parameters: ",
      join (' ',keys %args) 
	if %args ;

    $self->{aug_c} = Config::Augeas::init($root,$loadpath,$flags) ;

    bless $self,$type ;

    return $self
}

=head1 Methods

=head2 defvar( name, [ expr ])

Define a variable C<name> whose value is the result of evaluating
C<expr>. If a variable C<name> already exists, its name will be replaced
with the result of evaluating C<expr>.

If C<expr> is omitted, the variable C<name> will be removed if it is
defined.

Path variables can be used in path expressions later on by prefixing
them with '$'.

Returns -1 on error; on success, returns 0 if C<expr> evaluates to anything
other than a nodeset, and the number of nodes if C<expr> evaluates to a
nodeset

=cut

sub defvar {
    my $self = shift ;
    my $name = shift || croak __PACKAGE__," defvar: undefined name";
    my $expr = shift || 0 ;

    return $self->{aug_c} -> defvar($name, $expr) ;
}

=head2 defnode ( name, expr, value )

Define a variable C<name> whose value is the result of evaluating
C<expr>, which must evaluate to a nodeset. If a variable C<name>
already exists, its name will be replaced with the result of
evaluating C<expr>.

If C<expr> evaluates to an empty nodeset, a node is created, equivalent to
calling C<set( expr, value)> and C<name> will be the nodeset containing
that single node.

Returns undef on error

Returns an array containing:

=over

=item *

the number of nodes in the nodeset

=item *

1 if a node was created, and 0 if it already existed.

=back

=cut

sub defnode {
    my $self = shift ;
    my $name = shift || croak __PACKAGE__," defnode: undefined name";
    my $expr = shift || croak __PACKAGE__," defnode: undefined expr";
    my $value = shift || croak __PACKAGE__," defnode: undefined value";

    return ($self->{aug_c} -> defnode($name, $expr, $value)) ;
}

=head2 get( path )

Lookup the value associated with C<path>. Returns the value associated
with C<path> if C<path> matches exactly one node. If PATH matches no
nodes or more than one node, returns undef.

=cut

sub get {
    my $self = shift ;
    my $path = shift || croak __PACKAGE__," get: undefined path";

    return $self->{aug_c} -> get($path) ;
}

=head2 set ( path, value )

Set the value associated with C<path> to C<value>. C<value> is copied
into Augeas internal data structure. Intermediate entries are created
if they don't exist. Return 1 on success, 0 on error. It is an error
if more than one node matches C<path>.

=cut

sub set {
    my $self  = shift ;
    my $path  = shift || croak __PACKAGE__," set: undefined path";
    my $value = shift ;

    croak __PACKAGE__," set: undefined value" unless defined $value;

    my $result ;
    my $ret = $self->{aug_c} -> set($path,$value) ;
    return $ret == 0 ? 1 : 0 ;
}

=head2 text_store ( lens, node, path )

Use the value of node C<node> as a string and transform it into a tree
using the lens C<lens> and store it in the tree at C<path>, which will be
overwritten. C<path> and C<node> are path expressions.

=cut

sub text_store {
    my $self  = shift ;
    my $lens  = shift || croak __PACKAGE__," text_store: undefined lens";
    my $node  = shift || croak __PACKAGE__," text_store: undefined node";
    my $path  = shift || croak __PACKAGE__," text_store: undefined path";

    my $result ;
    my $ret = $self->{aug_c} -> text_store($lens,$node,$path) ;
    return $ret == 0 ? 1 : 0 ;
}

=head2 text_retrieve ( lens, node_in, path, node_out )

Transform the tree at C<path> into a string using lens C<lens> and store it in
the node C<node_out>, assuming the tree was initially generated using the
value of node C<node_in>. C<path>, C<node_in>, and C<node_out> are path expressions.

=cut

sub text_retrieve {
    my $self     = shift ;
    my $lens     = shift || croak __PACKAGE__," text_store: undefined lens";
    my $node_in  = shift || croak __PACKAGE__," text_store: undefined node_in";
    my $path     = shift || croak __PACKAGE__," text_store: undefined path";
    my $node_out = shift || croak __PACKAGE__," text_store: undefined node_out";

    my $result ;
    my $ret = $self->{aug_c} -> text_retrieve($lens,$node_in,$path,$node_out) ;
    return $ret == 0 ? 1 : 0 ;
}

=head2 insert ( label, before | after , path )

Create a new sibling C<label> for C<path> by inserting into the tree
just before or just after C<path>.

C<path> must match exactly one existing node in the tree, and C<label>
must be a label, i.e. not contain a '/', '*' or end with a bracketed
index '[N]'.

Return 1 on success, and 0 if the insertion fails.

=cut 

sub insert {
    my $self   = shift ;
    my $label  = shift || croak __PACKAGE__," insert: undefined label";
    my $where  = shift || croak __PACKAGE__," insert: undefined 'where'";
    my $path   = shift || croak __PACKAGE__," insert: undefined path";

    my $before = $where eq 'before' ? 1
               : $where eq 'after'  ? 0
	       :                      undef ;
    croak __PACKAGE__," insert: 'where' must be 'before' or 'after' not $where"
      unless defined $before ;

    if ($label =~ m![/\*]! or $label =~ /\]/ ) {
	croak __PACKAGE__," insert: invalid label '$label'";
    }

    my $result ;
    my $ret = $self->{aug_c} -> insert($path,$label, $before) ;
    return $ret == 0 ? 1 : 0 ;
}

=head2 remove ( path )

Remove path and all its children. Returns the number of entries
removed.  All nodes that match C<path>, and their descendants, are
removed. (C<remove> can also be called with C<rm>)

=cut 

sub rm {
    goto &remove ;
}

sub remove {
    my $self   = shift ;
    my $path   = shift || croak __PACKAGE__," remove: undefined path";

    return $self->{aug_c} -> rm($path) ;
}

=head2 move ( src, dest )

Move the node SRC to DST. SRC must match exactly one node in the
tree. DST must either match exactly one node in the tree, or may not
exist yet. If DST exists already, it and all its descendants are
deleted. If DST does not exist yet, it and all its missing ancestors
are created.

Note that the node SRC always becomes the node DST: when you move
C</a/b> to C</x>, the node C</a/b> is now called C</x>, no matter
whether C</x> existed initially or not. (C<move> can also be called
with C<mv>)

Returns 1 in case of success, 0 otherwise.

=cut

sub mv {
    goto &move ;
}

sub move {
    my $self   = shift ;
    my $src    = shift || croak __PACKAGE__," move: undefined src";
    my $dst    = shift || croak __PACKAGE__," move: undefined dst";

    my $result = $self->{aug_c} -> mv($src,$dst) ;
    return $result == 0 ? 1 : 0 ;
}


=head2 rename ( src, dest )

Rename the label of all nodes matching C<src> to C<lbl>.

Returns the number of nodes renamed on success and -1 on failure.

=cut

sub rename {
    my $self   = shift ;
    my $src    = shift || croak __PACKAGE__," rename: undefined src";
    my $dst    = shift || croak __PACKAGE__," rename: undefined dst";

    my $result = $self->{aug_c} -> rename($src,$dst) ;
    return $result;
}


=head2 span ( path )

Returns a hash containing the C<filename>, C<label_start>, C<label_end>,
C<value_start>, C<value_end>, C<span_start> and C<span_end> of the given C<path>.

Example:

  my $span = $aug->span('/files/etc/passwd/root') ;
  # If filename is undefined, there are no valid span information for this node
  if ($span->{filename}) {
     print "Found root in passwd at character $span->{span_start}\n" ;
  }

WARNING: You must check that $span->{filename} is defined. If it isn't,
the node has no span information and all other values in the hash are wrong.

=cut

sub span {
    my $self = shift ;
    my $path = shift || croak __PACKAGE__," span: undefined path";

    return $self->{aug_c} -> span($path) ;

}

=head2 match ( pattern )

Returns an array of the elements that match of the path expression
C<pattern>. The returned paths are sufficiently qualified to make sure
that they match exactly one node in the current tree.

=cut

sub match {
    my $self = shift ;
    my $pattern = shift || croak __PACKAGE__," match: undefined pattern";

    # Augeas 0.4.0 is a little picky about trailing slashes
    $pattern =~ s!/$!!;
    return $self->{aug_c} -> match($pattern) ;

}

=head2 count_match ( pattern )

Same as match but return the number of matching element in manner more
efficient than using C<scalar match( pattern )>

=cut

sub count_match {
    my $self = shift ;
    my $pattern = shift || croak __PACKAGE__," count_match: undefined pattern";

    # Augeas 0.4.0 is a little picky about trailing slashes
    $pattern =~ s!/$!!;
    return $self->{aug_c} -> count_match($pattern) ;
}

=head2 save

Write all pending changes to disk. Return 0 if an error is
encountered, 1 on success. Only files that had any changes made to
them are written. C<save> will follow backup files as specified with
Config::Augeas::new C<backup> parameter.

=cut

sub save {
    my $self   = shift ;
    my $ret = $self->{aug_c} -> save() ;
    return $ret == 0 ? 1 : 0 ;
}

=head2 load

Load files into the tree. Which files to load and what lenses to use on
them is specified under C</augeas/load> in the tree; each entry
C</augeas/load/NAME> specifies a 'transform', by having itself exactly one
child 'lens' and any number of children labelled 'incl' and 'excl'. The
value of NAME has no meaning.

The 'lens' grandchild of C</augeas/load> specifies which lens to use, and
can either be the fully qualified name of a lens 'Module.lens' or
'C<@Module>'. The latter form means that the lens from the transform marked
for autoloading in C<MODULE> should be used.

The 'incl' and 'excl' grandchildren of C</augeas/load> indicate which files
to transform. Their value are used as glob patterns. Any file that
matches at least one 'incl' pattern and no 'excl' pattern is
transformed. The order of 'incl' and 'excl' entries is irrelevant.

When L<init> is first called, it populates C</augeas/load> with the
transforms marked for autoloading in all the modules it finds.

Before loading any files, C<load> will remove everything underneath
C</augeas/files> and C</files>, regardless of whether any entries have been
modified or not.

Returns 0 on error, 1 on success. Note that success includes the case
where some files could not be loaded. Details of such files can be found
as 'C</augeas//error>'.

=cut

sub load {
    my $self   = shift ;
    my $ret = $self->{aug_c} -> load() ;
    return $ret == 0 ? 1 : 0 ;
}

=head2 print ( [ path  , [ file ] ] )

Print each node matching C<path> and its descendants on STDOUT or in a file

The second parameter can be :

=over

=item *

A file name. 

=item *

Omitted. In this case, print to STDOUT

=back

If path is omitted, all Augeas nodes will be printed.

Example:

  $aug->print ; # print all nodes to STDOUT
  $aug->print('/files') ; # print all file nodes to STDOUT
  $aug->print('/augeas/','bar.txt'); # print Augeas meta data in bar.txt

WARNING: The parameter order is reversed compared to Augeas C API.

=cut

sub print {
    my $self   = shift ;
    my $path   = shift || '' ;
    my $f_param     = shift ;

    my $fd = IO::File->new ;

    if (defined $f_param) {
        $fd->open($f_param,"w")
            or croak  __PACKAGE__," opening '$f_param' for writing failed";
    }
    else {
	# stdio 
	$fd->fdopen(fileno(STDOUT),"w")
            or croak __PACKAGE__, " couldn't create handle to STDOUT";
    } 

    my $ret = $self->{aug_c} -> print($fd,$path) ;
    return $ret == 0 ? 1 : 0 ;
}

=head2 srun ( [ text  , [ file ] ] )

Run one or more newline-separated commands listed in C<text>.
Running just C<help> will print what commands are available.
Commands accepted by this are identical to what augtool accepts.

The second parameter can be :

=over

=item *

A file name. 

=item *

Omitted. In this case, print to STDOUT

=back

The function returns the number of executed commands on success,
and 0 otherwise.

=cut

sub srun {
    my $self   = shift ;
    my $text   = shift || '' ;
    my $f_param     = shift ;

    my $fd = IO::File->new ;

    if (defined $f_param) {
	$fd->open($f_param,"w");
    }
    else {
	# stdio 
	$fd->fdopen(fileno(STDOUT),"w");
    } 

    my $ret = $self->{aug_c} -> srun($fd,$text) ;
    return $ret > 0 ? $ret : 0 ;
}

=head1 Error reporting

=head2 error

Returns the error code from the last API call as a short string:
noerror, nomem, internal, pathx, nomatch, manymatch, syntax, nolens,
multiple_transforms

=cut

my @errcode = qw/noerror nomem internal pathx nomatch manymatch syntax nolens 
		multiple_transforms/;

sub error {
    my $self   = shift ;
    my $code = $self->{aug_c} -> error() ;
    return $errcode[$code] ;
}

=head2 error_message

Return a human-readable message for the error code.

=cut

sub error_message {
  my $self   = shift ;
  $self->{aug_c} -> error_message() ;
}

=head2 error_minor_message

Return a human-readable message elaborating the error code; might be
undef. For example, when the error code is C<pathx>, this will explain
how the path expression is invalid.

=cut

sub error_minor_message {
  my $self   = shift ;
  $self->{aug_c} -> error_minor_message() ;
}

=head2 error_details

Return details about the error, which might be undef. For example, for
C<pathx>, indicates where in the path expression the error
occurred. The returned value can only be used until the next API call

=cut

sub error_details {
  my $self   = shift ;
  $self->{aug_c} -> error_details() ;
}

1;

__END__

=head1 CAVEATS

Object oriented design would suggest to use a new class to represent
Augeas errors, but this would stray too far from current Augeas design
and API.

=head1 SEE ALSO

=over 

=item * 

http://augeas.net/ : Augeas project page

=item *

L<Config::Model> : Another kind of configuration editor (with optional
GUI and advanced validation).

=item *

L<Config::Augeas::Validator> : A unit test framework for configuration files.

=item *

L<Config::Augeas::Exporter> : A module to export the Augeas tree to various formats.

=item *

Augeas mailing list: http://augeas.net/developers.html

=item *

Source repository: https://github.com/raphink/config-augeas

=back

=head1 AUTHORS

=over

=item *

Dominique Dumont, E<lt>ddumont at cpan dot org@<gt>

=item *

Raphael Pinson, E<lt>raphink at cpan dot org@<gt>

=back

=head1 COPYRIGHT AND LICENSE

=over

=item *

Copyright (C) 2008-2010 by Dominique Dumont

=item *

Copyright (C) 2011-2012 by Raphael Pinson

=back

This library is free software; you can redistribute it and/or modify
it under the LGPL terms.

=cut