view release on metacpan or  search on metacpan

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

=head1 EXPORT

=cut

sub ascii_emoji {
    return pack( 'C*', @{ $EMOJI{ $_[0] } } );
}

=head2 innocent

ʘ‿ʘ
Innocent face 

=cut

sub innocent {
    return ascii_emoji('innocent');
}

=head2 disapproval

ಠ_ಠ
Reddit disapproval face 

=cut

sub disapproval {
    return ascii_emoji('disapproval');
}

=head2 table_flip

(╯°□°）╯︵ ┻━┻
Table Flip / Flipping Table 

=cut

sub table_flip {
    return ascii_emoji('table_flip');
}

=head2 put_the_table_back

┬─┬ ノ( ゜-゜ノ)
Put the table back

=cut

sub put_the_table_back {
    return ascii_emoji('put_the_table_back');
}

=head2 double_flip 

┻━┻ ︵ヽ(`Д´)ﾉ︵ ┻━┻
Double Flip / Double Angry

=cut

sub double_flip {
    return ascii_emoji('double_flip');
}

=head2 super_waving

( ﾟ∀ﾟ)ｱﾊﾊ八八ﾉヽﾉヽﾉヽﾉ ＼ / ＼/ ＼
Super waving

=cut

sub super_waving {
    return ascii_emoji('super_waving');
}

=head2 fistacuffs

ლ(｀ー´ლ)
Fistacuffs

=cut

sub fistacuffs {
    return ascii_emoji('fistacuffs');
}

=head2 cute_bear 

ʕ•ᴥ•ʔ
Cute bear 

=cut

sub cute_bear {
    return ascii_emoji('cute_bear');
}

=head2 big_eyes 

(｡◕‿◕｡)
Big eyes 

=cut

sub big_eyes {
    return ascii_emoji('big_eyes');
}

=head2 surprised

（　ﾟДﾟ）
surprised / loudmouthed 

=cut

sub surprised {
    return ascii_emoji('surprised');
}

=head2 shrug

¯\_(ツ)_/¯
shrug face  

=cut

sub shrug {
    return ascii_emoji('shrug');
}

=head2 meh

¯\(°_o)/¯
meh

=cut

sub meh {
    return ascii_emoji('meh');
}

=head2 feel_perky 

(`･ω･´)
feel perky  

=cut

sub feel_perky {
    return ascii_emoji('feel_perky');
}

=head2 angry 

(╬ ಠ益ಠ)
angry face

=cut

sub angry {
    return ascii_emoji('angry');
}

=head2 excited

☜(⌒▽⌒)☞
excited 

=cut

sub excited {
    return ascii_emoji('excited');
}

=head2 running

ε=ε=ε=┌(;*´Д`)ﾉ
running 

=cut

sub running {
    return ascii_emoji('running');
}

=head2 happy

ヽ(´▽`)/
happy face  

=cut

sub happy {
    return ascii_emoji('happy');
}

=head2 basking_in_glory

ヽ(´ー｀)ノ
basking in glory  

=cut

sub basking_in_glory {
    return ascii_emoji('basking_in_glory');
}

=head2 kitty

ᵒᴥᵒ#
kitty emote

=cut

sub kitty {
    return ascii_emoji('kitty');
}

=head2 meow

ฅ^•ﻌ•^ฅ
meow

=cut

sub meow {
    return ascii_emoji('meow');
}

=head2 cheers

（ ^_^）o自自o（^_^ ）
Cheers  

=cut

sub cheers {
    return ascii_emoji('cheers');
}

=head2 devious

ಠ‿ಠ
devious smile

=cut

sub devious {
    return ascii_emoji('devious');
}

=head2 chan

( ͡° ͜ʖ ͡°)
4chan emoticon  

=cut

sub chan {
    return ascii_emoji('chan');
}

=head2 disagree

٩◔̯◔۶
disagree

=cut

sub disagree {
    return ascii_emoji('disagree');
}

=head2 flexing

ᕙ(⇀‸↼‶)ᕗ
flexing 

=cut

sub flexing {
    return ascii_emoji('flexing');
}

=head2 do_you_lift_bro

ᕦ(ò_óˇ)ᕤ
do you even lift bro?

=cut

sub do_you_lift_bro {
    return ascii_emoji('do_you_lift_bro');
}

=head2 kirby

⊂(◉‿◉)つ
kirby

=cut

sub kirby {
    return ascii_emoji('kirby');
}

=head2 tripping_out

q(❂‿❂)p
tripping out  

=cut

sub tripping_out {
    return ascii_emoji('tripping_out');
}

=head2 discombobulated

⊙﹏⊙
discombobulated 

=cut

sub discombobulated {
    return ascii_emoji('discombobulated');
}

=head2 sad_shrug

¯\_(⊙︿⊙)_/¯
sad and confused  

=cut

sub sad_shrug {
    return ascii_emoji('sad_shrug');
}

=head2 confused

¿ⓧ_ⓧﮌ
confused  

=cut

sub confused {
    return ascii_emoji('confused');
}

=head2 confused_scratch

(⊙.☉)7
confused scratch

=cut

sub confused_scratch {
    return ascii_emoji('confused_scratch');
}

=head2 worried

(´･_･`)
worried

=cut

sub worried {
    return ascii_emoji('worried');
}

=head2 dear_god_why

щ（ﾟДﾟщ）
dear god why  

=cut

sub dear_god_why {
    return ascii_emoji('dear_god_why');
}

=head2 staring

٩(͡๏_๏)۶
staring 

=cut

sub staring {
    return ascii_emoji('staring');
}

=head2 strut

ᕕ( ᐛ )ᕗ
strut

=cut

sub strut {
    return ascii_emoji('strut');
}

=head2 zoned

(⊙_◎)
zoned

=cut

sub zoned {
    return ascii_emoji('zoned');
}

=head2 crazy

ミ●﹏☉ミ
crazy

=cut

sub crazy {
    return ascii_emoji('crazy');
}

=head2 trolling

༼∵༽ ༼⍨༽ ༼⍢༽ ༼⍤༽
trolling

=cut

sub trolling {
    return ascii_emoji('trolling');
}

=head2 angry_troll

ヽ༼ ಠ益ಠ ༽ﾉ
angry troll

=cut

sub angry_troll {
    return ascii_emoji('angry_troll');
}

=head2 hugger

(づ￣ ³￣)づ
hugger

=cut

sub hugger {
    return ascii_emoji('hugger');
}

=head2 stranger_danger

(づ｡◕‿‿◕｡)づ
stranger danger

=cut

sub stranger_danger {
    return ascii_emoji('stranger_danger');
}

=head2 flip_friend

(ノಠ ∩ಠ)ノ彡( \o°o)\
flip friend

=cut

sub flip_friend {
    return ascii_emoji('flip_friend');
}

=head2 cry

｡ﾟ( ﾟஇ‸இﾟ)ﾟ｡
cry face

=cut

sub cry {
    return ascii_emoji('cry');
}

=head2 tgif

“ヽ(´▽｀)ノ”
TGIF

=cut

sub tgif {
    return ascii_emoji('tgif');
}

=head2 dancing

┌(ㆆ㉨ㆆ)ʃ
dancing 

=cut

sub dancing {
    return ascii_emoji('dancing');
}

=head2 sleepy

눈_눈
sleepy

=cut

sub sleepy {
    return ascii_emoji('sleepy');
}

=head2 fly_away

⁽⁽ଘ( ˊᵕˋ )ଓ⁾⁾
fly away

=cut

sub fly_away {
    return ascii_emoji('fly_away');
}

=head2 careless

â—”_â—”
careless

=cut

sub careless {
    return ascii_emoji('careless');
}

=head2 love

♥‿♥
love

=cut

sub love {
    return ascii_emoji('love');
}

=head2 touch

ԅ(≖‿≖ԅ)
Touchy Feely

=cut

sub touchy {
    return ascii_emoji('touchy');
}

=head2 robot
  
{•̃_•̃}
robot

=cut

sub robot {
    return ascii_emoji('robot');
}

=head2 seal

(ᵔᴥᵔ)
seal
``
=cut

sub seal {
    return ascii_emoji('seal');
}

=head2 questionable

(Ծ‸ Ծ)
questionable / dislike

=cut

sub questionable {
    return ascii_emoji('questionable');
}

=head2 winning

(•̀ᴗ•́)و ̑̑
Winning!

=cut

sub winning {
    return ascii_emoji('winning');
}

=head2 zombie

[¬º-°]¬
Zombie

=cut

sub zombie {
    return ascii_emoji('zombie');
}

=head2 pointing

(☞ﾟヮﾟ)☞
pointing

=cut

sub pointing {
    return ascii_emoji('pointing');
}

=head2 chasing

''⌐(ಠ۾ಠ)¬'''
chasing / running away

=cut

sub chasing {
    return ascii_emoji('chasing');
}

=head2 shy 

(๑•́ ₃ •̀๑) 
shy 

=cut

sub shy {
    return ascii_emoji('shy');
}

=head2 okay

( •_•)
okay..

=cut

sub okay {
    return ascii_emoji('okay');
}

=head2 put_sunglasses_on

( •_•)>⌐■-■
Put Sunglasses on.

=cut

sub put_sunglasses_on {
    return ascii_emoji('put_sunglasses_on');
}

=head2 sunglasses 

(⌐■_■)
sunglasses

=cut

sub sunglasses {
    return ascii_emoji('sunglasses');
}

=head2 giving_up

o(╥﹏╥)o
Giving Up

=cut

sub giving_up {
    return ascii_emoji('giving_up');
}

=head2 magical

(ﾉ◕ヮ◕)ﾉ*:・ﾟ✧
Magical

=cut

sub magical {
    return ascii_emoji('magical');
}

=head2 mustach

( ˇ෴ˇ )
Mustach

=cut

sub mustach {
    return ascii_emoji('mustach');
}

=head2 friends

(ｏ・_・)ノ”(ᴗ_ ᴗ。)
Friends

=cut

sub friends {
    return ascii_emoji('friends');
}

=head2 evil

(屮｀∀´)屮
Evil

=cut

sub evil {
    return ascii_emoji('evil');
}

=head2 devil

(◣∀◢)ψ
Devil

=cut

sub devil {
    return ascii_emoji('devil');
}

=head2 salute

(￣ー￣)ゞ
Salute

=cut

sub salute {
    return ascii_emoji('salute');
}

=head2 inject

┌(◉ ͜ʖ◉)つ┣▇▇▇═──
inject

=cut

sub inject {
    return ascii_emoji('inject');
}

=head2 why 

ヽ(｀⌒´メ)ノ
why

=cut

sub why {
    return ascii_emoji('why');
}

=head2 execution

(⌐■_■)︻╦╤─ (╥﹏╥)
execution

=cut

sub execution {
    return ascii_emoji('execution');
}

=head2 kicking

ヽ( ･∀･)ﾉ┌┛Σ(ノ `Д´)ノ
kicking

=cut

sub kicking {
    return ascii_emoji('kicking');
}

=head2 success

✧*｡٩(ˊᗜˋ*)و✧*｡
yay

=cut

sub success {
    return ascii_emoji('success');
}

=head2 punch

┏┫*｀ｰ´┣━━━━━━━━━●)ﾟOﾟ).｡ﾟ
punch

=cut

sub punch {
    return ascii_emoji('punch');
}

=head2 fu

ᕕ╏ ͡ᵔ ‸ ͡ᵔ ╏凸
*fu*

=cut

sub fu {
    return ascii_emoji('fu');
}

=head2 vision

(-(-(-_-)-)-)
vision

=cut

sub vision {
    return ascii_emoji('vision');
}

=head2 eyes

╭(◕◕ ◉෴◉ ◕◕)╮
eyes

=cut

sub eyes {
    return ascii_emoji('eyes');
}

=head2 wall

┴┬┴┤･_･├┴┬┴
wall

=cut

sub wall {
    return ascii_emoji('wall');
}

=head1 AUTHOR

 view release on metacpan or  search on metacpan

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

BEGIN {
    use Tie::Trace qw/watch/;
    no warnings 'redefine';

    *Tie::Trace::_output_message = sub {
        my ($self, $class, $value, $args) = @_;
        if (!$value) {
            return;
        }

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

            return("${msg}" . (! $self->{options}->{pkg} || @msg ? "" : " => "). "{$args->{key}} => $value$location");
        }
    };


    *Tie::Trace::_carpit = sub {
        my ($self, %args) = @_;
        return if $Tie::Trace::QUIET;
        
        my $class = (split /::/, ref $self)[2];
        my $op = $self->{options} || {};

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

            croak $watch_msg . $msg . "\n";
        }
    };

    watch @INC, (
        debug => sub {
            my ($self, $things) = @_;
            for my $thing (@$things) {
                my $ref = ref($thing);
                if ($ref) {
                    return "Acme::AtIncPolice does not allow contamination of \@INC";

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

=head1 SYNOPSIS

    use Acme::AtIncPolice;
    # be killed by Acme::AtIncPolice
    push @INC, sub {
        my ($coderef, $filename) = @_;
        my $modfile = "lib/$filename";
        if (-f $modfile) {
            open my $fh, '<', $modfile;
            return $fh;

 view release on metacpan or  search on metacpan

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

use strict;
use warnings;
package Acme::Auggy;

sub say_auggy {
    return "Auggy";
}

sub say_auggy_is {
    my ($is) = @_;

    return say_auggy . ' is ' . $is;
}

 view release on metacpan or  search on metacpan

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

our $VERSION = '0.04';

our $Colors;

sub import {
  my $class = shift;
  # TODO: parse version numbers
  $Colors = Graphics::ColorNames->new(@_);
}

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

use Carp qw( croak );
use Graphics::ColorNames qw( hex2tuple );

our $AUTOLOAD;

sub AUTOLOAD {
  my $class = shift;
  $AUTOLOAD =~ /.*::(\w+)/;

  my $cname = $1;

 view release on metacpan or  search on metacpan

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

our $last_fetched = "";
our $lib = "lib";
our $hook = \&inc;

sub ignore {}
sub import {
  warn "DEBUG: Congratulations! Acme::AutoLoad has been loaded.\n" if $ENV{AUTOLOAD_DEBUG};
  $lib = $ENV{AUTOLOAD_LIB} if $ENV{AUTOLOAD_LIB};
  if ($lib =~ m{^[^/]}) {
    eval {
      require Cwd;

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

  push @INC, $lib, $hook if $hook;
  $hook = undef;
  return \&ignore;
}

sub mkbase {
  my $path = shift;
  if ($path =~ s{/+[^/]*$ }{}x) {
    return 1 if -d $path;
  }
  die "$path: Not a directory\n" if lstat $path;

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

    return mkdir $path, 0755;
  }
  return 0;
}

sub fetch {
  my $url = shift;
  my $recurse = shift || {};
  $url = full($url) unless $url =~ m{^\w+://};
  my $contents = get($url);
  $last_fetched = $url;

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

  return $contents;
}

# full
# Turn a relative URL into a full URL
sub full {
  my $rel = shift;
  if ($rel =~ m{http://} || $last_fetched !~ m{^(http://[^/]+)(/?.*)}) {
    return $rel;
  }
  my $h = $1;

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

  return "$h$p$rel";
}

# fly
# Create a stub module to load the real file on-the-fly if needed.
sub fly {
  my $inc = shift;
  my $url = shift;
  my $write = shift;
  warn "DEBUG: Creating stub for [$inc] in order to download [$url] later if needed.\n" if $ENV{AUTOLOAD_DEBUG};
  my $contents = q{

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

    close $fh;
  }
  return $contents;
}

sub inc {
  my $i = shift;
  my $f = shift;
  my $cache_file = "$lib/$f";
  if (-f $cache_file) {
    warn "$cache_file: Broken module. Can't continue.\n";

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

  }

  return ();
}

sub get {
  local $_ = shift;
  s{^http(s|)://}{}i;
  s{^([\w\-\.\:]+)$}{$1/};
  s{^([\w\-\.]+)/}{$1:80/};
  if (m{^([\w\-\.]+:\d+)(/.*)}) {

 view release on metacpan or  search on metacpan

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

use warnings;

our $DEBUG = 0;

BEGIN {
    $SIG{__WARN__} = sub {
        warn @_ unless $_[0] =~ m/inherited AUTOLOAD/;
    };
}

sub find_function {
    my $function = shift;
    my $package  = shift || 'main';
    my $seen     = shift || {};
    # remove last ::
    $package =~ s/::$//;

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

    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
    my $symbols = do { no strict 'refs'; \%{$package . '::'} };
    my @packages = grep { $_ =~ m/::$/ } keys(%$symbols);
    foreach my $pkg (@packages) {
        $pkg = $package . '::' . $pkg unless ($package eq 'main');
        $sub = find_function($function, $pkg, $seen);
        return $sub if (ref($sub) eq 'CODE');
    }

    # not found
    return undef;
}

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;

__END__

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

This module allows you to call any function ever seen by your perl instance.
As long as you used/required a module in the past you can now call its functions everywhere.

=head1 HOW IT WORKS

The module puts an AUTOLOAD sub into UNIVERSAL so every package has it.
When it is called (i.e. your current package doesn't have the called sub itself)
it traverses all known packages (it examines main:: and from there on everything else).
The first found function will then be executed.

=head1 LIMITATIONS

Obviously calling 'new' in a package that does not have it is kind of not clever as a lot of packages have that sub.
So you cannot really be sure which one is called...

Also calling subs working on a $self only works, if your package has the guts the called sub expects.

Other than that it might collide with other AUTOLOADs, so use with care ;-)

=head2 WARNING

 view release on metacpan or  search on metacpan

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

                 'notcaron' => qr/[^\P{NonspacingMark}\x{030C}]/,
                 'puncsep'  => qr/[\p{Separator}\p{Punctuation}]/,
                );


sub GetAwesome {
	(my $string = NFD($_[0])) =~ s/(?:^${chartypes{puncsep}}+|${chartypes{puncsep}}+$)//g;

	eval {checkstring($string)} or croak $@;

	# For individual characters, use a caron instead of terminal acute/grave accents:

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

	return(NFC($string));
}


sub checkstring {
	my $string = $_[0];
	if ($string eq '') {
		die "String is empty!\n";
	}
	elsif ((($string =~ /^`\p{Letter}${chartypes{notgrave}}*\x{0300}/) &&

 view release on metacpan or  search on metacpan

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

our $VERSION = "0.03";

my @members = qw(SU-METAL YUIMETAL MOAMETAL);

sub new {
    my $class = shift;
    my $self  = bless {members => []}, $class;
    for my $member (@members) {
        $member =~ s|-|_|;
        my $module_name = 'Acme::BABYMETAL::' . $member;

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

        push @{$self->{members}}, $module_name->new;
    }
    return $self;
}

sub homepage {
    my ($self) = @_;
    return 'http://www.babymetal.jp/';
}

sub youtube {
    my ($self) = @_;
    return 'https://www.youtube.com/BABYMETAL';
}

sub facebook {
    my ($self) = @_;
    return 'https://www.facebook.com/BABYMETAL.jp/';
}

sub instagram {
    my ($self) = @_;
    return 'https://www.instagram.com/babymetal_official/';
}

sub twitter {
    my ($self) = @_;
    return 'https://twitter.com/BABYMETAL_JAPAN';
}

sub members {
    my ($self, $member) = @_;
    return @{$self->{members}} unless $member;

    if ( $member =~ /^S/i ) {
        @members = $self->{members}[0];

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

        @members = @{$self->{members}};
    }
    return @members;
}

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

 view release on metacpan or  search on metacpan

lib/Acme/BLACKJ/Utils.pm  view on Meta::CPAN

=head2 sum

=cut

sub sum {
    my $a = shift;
    my $b = shift;
    return $a + $b;
}

 view release on metacpan or  search on metacpan

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

Returns the sum of the numbers

=cut

sub sum {
    my $sum = 0;
    foreach( @_ ) { $sum += $_ }
    return $sum;
}

=head2 function2

=cut

sub function2 {
}

=head1 AUTHOR

Brian Oates, C<< <boates at cpan.org> >>

 view release on metacpan or  search on metacpan

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

#my $ignoradas = join "|", @ignoradas;

use Filter::Simple;

FILTER_ONLY
  all => sub {
  my $package = shift;
  my %par = @_;
  
  if ( $par{'DEBUG'} ) {
    filter($_);

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

#   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

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

  s#"(\d+)"#"$quotes[$1]"#g;

};

# hinos do bope:
sub canta_hino {
    my $self = shift;
    my @hinos = (
         'O interrogatório é muito fácil de fazer/pega o favelado e dá porrada até doer/O interrogatório é muito fácil de acabar/pega o bandido e dá porrada até matar',
         'Esse sangue é muito bom/ já provei não tem perigo/é melhor do que café/é o sangue do inimigo',
         'O quintal do inimigo/não se varre com vassoura/se varre com granada/com fuzil, metralhadora',

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

    $hinos[int(rand(@hinos))];

}

# frases sobre o cap.nascimento
sub fato {
    my $self = shift;
    my @fatos = (
        'Deus disse que iria fazer o mundo em 7 anos. Capitão Nascimento disse bem alto: "O senhor é um fanfarrão, Sr. 01. O senhor tem 7 dias, sr. 01! SETE DIAS!"',
        'Quando vivia no paraíso, Capitão Nascimento forçou Eva a comer a maçã, dizendo: "Come a porra da maçã 02! Tá com nojinho, 02? Come tudo, porra!"', 
        'A farda do Capitão Nascimento é preta porque nenhuma outra cor quis ficar perto dele.',

 view release on metacpan or  search on metacpan

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

package Acme::Backwards; 
our $VERSION = '1.01';
use Keyword::Declare;
sub import {
	keytype OKAY is m{(?:fisle (?&PerlNWS)(?&PerlExpression).*?;|esle (?&PerlNWS).*?;)?+}xms;
	keyword rof (/(my\s*\$\w+)?/ $declare, Expr $test, /.+?;$/ $code) {_backwards('for', ($declare ? $declare : ()), $test, $code);};
	keyword fi (Expr $test, /.+?;/ $code, OKAY @next) {_backwards('if', $test, $code)._process_backwards(@next);};
	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__

 view release on metacpan or  search on metacpan

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

$VERSION =~ tr/_//d;

use Scalar::Util qw(dualvar looks_like_number);
use overload ();

sub import {
  overload::constant(q => sub {
    my $string = $_[1];
    my $number = $string;
    if (looks_like_number($number)) {
      return $string;
    }

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

    }
    return $string;
  });
}

sub unimport {
  overload::remove_constant('q');
}

1;
__END__

 view release on metacpan or  search on metacpan

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

use warnings;
use Carp qw/croak/;

our $VERSION = '0.05';

sub new {
    my $class = shift;
    my $args  = shift || +{};

    bless $args, $class;
}

 view release on metacpan or  search on metacpan

lib/Acme/Be/Modern.pm  view on Meta::CPAN

=cut

=head1 WARNING

The source filter (defined in the L<Acme::Be::Modern::filter> sub is
simply a naive search-and-replace. Don't use this in any real code.

=head1 IMPLEMENTATION

The implementation is a slight variation of the example in

lib/Acme/Be/Modern.pm  view on Meta::CPAN

calls filter_add() with a blessed reference. Now the filter is
activated.

=cut

sub import {
    my ($type) = @_;
    my ($ref) = [];
    filter_add(bless $ref);
}

lib/Acme/Be/Modern.pm  view on Meta::CPAN

filter_read(). Any occurrence (and I mean any) of 'be modern' will be
replace with 'use Modern::Perl'.

=cut

sub filter {
    my ($self) = @_;
    my ($status);
    s/be modern/use Modern::Perl/g if ($status = filter_read()) > 0;
    $status;
}

 view release on metacpan or  search on metacpan

BeCool.pm  view on Meta::CPAN

$VERSION = '0.02';

use LWP::Simple;

sub import
{
    shift;
    if (!@_) {
        my $page = get 'http://search.cpan.org/search?query=cool&mode=all';
        push @_, $1 while $page =~ m!<h2.*?<b>(.*?)</b></a></h2>!g;

 view release on metacpan or  search on metacpan

lib/Acme/Beamerang/Logger.pm  view on Meta::CPAN

our $VERSION = '0.001000';

use parent 'Log::Contextual';

sub default_import { qw(:dlog :log ) }

# This ideally would be regulated by the importing class
# but I got tired of trying to guess what horrible magic
# was necessary to make Exporter::Declare and whatever
# the hell Log::Contextual's import logic does work.
sub _get_prefixes {
    my $class = $_[0];
    my (@parts) = split /::/sx, $class;

    # Always assume there is no Acme
    # Acme::X is X in the future.

lib/Acme/Beamerang/Logger.pm  view on Meta::CPAN

        }
    }
    return @prefixes, 'BEAMERANG';
}

sub arg_default_logger {
    return $_[1] if $_[1];
    require Log::Contextual::WarnLogger::Fancy;
    my $caller = caller(3);

    my ( $env, @group ) = _get_prefixes($caller);

 view release on metacpan or  search on metacpan

Beatnik.pm  view on Meta::CPAN

%scrabble = 
('A',1,'B',3,'C',3,'D',2,'E',1,'F',4,'G',2,'H',4,'I',1,'J',8,'K',5,'L',1,'M',3,'N',1,'O',1,'P',3,'Q',10,'R',1,'S',1,'T',1,'U',1,'V',4,'W',4,'X',8,'Y',4,'Z',10);

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

 view release on metacpan or  search on metacpan

lib/Acme/BeyondPerl/ToSQL.pm  view on Meta::CPAN

	$Dbh->disconnect()
}

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

sub import {
	my $class = shift;
	my %hash  = %{ $_[0] } if(@_ == 1);
	my ($dsn, $user, $pass, $opt) = (@_ > 1) ? @_ : @{$hash{dbi}};

	_connect($dsn, $user, $pass, $opt) unless($Dbh);

lib/Acme/BeyondPerl/ToSQL.pm  view on Meta::CPAN

}


my $OPs = {
	'+'    => sub { shift->add(@_) },
	'-'    => sub { shift->sub(@_) },
	'*'    => sub { shift->mul(@_) },
	'/'    => sub { shift->div(@_) },
	'%'    => sub { shift->mod(@_) },
	'**'   => sub { shift->pow(@_) },
	'log'  => sub { shift->log(@_) },
	'sqrt' => sub { shift->sqrt(@_)},
	'abs'  => sub { shift->abs(@_) },
	'cos'  => sub { shift->cos(@_) },
	'sin'  => sub { shift->sin(@_) },
	'exp'  => sub { shift->exp(@_) },
	'atan2'=> sub { shift->atan2(@_) },
	'<<'   => sub { shift->lshift(@_) },
	'>>'   => sub { shift->rshift(@_) },
	'&'    => sub { shift->and(@_) },
	'|'    => sub { shift->or(@_)  },
	'^'    => sub { shift->xor(@_) },
};


sub ops { return $OPs; }

sub Type { $Type; }

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

sub _connect {
	my ($dsn, $user, $pass, $opts) = @_;

	$Dbh = DBI->connect($dsn, $user, $pass, $opts) or die $!;

	$Type = ($dsn =~ /dbi:(\w+)/)[0];
}


sub _overload {
	my $mod = __PACKAGE__ . '::' . $Type;

	eval qq| require $mod |;
	if($@){ croak "Can't load $mod."; }

	my $ops = $mod->ops;
	my %operators = (
		nomethod => \&_nomethod,
		'""'   => sub { ${$_[0]} },
		'<=>'  => sub { ${$_[0]} <=> ${$_[1]} },
		'0+'   => sub { ${$_[0]} },
		'bool' => sub { ${$_[0]} },
		'cmp'  => sub { ${$_[0]} cmp ${$_[1]} },
		%{ $ops }
	);

	eval q| use overload %operators |;
	if($@){ die $@; }

}


sub _integer_handler {
	my ($ori, $interp, $contect) = @_;
	return bless \$interp, __PACKAGE__ . "::$Type\::__Integer";
}

sub _float_handler {
	my ($ori, $interp, $contect) = @_;
	return bless \$interp, __PACKAGE__ . "::$Type\::__Float";
}


##############################################################################
# Use From Objects
##############################################################################

sub _calc_by_rdbm {
	if($DEBUG){ print "$_[0]\n"; }
	_float_handler( undef, $Dbh->selectrow_array($_[0]) );
}


sub _nomethod {
	my ($x, $y, $swap, $op) = @_;
	croak "This operator '$op' is not implemented in $Type";
}


sub _get_args {
	my ($x, $y, $swap) = @_;
	if($swap){ ($x, $y) = ($y, $x) }
	$x = $x->as_sql if(UNIVERSAL::can($x,'as_sql'));
	$y = $y->as_sql if(UNIVERSAL::can($y,'as_sql'));
	return ($x,$y);
}

sub _get_args_as_bits {
	my ($x, $y, $swap) = @_;
	if($swap){ ($x, $y) = ($y, $x) }
	$x = $x->as_bit if(UNIVERSAL::can($x,'as_sql'));
	$y = $y->as_bit if(UNIVERSAL::can($y,'as_sql'));
	return ($x,$y);
}

sub as_sql { ${$_[0]} }

sub as_bit { ${$_[0]} }

##############################################################################
# OPERATORS
##############################################################################

sub add {
	my ($x, $y) = _get_args(@_);
	_calc_by_rdbm("SELECT $x + $y");
}


sub sub {
	my ($x, $y) = _get_args(@_);
	_calc_by_rdbm("SELECT $x - $y");
}


sub mul {
	my ($x, $y) = _get_args(@_);
	_calc_by_rdbm("SELECT $x * $y");
}


sub div {
	my ($x, $y) = _get_args(@_);
	_calc_by_rdbm("SELECT $x / $y");
}


sub mod {
	my ($x, $y) = _get_args(@_);
	_calc_by_rdbm("SELECT $x % $y");
}


sub pow {
	my ($x, $y) = _get_args(@_);
	_calc_by_rdbm("SELECT pow($x, $y)");
}

sub abs {
	my ($x) = _get_args(@_);
	_calc_by_rdbm("SELECT abs($x)");
}

sub log {
	my ($x) = _get_args(@_);
	_calc_by_rdbm("SELECT ln($x)");
}

sub exp {
	my ($x) = _get_args(@_);
	_calc_by_rdbm("SELECT exp($x)");
}

sub sqrt {
	my ($x) = _get_args(@_);
	_calc_by_rdbm("SELECT sqrt($x)");
}

sub sin {
	my ($x) = _get_args(@_);
	_calc_by_rdbm("SELECT sin($x)");
}

sub cos {
	my ($x) = _get_args(@_);
	_calc_by_rdbm("SELECT cos($x)");
}

sub atan2 {
	my ($x, $y) = _get_args(@_);
	_calc_by_rdbm("SELECT atan2($x, $y)");
}

sub lshift {
	my ($x, $y) = _get_args_as_bits(@_);
	_calc_by_rdbm("SELECT $x << $y");
}

sub rshift {
	my ($x, $y) = _get_args_as_bits(@_);
	_calc_by_rdbm("SELECT $x >> $y");
}

sub and {
	my ($x, $y) = _get_args_as_bits(@_);
	_calc_by_rdbm("SELECT $x & $y");
}

sub or {
	my ($x, $y) = _get_args_as_bits(@_);
	_calc_by_rdbm("SELECT $x | $y");
}

sub xor {
	my ($x, $y) = _get_args_as_bits(@_);
	_calc_by_rdbm("SELECT $x ^ $y");
}

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

 view release on metacpan or  search on metacpan

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

    blah_blah_blah	    
);

our $VERSION = '0.01';

sub blah_blah_blah {
    croak "blah blah blah";
} 


1;

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

Acme::BlahBlahBlah - Perl extension for blah blah blah

=head1 SYNOPSIS

  use Acme::BlahBlahBlah;
  sub bla { blah_blah_blah }

=head1 DESCRIPTION

Perl 6 will have a C<...> operator that dies if it is ever evaluated.  This is an implementation
of it, called C<blah_blah_blah>.

 view release on metacpan or  search on metacpan

inc/Module/AutoInstall.pm  view on Meta::CPAN

# See if it's a testing or non-interactive session
_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN ); 
_init();

sub _accept_default {
    $AcceptDefault = shift;
}

sub missing_modules {
    return @Missing;
}

sub do_install {
    __PACKAGE__->install(
        [
            $Config
            ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
            : ()

inc/Module/AutoInstall.pm  view on Meta::CPAN

        @Missing,
    );
}

# initialize various flags, and/or perform install
sub _init {
    foreach my $arg (
        @ARGV,
        split(
            /[\s\t]+/,
            $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || ''

inc/Module/AutoInstall.pm  view on Meta::CPAN

        }
    }
}

# overrides MakeMaker's prompt() to automatically accept the default choice
sub _prompt {
    goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;

    my ( $prompt, $default ) = @_;
    my $y = ( $default =~ /^[Yy]/ );

inc/Module/AutoInstall.pm  view on Meta::CPAN

    print "$default\n";
    return $default;
}

# the workhorse
sub import {
    my $class = shift;
    my @args  = @_ or return;
    my $core_all;

    print "*** $class version " . $class->VERSION . "\n";

inc/Module/AutoInstall.pm  view on Meta::CPAN

    *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
}

# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
# if we are, then we simply let it taking care of our dependencies
sub _check_lock {
    return unless @Missing;

    if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
        print <<'END_MESSAGE';

inc/Module/AutoInstall.pm  view on Meta::CPAN

    close LOCK;
    return;
}

sub install {
    my $class = shift;

    my $i;    # used below to strip leading '-' from config keys
    my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );

inc/Module/AutoInstall.pm  view on Meta::CPAN

    close FAILED if $args{do_once};

    return @installed;
}

sub _install_cpanplus {
    my @modules   = @{ +shift };
    my @config    = _cpanplus_config( @{ +shift } );
    my $installed = 0;

    require CPANPLUS::Backend;

inc/Module/AutoInstall.pm  view on Meta::CPAN

    }

    return $installed;
}

sub _cpanplus_config {
	my @config = ();
	while ( @_ ) {
		my ($key, $value) = (shift(), shift());
		if ( $key eq 'prerequisites_policy' ) {
			if ( $value eq 'follow' ) {

inc/Module/AutoInstall.pm  view on Meta::CPAN

		}
	}
	return @config;
}

sub _install_cpan {
    my @modules   = @{ +shift };
    my @config    = @{ +shift };
    my $installed = 0;
    my %args;

inc/Module/AutoInstall.pm  view on Meta::CPAN

    }

    return $installed;
}

sub _has_cpanplus {
    return (
        $HasCPANPLUS = (
            $INC{'CPANPLUS/Config.pm'}
              or _load('CPANPLUS::Shell::Default')
        )
    );
}

# make guesses on whether we're under the CPAN installation directory
sub _under_cpan {
    require Cwd;
    require File::Spec;

    my $cwd  = File::Spec->canonpath( Cwd::cwd() );
    my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );

    return ( index( $cwd, $cpan ) > -1 );
}

sub _update_to {
    my $class = __PACKAGE__;
    my $ver   = shift;

    return
      if defined( _version_check( _load($class), $ver ) );  # no need to upgrade

inc/Module/AutoInstall.pm  view on Meta::CPAN

*** Cannot bootstrap myself. :-( Installation terminated.
.
}

# check if we're connected to some host, using inet_aton
sub _connected_to {
    my $site = shift;

    return (
        ( _load('Socket') and Socket::inet_aton($site) ) or _prompt(
            qq(

inc/Module/AutoInstall.pm  view on Meta::CPAN

          ) =~ /^[Yy]/
    );
}

# check if a directory is writable; may create it on demand
sub _can_write {
    my $path = shift;
    mkdir( $path, 0755 ) unless -e $path;

    return 1 if -w $path;

inc/Module/AutoInstall.pm  view on Meta::CPAN

==> Should we try to install the required module(s) anyway?), 'n'
    ) =~ /^[Yy]/;
}

# load a module and return the version it reports
sub _load {
    my $mod  = pop;    # class/instance doesn't matter
    my $file = $mod;

    $file =~ s|::|/|g;
    $file .= '.pm';

inc/Module/AutoInstall.pm  view on Meta::CPAN

    local $@;
    return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
}

# Load CPAN.pm and it's configuration
sub _load_cpan {
    return if $CPAN::VERSION;
    require CPAN;
    if ( $CPAN::HandleConfig::VERSION ) {
        # Newer versions of CPAN have a HandleConfig module
        CPAN::HandleConfig->load;

inc/Module/AutoInstall.pm  view on Meta::CPAN

        CPAN::Config->load;
    }
}

# compare two versions, either use Sort::Versions or plain comparison
sub _version_check {
    my ( $cur, $min ) = @_;
    return unless defined $cur;

    $cur =~ s/\s+$//;

inc/Module/AutoInstall.pm  view on Meta::CPAN

    local $^W = 0;    # shuts off 'not numeric' bugs
    return ( $cur >= $min ? $cur : undef );
}

# nothing; this usage is deprecated.
sub main::PREREQ_PM { return {}; }

sub _make_args {
    my %args = @_;

    $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing }
      if $UnderCPAN or $TestOnly;

inc/Module/AutoInstall.pm  view on Meta::CPAN

    return %args;
}

# a wrapper to ExtUtils::MakeMaker::WriteMakefile
sub Write {
    require Carp;
    Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;

    if ($CheckOnly) {
        print << ".";

inc/Module/AutoInstall.pm  view on Meta::CPAN

.

    return 1;
}

sub postamble {
    $PostambleUsed = 1;

    return << ".";

config :: installdeps

 view release on metacpan or  search on metacpan

lib/Acme/Bleach/Numerically.pm  view on Meta::CPAN

our $MAX_SIZE = 0x7fff_ffff;
use Math::BigInt lib => 'GMP'; # faster if there, fallbacks if not
use Math::BigFloat;
use Math::BigRat;

sub str2num{
    my $str = shift;
    return 0 if $str eq '';
    Math::BigFloat->accuracy(length($str) * 8); 
    my $bnum = Math::BigFloat->new(0);
    my $bden = Math::BigInt->new(256);

lib/Acme/Bleach/Numerically.pm  view on Meta::CPAN

    $bnum /= $bden;
    $bnum =~ s/0+$//o;
    return $bnum;
}

sub num2str{
    my $num = shift;
    return '' unless $num;
    my $bnum = Math::BigFloat->new($num);
    my $str = '';
    while($bnum > 0){

lib/Acme/Bleach/Numerically.pm  view on Meta::CPAN

	$bnum -= $ord;
    }
    return $str;
}

sub import{
    my $class = shift;
    if (@_){ # behave nicely
	my ($pkg, $filename, $line) = caller;
	for my $arg (@_){
	    no strict 'refs';

 view release on metacpan or  search on metacpan

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

package Acme::Bleach;
our $VERSION = '1.150';
my $tie = " \t"x8;
sub whiten { local $_ = unpack "b*", pop; tr/01/ \t/; s/(.{9})/$1\n/g; $tie.$_ }
sub brighten { local $_ = pop; s/^$tie|[^ \t]//g; tr/ \t/01/; pack "b*", $_ }
sub dirty { $_[0] =~ /\S/ }
sub dress { $_[0] =~ /^$tie/ }
open 0 or print "Can't rebleach '$0'\n" and exit;
(my $shirt = join "", <0>) =~ s/(.*)^\s*use\s+Acme::Bleach\s*;\n//sm;
my $coat = $1;
my $pressed = '#line ' . ("$coat\n" =~ tr/\n/\n/) . ' ' . (caller)[1] . "\n";
local $SIG{__WARN__} = \&dirty;