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 .= "$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 = '