view release on metacpan or  search on metacpan

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

package Acme::MetaSyntactic;
$Acme::MetaSyntactic::VERSION = '1.015';
use strict;
use warnings;
use Carp;
use File::Basename;
use File::Spec;
use File::Glob;

# some class data
our $Theme = 'foo'; # default theme
our %META;

# private class method
sub _find_themes {
    my ( $class, @dirs ) = @_;
    return
        map  @$_,
        grep { $_->[0] !~ /^[A-Z]/ }    # remove the non-theme subclasses
        map  { [ ( fileparse( $_, qr/\.pm$/ ) )[0] => $_ ] }
        map  { File::Glob::bsd_glob( File::Spec->catfile( $_, qw( Acme MetaSyntactic *.pm ) ) ) } @dirs;
}

# fetch the list of standard themes
$META{$_} = 0 for keys %{ { __PACKAGE__->_find_themes(@INC) } };

# the functions actually hide an instance
my $meta = Acme::MetaSyntactic->new( $Theme );

# END OF INITIALISATION

# support for use Acme::MetaSyntactic 'foo'
# that automatically loads the required classes
sub import {
    my $class = shift;

    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;