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;

 view release on metacpan or  search on metacpan

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

in which case it's all random. Probabilities don't (yet) model real-world
distributions.

=cut

sub new {
	my ($class, $init) = @_;

	my $self = {};

	if (defined $init && defined $init->{'genotype'}) {

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

Get the bloodtype (phenotype) of this person. Returns "A", "B", "AB", or "O".

=cut

sub get_bloodtype {
	my ($self) = @_;

	return $geno_pheno->{ $self->{'genotype'} };
}

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

Get the genotype of this person. Returns a string of two characters, which
may be "A", "B", or "O".

=cut

sub get_genotype {
	my ($self) = @_;
	return $self->{'genotype'};
}

=head2 $bt1->cross($bt2)

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

"Mate" one person with the other, producing a result chosen randomly in the
style of Mendel.

=cut

sub cross {
	my ($self, $other) = @_;

	die "Uh?" unless $other->isa(__PACKAGE__);

	my $from_self = substr $self->get_genotype, int rand 2, 1;

 view release on metacpan or  search on metacpan

lib/Acme/BooK/Is/My/Bitch.pm  view on Meta::CPAN

use Acme::MetaSyntactic;

# ###### Implementation ###########

sub new { shift }

my $de_underscore = sub { map { y/_/ /; $_ } @_ };

my %methods = (
    'tell_the_truth' => [
        'You know, my favorite pornstar is definitely %s.',
        'pornstars', $de_underscore

lib/Acme/BooK/Is/My/Bitch.pm  view on Meta::CPAN

        'You know, I wrote some code for the %s space mission, but it was rejected for its lack of clarity...',
        'space_missions', $de_underscore
    ],
    'next_talk' => [
        'My next lightning talk will be called "%s! %s!! %s!!!"',
        'batman', sub { map { y/_/-/; ucfirst } @_ }
    ],
    'next_yapc' => [
         'I think the next YAPC should be on %s!',
         'planets', ],
    'sql' => [

lib/Acme/BooK/Is/My/Bitch.pm  view on Meta::CPAN

    ],
    ( # quotes that need a theme/category
        'baby_girl' => [
            'You know we considered naming our baby girl %s?',
            'pornstars/female',
            sub { ( my $baby = shift ) =~ s/_.*$//; $baby }
        ],
        meeting_room => [
            'I think this meeting room should be called %s',
            [ 'barbapapa/nl', 'barbapapa/en' ],
        ],
        favourite_colour => [
            'My favourite colour is %s',
            [ 'colours/en', 'colours/x-11' ],
            sub { my $colour = shift; return $colour =~ /pink|rose/i ? $de_underscore->( $colour ) : (); }
        ]
    )x!! ( $Acme::MetaSyntactic::VERSION >= 1.011 ),
);

for my $method ( keys %methods ) {
    my ( $template, $theme, $filter ) = @{ $methods{$method} };
    $filter ||= sub {@_};
    my $qty =()= $template =~ /%s/g;
    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 }

sub random_quote {
    my $self = shift;
    my $method  = (keys %methods)[ rand keys %methods ];
    return $self->$method();
}

 view release on metacpan or  search on metacpan

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

my @true = map {
    *{"$_"} = \&true;
    $_;
} map { ($_, uc($_)) } qw(yes verifiable trusty accurate actual appropriate authentic authoritative correct dependable direct exact factual fitting genuine honest indubitable kosher lawful legal legitimate natural normal perfect precise proper pure r...

sub NO { false }
sub no { false }

my @false = map {
    *{$_} = \&false;
    $_;
} map { ($_, uc($_)) } qw(untrue wrong incorrect errorneous fallacious untruthful nah apocryphal beguiling bogus casuistic concocted counterfactual deceitful deceiving delusive dishonest distorted erroneous ersatz fake fanciful faulty fictitious fish...

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

my @ad = map {
    *{$_} = sub($) { shift; };
    $_;
} map { ($_, uc($_)) } qw(just so totally very definitely really certainly surely unquestionably undoubtedly absolutely exactly);

sub NOT($) { not shift }
push @ad, 'NOT';

our @EXPORT = (qw(true false), @ad, @true, @false);
our @EXPORT_OK = qw(isTrue isFalse isBoolean);
our %EXPORT_TAGS = (

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

    use Acme::Boolean;

    $decision = correct if verifiable;

    sub do_me_a_favor {
       nah;
    }

=head1 DESCRIPTION

 view release on metacpan or  search on metacpan

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

package Acme::Boom; no warnings;
$VERSION = 0xdeadbeef + 1;

sub import {
  unpack "p", pack "L!", 1;
}

Earth-Shattering-Kaboom-!!1;