—package
Acme::MetaSyntactic::MultiList;
use
strict;
use
Carp;
our
@ISA
=
qw( Acme::MetaSyntactic::RemoteList )
;
our
$VERSION
=
'1.000'
;
sub
init {
my
(
$self
,
$data
) =
@_
;
my
$class
=
caller
(0);
$data
||= Acme::MetaSyntactic->load_data(
$class
);
no
strict
'refs'
;
# note: variables mentioned twice to avoid a warning
my
$sep
= ${
"$class\::Separator"
} = ${
"$class\::Separator"
} ||=
'/'
;
my
$tail
=
qr/$sep?[^$sep]*$/
;
# compute all categories
my
@categories
= ( [
$data
->{names},
''
] );
while
(
my
(
$h
,
$k
) = @{
shift
@categories
or []} ) {
if
(
ref
$h
eq
'HASH'
) {
push
@categories
,
map
{ [
$h
->{
$_
}, (
$k
?
"$k$sep$_"
:
$_
) ] }
keys
%$h
;
}
else
{
# leaf
my
@items
=
split
/\s+/,
$h
;
while
(
$k
) {
push
@{ ${
"$class\::MultiList"
}{
$k
} },
@items
;
$k
=~ s!
$tail
!!;
}
}
}
${
"$class\::Default"
} = ${
"$class\::Default"
} =
$data
->{
default
} ||
':all'
;
${
"$class\::Theme"
} = ${
"$class\::Theme"
} = (
split
/::/,
$class
)[-1];
*{
"$class\::import"
} =
sub
{
my
$callpkg
=
caller
(0);
my
$theme
= ${
"$class\::Theme"
};
my
$meta
=
$class
->new;
*{
"$callpkg\::meta$theme"
} =
sub
{
$meta
->name(
@_
) };
};
${
"$class\::meta"
} = ${
"$class\::meta"
} =
$class
->new();
}
sub
name {
my
(
$self
,
$count
) =
@_
;
my
$class
=
ref
$self
;
if
( !
$class
) {
# called as a class method!
$class
=
$self
;
no
strict
'refs'
;
$self
= ${
"$class\::meta"
};
}
if
(
defined
$count
&&
$count
== 0 ) {
no
strict
'refs'
;
return
wantarray
? shuffle @{
$self
->{base} }
:
scalar
@{
$self
->{base} };
}
$count
||= 1;
my
$list
=
$self
->{cache};
if
( @{
$self
->{base} } ) {
push
@$list
, shuffle @{
$self
->{base} }
while
@$list
<
$count
;
}
splice
(
@$list
, 0,
$count
);
}
sub
new {
my
$class
=
shift
;
no
strict
'refs'
;
my
$self
=
bless
{
@_
,
cache
=> [] },
$class
;
# compute some defaults
$self
->{category} ||= ${
"$class\::Default"
};
# fall back to last resort (FIXME should we carp()?)
$self
->{category} = ${
"$class\::Default"
}
if
$self
->{category} ne
':all'
&& !
exists
${
"$class\::MultiList"
}{
$self
->{category} };
$self
->_compute_base();
return
$self
;
}
sub
_compute_base {
my
(
$self
) =
@_
;
my
$class
=
ref
$self
;
# compute the base list for this category
no
strict
'refs'
;
my
%seen
;
$self
->{base} = [
grep
{ !
$seen
{
$_
}++ }
map
{ @{ ${
"$class\::MultiList"
}{
$_
} } }
$self
->{category} eq
':all'
? (
keys
%{
"$class\::MultiList"
} )
: (
$self
->{category} )
];
return
;
}
sub
category {
$_
[0]->{category} }
sub
categories {
my
$class
=
shift
;
$class
=
ref
$class
if
ref
$class
;
no
strict
'refs'
;
return
keys
%{
"$class\::MultiList"
};
}
sub
has_category {
my
(
$class
,
$category
) =
@_
;
$class
=
ref
$class
if
ref
$class
;
no
strict
'refs'
;
return
exists
${
"$class\::MultiList"
}{
$category
};
}
sub
theme {
my
$class
=
ref
$_
[0] ||
$_
[0];
no
strict
'refs'
;
return
${
"$class\::Theme"
};
}
1;
__END__
=head1 NAME
Acme::MetaSyntactic::MultiList - Base class for themes with multiple lists
=head1 SYNOPSIS
package Acme::MetaSyntactic::digits;
use Acme::MetaSyntactic::MultiList;
our @ISA = ( Acme::MetaSyntactic::MultiList );
__PACKAGE__->init();
1;
=head1 NAME
Acme::MetaSyntactic::digits - The numbers theme
=head1 DESCRIPTION
You can count on this module. Almost.
=cut
__DATA__
# default
:all
# names primes even
two
# names primes odd
three five seven
# names composites even
four six eight
# names composites odd
nine
# names other
zero one
=head1 DESCRIPTION
C<Acme::MetaSyntactic::MultiList> is the base class for all themes
that are meant to return a random excerpt from a predefined list
I<divided in categories>.
The category is selected at construction time from:
=over 4
=item 1.
the given C<category> parameter,
=item 2.
the default category for the selected theme.
=back
Categories and sub-categories are separated by a C</> character.
=head1 METHODS
Acme::MetaSyntactic::MultiList offers several methods, so that the subclasses
are easy to write (see full example in L<SYNOPSIS>):
=over 4
=item new( category => $category )
The constructor of a single instance. An instance will not repeat items
until the list is exhausted.
$meta = Acme::MetaSyntactic::digits->new( category => 'primes' );
$meta = Acme::MetaSyntactic::digits->new( category => 'primes/odd' );
The special category C<:all> will use all the items in all categories.
$meta = Acme::MetaSyntactic::digits->new( category => ':all' );
If no C<category> parameter is given, C<Acme::MetaSyntactic::MultiList>
will use the class default. If the class doesn't define a default,
then C<:all> is used.
=item init()
init() must be called when the subclass is loaded, so as to read the
__DATA__ section and fully initialise it.
=item name( $count )
Return $count names (default: C<1>).
Using C<0> will return the whole list in list context, and the size of the
list in scalar context (according to the C<category> parameter passed to the
constructor).
=item category()
Return the selected category for this instance.
=item categories()
Return the categories supported by the theme (except C<:all>).
=item has_category( $category )
Return a boolean value indicating if the theme contains the given category.
=item theme()
Return the theme name.
=back
=head1 AUTHOR
Philippe 'BooK' Bruhat, C<< <book@cpan.org> >>
=head1 COPYRIGHT & LICENSE
Copyright 2006 Philippe 'BooK' Bruhat, All Rights Reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut