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

package Lire::Config::SpecParser;

use strict;

use Lire::Config::TypeSpec;
use Lire::Utils qw/ check_param /;
use Lire::Error qw/directory_not_readable/;

use base qw/Lire::DocBookParser Lire::Config::Parser/;

use Carp;

=pod

=head1 NAME

Lire::Config::SpecParser - Create configuration specification from XML files

=head1 SYNOPSIS

 use Lire::Config::SpecParser;

 my $parser = new Lire::Config::SpecParser;
 my $spec = $parser->parsefile( 'spec.xml' );

 $parser->merge_specifications_dir( '/etc/lire/config' );
 my $spec = $parser->configspec();

=head1 DESCRIPTION

This is an Lire::XMLParser which can build Lire::Config::ConfigSpec
objects from an XML file.

=cut

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

    return { %{$self->Lire::Config::Parser::namespaces()},
             'http://www.logreport.org/LRCSML/' => 'lrcsml'
           };
}

my %elements2class =
  ( 'lrcsml:boolean' => 'Lire::Config::BooleanSpec',
    'lrcsml:command' => 'Lire::Config::CommandSpec',
    'lrcsml:dlf-converter' => 'Lire::Config::DlfConverterSpec',
    'lrcsml:dlf-schema' => 'Lire::Config::DlfSchemaSpec',
    'lrcsml:dlf-streams' => 'Lire::Config::DlfStreamsSpec',
    'lrcsml:directory' => 'Lire::Config::DirectorySpec',
    'lrcsml:executable' => 'Lire::Config::ExecutableSpec',
    'lrcsml:file' => 'Lire::Config::FileSpec',
    'lrcsml:integer' => 'Lire::Config::IntegerSpec',
    'lrcsml:list' => 'Lire::Config::ListSpec',
    'lrcsml:object' => 'Lire::Config::ObjectSpec',
    'lrcsml:option' => 'Lire::Config::OptionSpec',
    'lrcsml:output-format' => 'Lire::Config::OutputFormatSpec',
    'lrcsml:plugin' => 'Lire::Config::PluginSpec',
    'lrcsml:record' => 'Lire::Config::RecordSpec',
    'lrcsml:reference' => 'Lire::Config::ReferenceSpec',
    'lrcsml:report-config' => 'Lire::Config::ReportSpec',
    'lrcsml:select' => 'Lire::Config::SelectSpec',
    'lrcsml:string' => 'Lire::Config::StringSpec',
  );

my @scalar_mix = qw/ lrcsml:boolean lrcsml:command lrcsml:directory
                     lrcsml:dlf-converter lrcsml:dlf-schema lrcsml:dlf-streams
                     lrcsml:executable lrcsml:output-format
                     lrcsml:report-config lrcsml:reference
                     lrcsml:file lrcsml:integer lrcsml:string /;
my @compound_mix = qw/ lrcsml:list lrcsml:record lrcsml:object /;
my @specs_mix = ( qw/ lrcsml:select lrcsml:plugin/, @scalar_mix,
                  @compound_mix ),
my @infos_mix = qw/lrcsml:summary lrcsml:description/;

my %spec =
  (
   'lrcsml:config-spec' => [ @specs_mix ],
   'lrcsml:summary' => { 'start' => 'collector_start',
                         'char' => 'collector_char',
                         'end' => 'summary_end',
                         'content' => [ 'PCDATA' ], },
   'lrcsml:description' => { 'start' => 'dbk_init',
                             'char' => 'dbk_element_char',
                             'end' => 'description_end',
                             'content' => [ @Lire::DocBookParser::top_levels ],
                           },
   'lrcsml:select' => { 'start' => 'spec_start',
                        'end' => 'spec_end',
                        'content' => [ @infos_mix, 'lrcsml:option',
                                       'lrcml:param' ] },
   'lrcsml:plugin' => { 'start' => 'spec_start',
                        'end' => 'spec_end',
                        'content' => [ @infos_mix, 'lrcsml:option',
                                       'lrcml:param' ] },
   'lrcsml:option' => { 'start' => 'spec_start',
                        'end' => 'spec_end',
                        'content' => [ @infos_mix ] },
  );
