package Lire::Config::TypeSpec;

use strict;

use Carp;

use Lire::DataTypes qw/ check_xml_name check_nmtoken /;
use Lire::I18N qw/ dgettext dgettext_para /;
use Lire::ReportParser::AsciiDocBookFormatter qw/ dbk2txt /;
use Lire::Utils qw/ check_param check_object_param /;

BEGIN {
    no strict 'refs';

    foreach my $pkg (qw/Scalar Compound Object List Config String File
                        Command Executable Directory Boolean Integer
                        Select Option DlfAnalyser DlfConverter DlfSchema
                        DlfStream DlfStreams Record Reference
                        Report ReportSection Plugin XMLSpecList
                        Chart ChartType OutputFormat
                        / )
    {
        eval "use Lire\::Config\::${pkg}Spec";
        die if $@;
    }
}

=pod

=head1 NAME

Lire::Config::TypeSpec - Base class for object which specifies configuration types.

=head1 DESCRIPTION

Abstract superclass for the other type classes. Implements basic methods but
croaks when those are invoked.

=head2 new( 'name' => $name )

The constructor takes one mandatory argument which is the parameter's
name.

=cut

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

    check_param ( $args{'name'}, 'name', \&check_xml_name,
                  "name should only contain digits, numbers or '.', '-' or '_'" );

    my $self = bless { 'name' => $args{'name'},
                       'section' => undef,
                       'summary' => $args{'summary'},
                       'description' => undef,
                       'i18n_domain' => $args{'i18n_domain'} || 'lire',
                       '_required' => 1,
                       '_obsolete' => $args{'obsolete'} || 0,
                       '_default' => undef,
                     }, $class;

    $self->required( $args{'required'} )
      if defined $args{'required'};
    $self->section($args{'section'});
    $self->description( $args{'description'} )
      if defined $args{'description'};

    return $self;
}

=pod

=head2 name()

Returns the parameter's name.

=cut

sub name {
    return $_[0]{'name'};
}

=pod

=head2 has_section()

Returns if this parameter is interesting for the given section.

=cut

sub has_section {
    my $self = shift;

    foreach(@_) {
        if(defined) {
            s/^\s+|\s+$//g;
            return lc eq $self->section();
        } else {
            return !defined $self->section();
        }
    }

    return;
}

=pod

=head2 section()

Returns a the section of this parameter. If an argument is passed, it is
used to change the section. It's ok to pass undef as a parameter
(treated as "not a member of any section").

=cut

sub section {
    my $self = shift;

    foreach(@_) {
        if(defined) {
            s/^\s+|\s+$//g;
            $self->{'section'} = lc;
        } else {
            $self->{'section'} = undef;
        }
    }

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

=pod

=head2 has_default()

Returns whether this TypeSpec has a default configuration value
specified.

=cut

sub has_default {
    return defined $_[0]{'_default'};
}

=pod

=head2 default( [ $new_default ] )

Returns the Lire::Config::Value object which will be used as a
template. It returns undef if there is no default defined. The
$new_default parameter can be used to change the current default. This
value should be a Lire::Config::Value that was instantiated by this
specification.

=cut

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

    if ( @_ == 2 ) {
        if ( defined $new_default ) {
            check_object_param( $new_default, 'new_default',
                                'Lire::Config::Value' );
            croak "default value doesn't come from this specification"
              unless $self->is_instance( $new_default );
        }
        $self->{'_default'} = $new_default;
    }
    return $self->{'_default'};
}

=pod

=head2 required( [ $is_required ] )

Returns whether this configuration parameter is required. Container of
this parameter will use this result in their is_valid()
implementation. Values that are invalid but not required will not make
the is_valid() test fails. By default, all parameters are required.

=cut

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

    $self->{'_required'} = $_[1] ? 1 : 0
      if ( @_ == 2 );

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

=pod

=head2 obsolete( [ $is_obsolete ] )

Returns (and optionally changes) the obsolete flag for this parameter.

=cut

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

    $self->{'_obsolete'} = $_[1] ? 1 : 0
      if ( @_ == 2 );

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

=pod

=head2 summary( [$summary] )

Returns this parameter summary description. It can also be used
to change the parameter's summary.

=cut

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

    if ( @_ == 2 ) {
        $self->{'summary'} = $_[1];
    }

    return $self->{'name'}
      unless defined $self->{'summary'};

    my $summary = $self->{'summary'};
    $summary =~ s/(^ +| +$)//gm;
    $summary =~ s/\n/ /g;

    return dgettext( $self->{'i18n_domain'}, $summary );
}

=pod

=head2 description( [$description] )

Returns this parameter's description. This is a DocBook string. It can
also be used to change the parameter's description.

=cut

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

    if (@_ == 2) {
        croak "'description' parameter should be a DocBook string"
          if defined $_[1] && $_[1] !~ /^\s*<[\w.-]+>/;

        $self->{'description'} = $_[1];
    }

    my $description = $self->{'description'};
    return undef unless defined $description;

    $description =~ s/(^ +| +$)//gm;
    $description =~ s/\n/ /gm;

    return dgettext_para( $self->{'i18n_domain'}, $description );
}

=pod

=head2 text_description()

Returns the specification's description formatted in plain text,
one line per paragraph.

=cut

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

    my $description = $self->description();
    return undef unless defined $description;

    my $text = dbk2txt( $description, 32_766 );
    $text =~ s/^ +//gm;
    $text =~ s/ +$//gm;
    chomp $text while ( substr( $text, -1, 1 ) eq "\n" );

    return $text;
}

=pod

=head2 instance( %params )

This method is a factory type function which returns a new
Lire::Config::Value object of the correct type. If the specification
has a default value, the returned instance will be a clone of that
value, otherwise an unitialized value will be returned.

%params can contains any parameters accepted by the
Lire::Config::Value constructor.

=cut

sub instance {
    my $self = shift;

    if ( $self->{'_default'} ) {
        return $self->{'_default'}->new( @_ );
    } else {
        return $self->instance_class()->new( @_, 'spec' => $self );
    }
}


=pod

=head2 is_instance( $value_object )

Returns true if $value_object is a valid instance of this parameter.

=cut

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

    check_object_param( $instance, 'instance', 'Lire::Config::Value' );

    return $instance->spec() eq $self;
}

sub instance_class {
    croak( "instance_class_() method not implemented in ", ref $_[0] );
}

1;
__END__

=pod

=head1 VERSION

$Id: TypeSpec.pm,v 1.24 2004/08/28 03:39:36 flacoste Exp $

=head1 AUTHORS

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

=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 or write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111, USA.

=cut
