view release on metacpan or  search on metacpan

inc/MyBuilder.pm  view on Meta::CPAN

package MyBuilder;

use base qw( Module::Build );

sub create_build_script {
  my ( $self, @args ) = @_;
  $self->_auto_mm;
  return $self->SUPER::create_build_script( @args );
}

sub _auto_mm {
  my $self = shift;
  my $mm   = $self->meta_merge;
  my @meta = qw( homepage bugtracker MailingList repository );
  for my $meta ( @meta ) {
    next if exists $mm->{resources}{$meta};

inc/MyBuilder.pm  view on Meta::CPAN

    $mm->{resources}{$meta} = $av if defined $av;
  }
  $self->meta_merge( $mm );
}

sub _auto_repository {
  my $self = shift;
  if ( -d '.svn' ) {
    my $info = `svn info .`;
    return $1 if $info =~ /^URL:\s+(.+)$/m;
  }

inc/MyBuilder.pm  view on Meta::CPAN

    return $url;
  }
  return;
}

sub _auto_bugtracker {
  'http://rt.cpan.org/NoAuth/Bugs.html?Dist=' . shift->dist_name;
}

sub ACTION_testauthor {
  my $self = shift;
  $self->test_files( 'xt/author' );
  $self->ACTION_test;
}

sub ACTION_critic {
  exec qw( perlcritic -1 -q -profile perlcriticrc lib/ ), glob 't/*.t';
}

sub ACTION_tags {
  exec(
    qw(
     ctags -f tags --recurse --totals
     --exclude=blib
     --exclude=.svn

inc/MyBuilder.pm  view on Meta::CPAN

     t/ lib/
     )
  );
}

