File Coverage

blib/lib/Slackware/Slackget/List.pm

Criterion	Covered	Total	%
statement	56	69	81.1
branch	12	28	42.8
condition	6	21	28.5
subroutine	12	14	85.7
pod	12	12	100.0
total	98	144	68.0

package Slackware::Slackget::List;

use warnings;
use strict;

=head1 NAME

Slackware::Slackget::List - A generic list abstraction.

=head1 VERSION

Version 1.0.1

=cut

our $VERSION = '1.0.1';

=head1 SYNOPSIS

This class is a generic list abstraction. Most of the time it rely on Perl implementation of list operation, but it also implements some sanity checks.

This class is mainly designed to be inherited from.

    use Slackware::Slackget::List;

    my $list = Slackware::Slackget::List->new();
    $list->add($element);
    $list->get($index);
    my $element = $list->Shift();


=head1 CONSTRUCTOR

=head2 new

This class constructor take the followings arguments :

* list_type. You must provide a string which will specialize your list. Ex:

	For a Slackware::Slackget::Package list :
		my $packagelist = new Slackware::Slackget::List (list_type => 'Slackware::Slackget::Package') ;

* root-tag : the root tag of the XML generated by the to_XML method.

	For a Slackware::Slackget::Package list :
		my $packagelist = new Slackware::Slackget::List ('root-tag' => 'packagelist') ;


* no-root-tag : to disabling the root tag in the generated XML output.

	For a Slackware::Slackget::Package list :
		my $packagelist = new Slackware::Slackget::List ('no-root-tag' => 1) ;

A traditionnal constructor is :

	my $speciallist = new Slackware::Slackget::List (
		'list_type' => 'Slackware::Slackget::Special',
		'root-tag' => 'special-list'
	);

But look at special class Slackware::Slackget::*List before creating your own list : maybe I have already do the work :)

=cut

sub new
{
	my ($class,%args) = @_ ;
	return undef unless(defined($args{list_type}));
	my $self={%args};
	$self->{LIST} = [] ;
	$self->{ENCODING} = 'utf8' ;
	$self->{ENCODING} = $args{'encoding'} if(defined($args{'encoding'})) ;
	bless($self,$class);
	return $self;
}

=head1 FUNCTIONS

=head2 add

Add the element passed in argument to the list. The argument must be an object of the list_type type.

	$list->add($element);

=cut

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

# 	return undef if(ref($pack) ne "$self->{list_type}");
	if(defined($self->{list_type}) ){
		return undef unless(UNIVERSAL::isa($pack,$self->{list_type}));
	}
	push @{$self->{LIST}}, $pack;
	return 1;
}

=head2 get

return the $index -nth object in the list

	$element = $list->get($index);

=cut

sub get {
	my ($self,$idx) = @_ ;
	return undef unless(defined($idx));
	return undef unless(defined($self->{LIST}) && ref($self->{LIST}) eq 'ARRAY') ;
	return $self->{LIST}->[$idx];
}

=head2 get_all

return a reference on an array containing all packages.

	$arrayref = $list->get_all();

=cut

sub get_all {
	my $self = shift ;
	return [] unless(defined($self->{LIST}) && ref($self->{LIST}) eq 'ARRAY') ;
	return $self->{LIST};
}

=head2 Shift

Same as the Perl shift. Shifts of and return the first object of the Slackware::Slackget::List;

	$element = $list->Shift();

If a numerical index is passed shift and return the given index.

=cut

sub Shift {
	my ($self,$elem) = @_ ;
	return undef unless(defined($self->{LIST}) && ref($self->{LIST}) eq 'ARRAY') ;
	unless(defined($elem))
	{
		return shift(@{$self->{LIST}});
	}
	else
	{
		my $e = $self->get($elem);
		$self->{LIST} = [@{$self->{LIST}}[0..($elem-1)], @{$self->{LIST}}[($elem+1)..$#{$self->{LIST}}]] ;
		return $e;
	}
}

=head2 to_XML (deprecated)

Same as to_xml(), provided for backward compatibility.

=cut

sub to_XML {
	return to_xml(@_);
}

=head2 to_xml

return an XML encoded string.

	$xml = $list->to_xml();

=cut

sub to_xml
{
	my $self = shift;
	my $xml = "";
	return [] unless(defined($self->{LIST}) && ref($self->{LIST}) eq 'ARRAY') ;
	$self->{ENCODING} = uc($self->{ENCODING}) ; # NOTE: check if it do not screw up
	$xml .= "{ENCODING}\" standalone=\"yes\"?>\n<$self->{'root-tag'}>\n" if(!defined($self->{'no-root-tag'}) && defined($self->{'root-tag'}));
	foreach (@{$self->{LIST}}){
		$xml .= $_->to_xml();
	}
	$xml .= "{'root-tag'}>\n" if(!defined($self->{'no-root-tag'}) && defined($self->{'root-tag'}));
	return $xml;
}


=head2 to_HTML (deprecated)

Same as to_html(), provided for backward compatibility.

=cut

sub to_HTML {
	return to_html(@_);
}


=head2 to_html

return an HTML encoded string.

	$xml = $list->to_html();

=cut

sub to_html
{
	my $self = shift;
	my $xml = '';
	foreach (@{$self->{LIST}}){
		$xml .= $_->to_html();
	}
	$xml .= '';
	return $xml;
}

=head2 to_string

If this class is subclassed and if the subclass have a __to_string() method this is one is called.

If not, this method is an alias for to_xml().

=cut

sub to_string{
	my $self = shift;
	if( $self->can('__to_string') ){
		return $self->__to_string();
	}else{
		return $self->to_xml();
	}
}

=head2 Length

Return the length (the number of element) of the current list. If you are interest by the size in memory you have to multiply by yourself the number returned by this method by the size of a single object.

	$list->Length ;

=cut

sub Length
{
	my $self = shift;
	return 0 unless(defined($self->{LIST}) && ref($self->{LIST}) eq 'ARRAY') ;
	return scalar(@{$self->{LIST}});
}

=head2 empty

Empty the list

	$list->empty ;

=cut

sub empty
{
	my $self = shift ;
	$self->{LIST} = undef ;
	delete($self->{LIST});
	$self->{LIST} = [] ;
}


=head1 AUTHOR

DUPUIS Arnaud, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to
C, or through the web interface at
L.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Slackware::Slackget::List


You can also look for information at:

=over 4

=item * Infinity Perl website

L

=item * slack-get specific website

L

=item * RT: CPAN's request tracker

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back

=head1 ACKNOWLEDGEMENTS

Thanks to Bertrand Dupuis (yes my brother) for his contribution to the documentation.

=head1 SEE ALSO

=head1 COPYRIGHT & LICENSE

Copyright 2005 DUPUIS Arnaud, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of Slackware::Slackget::List