David Manura wrote:
Hi Ruslan,
Do you have a link? or some POD documentation?
-davidm
I realy realy sorry, I've forgot to attach file :(
Was tired a lot.
Ruslan U. Zakirov wrote:
Hello.
I'm planning to do my first CPAN upload.
I realy need some feedback.
Reasons:
1) Module is very simple, but I like it and use it.
2) I didn't find any similar on CPAN.
Questions:
1) I'm not native English speaker, so I want some feedback about
Name.
2) Code, coding style, and so.
3) Something like: fooooo..., useless, suxxx is OK, but with
reasons :)
My ideas:
1) May be it's better to prefix with _ all funcs which have
AUTOLOAD magic? There is many such methods in module so it's hard to
inherit this object.
Best regards. Ruslan.
Beforehead thanks.
package Class::MultiList;
use 5.006;
use strict;
use warnings;
our $VERSION = '0.1';
our $AUTOLOAD;
sub new
{
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
bless ($self, $class);
return $self;
}
sub InitList
{
my $self = shift;
my $args = {
Name => undef,
@_,
};
die 'Where Name?' unless ($args->{'Name'});
$self->{'Lists'}->{ $args->{'Name'} } = {
List => [],
Current => undef,
Counter => 0,
Hash => {},
};
}
sub AUTOLOAD
{
my $self = shift;
my @avail = qw(Count First Current Last Next Prev Push Pop Unshift Shift);
my $re = join('|', @avail);
my ($func, $list) = ($AUTOLOAD =~ /^.*::($re)(.*)$/);
unless ( $func ) {
my ($package, $filename, $line) = caller;
die "$AUTOLOAD Unimplemented in $package. ($filename line $line) \n";
}
unless ( $self->Exists( List => $list ) ) {
die "List $list not exists";
}
no strict qw(refs);
*{$AUTOLOAD} = sub { return ( $self->$func( List => $list, @_ ) ) };
return ( $self->$func( List => $list, @_ ) );
}
sub Exists
{
my $self = shift;
my $args = {
List => undef,
@_,
};
return exists($self->{'Lists'}->{ $args->{'List'} });
}
sub Names
{
my $self = shift;
return keys %{$self->{'Lists'}};
}
sub First
{
my $self = shift;
my $args = {
List => undef,
@_,
};
my $list = $self->__GetList( $args->{'List'} );
$list->{'Current'} = 0;
return $self->Current( List => $args->{'List'} );
}
sub Current
{
my $self = shift;
my $args = {
List => undef,
@_,
};
my $list = $self->__GetList( $args->{'List'} );
return $list->{'List'}->{ $list->{'Current'} };
}
sub Last
{
my $self = shift;
my $args = {
List => undef,
@_,
};
my $list = $self->__GetList( $args->{'List'} );
$list->{'Current'} = $self->Count( List => $args->{'List'} );
return $self->Current( List => $args->{'List'} );
}
sub Next
{
my $self = shift;
my $args = {
List => undef,
@_,
};
my $list = $self->__GetList( $args->{'List'} );
$list->{'Counter'}++;
return $self->Current( List => $args->{'List'} )
if( $list->{'Counter'} < $self->Count( List => $args->{'List'} ) );
$list->{'Counter'} = undef;
return undef;
}
sub Prev
{
my $self = shift;
my $args = {
List => undef,
@_,
};
my $list = $self->__GetList( $args->{'List'} );
$list->{'Counter'}--;
return $self->Current( List => $args->{'List'} )
if( $list->{'Counter'} >= 0 );
$list->{'Counter'} = undef;
return undef;
}
sub Count
{
my $self = shift;
my $args = {
List => undef,
@_,
};
my $list = $self->__GetList( $args->{'List'} );
return $list->{'Counter'};
}
sub Push
{
my $self = shift;
my $args = {
List => undef,
Element => undef,
Mark => undef,
@_,
};
my $list = $self->__GetList( $args->{'List'} );
if ( $args->{'Mark'} ) {
die 'Mark already exists' if (exists $list->{'Hash'}->{
$args->{'Mark'} });
$list->{'Hash'}->{ $args->{'Mark'} } = $list->{'Counter'};
}
$list->{'Counter'}++;
push( @{$list->{'List'}}, $args->{'Element'} );
return;
}
sub Pop
{
my $self = shift;
my $args = {
List => undef,
@_,
};
my $list = $self->__GetList( $args->{'List'} );
$list->{'Counter'}--;
$list->{'Current'} = undef if ( $list->{'Current'} == $list->{'Counter'} );
# check for mark, candidate for optimizing
foreach my $mark ( keys %{$list->{'Hash'}} ) {
next unless ( $list->{'Hash'}->{ $mark } != $list->{'Counter'} );
delete $list->{'Hash'}->{ $mark };
last;
}
return pop( @{$list->{'List'}} );
}
sub Unshift
{
my $self = shift;
my $args = {
List => undef,
Element => undef,
Mark => undef,
@_,
};
my $list = $self->__GetList( $args->{'List'} );
if ( $args->{'Mark'} ) {
die 'Mark already exists' if (exists $list->{'Hash'}->{
$args->{'Mark'} });
$list->{'Hash'}->{ $args->{'Mark'} } = 0;
}
$list->{'Current'} = 1 if ( $list->{'Current'} == 0 );
$list->{'Counter'}++;
unshift( @{$list->{'List'}}, $args->{'Element'} );
return;
}
sub Shift
{
my $self = shift;
my $args = {
List => undef,
@_,
};
my $list = $self->__GetList( $args->{'List'} );
$list->{'Counter'}--;
$list->{'Current'} = undef if ( $list->{'Current'} == 0 );
# check for mark, candidate for optimizing
foreach my $mark ( keys %{$list->{'Hash'}} ) {
next unless ( $list->{'Hash'}->{ $mark } != $list->{'Counter'} );
delete $list->{'Hash'}->{ $mark };
last;
}
return shift( @{$list->{'List'}} );
}
sub __GetList
{
my ($self, $name)= @_;
die "List $name not exists"
unless $self->Exists( List => $name );
return $self->{'Lists'}->{ $name };
}
1;
__END__
=head1 NAME
Class::MultiList - Simple OO arrays container
=head1 SYNOPSIS
use Class::MultiList;
my $ML = new Class::MultiList;
$ML->InitList( Name => 'Child' );
$ML->PushChild( 666 );
$ML->PushChild( 'Just string' );
$ML->PushChild( $obj );
while ( $el->NextChild ) {
...
}
$ML->InitList( Name => 'Sibling' );
=head1 DESCRIPTION
This module represents C<Class::MultiList> class. Objects of
this class allow handle different lists(arrays) in one instance
with separated namespaces.
This module also provide AUTOLOAD magic which allow to use
dinamic methods like MethodListname.
=head1 METHODS
It's TODO somewhere somwhow sometime
=head1 TODO
=over
=item *
Implement marks interface ala hash aliases for elements
=item *
Implement structures clonning via C<Clone::Any>
=item *
Write test suit
=item *
Fix documentation errors
=back
=head1 SEE ALSO
perltoot(1)
=head1 AUTHOR
Ruslan U. Zakirov, E<lt>[EMAIL PROTECTED]<gt>
=head1 COPYRIGHT AND LICENSE
Copyright 2004 by Ruslan U. Zakirov
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
