print results from the CPAN

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 all matches for this distribution

Acme-Automatix

1 match

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 all matches for this distribution

Acme-AwesomeQuotes

1 match

LICENSE view on Meta::CPAN

    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 all matches for this distribution

Acme-BABYMETAL

3 results

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

    return @members;
}

sub shout {
    my ($self) = @_;
    print "We are BABYMETAL DEATH!!\n";  
}


1;
__END__

view all matches for this distribution

Acme-BLACKJ-Utils

3 results

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 all matches for this distribution

Acme-BOATES

3 results

Makefile view on Meta::CPAN



# --- 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)

Makefile view on Meta::CPAN

# --- 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 all matches for this distribution

Acme-BOPE

1 match

  
  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;

  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;

  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;
   }

        '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__

   $_01 = "fanfarrao";
   if ($_01 eq "moleque") {
      die "seu viado";
   }
   else {
      print "Caveira, meu capitao!\n" and exit;
      warn "vai morrer gente";

      $_01 = undef;
   }


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 all matches for this distribution

Acme-Backwards

3 results

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 all matches for this distribution

Acme-BadFont

2 results

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 all matches for this distribution

Acme-Be-Modern

1 match

#!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 all matches for this distribution

Acme-BeCool

1 match

BeCool.pm view on Meta::CPAN

    my $cool = 0;
    for (@_) {
        eval "require $_";
        $caller->import($_) unless $@;
    }
    print STDERR "You are ", ($cool / @_), "\% cool\n";
}

1;
__END__

view all matches for this distribution

Acme-Beatnik

4 results

Beatnik.pm view on Meta::CPAN


$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;

Beatnik.pm view on Meta::CPAN


  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 all matches for this distribution

Acme-BeyondPerl-ToSQL

2 results

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 all matches for this distribution

Acme-BlahBlahBlah

1 match

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 all matches for this distribution

Acme-Blarghy-McBlarghBlargh

8 results

blarghymcblarghblargh.pl view on Meta::CPAN

#!/usr/bin/perl 

use Acme::Blarghy::McBlarghBlargh;

print blargh();

view all matches for this distribution

Acme-Bleach-Numerically

4 results

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 all matches for this distribution

Acme-Bleach

11 results

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 all matches for this distribution

Acme-BloodType

1 match

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 all matches for this distribution

Acme-BooK-Is-My-Bitch

3 results

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 all matches for this distribution

Acme-Boolean

2 results

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 all matches for this distribution

Acme-Boom

1 match

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 all matches for this distribution

Acme-Both-MakefilePL-And-BuildPL

1 match

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 all matches for this distribution

Acme-BottomsUp

2 results

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 all matches for this distribution

Acme-Brainfuck

7 results

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";

view all matches for this distribution

Acme-Buckaroo

4 results

# Data::Dumper is a very, very handy module, but it wasn't in the default Perl
# installation until (I think) Perl 5.6.  Perl 5.005 usually don't have it.
# Look on CPAN.ORG for Data::Dumper if you don't have it.
###############################################################################
my $debug_mode = 0;
print("starting script...\n") if $debug_mode;

if ($debug_mode)
{
    use Data::Dumper;
}


    my $in_string = shift;

    my $out = "";
    $out = Dumper($in_string);
    print("Instring=>>$out<<\n") if $debug_mode;

    my @in_array = split(//, $in_string);
    $out = Dumper(@in_array);
    print("in_array=>>$out<<\n")  if $debug_mode;

    my $i = 0;
    my @temparray = ();
    foreach my $thischar (@in_array)
    {
        # translate each character into it's ascii value.
        my $num = unpack("c", $thischar);
        # change that ascii value into a string from the array...
        my $newchar = $xlate_array[$num];
        print("char=>>$thischar<<, num=>>$num<<, newchar=>>$newchar<<\n")  if $debug_mode;
        print("char=>>%s<<, num=>>%s<<, newchar=>>%s<<\n", $thischar, $num, $newchar)  if $debug_mode;
        push(@temparray, "$newchar");
        $i++;
        if ($i > 3)
        {
            push(@temparray, "\n");
            $i = 0;
        }
    }

    my $out_string = $header . join("\t", @temparray) . "\n";
    print("out_string=>>$out_string<<\n")  if $debug_mode;
    return $out_string;

}

################################################################################