sub ACTION_tidy {
  my $self = shift;

  my @extra = qw( Build.PL );

  my %found_files = map { %$_ } $self->find_pm_files,

 view release on metacpan or  search on metacpan

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

    Accepts a list, returns the sum of the numbers provided. Anything
    that isn't a number will be treated as zero.

=cut

sub sum {

  my $sum = 0;

  foreach my $element ( @_ ) {
    # I could get a module to do this check, but I don't want to

 view release on metacpan or  search on metacpan

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

=head2 sum 

=cut

sub sum {
  my $sum;
  $sum += $_ for @_;
  $sum;
}

 view release on metacpan or  search on metacpan

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

Returns the sum of the numbers passed to it, ignoring arguments
that don't look like numbers.

=cut

sub sum {
    my $sum;
    foreach my $num ( grep { /\A-?\d+\.*\d*\z/ } @_ ) {
        $sum += $num;
    }
    $sum;

 view release on metacpan or  search on metacpan

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

=head2 sum

=cut

sub sum {
    my $sum;
    for (grep /^\d+$/, @_) { $sum += $_ }
    $sum;
}

 view release on metacpan or  search on metacpan

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

Add a bunch of numbers. Definitely don't multiply them.

=cut

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

 view release on metacpan or  search on metacpan

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

Returns the sime of the numbers.

=cut

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

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

=head2 function2

=cut

sub function2 {
}

=head1 AUTHOR

"abhishek", C<< <"abhishekisnot at gmail.com"> >>

 view release on metacpan or  search on metacpan

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

use Cwd        ();
use File::Find ();
use File::Path ();
use FindBin;

sub autoload {
	my $self = shift;
	my $who  = $self->_caller;
	my $cwd  = Cwd::cwd();
	my $sym  = "${who}::AUTOLOAD";
	$sym->{$cwd} = sub {
		my $pwd = Cwd::cwd();
		if ( my $code = $sym->{$pwd} ) {
			# delegate back to parent dirs
			goto &$code unless $cwd eq $pwd;
		}

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

		unshift @_, ( $self, $1 );
		goto &{$self->can('call')} unless uc($1) eq $1;
	};
}

sub import {
	my $class = shift;
	my $self  = $class->new(@_);
	my $who   = $self->_caller;

	unless ( -f $self->{file} ) {

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

	delete $INC{"$self->{path}.pm"};

	return 1;
}

sub preload {
	my $self = shift;
	unless ( $self->{extensions} ) {
		$self->load_extensions(
			"$self->{prefix}/$self->{path}", $self
		);

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

		}
	}

	my $who = $self->_caller;
	foreach my $name ( sort keys %seen ) {
		*{"${who}::$name"} = sub {
			${"${who}::AUTOLOAD"} = "${who}::$name";
			goto &{"${who}::AUTOLOAD"};
		};
	}
}

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

	# ignore the prefix on extension modules built from top level.
	my $base_path = Cwd::abs_path($FindBin::Bin);
	unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {

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

	$args{wrote}      = 0;

	bless( \%args, $class );
}

sub call {
	my ($self, $method) = @_;
	my $obj = $self->load($method) or return;
        splice(@_, 0, 2, $obj);
	goto &{$obj->can($method)};
}

sub load {
	my ($self, $method) = @_;

	$self->load_extensions(
		"$self->{prefix}/$self->{path}", $self
	) unless $self->{extensions};

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

	push @{$self->{extensions}}, $obj;

	$obj;
}

sub load_extensions {
	my ($self, $path, $top) = @_;

	unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) {
		unshift @INC, $self->{prefix};
	}

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

	}

	$self->{extensions} ||= [];
}

sub find_extensions {
	my ($self, $path) = @_;

	my @found;
	File::Find::find( sub {
		my $file = $File::Find::name;
		return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
		my $subpath = $1;
		return if lc($subpath) eq lc($self->{dispatch});

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

#####################################################################
# Utility Functions

sub _caller {
	my $depth = 0;
	my $call  = caller($depth);
	while ( $call eq __PACKAGE__ ) {
		$depth++;
		$call = caller($depth);
	}
	return $call;
}

sub _read {
	local *FH;
	open FH, "< $_[0]" or die "open($_[0]): $!";
	my $str = do { local $/; <FH> };
	close FH or die "close($_[0]): $!";
	return $str;
}

sub _write {
	local *FH;
	open FH, "> $_[0]" or die "open($_[0]): $!";
	foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" }
	close FH or die "close($_[0]): $!";
}

sub _version ($) {
	my $s = shift || 0;
	   $s =~ s/^(\d+)\.?//;
	my $l = $1 || 0;
	my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
	   $l = $l . '.' . join '', @v if @v;
	return $l + 0;
}

# Cloned from Params::Util::_CLASS
sub _CLASS ($) {
	(
		defined $_[0]
		and
		! ref $_[0]
		and

 view release on metacpan or  search on metacpan

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

enough slashes added to make Freddy Krueger jealous.

=cut

# The addslashes function. It is documented above. -- JAITKEN
sub addslashes {
    # Get the arguments passed to the function using the shift command -- JAITKEN
    my $unsafe_string = shift;

    # Split the string into letters - just like explode in PHP. Or maybe str_split
    # I can't remember which one is which -- JAITKEN

 view release on metacpan or  search on metacpan

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

use namespace::clean;


has questions => (
    is       => 'ro',
    isa      => sub { die 'Not an ArrayRef' unless ref($_[0]) eq 'ARRAY' },
    default  => sub { [] },
    required => 1,
);


has importance => (
    is      => 'ro',
    isa     => sub { die 'Not a HashRef' unless ref($_[0]) eq 'HASH' },
    default => sub {
        {
            'irrelevant'         => 0,
            'a little important' => 1,
            'somewhat important' => 10,
            'very important'     => 50,

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

);


has me => (
    is       => 'ro',
    isa      => sub { die 'Not an ArrayRef' unless ref($_[0]) eq 'ARRAY' },
    default  => sub { [] },
    required => 1,
);


has you => (
    is       => 'ro',
    isa      => sub { die 'Not an ArrayRef' unless ref($_[0]) eq 'ARRAY' },
    default  => sub { [] },
    required => 1,
);


sub score {
    my $self = shift;

    my $me_score  = _score( $self->me, $self->you, $self->importance );
    my $you_score = _score( $self->you, $self->me, $self->importance );

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

    my $score = $product->broot($question_count);

    return $score->numify * 100;
}

sub _score {
    my ( $me, $you, $importance ) = @_;

    my $score = 0;
    my $total = 0;

 view release on metacpan or  search on metacpan

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

This method will create and return C<Acme::Aheui> object.

=cut

sub new {
    my $class = shift;
    my %args = @_;
    my $source = $args{source} || '';
    my $encoding = $args{output_encoding} || Term::Encoding::get_encoding();

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

    bless $self, $class;

    return $self;
}

sub build_codespace {
    my ($source) = @_;

    my @lines = split /\r?\n/, $source;
    my @rows = ();
    for my $line (@lines) {

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

        push @rows, \@row;
    }
    return \@rows;
}

sub disassemble_hangul_char {
    my ($char) = @_;

    if ($char =~ /[가-힣]/) {
        my $code = unpack 'U', $char;
        $code -= 0xAC00;

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

This method will execute the aheui program and return the exit code.
It may use C<STDIN> and/or C<STDOUT> if the aheui program uses I/O.

=cut

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

    return 0 unless $self->_has_initial_command();
    return $self->_loop_steps();
}

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

    for my $row (@{ $self->{_codespace} }) {
        my $first_command = @$row[0];
        if ($first_command && $$first_command{cho} != -1) {

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

        }
    }
    return 0;
}

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

    while (1) {
        my $codespace = $self->{_codespace};
        my ($x, $y) = ($self->{_x}, $self->{_y});

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

        $self->_move_cursor();
    }
}

sub _move_cursor {
    my ($self) = @_;
    my $codespace = $self->{_codespace};

    $self->{_x} += $self->{_dx};
    $self->{_y} += $self->{_dy};

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

        $self->{_dx} != 0) {
        $self->{_x} = 0;
    }
}

sub _get_deltas_upon_jung {
    my ($self, $jung) = @_;

    my $dx = $self->{_dx};
    my $dy = $self->{_dy};

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

    else {
        return ($dx, $dy);
    }
}

sub _push {
    my ($self, $i, $n) = @_;

    if ($i == 27) { # ã…Ž
        return;
    }
    else {
        push @{$self->{_stacks}->[$i]}, $n;
    }
}

sub _pop {
    my ($self, $i) = @_;
    my $stack = $self->{_stacks}->[$i];

    if ($i == 21) { # ã…‡
        return shift @$stack;

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

    else {
        return pop @$stack;
    }
}

sub _duplicate {
    my ($self, $i) = @_;
    my $stack = $self->{_stacks}->[$i];

    if ($i == 21) { # ã…‡
        my $first = $$stack[0];

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

        my $last = $$stack[-1];
        push @$stack, $last;
    }
}

sub _swap {
    my ($self, $i) = @_;
    my $stack = $self->{_stacks}->[$i];

    if ($i == 21) { # ã…‡
        my $first = $$stack[0];

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

        $$stack[-1] = $next;
        $$stack[-2] = $last;
    }
}

sub _output_number {
    my ($self, $number) = @_;

    print $number;
}

sub _output_code_as_character {
    my ($self, $code) = @_;

    my $unichar = pack 'U', $code;
    print encode($self->{_encoding}, $unichar);
}

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

    my $char = ReadKey(0);
    return unpack 'U', $char;
}

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

    return int(ReadLine(0));
}

 view release on metacpan or  search on metacpan

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

	*inc::Module::Install::VERSION = *VERSION;
	@inc::Module::Install::ISA     = __PACKAGE__;

}

sub import {
	my $class = shift;
	my $self  = $class->new(@_);
	my $who   = $self->_caller;

	#-------------------------------------------------------------

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

	$MAIN = $self;

	return 1;
}

sub autoload {
	my $self = shift;
	my $who  = $self->_caller;
	my $cwd  = Cwd::cwd();
	my $sym  = "${who}::AUTOLOAD";
	$sym->{$cwd} = sub {
		my $pwd = Cwd::cwd();
		if ( my $code = $sym->{$pwd} ) {
			# Delegate back to parent dirs
			goto &$code unless $cwd eq $pwd;
		}

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

		unshift @_, ( $self, $1 );
		goto &{$self->can('call')};
	};
}

sub preload {
	my $self = shift;
	unless ( $self->{extensions} ) {
		$self->load_extensions(
			"$self->{prefix}/$self->{path}", $self
		);

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

	}

	my $who = $self->_caller;
	foreach my $name ( sort keys %seen ) {
		local $^W;
		*{"${who}::$name"} = sub {
			${"${who}::AUTOLOAD"} = "${who}::$name";
			goto &{"${who}::AUTOLOAD"};
		};
	}
}

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

	delete $INC{'FindBin.pm'};
	{
		# to suppress the redefine warning
		local $SIG{__WARN__} = sub {};
		require FindBin;
	}

	# ignore the prefix on extension modules built from top level.
	my $base_path = Cwd::abs_path($FindBin::Bin);

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

	$args{wrote}      = 0;

	bless( \%args, $class );
}

sub call {
	my ($self, $method) = @_;
	my $obj = $self->load($method) or return;
        splice(@_, 0, 2, $obj);
	goto &{$obj->can($method)};
}

sub load {
	my ($self, $method) = @_;

	$self->load_extensions(
		"$self->{prefix}/$self->{path}", $self
	) unless $self->{extensions};

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

	push @{$self->{extensions}}, $obj;

	$obj;
}

sub load_extensions {
	my ($self, $path, $top) = @_;

	my $should_reload = 0;
	unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
		unshift @INC, $self->{prefix};

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

	}

	$self->{extensions} ||= [];
}

sub find_extensions {
	my ($self, $path) = @_;

	my @found;
	File::Find::find( sub {
		my $file = $File::Find::name;
		return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
		my $subpath = $1;
		return if lc($subpath) eq lc($self->{dispatch});

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

#####################################################################
# Common Utility Functions

sub _caller {
	my $depth = 0;
	my $call  = caller($depth);
	while ( $call eq __PACKAGE__ ) {
		$depth++;
		$call = caller($depth);

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

	return $call;
}

# Done in evals to avoid confusing Perl::MinimumVersion
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _read {
	local *FH;
	open( FH, '<', $_[0] ) or die "open($_[0]): $!";
	my $string = do { local $/; <FH> };
	close FH or die "close($_[0]): $!";
	return $string;
}
END_NEW
sub _read {
	local *FH;
	open( FH, "< $_[0]"  ) or die "open($_[0]): $!";
	my $string = do { local $/; <FH> };
	close FH or die "close($_[0]): $!";
	return $string;
}
END_OLD

sub _readperl {
	my $string = Module::Install::_read($_[0]);
	$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
	$string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
	$string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
	return $string;
}

sub _readpod {
	my $string = Module::Install::_read($_[0]);
	$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
	return $string if $_[0] =~ /\.pod\z/;
	$string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
	$string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;

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

	return $string;
}

# Done in evals to avoid confusing Perl::MinimumVersion
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _write {
	local *FH;
	open( FH, '>', $_[0] ) or die "open($_[0]): $!";
	foreach ( 1 .. $#_ ) {
		print FH $_[$_] or die "print($_[0]): $!";
	}
	close FH or die "close($_[0]): $!";
}
END_NEW
sub _write {
	local *FH;
	open( FH, "> $_[0]"  ) or die "open($_[0]): $!";
	foreach ( 1 .. $#_ ) {
		print FH $_[$_] or die "print($_[0]): $!";
	}

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

}
END_OLD

# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
sub _version ($) {
	my $s = shift || 0;
	my $d =()= $s =~ /(\.)/g;
	if ( $d >= 2 ) {
		# Normalise multipart versions
		$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;

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

	} $s =~ /(\d{1,3})\D?/g;
	$l = $l . '.' . join '', @v if @v;
	return $l + 0;
}

sub _cmp ($$) {
	_version($_[1]) <=> _version($_[2]);
}

# Cloned from Params::Util::_CLASS
sub _CLASS ($) {
	(
		defined $_[0]
		and
		! ref $_[0]
		and

 view release on metacpan or  search on metacpan

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

];
use constant P_SOUND => [ 'ぱ', 'ぴ', 'ぷ', 'ぺ', 'ぽ' ];
use constant DOUBLE_CONSONANT =>
  [ 'ぁ', 'ぃ', 'ぅ', 'ぇ', 'ぉ', 'っ', 'ゃ', 'ゅ', 'ょ', 'ゎ' ];

sub new {
    my $class = shift;
    return $class;
}

sub to_AjiFry {
    my ( $self, $raw_string ) = @_;

    my $chomped = chomp($raw_string);
    unless ($raw_string) {
        return "\n" if $chomped;

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

    my $ajifry_word = $self->_to_ajifry($raw_string);
    $ajifry_word .= "\n" if $chomped;
    return encode_utf8($ajifry_word);
}

sub translate_to_ajifry {
    my ( $self, $raw_string ) = @_;
    return $self->to_AjiFry($raw_string);
}

sub to_Japanese {
    my ( $self, $ajifry_word ) = @_;
    my $chomped = chomp($ajifry_word);

    unless ($ajifry_word) {
        return "\n" if $chomped;

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

    my $japanese_word = $self->_to_Japanese($ajifry_word);
    $japanese_word .= "\n" if $chomped;
    return encode_utf8($japanese_word);
}

sub translate_from_ajifry {
    my ( $self, $ajifry_word ) = @_;
    return $self->to_Japanese($ajifry_word);
}

sub _search_key_of_element {
    my ( $self, $element, $hash ) = @_;

    foreach my $key ( sort keys %$hash ) {
        if ( List::Util::first { $_ eq $element } @{ $hash->{$key} } ) {
            return $key;
        }
    }
}

sub _find_first {
    my ( $self, $key, $list ) = @_;

    return ( List::Util::first { $_ eq $key } @$list ) ? 1 : 0;
}

sub _find_duplicate_element_in_both_lists {
    my $self = shift;
    my ( $list_A, $list_B ) = @_;

    my @duplicate_elements;
    foreach my $element_A ( @{$list_A} ) {

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

        }
    }
    return @duplicate_elements;
}

sub _get_ajifry_word_by_consonant {
    my $self      = shift;
    my $consonant = shift;

    if ( $consonant eq 'a' ) {
        return "食え";

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

    else {
        return "";
    }
}

sub _get_ajifry_word_by_vowel {
    my $self  = shift;
    my $vowel = shift;

    if ( $vowel eq 'a' ) {
        return "食え食え";

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

    else {
        return "";
    }
}

sub _get_consonant_by_ajifry_word {
    my $self        = shift;
    my $ajifry_word = shift;

    if ( $ajifry_word eq '食え' ) {
        return 'a';

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

    else {
        return;
    }
}

sub _get_vowel_by_ajifry_word {
    my $self        = shift;
    my $ajifry_word = shift;

    if ( $ajifry_word eq '食え食え' ) {
        return 'a';

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

    else {
        return;
    }
}

sub _to_ajifry {
    my $self       = shift;
    my $raw_string = shift;

    my @raw_chars = split //, $raw_string;
    my $ajifry_word;

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

        $ajifry_word .= "陶人" if $self->_find_first( $raw_char, DULLNESS );
    }
    return $ajifry_word;
}

sub _to_Japanese {
    my $self        = shift;
    my $ajifry_word = shift;

    my $translated_word;
    while (1) {

 view release on metacpan or  search on metacpan

lib/Acme/Akashic/Records.pm  view on Meta::CPAN

my $records;
$records = \$records;
bless $records, __PACKAGE__;

sub AUTOLOAD { $records }

for my $type (qw/ARRAY HASH HANDLE/) {
    no strict 'refs';
    *{ __PACKAGE__ . '::' . $type . '::AUTOLOAD' } = \&AUTOLOAD;
}

use overload
  '@{}' => sub { tie my @records, __PACKAGE__ . '::ARRAY';  \@records },
  '%{}' => sub { tie my %records, __PACKAGE__ . '::HASH';   \%records },
  '*{}' => sub { tie *records,    __PACKAGE__ . '::HANDLE'; \*records },
  '&{}' => sub { sub { $records } },
  fallback => 1;

$records; # End of Acme::Akashic::Records -- or do they ever end?
__END__
=head1 NAME

 view release on metacpan or  search on metacpan

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

use Cwd        ();
use File::Find ();
use File::Path ();
use FindBin;

sub autoload {
	my $self = shift;
	my $who  = $self->_caller;
	my $cwd  = Cwd::cwd();
	my $sym  = "${who}::AUTOLOAD";
	$sym->{$cwd} = sub {
		my $pwd = Cwd::cwd();
		if ( my $code = $sym->{$pwd} ) {
			# Delegate back to parent dirs
			goto &$code unless $cwd eq $pwd;
		}

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

		unshift @_, ( $self, $1 );
		goto &{$self->can('call')};
	};
}

sub import {
	my $class = shift;
	my $self  = $class->new(@_);
	my $who   = $self->_caller;

	unless ( -f $self->{file} ) {

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

	$MAIN = $self;

	return 1;
}

sub preload {
	my $self = shift;
	unless ( $self->{extensions} ) {
		$self->load_extensions(
			"$self->{prefix}/$self->{path}", $self
		);

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

		}
	}

	my $who = $self->_caller;
	foreach my $name ( sort keys %seen ) {
		*{"${who}::$name"} = sub {
			${"${who}::AUTOLOAD"} = "${who}::$name";
			goto &{"${who}::AUTOLOAD"};
		};
	}
}

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

	# ignore the prefix on extension modules built from top level.
	my $base_path = Cwd::abs_path($FindBin::Bin);
	unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {

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

	$args{wrote}      = 0;

	bless( \%args, $class );
}

sub call {
	my ($self, $method) = @_;
	my $obj = $self->load($method) or return;
        splice(@_, 0, 2, $obj);
	goto &{$obj->can($method)};
}

sub load {
	my ($self, $method) = @_;

	$self->load_extensions(
		"$self->{prefix}/$self->{path}", $self
	) unless $self->{extensions};

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

	push @{$self->{extensions}}, $obj;

	$obj;
}

sub load_extensions {
	my ($self, $path, $top) = @_;

	unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
		unshift @INC, $self->{prefix};
	}

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

	}

	$self->{extensions} ||= [];
}

sub find_extensions {
	my ($self, $path) = @_;

	my @found;
	File::Find::find( sub {
		my $file = $File::Find::name;
		return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
		my $subpath = $1;
		return if lc($subpath) eq lc($self->{dispatch});

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

#####################################################################
# Common Utility Functions

sub _caller {
	my $depth = 0;
	my $call  = caller($depth);
	while ( $call eq __PACKAGE__ ) {
		$depth++;
		$call = caller($depth);
	}
	return $call;
}

sub _read {
	local *FH;
	if ( $] >= 5.006 ) {
		open( FH, '<', $_[0] ) or die "open($_[0]): $!";
	} else {
		open( FH, "< $_[0]"  ) or die "open($_[0]): $!";

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

	my $string = do { local $/; <FH> };
	close FH or die "close($_[0]): $!";
	return $string;
}

sub _readperl {
	my $string = Module::Install::_read($_[0]);
	$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
	$string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
	$string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
	return $string;
}

sub _readpod {
	my $string = Module::Install::_read($_[0]);
	$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
	return $string if $_[0] =~ /\.pod\z/;
	$string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
	$string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
	$string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
	$string =~ s/^\n+//s;
	return $string;
}

sub _write {
	local *FH;
	if ( $] >= 5.006 ) {
		open( FH, '>', $_[0] ) or die "open($_[0]): $!";
	} else {
		open( FH, "> $_[0]"  ) or die "open($_[0]): $!";

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

	close FH or die "close($_[0]): $!";
}

# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
sub _version ($) {
	my $s = shift || 0;
	my $d =()= $s =~ /(\.)/g;
	if ( $d >= 2 ) {
		# Normalise multipart versions
		$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;

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

	} $s =~ /(\d{1,3})\D?/g;
	$l = $l . '.' . join '', @v if @v;
	return $l + 0;
}

sub _cmp ($$) {
	_version($_[0]) <=> _version($_[1]);
}

# Cloned from Params::Util::_CLASS
sub _CLASS ($) {
	(
		defined $_[0]
		and
		! ref $_[0]
		and

 view release on metacpan or  search on metacpan

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

  $al = Acme::AlgebraicToRPN->new(userFunc =>
    [qw(box fft)]);

=cut

sub new {
    my ($class, %opts) = @_;
    my $self = \%opts;
    bless $self, $class;
    $.stack = [];
    $.parser = Math::Symbolic::Parser->new;

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

        map { $uf{$_} = 1 } @uf;
        $.userFunc = \%uf;
        my %x;
        map {
            my $proc = $_;
            $x{$_} = sub {
                my $argumentstring = shift;
                return Math::Symbolic::Constant->new(
                    qq($proc($argumentstring))
                );
            };

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

      You'd get back this:
      4 a 3 2 foo multiply

=cut

sub rpn {
    my ($self, $algebraic) = @_;
    $algebraic =~ s/\s+//g;
    # ensure parens match
    my $open  = $algebraic =~ tr/(/(/;
    my $close = $algebraic =~ tr/)/)/;

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

Same as B<rpn>, but returns as a comma-separated list. Split on
commas, and you have your stack to be processed.

=cut

sub rpn_as_string {
    my ($self, $algebraic) = @_;
    my @result = ./rpn($algebraic);
    return join(",", @result);
}

sub _Cleanup {
    my ($self) = @_;
    my @Stack;
    map {
        $_ =~ s/^,//;
        if ($_ ne '') {

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

        }
    } @{$.stack};
    return @Stack;
}

sub _Eval {
    my ($self, $expr) = @_;
    return unless defined $expr;
    #print "Evaling $expr\n";
    if ($expr =~ /(.+?),(.+)/) {
        my $L = $1;

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

Returns 1 if both @stack and @expected were the same, 0 if not.

=cut

sub check {
    my ($self, $ref, @result) = @_;
    my @shouldbe = @$ref;
    return 0 unless @shouldbe == @result;
    my $same = 1;
    map {

 view release on metacpan or  search on metacpan

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

    "having a piss" => "doing a piss",
    "slagging off" => "dissing",
    "welcome to" => "hear me now, dis is",
);

sub alig {
    my ($s) = @_;
    while (my ($key, $value) = each %phrases) { $s =~ s/\b$key\b/$value/g }
    while (my ($key, $value) = each %words)   { $s =~ s/\b$key\b/$value/g }
    foreach (split ' ', $s) {
        $s =~ s/ing\b/in/g;

 view release on metacpan or  search on metacpan

Makefile.PL  view on Meta::CPAN

# BEGIN code inserted by Dist::Zilla::Plugin::AlienBuild
{ package
    MY;

  sub postamble {
    $abmm->mm_postamble(@_);
  }

  sub install {
    $abmm->can('mm_install')
      ? $abmm->mm_install(@_)
      : shift->SUPER::install(@_);
  }
}

 view release on metacpan or  search on metacpan

alienfile  view on Meta::CPAN

  };

};

meta->after_hook(
  $_ => sub {
    my($build) = @_;
    $build->runtime_prop->{legacy}->{inline_auto_include} = ['libdontpanic.h'];
  },
) for qw( gather_share gather_system );

 view release on metacpan or  search on metacpan

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

use Acme::AllThePerlIsAStage::AndAllTheMenAndWomenJAPH;

# TODO v0.02: functions
# use Acme::AllThePerlIsAStage::AndAllTheMenAndWomenJAPH 'set_at_begin_via_import';
#
# BEGIN { *set_at_begin_via_block = sub { return $$ }; };
#
# sub set_at_begin_via_sub_defined_at_global;
# *set_at_begin_via_sub_defined_at_global = sub { return $$ };
#
# sub set_at_begin { return $$ }
#
# *set_at_global = sub { return $$ };
# etc …

my $my_set_at_global = $$;
my $my_set_at_run;
my $my_set_at_begin;

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

our $our_set_at_check;
our $our_set_at_init;
our $our_set_at_end;
our $our_set_at_init_and_run;

sub import {
    _say_stage("inside import()");
}

# Since we are doing BEGIN blocks that call this we need it first:
sub _say_stage {
    my ($name) = @_;
    print caller() . " - $name (\${^GLOBAL_PHASE} is '${^GLOBAL_PHASE}')\n";
    return unless $ENV{'AllThePerlIsAStage_verbose'};

    # TODO v0.02: test that this does not change results

 view release on metacpan or  search on metacpan

t/000-compile-modules.t  view on Meta::CPAN

# This test does a basic `use` check on all the code.
use Test::More;

use File::Find;

sub test {
    s{^lib/(.*)\.pm$}{$1} or return;
    s{/}{::}g;
    use_ok $_;
}

 view release on metacpan or  search on metacpan

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

use Exporter "import";

our $VERSION = "0.01";
our @EXPORT_OK = qw( ane );

sub new {
  my ($class, $object) = @_;
  bless {object => $object}, $class
}

sub is_ane { 1; }

sub ane {
  __PACKAGE__->new($_[0]);
}

sub AUTOLOAD {
  my $self = shift;
  my $meth = our $AUTOLOAD;
  $meth =~ s/.*:://;
  $self->{object}->$meth(@_);
}

 view release on metacpan or  search on metacpan

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

our $VERSION = '0.04';

push @main::INC, \ &handler_of_last_resort;

sub handler_of_last_resort {
    my $fake_source_code = '1';
    open my ($fh), '<', \ $fake_source_code;
    return $fh;
};

 view release on metacpan or  search on metacpan

lib/Acme/Apache/Werewolf.pm  view on Meta::CPAN

use Apache::Constants qw(:common);

use vars qw($VERSION);
$VERSION = '1.05';

sub handler {
    my $r = shift;
    my $moonlength = $r->dir_config('MoonLength');
    warn "Moon length is $moonlength";

    my ( $MoonPhase,

 view release on metacpan or  search on metacpan

lib/Acme/App/Broken.pm  view on Meta::CPAN

=head2 function1

=cut

sub function1 {
}

=head2 function2

=cut

sub function2 {
}

=head1 AUTHOR

Thibault DUPONCHELLE, C<< <thibault.duponchelle at gmail.com> >>

 view release on metacpan or  search on metacpan

lib/Acme/Archive/Mbox.pm  view on Meta::CPAN

Create an Acme::Archive::Mbox object.

=cut

sub new {
    my $class = shift;
    my $self = { files => [] };
    return bless $self,$class;
}

lib/Acme/Archive/Mbox.pm  view on Meta::CPAN

Add a file given a filename and contents.  (File need not exist on disk)

=cut

sub add_data {
    my $self = shift;
    my $name = shift;
    my $contents = shift;
    my %attr = @_;

lib/Acme/Archive/Mbox.pm  view on Meta::CPAN

slashes will be stripped.  Will accept an optional alternative filename
to be used in the archive.

=cut

sub add_file {
    my $self = shift;
    my $name = shift;
    my $altname = shift || $name;
    my %attr;

lib/Acme/Archive/Mbox.pm  view on Meta::CPAN

Returns a list of AAM::File objects.

=cut

sub get_files {
    my $self = shift;
    return @{$self->{files}};
}

=head2 write (filename)

Write archive to a file

=cut

sub write {
    my $self = shift;
    my $mboxname = shift;
    
    my $mgr = Mail::Box::Manager->new;
    my $folder = $mgr->open($mboxname, type => 'mbox', create => 1, access => 'rw') or die "Could not create $mboxname";

lib/Acme/Archive/Mbox.pm  view on Meta::CPAN

Read archive from a file.

=cut

sub read {
    my $self = shift;
    my $mboxname = shift;

    my $mgr = Mail::Box::Manager->new;
    my $folder = $mgr->open($mboxname, type => 'mbox') or die "Could not open $mboxname";

 view release on metacpan or  search on metacpan

lib/Acme/Array/MaxSize.pm  view on Meta::CPAN

use parent 'Tie::Array';
use Carp;

my %max_size;
my $last_index = sub { $max_size{+shift} - 1 };


sub TIEARRAY {
    my ($class, $max_size) = @_;
    my $self = bless [], $class;
    $max_size{$self} = $max_size;
    return $self
}

sub STORE {
    my ($self, $index, $value) = @_;
    if ($index > $self->$last_index) {
        carp 'Array too long';
        return
    }
    $self->[$index] = $value;
}

sub FETCH {
    my ($self, $index) = @_;
    $self->[$index]
}

sub FETCHSIZE {
    my $self = shift;
    @$self
}

sub STORESIZE {
    my ($self, $count) = @_;
    if ($count > $max_size{$self}) {
        carp 'Array too long';
        $count = $max_size{$self};
    }
    $#{$self} = $count - 1;
}

sub SPLICE {
    my ($self, $offset, $length, @list) = @_;
    if ($offset > $max_size{$self}) {
        carp 'Array too long';
        return;
    }

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