view release on metacpan or  search on metacpan

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

=back

=cut

sub aa2ht {

  # default configuration
  my %config = _clone_hash( \%default_configuration );

=head3 OPTIONS

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

}

# subroutines

sub _random_color {
  my $color = '';

  for (1 .. 6) {
    $color .= qw/1 2 3 4 5 6 7 8 9 0 a b c d e f/[int rand 16];
  }

  return $color;
}

sub _clone_hash {
  my %hash = %{+shift};

  my %new_hash;

  for (keys %hash) {

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

  }

  return %new_hash;
}

sub _count_in_the_beginning {
  my ($cell, @elems) = @_;
  my $t = 0;
  for (@elems) {
    if ($cell eq $_) {
      $t++;

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

    }
  }
  return $t;
}

sub _min {
  my $min = shift;

  for (@_) {
    if ( $min > $_ ) { $min = $_ }
  }

  return $min;
}

sub _max {
  my $max = shift;

  for (@_) {
    if ( $max < $_ ) { $max = $_ }
  }

 view release on metacpan or  search on metacpan

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

Constructor - creates a new Acme:AsciiArtFarts object.  This method takes no arguments.

=cut

sub new {
	my $class	= shift;
	my $self	= {};
	bless $self, $class;
	$self->{ua}	= LWP::UserAgent->new();
	$self->{uri}	= 'http://www.asciiartfarts.com';

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

Returns the current strip.

=cut

sub current {
	return $_[0]->__request('/today.txt')
}

=head2 random

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

Returns a random strip.

=cut

sub random {
	return __parse($_[0]->__request('/random.cgi'));
}

=head2 list_keywords

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

Returns a list of all keywords by which strips are sorted.

=cut

sub list_keywords {
	return sort keys %{$_[0]->{keywords}}
}

=head2 list_by_keyword

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

Returns a list of strip numbers for the given keyword.

=cut

sub list_by_keyword {
	my ($self,$keyword)= @_;
	exists $self->{keywords}->{$keyword} or return 0;
	return @{$self->{keywords}{$keyword}{strips}};
}

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

Alternately, given an integer value that is a valid strip number, return the requested strip.

=cut

sub get_by_num {
	my ($self,$num)	=@_;
	$num	=~ /^#/	or $num = '#'.$num;
	return __parse($self->__request("/$self->{strips}{$num}{page}"))
}

sub __get_keywords {
	my $self= shift;
	my $itr	= 0;
	my @html= split /\n/, $self->__request('/keyword.html');

	for ($itr=0;$itr<@html;$itr++) {

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

			$self->{strips}{$num}{keyword}	= $key;
		}
	}
}

sub __request {
	my($self,$rl)	= @_;
	$rl 		|= '';
	my $res		= $self->{ua}->get($self->{uri}.$rl);
	$res->is_success and return $res->content;
	$self->{error}	= 'Unable to retrieve content: ' . $res->status_line;
	return 0
}

sub __parse {
	my @html	= split /\n/, $_[0];
	my $found	= 0;
	my $res;

	foreach (@html) {

 view release on metacpan or  search on metacpan

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

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

#
# run ASCII Artinization on a picture and a code string.
#
sub asciiartinate {
  my %opts = @_;
  if (@_ == 1 && ref $_[0] eq "HASH") {
    %opts = @{$_[0]};
  }

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

}

#
# run a file containing Perl code for a Perl compilation check
#
sub compile_check {
  my ($file) = @_;
  print "\n";
  print "- " x 20, "\n";
  print "Compile check for $file:\n";
  print "- " x 20, "\n";
  print `$^X -cw "$file"`;
  print "- " x 20, "\n";
  return $?;
}

sub tweak_padding {
  my ($filler, $tref, $cref) = @_;

  # TODO: if there are many consecutive characters of padding
  #       in the code, we can improve its appearance by 
  #       inserting some quoted text in void context.

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

#
# does the current string begin with an "operator keyword"?
# if so, return it
#
sub find_token_keyword {
  my ($q) = @_;
  foreach my $k (@token_keywords) {
    if (substr($q,0,length($k)) eq $k) {
      return $k;
    }

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

}

#
# find position of a scalar in an array.
#
sub STRPOS {
  my ($word, @array) = @_;
  my $pos = -1;
  for (my $i=0; $i<@array; $i++) {
    $pos = $i if $array[$i] =~ /$word/;
  }

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

#
# what does the "/" token that we just encountered mean?
# this is a hard game to play.
# see http://www.perlmonks.org/index.pl?node_id=44722
#
sub regex_or_divide {
  my ($tokenref, $contextref) = @_;
  my @tokens = @$tokenref;
  my @contexts = @$contextref;

  # regex is expected following an operator,

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

  return "regex" if $tokens[$c] eq ";" && $tokens[$c-1] ne "SIGIL";

  return "divide";
}

sub tokenize_code {
  my ($INPUT) = @_;
  local $" = '';
  my @INPUT = grep { /[^\n]/ } split //, $INPUT;

  # tokens are:

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

  @asciiartinate::tokens = @tokens;

  @tokens;
}

sub asciiindex_code {
  my ($X) = @_;
  my $endpos = index($X,"\n__END__\n");
  if ($endpos >= 0) {
    substr($X,$endpos) = "\n";
  }

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

  &tokenize_code($X);
}

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

sub tokenize_art {
  my ($INPUT) = @_;
  my @INPUT = split //, $INPUT;

  my $white = 1;
  my $block_size = 0;

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

    push @blocks, $block_size;
  }
  return @blocks;
}

sub asciiindex_art {
  my ($X) = @_;
  &tokenize_art($X);
}

#
# replace darkspace on the pic with characters from the code
#
sub print_code_to_pic {
  my ($pic, @tokens) = @_;
  local $" = '';
  my $code = "@tokens";
  my @code = split //, $code;

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

#
# find misalignment between multi-character tokens and blocks
# and report position where additional padding is needed for
# alignment
#
sub padding_needed {
  my @tokens = @{$_[0]};
  my @contexts = @{$_[1]};
  my @blocks = @{$_[2]};
  my $ib = 0;
  my $tc = 0;

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

#
# choose a random number between 0 and n-1,
# with the distribution heavily weighted toward
# the high end of the range
#
sub hi_weighted_rand {
  my $n = shift;
  my (@p, $r, $p);
  for ($r = 1; $r <= $n; $r++) {
    push @p, $p += $r * $r * $r;
  }

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

#
# look for opportunity to insert padding into the
# code at the specified location
#
sub try_to_pad {
  my ($pos, $npad, $tref, $cref) = @_;

    #      padding techniques:
    # X        SIGIL name --->   SIGIL { name }
    #          XXX       --->    ( XXX )

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

#
# find all misalignments and insert padding into the code
# until all code is aligned or until the padded code is
# too large for the pic.
#
sub pad {
  my @tokens = @{$_[0]};
  my @contexts = @{$_[1]};
  my @blocks = @{$_[2]};

  my $nblocks = 0;

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

    &I();$N=<>;@o=(map{$z=${U}x($x=1+$N-$_);
    ' 'x$x.($".$F)x$_.($B.$z.$P.$z.$F).($B.$")x$_.$/}
    0..$N);@o=(@o,($U.$F)x++$N.($"x3).($B.$U)x$N.$/);
    print@o;
    sub I{($B,$F,$P,$U)=qw(\\ / | _);}
    while($_=pop@o){y'/\\'\/';@o||y#_# #;$t++||y#_ # _#;print}

What this code does is read one value from standard input
and draws a spider web of the given size:

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

       {U      }x(           $x=      1+
       $N-      $_)  ;' 'x  $x.     ($".
        $F)x$_   .($B.$z.$ P.   $z.$F).
            ($B.$")x$_.$/}0..$N);@
        o=(@o,($U.$F)x++$N.($"x3).($B.$U
       )x$N.$/);;;;print@o;;;sub I{( $B,
      $F,         $P,$U)=qw(\\          /
      |         _);;}while($_=pop       @o
     ){     y'/\\'\/';;;@o||y#_# #;;    ;;;
    ;$     t++  ||y#_ # _#;print  }#     ##
     ##    ##   ################  ##    ##

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

=head2 eastern smile

))
smile

=cut

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

=head2 western smile

:)
smile

=cut

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

=head2 bat

/|\ ^._.^ /|\
bat

=cut

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

=head2 dollarbill

[̲̅$̲̅(̲̅ιο̲̅̅)̲̅$̲̅]
dollarbill

=cut

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

=head2 wizard

╰( ͡° ͜ʖ ͡° )つ──☆*:・ﾟ

=cut

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

=head2 terrorist

୧༼ಠ益ಠ༽︻╦╤─

=cut

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

=head2 sword

o()xxxx[{::::::::::::::::::>

=cut

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

=head2 swag

(̿▀̿‿ ̿▀̿ ̿)

=cut

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

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