{
    my $in_string = shift;;

    $in_string =~ s/^$header//g;

    print("normalize, got in_string>>$in_string<<\n")  if $debug_mode;

    my %revhash = ();
    my $counter = 0;
    foreach my $this_elem (@xlate_array)
    {


    $in_string =~ s/\t\n/\t/g;
    $in_string =~ s/\t+/\t/g;
    my @in_array  = split(/[\t]/, $in_string);
    my $in_array_dump = Dumper(@in_array);
    print("in_array_dump=>>$in_array_dump<<\n")  if $debug_mode;

    my @translate_array = ();
    my $this_elem = "";
    $counter = 1;
    foreach $this_elem (@in_array)
    {
        if (!($this_elem)) { print("Found undefined elem, counter=$counter.\n"); $counter++; next; }
        my $ascii_num = $xlate_2_hash{$this_elem} || 0;
        my $to_char = pack("c", $ascii_num);
        printf("Normalized >>%s<<, ascii_num=>>%s<<, char=>>%s<<, counter=>>%s<<\n", $this_elem, $ascii_num, $to_char, $counter)  if $debug_mode;
        push(@translate_array, $to_char);
        $counter++;
    }

    my $outtext = join('', @translate_array);
    print("Converted back to text=>>$outtext<<\n") if $debug_mode;

    return("$outtext");

}

{

    my $in_string = shift;
    my $retval = 0;

    print("In has_wordchars\n") if $debug_mode;

    if ($in_string =~ /\s/)
    {
        return $in_string;
    }

{

    my $in_string = shift;
    my $retval = 0;

    print("In starts_with_header\n") if $debug_mode;

    if ($in_string =~ /^$header/)
    {
        return $in_string;
    }

{

    my $first           = shift;     # name of module, in this case "Buckaroo.pm"
    my $source_filename = $0;        # name of file called from (if test.pl does a 'use Acme::Buckaroo;' then this will be "test.pl")

    print("Starting \"Buckaroo\" process...\n") if $debug_mode;

    # set up some hashes to go to/from encoding scheme.
    my $i = 0;
    foreach my $this_elem (@xlate_array)
    {

        $i++;
    }

    if (!(open(FILE_HANDLE, "<$source_filename")))
    {
        print("Can't Buckaroo again on '$0'\n");
        exit;
    }
    else
    {
        #comment this out if you don't care.
        print("Past open... ") if $debug_mode;
    }

    #read entire file in as a string.
    my @file_array = <FILE_HANDLE>;
    my $file_array_dump = Dumper(@file_array);
    print("file_array_dump=>>$file_array_dump<<")  if $debug_mode;

    my $file_string = join("",  @file_array);

    # elim anything before the 'use Acme::Buckaroo; line.
    $file_string =~ s/use\s*Acme::Buckaroo\s*;\s*\n//;

    print("Filestring=>>$file_string<<\n")  if $debug_mode;

    # no clue why we do this.  Anyone know?
    #local $SIG{__WARN__} = \&has_wordchars;

    if ( (has_wordchars($file_string)        ) &&
         (!(starts_with_header($file_string))) )
    {
        if (!(open(FILE_HANDLE, ">$0")))
        {
            print("Cannot Buckaroo '$0'\n");
            exit;
        }
        print("past open2...")  if $debug_mode;
        print(FILE_HANDLE "use Acme::Buckaroo;\n");
        my $result = translate($file_string);
        print(FILE_HANDLE $result);
        print("Done \"Buckaroo-ing!\n");
    }
    else
    {
        print("normalizing...\n")  if $debug_mode;
        my $out_string = normalize($file_string);
        print("out_string=>>$out_string<<\n")  if $debug_mode;
        my $outval = eval($out_string);
        print("Outval returned: $outval\n") if $debug_mode;
        if ($@)
        {
            print("Perl Error returned: $@\n");
        }
        print("No eval error returned.\n") if $debug_mode;
    }

    print("Finishing...\n")  if $debug_mode;

    exit;

}


Before Buckaroo-ing:

use Acme::Buckaroo;

print "Watch 'Buckaroo Banzai Across the 8th Dimension' Today!";

After Bucaroo-ing:

use Acme::Buckaroo;
Buckaroo Banzai Across The Eigth Dimension Buckaroo Banzai Across The Eigth Dimension

view all matches for this distribution

Acme-Buffalo-Buffalo

1 match

use Test::More;

plan tests => 1;

BEGIN {
    use_ok( 'Acme::Buffalo::Buffalo' ) || print "Bail out!\n";
}

diag( "Testing Acme::Buffalo::Buffalo $Acme::Buffalo::Buffalo::VERSION, Perl $], $^X" );

view all matches for this distribution

Acme-Buffy

2 results

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

sub _punch {
    return $_[0] =~ /^$horns/;
}

sub import {
    open 0 or print "Can't rebuffy '$0'\n" and exit;
    ( my $demon = join "", <0> ) =~ s/.*^\s*use\s+Acme::Buffy\s*;\n//sm;
    local $SIG{__WARN__} = \&evil;
    do { eval _unslay $demon; exit }
        unless _evil $demon and not _punch $demon;
    open my $fh, ">$0" or print "Cannot buffy '$0'\n" and exit;
    print $fh "use Acme::Buffy;\n", _slay $demon and exit;
    print "use Acme::Buffy;\n", _slay $demon and exit;
    return;
}
"Grrr, arrrgh";

__END__

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


=head1 SYNOPSIS

  use Acme::Buffy;

  print "Hello world";

=head1 DESCRIPTION

The first time you run a program under C<use Acme::Buffy>, the module
removes most of the unsightly characters from your source file.  The

view all matches for this distribution

Acme-Buga

2 results

test.pl view on Meta::CPAN


## OO api
my $b = Acme::Buga->new;

my $en = $b->encode('Test');
print "Encode: $en \n";

my $de = $b->decode($en);
print "Decode: $de \n";

## using alternative constructor
my $en_static = buga('Test Static')->encode;
print "Encode Static: $en_static\n";

my $de_static = buga($en_static)->decode;
print "Decode Static: $de_static\n";

view all matches for this distribution

Acme-Bushisms

3 results