foreach my $name ( @scalar_mix ) {
    $spec{$name} = { 'start' => 'spec_start',
                     'end' => 'spec_end',
                     'content' => [ @infos_mix, 'lrcml:param' ] };
}
foreach my $name ( @compound_mix ) {
    $spec{$name} = { 'start' => 'spec_start',
                     'end' => 'spec_end',
                     'content' => [ @infos_mix, @specs_mix, 'lrcml:param' ] };
}

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

    return {
            %{$self->Lire::Config::Parser::elements_spec()},
            %{$self->Lire::DocBookParser::elements_spec()},
            %spec,
           };
}

=pod

=head2 new()

Creates a new parser object.

=cut

sub new {
    my $self = shift->SUPER::new( @_ );
    $self->{'_spec'} = new Lire::Config::ConfigSpec();

    return $self;
}


=pod

=head2 configspec()

Returns the Lire::Config::ConfigSpec object parsed.

=cut

sub configspec {
    return $_[0]->{'_spec'};
}

=pod

=head2 merge_specifications_dir( $dir )

Parses all the files ending in '.xml' in the $directory. The types
defined in these files will be merged to the ConfigSpec object of this
parser.

=cut

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

    check_param( $dir, 'dir' );

    opendir(my $dh, $dir)
      or die directory_not_readable( $dir ), "\n";
    foreach my $file (readdir($dh)) {
        next unless $file =~ /\.xml$/;

        $self->merge_specification("$dir/$file");
    }
    close($dh);
    return;
}

=pod

=head2 merge_specification_dir( $file )

Parses the $file XML file and merges the types it defines in the
ConfigSpec defined by this parser.

=cut

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

    check_param( $file, 'file' );

    eval { $self->parsefile( $file ) };
    croak "error while parsing XML Config spec $file: $@"
       if $@;
    return;
}

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

    $self->init_stack( 'config_spec' );
    $self->init_stack( 'config_value' );

    return;
}

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

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

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

    $self->SUPER::dbk_element_char()
      if $self->within_element( 'lrcsml:description' );

    return;
}

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

    $self->stack_push( 'config_spec', $self->{'_spec'} );

    return;
}

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

    $self->error( "No Lire::Config:: class defined for element '$name'" )
      unless exists $elements2class{$name};

    my $spec = eval {
        no strict 'refs';
        $elements2class{$name}->new( %$attributes );
    };
    $self->error( $@ ) if $@;

    my $parent = $self->stack_peek( 'config_spec' );
    $parent->add( $spec )
      if defined $parent;

    $self->stack_push( 'config_spec', $spec );

    return;
}

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

    $self->stack_pop( 'config_spec' );

    return;
}

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

    my $spec = $self->stack_peek( 'config_spec' );
    return $spec->name() eq $name ? $spec : $spec->get( $name );
}

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

    my $spec = $self->stack_peek( 'config_spec' );
    $spec->summary( $self->get_collector( 'lrcsml:summary' ) );

    return;
}

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

    my $spec = $self->stack_peek( 'config_spec' );
    $spec->description( $self->dbk_string() );

    return;
}

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

    my $spec = $self->stack_peek( 'config_spec' );
    my $value = $self->stack_peek( 'config_value' );
    $spec->default( $value )
      if $self->stack_depth( 'config_value' ) == 1;
    $self->SUPER::param_end();

    return;
}

# keep perl happy
1;

__END__

=pod

=head1 SEE ALSO

 Lire::Config::Parser(3pm), Lire::Config::TypeSpec(3pm),
 Lire::Config::ConfigSpec(3pm)

=head1 AUTHORS

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

=head1 VERSION

$Id: SpecParser.pm,v 1.44 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