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 Francis J. Lacoste =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