view release on metacpan or  search on metacpan

lib/Acme/MetaSyntactic.pm  view on Meta::CPAN

    my @themes = ( grep { $_ eq ':all' } @_ )
      ? ( 'foo', grep { !/^(?:foo|:all)$/ } keys %META ) # 'foo' is still first
      : @_;

    $Theme = $themes[0] if @themes;
    $meta = Acme::MetaSyntactic->new( $Theme );

    # export the metaname() function
    no strict 'refs';
    my $callpkg = caller;
    *{"$callpkg\::metaname"} = \&metaname;    # standard theme

    # load the classes in @themes
    for my $theme( @themes ) {
        eval "require Acme::MetaSyntactic::$theme; import Acme::MetaSyntactic::$theme;";
        croak $@ if $@;
        *{"$callpkg\::meta$theme"} = sub { $meta->name( $theme, @_ ) };
    }
}

sub new {
    my ( $class, @args ) = ( @_ );
    my $theme;
    $theme = shift @args if @args % 2;
    $theme = $Theme unless $theme; # same default everywhere

    # defer croaking until name() is actually called
    bless { theme => $theme, args => { @args }, meta => {} }, $class;
}

# CLASS METHODS
sub add_theme {
    my $class  = shift;
    my %themes = @_;

    for my $theme ( keys %themes ) {
        croak "The theme $theme already exists!" if exists $META{$theme};
        my @badnames = grep { !/^[a-z_]\w*$/i } @{$themes{$theme}};
        croak "Invalid names (@badnames) for theme $theme"
          if @badnames;

        my $code = << "EOC";
package Acme::MetaSyntactic::$theme;
use strict;
use Acme::MetaSyntactic::List;
our \@ISA = qw( Acme::MetaSyntactic::List );
our \@List = qw( @{$themes{$theme}} );
1;
EOC
        eval $code;
        $META{$theme} = 1; # loaded

        # export the metatheme() function
        no strict 'refs';
        my $callpkg = caller;
        *{"$callpkg\::meta$theme"} = sub { $meta->name( $theme, @_ ) };
    }
}

# load the content of __DATA__ into a structure
# this class method is used by the other Acme::MetaSyntactic classes
sub load_data {
    my ($class, $theme ) = @_;
    my $data = {};

    my $fh;
    { no strict 'refs'; $fh = *{"$theme\::DATA"}{IO}; }

    my $item;
    my @items;
    $$item = "";

    {
        local $_;
        while (<$fh>) {
            /^#\s*(\w+.*)$/ && do {
                push @items, $item;
                $item = $data;
                my $last;
                my @keys = split m!\s+|\s*/\s*!, $1;
                $last = $item, $item = $item->{$_} ||= {} for @keys;
                $item = \( $last->{ $keys[-1] } = "" );
                next;
            };
            s/#.*//;    # remove end-of-line comments
            $$item .= $_;
        }
    }

    # avoid leaving all the DATA handles open
    close $fh;

    # clean up the items
    for( @items, $item ) {
        $$_ =~ s/\A\s*//;
        $$_ =~ s/\s*\z//;
        $$_ =~ s/\s+/ /g;
    }
    return $data;
}

# main function
sub metaname { $meta->name( @_ ) };

# corresponding method
sub name {
    my $self = shift;
    my ( $theme, $count );

    if (@_) {
        ( $theme, $count ) = @_;
        ( $theme, $count ) = ( $self->{theme}, $theme )
          if $theme =~ /^(?:0|[1-9]\d*)$/;
    }
    else {
        ( $theme, $count ) = ( $self->{theme}, 1 );
    }

    if( ! exists $self->{meta}{$theme} ) {
        my ( $Theme, $category ) = split /\//, $theme, 2;
        if( ! $META{$Theme} ) {
            eval "require Acme::MetaSyntactic::$Theme;";
            croak "Metasyntactic list $Theme does not exist!" if $@;
            $META{$theme} = 1; # loaded
        }
        $self->{meta}{$theme}
            = "Acme::MetaSyntactic::$Theme"->new( %{ $self->{args} },
            ( category => $category )x!! $category );
    }

    $self->{meta}{$theme}->name( $count );
}

# other methods
sub themes { wantarray ? ( sort keys %META ) : scalar keys %META }
sub has_theme { $_[1] ? exists $META{$_[1]} : 0 }

1;

__END__

=encoding iso-8859-1

=head1 NAME

