package Slackware::Slackget::List; use warnings; use strict; =head1 NAME Slackware::Slackget::List - This class is a general List class. =head1 VERSION Version 1.0.0 =cut our $VERSION = '1.0.0'; =head1 SYNOPSIS This class is a container of Slackware::Slackget::Package object, and allow you to perform some operations on this packages list. As the Package class, it is a slack-get's internal representation of data. 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}"); push @{$self->{LIST}}, $pack; return 1; } =head2 get return the $index -nth object in the list $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 = '