lire 2:2.1.1-2.1 / usr / share / perl5 / Lire / Config / ConfigFile.pm

package Lire::Config::ConfigFile;

use strict;

use base qw/ Lire::Config::Dictionary /;

use Carp;

use Lire::Config::Parser;
use Lire::I18N qw/ set_fh_encoding /;
use Lire::Utils qw/ check_param check_object_param /;

=pod

=head1 NAME

Lire::Config::ConfigFile - Class for configuration file manipulation.

=head1 SYNOPSIS

  use Lire::Config::ConfigFile;

=head1 DESCRIPTION

Object representing a Lire configuration file.

=head2 new( 'filename' => $file, spec => $config_spec )

Creates a new Lire::Config::ConfigFile object. The constructor
takes two parameters:

=over

=item filename

The file form where the configuration was stored or was loaded from.

=item spec

The Lire::Config::TypeSpec object to which this configuration adheres.

=back

=cut

sub new {
    my ( $proto, %args ) = @_;
    my $class = ref $proto || $proto;

    check_object_param( $args{'spec'}, 'spec', 'Lire::Config::ConfigSpec' );
    check_param( $args{'filename'}, 'filename' );

    my $self = bless {
        'spec'      => $args{'spec'},
        'filename'  => $args{'filename'},
        'global' => new Lire::Config::Dictionary( 'spec' => $args{'spec'} ),
    }, $class;

    return $self;
}

=pod

=head2 filename( [$new_filename] )

Returns (and optionally changes) the filename where this configuration
file should be stored.

=cut

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

    if ( @_ == 2 ) {
        check_param( $filename, 'filename' );
        $self->{'filename'} = $filename;
    }

    return $self->{'filename'};
}

=pod

=head2 spec()

Returns the Lire::Config::TypeSpec object to which this configuration file
adheres.

=cut

sub spec {
    $_[0]{'spec'};
}

=pod

=head2 global( [ $config] )

Returns or modify the 'global' configuration part of the file. This is
an instance Lire::Config::Compound object.

=cut

sub global {
    my ( $self, $config ) = @_;

    if ( @_ == 2 ) {
        if ( defined $config ) {
            croak "'config' parameter isn't an Lire::Config::Dictionary instance: $config"
              unless UNIVERSAL::isa( $config, "Lire::Config::Dictionary" );
        }
        $self->{'global'} = $config;
    }

    return $self->{'global'};
}

sub save_global {
    my ( $self, $fh, $indent, $xmlns ) = @_;

    $indent ||= 0;
    $xmlns ||= '';
    print $fh '  'x$indent, "<${xmlns}global>\n";
    $self->global()->save_value( $fh, $indent, $xmlns );
    print $fh '  'x$indent, "</${xmlns}global>\n";

    return;
}

=pod

=head2 save()

Saves this ConfigConfigFile object back to the filename from which
it was loaded.

=cut

sub save {
    my $self = $_[0];

    open my $fh, "> $self->{'filename'}"
      or die "open '$self->{'filename'}' for writing failed: $!\n";

    $self->save_xml( $fh );

    close $fh;

    return;
}

=pod

=head2 revert()

Reads back the configuration from the file.

=cut

sub revert {
    my $self = $_[0];

    my $parser = new Lire::Config::Parser( 'spec' => $self->{'spec'} );
    my $new_self = $parser->load_config_file( $self->{'filename'} );

    %$self = %$new_self;

    return;
}

sub save_xml {
    my $self = shift;
    my $fh = $_[0];

    set_fh_encoding( $fh, 'UTF-8' );

    print $fh join("\n",
        '<?xml version="1.0" encoding="UTF-8"?>',
        '<!DOCTYPE config PUBLIC',
        '  "-//LogReport.ORG//DTD Lire Report Configuration Markup Language V1.0//EN"',
        '  "http://www.logreport.org/LRCML/1.0/lrcml.dtd"[',
        '<!ENTITY % LIRE.pfx "">',
        ']>',
        '<config xmlns="http://www.logreport.org/LRCML/">', '');

    $self->save_global($fh, 1);

    print $fh "</config>\n";

    return;
}

=pod

=head2 as_value()

Returns this configuration file as an hash reference. Delegates
to the global configuration object contained in the file.

=cut

sub as_value { shift->{'global'}->as_value( @_ ) };

=pod

=head2 get( $name )

Returns the configuration parameter $name from this configuration file.
Delegates to the global configuration object contained in the file.

=cut

sub get { shift->{'global'}->get( @_ ) };

=pod

=head2 is_set( $name )

Checks that a configuration parameter is set in this file.
Delegates to the global configuration object contained in the file.

=cut

sub is_set {  shift->{'global'}->is_set( @_ ) };

=pod

=head2 set( $param )

Sets a configuration variable in the file. Delegates
to the global configuration object contained in the file.

=cut

sub set { shift->{'global'}->set( @_ ) };

1; # whine, whine

__END__

=pod

=head1 SEE ALSO

Lire::Config::Dictionary(3pm)

=head1 AUTHORS

Wessel Dankers <wsl@logreport.org>
Francis J. Lacoste <flacoste@logreport.org>
Wolfgang Sourdeau <wolfgang@logreport.org>

=head1 VERSION

$Id: ConfigFile.pm,v 1.9 2006/07/23 13:16:30 vanbaal Exp $

=head1 COPYRIGHT

Copyright (C) 2002-2004 Stichting LogReport Foundation LogReport@LogReport.org

This file is part of Lire.

Lire 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 (see COPYING); if not, check with
http://www.gnu.org/copyleft/gpl.html.

=cut