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 .= "<?xml version=\"1.0\" encoding=\"$self->{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 .= "</$self->{'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 = '<ul>';
foreach (@{$self->{LIST}}){
$xml .= $_->to_html();
}
$xml .= '</ul>';
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<< <a.dupuis@infinityperl.org> >>
=head1 BUGS
Please report any bugs or feature requests to
C<bug-Slackware-Slackget@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Slackware-Slackget>.
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<http://www.infinityperl.org/category/slack-get>
=item * slack-get specific website
L<http://slackget.infinityperl.org>
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Slackware-Slackget>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/Slackware-Slackget>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/Slackware-Slackget>
=item * Search CPAN
L<http://search.cpan.org/dist/Slackware-Slackget>
=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