Acme-MetaSyntactic
view release on metacpan or search on metacpan
lib/Acme/MetaSyntactic.pm view on Meta::CPAN
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
lib/Acme/MetaSyntactic/MultiList.pm view on Meta::CPAN
# 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!!;
}
}
}
lib/Acme/MetaSyntactic/MultiList.pm view on Meta::CPAN
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 {
lib/Acme/MetaSyntactic/RemoteList.pm view on Meta::CPAN
use Acme::MetaSyntactic::List;
our @ISA = qw( Acme::MetaSyntactic::List );
# data regarding the remote source
our %Remote = (
source =>
'http://search.cpan.org/dist/Acme-MetaSyntactic/CONTRIBUTORS',
extract => sub {
my $content = shift;
my @items =
map { Acme::MetaSyntactic::RemoteList::tr_nonword($_) }
map { Acme::MetaSyntactic::RemoteList::tr_accent($_) }
$content =~ /^\* (.*?)\s*$/gm;
return @items;
},
);
__PACKAGE__->init();
1;
# and the usual documentation and list definition
lib/Acme/MetaSyntactic/contributors.pm view on Meta::CPAN
use strict;
use Acme::MetaSyntactic::List;
our @ISA = qw( Acme::MetaSyntactic::List );
our $VERSION = '1.002';
{
my %seen;
__PACKAGE__->init(
{ names => join ' ',
grep { !$seen{$_}++ }
map { s/_+/_/g; $_ }
map { Acme::MetaSyntactic::RemoteList::tr_nonword($_) }
map { Acme::MetaSyntactic::RemoteList::tr_accent($_) }
map { /^=head2 (.*)/ ? $1 : () }
split /\n/ => <<'=cut'} );
=pod
=head2 Vahe Sarkissian
L<Acme::MetaSyntactic::donmartin>.
=head2 David Landgren
lib/Test/MetaSyntactic.pm view on Meta::CPAN
sub _theme_items {
my ($theme) = @_;
# assume the module has already been loaded
no strict 'refs';
my $class = "Acme::MetaSyntactic::$theme";
my @items
= $class->isa('Acme::MetaSyntactic::List')
? @{"$class\::List"}
: $class->isa('Acme::MetaSyntactic::MultiList')
? map @$_, values %{"$class\::MultiList"}
: ();
return @items;
}
sub _check_file_lines {
my ($theme, $file, $mesg, $cb ) = @_;
my $tb = __PACKAGE__->builder;
$tb->plan( tests => 1 );
local $Test::Builder::Level = $Test::Builder::Level + 1;
lib/Test/MetaSyntactic.pm view on Meta::CPAN
else {
$skip = "This test needs the source file for $theme";
}
if( $skip ) {
$tb->skip($skip);
last SKIP;
}
my @lines = $cb->( <$fh> );
$tb->is_num( scalar @lines, 0, sprintf $mesg, $file );
map $tb->diag( $_ ), "Failed lines:\n", map " $_", @lines if @lines;
close $fh;
}
}
#
# individual subtest functions
#
# t/01load.t
# t/51useall.t
lib/Test/MetaSyntactic.pm view on Meta::CPAN
my $tb = __PACKAGE__->builder;
$tb->plan( tests => my $tests = 2 );
SKIP: {
if ( $theme =~ /^(?:any|random)$/ ) {
$tb->skip("Not testing import for theme $theme") for 1 .. $tests;
last SKIP;
}
else {
my ($pkg) = _load( $theme, 1 );
my %seen = map { $_ => 1 } _theme_items($theme);
no strict 'refs';
$tb->ok( exists ${"$pkg\::"}{"meta$theme"},
"meta$theme exported" );
my @names
= eval qq{package $pkg; no strict 'refs'; "meta$theme"->();};
$tb->ok( exists $seen{ $names[0] }, "meta$theme -> $names[0]" );
}
}
script/meta view on Meta::CPAN
eval "require $module; 1;" or die $@;
die "Theme '$theme' is not updatable!\n"
unless $module->has_remotelist();
}
# informative options
print STDERR
"meta, a simple front-end to Acme::MetaSyntactic version $Acme::MetaSyntactic::VERSION\n"
if $conf{version};
print STDERR $usage if $conf{help};
print map "$_\n", Acme::MetaSyntactic->themes if $conf{themes};
if ( $conf{sources} ) {
my @sources = $module->sources( $conf{category} );
print map "$_\n", @sources;
}
exit if $conf{themes} || $conf{version} || $conf{help} || $conf{sources};
# real processing starts here
$\ = $/;
my $sep = $conf{whitespace} ? ' ' : $\;
my $meta = Acme::MetaSyntactic->new( $theme, category => $conf{category} );
my (@remote, @local);
script/meta view on Meta::CPAN
-- Gabor Szabo
L<http://perlmaven.com/acme-metasyntactic>
=back
=head1 EXAMPLES OF USE
Ever needed to debug with the help of a few C<print()> statements?
Simply map some keystrokes to insert a warning where you want it.
With B<meta>, you will never need to think about what write in the
string argument:
nmap _wa :r!meta donmartin<CR>iwarn"<Esc>A";<Esc>==
(This mapping kindly given by Rafael Garcia-Suarez.)
=head1 AUTHOR
Philippe "BooK" Bruhat, C<< <book@cpan.org> >>.
=head1 COPYRIGHT
Copyright 2005-2006 Philippe 'BooK' Bruhat, All Rights Reserved.
=head1 LICENSE
script/metafy view on Meta::CPAN
unless Acme::MetaSyntactic->has_theme($theme);
@conf{$t, "${t}_category"} = ($theme, $category);
}
# informative options
print STDERR
"metafy your files, using Acme::MetaSyntactic version $Acme::MetaSyntactic::VERSION\n"
if $conf{version};
print STDERR $usage if $conf{help};
print map "$_\n", Acme::MetaSyntactic->themes if $conf{themes};
exit if $conf{themes} || $conf{version} || $conf{help};
# real processing starts here
my $from =
Acme::MetaSyntactic->new( $conf{from}, category => $conf{from_category} );
my $to = Acme::MetaSyntactic->new( $conf{to}, category => $conf{to_category} );
my @to = $to->name(0);
my %to;
# find the origin list
script/metafy view on Meta::CPAN
if ( $conf{'force-random'} ) { push @{ $to{$1} }, $repl = $to->name() }
else { $repl = $to{$1} ||= shift @to; @to = $to->name(0) if !@to }
$repl
/gei;
}
continue { print }
if( $conf{verbose} ) {
print STDERR "Translations:\n",
$conf{'force-random'}
? map { "\t$_ => @{$to{$_}}\n" } sort keys %to
: map { "\t$_ => $to{$_}\n" } sort keys %to;
}
__END__
=head1 NAME
metafy - Change the metasyntactic words in your text
=head1 SYNOPSIS
script/metafy view on Meta::CPAN
$ metafy --in-place foo:batman *.c
There is currently no way to create backup files (like perl's I<-i> option
allows).
=back
Each word from the original theme is replaced by the same word of the
target theme. However, if the target theme does not contain enough words
to map to the words from the original theme used in the file, then the
same words maybe used more than once. B<This may break programs!>
The option I<--force-random> will certainly break your stuff.
=head1 COMMAND-LINE OPTIONS
The following command-line options are available (and can all be abbreviated):
=head2 Metasyntactic options
t/00-compile.t view on Meta::CPAN
use IO::Handle;
open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!";
my @warnings;
for my $lib (@module_files)
{
# see L<perlfaq8/How can I capture STDERR from an external command?>
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-e', "require q[$lib]"))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
my @_warnings = <$stderr>;
waitpid($pid, 0);
is($?, 0, "$lib loaded ok");
shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/
t/00-compile.t view on Meta::CPAN
my $line = <$fh>;
close $fh and skip("$file isn't perl", 1) unless $line =~ /^#!\s*(?:\S*perl\S*)((?:\s+-\w*)*)(?:\s*#.*)?$/;
@switches = (@switches, split(' ', $1)) if $1;
close $fh and skip("$file uses -T; not testable with PERL5LIB", 1)
if grep { $_ eq '-T' } @switches and $ENV{PERL5LIB};
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-c', $file))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-c', $file);
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
my @_warnings = <$stderr>;
waitpid($pid, 0);
is($?, 0, "$file compiled ok");
shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/
t/00-report-prereqs.t view on Meta::CPAN
if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) {
push @dep_errors, "$mod is not installed ($req_string)";
}
}
}
if ( @reports ) {
push @full_reports, "=== $title ===\n\n";
my $ml = _max( map { length $_->[0] } @reports );
my $wl = _max( map { length $_->[1] } @reports );
my $hl = _max( map { length $_->[2] } @reports );
if ($type eq 'modules') {
splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl];
push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports;
}
else {
splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl];
push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports;
}
push @full_reports, "\n";
}
}
}
if ( @full_reports ) {
diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports;
}
use Test::More;
use File::Find;
use strict;
my @modules;
find( sub { push @modules, $File::Find::name if /^[A-Z].*\.pm$/ }, 'blib' );
plan tests => scalar @modules;
use_ok( $_ ) for map { s!/!::!g;s/\.pm$//;s/^blib::lib:://; $_ } sort @modules;
diag("Tested Acme::MetaSyntactic $Acme::MetaSyntactic::VERSION, Perl $], $^X" );
my $count = $meta->name( 0 );
is( $count, scalar @all, "name(0) is scalar context returns the count" );
}
DEFAULT: {
my $meta = Acme::MetaSyntactic->new();
no warnings;
my @names = $meta->name;
my %seen = map { $_ => 0 } @{$Acme::MetaSyntactic::foo::MultiList{en}};
ok( exists $seen{$names[0]}, "From the default list" );
%seen = map { $_ => 1 } $meta->name( test_ams_list => 4 );
is_deeply(
\%seen,
{ John => 1, Paul => 1, George => 1, Ringo => 1 },
"Got the whole list"
);
@names = $meta->name( 'foo/fr' );
%seen = map { $_ => 0 } @{$Acme::MetaSyntactic::foo::MultiList{fr}};
ok( exists $seen{$names[0]}, "using name() with a category" );
}
use strict;
use lib 't/lib';
use NoLang;
use Acme::MetaSyntactic;
plan tests => 2;
# the default list
no warnings;
my @names = metaname();
my %seen = map { $_ => 1 } @{$Acme::MetaSyntactic::foo::MultiList{en}};
ok( exists $seen{$names[0]}, "metaname" );
is_deeply(
[ sort grep { /^meta\w+$/ } keys %:: ],
[qw( metaname )],
"Default exported function"
);
t/16import.t view on Meta::CPAN
use strict;
use File::Spec::Functions;
my $dir;
BEGIN { $dir = catdir qw( t lib ); }
use lib $dir;
use Acme::MetaSyntactic 'test_ams_list';
plan tests => 4;
my @names = metaname();
my %seen = map { $_ => 1 } @Acme::MetaSyntactic::test_ams_list::List;
ok( exists $seen{$names[0]}, "metaname" );
my @bots = qw( purl url sarko bender );
my $meta = Acme::MetaSyntactic->new( 'bots' );
# yep, you can add the theme after creating the instance
Acme::MetaSyntactic->add_theme( bots => [ @bots ] );
@names = metabots();
is( scalar @names, 1, "metabots() returned a single item" );
push @names, metabots(3);
is( scalar @names, 4, "metabots( 3 ) returned three more items" );
%seen = map { $_ => 1 } @names;
is_deeply( \%seen, { map { $_ => 1 } @bots }, "Got the whole list");
t/20theme.t view on Meta::CPAN
Acme::MetaSyntactic->add_theme( bots => [ @bots ] );
ok( Acme::MetaSyntactic->has_theme( 'bots' ), "has bots now" );
my @names = $meta->name;
is( scalar @names, 1, "name() returned a single item" );
push @names, $meta->name(3);
is( scalar @names, 4, "name( 3 ) returned three more items" );
my %seen = map { $_ => 1 } @names;
is_deeply( \%seen, { map { $_ => 1 } @bots }, "Got the whole list");
# the new method exists
$meta = Acme::MetaSyntactic->new( 'test_ams_list' );
@names = $meta->name( bots => 2 );
ok( exists( $seen{$_} ), "the name() method accepts bots" ) for @names;
# and the new function exists as well
$meta = Acme::MetaSyntactic->new( 'test_ams_list' );
@names = metabots( 2 );
ok( exists( $seen{$_} ), "the metabots() function" ) for @names;
sub (@) { my @t = sort @_; push @t, shift @t for 1 .. $j; $j++; @t };
}
# compute the first 6 installed themes
my $meta = Acme::MetaSyntactic->new();
my $count = my @themes = grep { ! /^any$/ } sort $meta->themes();
my $max = $count >= 6 ? 5 : $count - 1;
@themes = @themes[ 0 .. $max ];
# the test list is computed now because of cache issues
my @tests = map {
my @items = sort $meta->name( $themes[$_] => 0 );
[ ( (@items) x ( 1 + int( ( $_ + 1 ) / @items ) ) )[ 0 .. $_ + 1 ] ];
} 0 .. $max;
plan tests => scalar @tests;
for my $test (@tests) {
my @names = metaany( scalar @$test );
is_deeply( \@names, $test,
qq{Got "random" names from a "random" theme (@{[shift @themes]})} );
t/32multi.t view on Meta::CPAN
"All categories (class)"
);
@categories = Acme::MetaSyntactic::mongers->new()->categories();
is_deeply(
[ sort @categories ],
[ grep { $_ ne ':all' } sort keys %tests ],
"All categories (instances)"
);
for my $args ( [], map { [ category => $_ ] } @categories, ':all', 'zz' ) {
my $meta = Acme::MetaSyntactic::mongers->new(@$args);
my $category = $args->[1] || 'fr/lyon';
$category = 'fr/lyon'
if $category eq 'zz'; # check fallback to default
my ( $one, $four ) = ( 1, 4 );
( $one, $four ) = ( 0, 0 ) if $category eq 'mars'; # empty list
my @mongers = $meta->name();
is( $meta->category(), $category, "category() is $category" );
is( @mongers, $one, "Single item ($one $category)" );
t/33locale.t view on Meta::CPAN
"All languages (class)"
);
@langs = Acme::MetaSyntactic::test_ams_locale->new()->languages();
is_deeply(
[ sort @langs ],
[qw( en fr it x-chiendent yi )],
"All languages (instance)"
);
for my $args ( [], map { [ lang => $_ ] } @langs, 'zz' ) {
my $meta = Acme::MetaSyntactic::test_ams_locale->new(@$args);
my $lang = $args->[1] || 'fr';
my ( $one, $four ) = ( 1, 4 );
$lang = 'fr' if $lang eq 'zz'; # check fallback to default
my @digits = $meta->name;
is( $meta->lang, $lang, "lang() is $lang" );
is( @digits, $one, "Single item ($one $lang)" );
@digits = $meta->name(4);
is( @digits, $four, "Four items ($four $lang)" );
t/35remote.t view on Meta::CPAN
use Acme::MetaSyntactic::List;
our @ISA = qw( Acme::MetaSyntactic::List );
use Cwd;
# data regarding the updates
our %Remote = (
source => 'file://' . cwd() . '/t/remote',
extract => sub {
my $content = shift;
my @items =
map { Acme::MetaSyntactic::RemoteList::tr_nonword($_) }
map { Acme::MetaSyntactic::RemoteList::tr_accent($_) }
$content =~ /^\* (.*?)\s*$/gm;
return @items;
},
);
__PACKAGE__->init();
1;
__DATA__
# names
t/35remote2.t view on Meta::CPAN
our @ISA = qw( Acme::MetaSyntactic::List );
use Cwd;
# data regarding the updates
our %Remote = (
source =>
[ 'file://' . cwd() . '/t/remote1', 'file://' . cwd() . '/t/remote2' ],
extract => sub {
my $content = shift;
my @items =
map { Acme::MetaSyntactic::RemoteList::tr_nonword($_) }
map { Acme::MetaSyntactic::RemoteList::tr_accent($_) }
$content =~ /^\* (.*?)\s*$/gm;
return @items;
},
);
__PACKAGE__->init();
1;
__DATA__
# names
t/50usecase.t view on Meta::CPAN
my @list_cases = File::Glob::bsd_glob catfile(qw(t usecase_list*));
my @locale_fr_cases = File::Glob::bsd_glob catfile(qw(t usecase_locale_fr*));
my @locale_en_cases = File::Glob::bsd_glob catfile(qw(t usecase_locale_en*));
my @alias_cases = File::Glob::bsd_glob catfile(qw(t usecase_alias*));
plan tests => 2
* ( @list_cases + @locale_fr_cases + @locale_en_cases + @alias_cases );
LIST: {
use Acme::MetaSyntactic::test_ams_list;
my %items = map { $_ => 1 } @Acme::MetaSyntactic::test_ams_list::List;
for (@list_cases) {
my $result = `$^X "-I$dir" -Mstrict -w $_`;
is( $? >> 8, 0, "$_ ran successfully" );
ok( exists $items{$result},
"'$result' is an item from the test_ams_list theme" );
}
}
LOCALE: {
use Acme::MetaSyntactic 'test_ams_locale';
my %items_en = map { $_ => 1 } @{$Acme::MetaSyntactic::test_ams_locale::Locale{en}};
my %items_fr = map { $_ => 1 } @{$Acme::MetaSyntactic::test_ams_locale::Locale{fr}};
for (@locale_fr_cases) {
my $result = `$^X "-I$dir" -MNoLang -Mstrict -w $_`;
is( $? >> 8, 0, "$_ ran successfully" );
ok( exists $items_fr{$result},
"'$result' is an item from the test_ams_locale/fr theme" );
}
for (@locale_en_cases) {
my $result = `$^X "-I$dir" -MNoLang -Mstrict -w $_`;
is( $? >> 8, 0, "$_ ran successfully" );
ok( exists $items_en{$result},
"'$result' is an item from the test_ams_locale/en theme" );
}
}
ALIAS: {
use Acme::MetaSyntactic::test_ams_alias;
my %items = map { $_ => 1 } Acme::MetaSyntactic::test_ams_alias->new( category => ':all' )->name( 0 );
for (@alias_cases) {
my $result = `$^X "-I$dir" -Mstrict -w $_`;
is( $? >> 8, 0, "$_ ran successfully" );
ok( exists $items{$result},
"'$result' is an item from the test_ams_alias theme" );
}
}
( run in 2.810 seconds using v1.01-cache-2.11-cpan-49f99fa48dc )