Acme::MetaSyntactic::MultiList - Base class for themes with multiple lists

Acme-MetaSyntactic documentation Contained in the Acme-MetaSyntactic distribution.

Index

Code Index:

NAME

Top

Acme::MetaSyntactic::MultiList - Base class for themes with multiple lists

SYNOPSIS

Top

    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

DESCRIPTION

Top

Acme::MetaSyntactic::MultiList is the base class for all themes that are meant to return a random excerpt from a predefined list divided in categories.

The category is selected at construction time from:

1.

the given category parameter,

2.

the default category for the selected theme.

Categories and sub-categories are separated by a / character.

METHODS

Top

Acme::MetaSyntactic::MultiList offers several methods, so that the subclasses are easy to write (see full example in SYNOPSIS):

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 :all will use all the items in all categories.

    $meta = Acme::MetaSyntactic::digits->new( category => ':all' );

If no category parameter is given, Acme::MetaSyntactic::MultiList will use the class default. If the class doesn't define a default, then :all is used.

init()

init() must be called when the subclass is loaded, so as to read the __DATA__ section and fully initialise it.

name( $count )

Return $count names (default: 1).

Using 0 will return the whole list in list context, and the size of the list in scalar context (according to the category parameter passed to the constructor).

category()

Return the selected category for this instance.

categories()

Return the categories supported by the theme (except :all).

has_category( $category )

Return a boolean value indicating if the theme contains the given category.

theme()

Return the theme name.

AUTHOR

Top

Philippe 'BooK' Bruhat, <book@cpan.org>

COPYRIGHT & LICENSE

Top

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.

Acme-MetaSyntactic documentation Contained in the Acme-MetaSyntactic distribution. 
package Acme::MetaSyntactic::MultiList;
use strict;
use Acme::MetaSyntactic ();    # do not export metaname and friends
use Acme::MetaSyntactic::RemoteList;
use List::Util qw( shuffle );
use Carp;

our @ISA = qw( Acme::MetaSyntactic::RemoteList );

sub init {
    my $class = caller(0);
    my $data  = Acme::MetaSyntactic->load_data($class);
    no strict 'refs';

    my $sep = ${"$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"} = $data->{default} || ':all';
    ${"$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->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__