package Lire::Config::List;

use strict;

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

use Carp;

use Lire::Utils qw/ check_param check_object_param /;

=pod

=head1 NAME

Lire::Config::List - List Value Object.

=head1 DESCRIPTION

Used for configuration parameters which contains a list of values.

=cut

sub new {
    my $self = shift->SUPER::new( @_ );

    check_object_param( $self->{'spec'}, 'spec', 'Lire::Config::ListSpec' );

    $self->{'elements'} = []
      unless ( exists $self->{'elements'} );

    return $self;
}

sub as_value {
    return [ map { $_->as_value() } @{$_[0]->{'elements'}} ];
}

=pod

=head2 elements()

Returns this list's values as an array of Lire::Config::Value object.

=cut

sub elements {
    return @{$_[0]->{'elements'}};
}

=pod

=head2 get( $idx )

Returns the value stored at index $idx of this list. An exception is
thrown if the index is out-of-bounds.

=cut

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

    check_param( $idx, 'idx', qr/^-?\d+$/,
                 "'idx' parameter should be an integer" );

    croak "index out of bounds: $idx"
      unless $idx >= 0 ? ( $idx < @{$self->{'elements'}} ):
                         ( abs($idx)-1 < @{$self->{'elements'}} );

    return $self->{'elements'}[$idx];
}

=pod

=head2 remove( $idx )

Removes the value stored at index $idx of this list. An exception is
thrown if the index is out-of-bounds. It returns the deleted element.

=cut

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

    check_param( $idx, 'idx', qr/^-?\d+$/,
                 "'idx' parameter should be an integer" );

    croak "index out of bounds: $idx"
      unless ( $idx >= 0
               ? ( $idx < @{$self->{'elements'}} )
               : ( abs($idx)-1 < @{$self->{'elements'}} ) );

    return splice(@{$self->{'elements'}}, $idx, 1);
}

=pod

=head2 clear()

Removes all elements from this list

=cut

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

    $self->{'elements'} = [];

    return;
}

=pod

=head2 append( $val, [ $idx ] )

Adds $val to after element $idx. If $idx is omitted, the element will
be added at the end of the array. A negative index is interpreted
relative to the end of the array.

=cut

sub append {
    my ( $self, $value, $idx ) = @_;

    check_object_param( $value, 'value', 'Lire::Config::Value' );
    $self->check_idx( $idx )
      if defined $idx;

    my $value_name = $value->name();
    croak $self->name(), " cannot contains ", $value_name, " parameters"
      unless $self->spec()->has_component( $value_name );

    croak "$value is not a valid instance for component ", $value_name
      unless $self->spec()->get( $value_name )->is_instance( $value );

    if ( defined $idx ) {
        $idx = $idx == -1 ? $#{$self->{'elements'}} + 1 : $idx+1;
        splice @{$self->{'elements'}}, $idx, 0, $value;
    } else {
        push @{$self->{'elements'}}, $value;
    }


    return;
}

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

    croak "not an integer: $idx" unless $idx =~ /^-?\d+$/;
    croak "index out of bounds: $idx"
      unless $idx >= 0 ? ( $idx < @{$self->{'elements'}} ):
                         ( abs($idx)-1 < @{$self->{'elements'}} );
    return;
}

=pod

=head2 move( $idx, $new_idx )

Moves element $idx at position $new_idx. Indices can be negative and
are interpreted as position relative to the end of the array.

=cut

sub move {
    my ( $self, $idx, $new_idx ) = @_;

    $self->check_idx( $idx );
    $self->check_idx( $new_idx );

    $idx = @{$self->{'elements'}} + $idx
      if $idx < 0;
    $new_idx = @{$self->{'elements'}} + $new_idx
      if $new_idx < 0;

    return if $idx == $new_idx;

    my $elmnt = splice @{$self->{'elements'}}, $idx, 1;
    splice @{$self->{'elements'}}, $new_idx, 0, $elmnt;

    return;
}

=pod

=head2 set( $idx, $value )

Replaces value at index $idx with $value.

=cut

sub set {
    my ( $self, $idx, $value ) = @_;

    check_param( $idx, 'idx' );
    check_param( $value, 'value' );
    $self->check_idx( $idx );

    $self->{'elements'}[$idx] = $value;

    return;
}

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

    return 0 unless $self->SUPER::is_equals( $other );

    return 0 unless @{$self->{'elements'}} == @{$other->{'elements'}};

    for ( my $i=0; $i < @{$self->{'elements'}}; $i++ ) {
        return 0 unless $self->{'elements'}[$i]->is_equals( $other->{'elements'}[$i] );
    }
    return 1;
}

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

    foreach my $elmnt ( $self->elements() ) {
        return 0 if $elmnt->spec()->required() && !$elmnt->is_valid();
    }

    return 1;
}

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

    foreach my $val (@{$self->{'elements'}}) {
        $val->save_xml( $fh, $indent+1, $xmlns );
    }

    return;
}

1; # whine, whine

__END__

=pod

=head1 AUTHOR

  Wessel Dankers <wsl@logreport.org>

=head1 VERSION

$Id: List.pm,v 1.16 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