Acme::MetaSyntactic - Themed metasyntactic variables names

=head1 SYNOPSIS

    use Acme::MetaSyntactic; # loads the default theme

lib/Acme/MetaSyntactic.pm  view on Meta::CPAN

But one gets quickly stuck with the same old boring examples.
Does it have to be this way? I say "No".

Here is C<Acme::MetaSyntactic>, designed to fulfill your metasyntactic needs.
Never again will you scratch your head in search of a good variable name!

=head1 METHODS (& FUNCTIONS)

C<Acme::MetaSyntactic> has an object-oriented interface, but can also
export a few functions (see L<EXPORTS>).

=head2 Methods

If you choose to use the OO interface, the following methods are
available:

=over 4

=item new( $theme )

Create a new instance of C<Acme::MetaSyntactic> with the theme C<$theme>.
If C<$theme> is omitted, the default theme is C<foo>.

=item name( [ $theme, ] $count )

Return C<$count> items from theme C<$theme>. If no theme is given,
the theme is the one passed to the constructor.

If C<$count> is omitted, it defaults to C<1>.

If C<$count> is C<0>, the whole list is returned (this may vary depending
on the "behaviour" of the theme) in list context, and the size of the
list in scalar context.

=back

There are also some class methods:

=over 4

=item themes( )

Return the sorted list of all available themes.

=item has_theme( $theme )

Return true if the theme C<$theme> exists.

=item add_theme( theme => [ @items ], ... )

This class method adds a new theme to the list. It also creates and
exports all the convenience functions (C<metaI<theme>()>) needed.

Note that this method can only create themes that implement the
C<Acme::MetaSyntactic::List> behaviour.

=item load_data( $data )

This method is used by the "behaviour" classes (such as
C<Acme::MetaSyntactic::List>) to read the content of the C<DATA>
filehandle and fetch the theme data.

The format is very simple. If the C<DATA> filehandle contains the
following data:

    # names
    bam zowie plonk
    powie kapow # comment
    # multi level
      abc    def
    # empty
    # multi lingual
    fr de

C<load_data()> will return the following data structure (the string
is trimmed, newlines and duplicate whitespace characters are squashed,
and end-of-line comments are removed):

    {
        names => "bam zowie plonk powie kapow",
        multi => {
            level   => "abc def",
            lingual => "fr de",
        },
        empty => ""
    }

For example, C<Acme::MetaSyntactic::List> uses the single parameter C<names>
to fetch the lists of names for creating its subclasses.

The C<init()> method in all "behaviour" classes will also accept an optional
C<$data> hashref and if it provided, will use it instead of reading the
C<__DATA__> section of the module. The actual structure of the hashref
depends on the C<Acme::MetaSyntactic::> class.

=back

Convenience methods also exists for all the themes. The methods are named
after the theme. They are exported only when the theme is actually used
or when it appear in the C<Acme::MetaSyntactic> import list. The first
imported theme is the default, used by the C<metaname()> function.

=head1 EXPORTS

Depending on how C<Acme::MetaSyntactic> is used, several functions can
be exported. All of them behave like the following:

=over 4

=item metaname( [ $theme, ] $count )

Return C<$count> items from theme C<$theme>. If no theme is given,
the theme is "default" theme. See below how to change what the default is.

=back

=head2 Use cases

=over 4

=item C<use Acme::MetaSyntactic;>

This exports the C<metaname()> function only.

=item C<use Acme::MetaSyntactic 'theme';>

This exports the C<metaname()> function and the C<metaI<theme>()>
function. C<metaname()> default to the theme I<theme>.

=item C<use Acme::MetaSyntactic qw(theme1 theme2);>

This exports the C<metaname()>, C<metaI<theme1>()>, C<metaI<theme2>()>
functions. C<metaname()> default to the first theme of the list (I<theme1>).

=item C<use Acme::MetaSyntactic ':all';>

This exports the C<metaname()> function and the meta* functions for
B<all> themes. C<metaname()> default to the standard default theme (C<foo>).

=item C<use Acme::MetaSyntactic::theme;>

This exports the C<metaI<theme>()> function only. The C<metaname()>
function is not exported.

=back

=head1 THEMES

The list of available themes can be obtained with the following one-liner:

    $ perl -MAcme::MetaSyntactic -le 'print for Acme::MetaSyntactic->themes'

The themes are all the C<Acme::MetaSyntactic::I<theme>> classes, with