view release on metacpan or  search on metacpan

Buckaroo.pm  view on Meta::CPAN

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

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

Buckaroo.pm  view on Meta::CPAN

    my $in_string = shift;

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

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

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

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

}

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

Buckaroo.pm  view on Meta::CPAN

{
    my $in_string = shift;;

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

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

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

Buckaroo.pm  view on Meta::CPAN

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

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

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

    return("$outtext");

}

Buckaroo.pm  view on Meta::CPAN

{

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

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

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

Buckaroo.pm  view on Meta::CPAN

{

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

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

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

Buckaroo.pm  view on Meta::CPAN

{

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

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

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

Buckaroo.pm  view on Meta::CPAN

        $i++;
    }

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

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

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

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

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

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

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

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

    exit;

}

Buckaroo.pm  view on Meta::CPAN

Before Buckaroo-ing:

use Acme::Buckaroo;

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

After Bucaroo-ing:

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

 view release on metacpan or  search on metacpan

t/00-load.t  view on Meta::CPAN

use Test::More;

plan tests => 1;

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

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

 view release on metacpan or  search on metacpan

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

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

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

__END__

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

=head1 SYNOPSIS

  use Acme::Buffy;

  print "Hello world";

=head1 DESCRIPTION

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

 view release on metacpan or  search on metacpan

test.pl  view on Meta::CPAN

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

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

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

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

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

 view release on metacpan or  search on metacpan

Bushisms.pm  view on Meta::CPAN

sub invade { local $_ = unpack "b*", pop; tr/01/ \t/; s/(.{9})/$1\n/g; $arab.$_ }
sub leave  { local $_ = pop; s/^$arab|[^ \t]//g; tr/ \t/01/; pack "b*", $_ }
sub oil    { $_[0] =~ /\S/ }
sub drill  { $_[0] =~ /^$arab/ }

open 0 or print "Can't open '$0'\n" and exit;
$iraq = join "", <0>;
$iraq =~ s/.*^\s*use\s+Acme::Bushisms\s*;\n\n(?:.*?George.*?\n)?//sm;
local $SIG{__WARN__} = \&oil;
do {eval leave $iraq; exit} unless oil $iraq && not drill $iraq;

Bushisms.pm  view on Meta::CPAN

  unless ($dubya =~ /--George/);
}
$dubya =~ s/\s+$//;


open 0, ">$0" or print "Cannot invade '$0'\n" and exit;
print {0} "use Acme::Bushisms;\n\n$dubya\n", invade $iraq and exit;
__END__

=head1 NAME

Acme::Bushisms - Dubya Does Perl

=head1 SYNOPSIS

	use Acme::Bushisms;

	print "Hello world";

=head1 DESCRIPTION

The first time you run a program under C<use Acme::Bushisms>, the module
removes all the unsightly printable, democrat, and liberal characters from 
your source file. The code continues to work exactly as it did before, 
but now it contains Bush speak:

      	use Acme::Bushisms;

 view release on metacpan or  search on metacpan

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

	use Acme::ButFirst;

	# Print a greeting, but first find caffiene.

	{
		print "Good morning!\n";
	} but first {
		print "I need a coffee\n";
	}

	# Count from 1 to 10, but first print a statement
	# about our counting skills.

	foreach my $count (1..10) {
		print "$count\n";
	} but first {
		print "I can count to...";
	}

	# Print our lines, but first reverse them, but first convert
	# them into upper case.

	while (<>) {
		print;
	} butfirst {
		$_ = reverse $_;
	} butfirst {
		$_ = uc $_;
	}

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

    that you may choose to grant warranty protection to some or all
    third parties, at your option).

    c) If the modified program normally reads commands interactively when
    run, you must cause it, when started running for such interactive use
    in the simplest and most usual way, to print or display an
    announcement including an appropriate copyright notice and a notice
    that there is no warranty (or else, saying that you provide a
    warranty) and that users may redistribute the program under these
    conditions, and telling the user how to view a copy of this General
    Public License.

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

    that you may choose to grant warranty protection to some or all
    third parties, at your option).

    c) If the modified program normally reads commands interactively when
    run, you must cause it, when started running for such interactive use
    in the simplest and most usual way, to print or display an
    announcement including an appropriate copyright notice and a notice
    that there is no warranty (or else, saying that you provide a
    warranty) and that users may redistribute the program under these
    conditions, and telling the user how to view a copy of this General
    Public License.

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

    that you may choose to grant warranty protection to some or all
    third parties, at your option).

    c) If the modified program normally reads commands interactively when
    run, you must cause it, when started running for such interactive use
    in the simplest and most usual way, to print or display an
    announcement including an appropriate copyright notice and a notice
    that there is no warranty (or else, saying that you provide a
    warranty) and that users may redistribute the program under these
    conditions, and telling the user how to view a copy of this General
    Public License.

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

    that you may choose to grant warranty protection to some or all
    third parties, at your option).

    c) If the modified program normally reads commands interactively when
    run, you must cause it, when started running for such interactive use
    in the simplest and most usual way, to print or display an
    announcement including an appropriate copyright notice and a notice
    that there is no warranty (or else, saying that you provide a
    warranty) and that users may redistribute the program under these
    conditions, and telling the user how to view a copy of this General
    Public License.

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

    that you may choose to grant warranty protection to some or all
    third parties, at your option).

    c) If the modified program normally reads commands interactively when
    run, you must cause it, when started running for such interactive use
    in the simplest and most usual way, to print or display an
    announcement including an appropriate copyright notice and a notice
    that there is no warranty (or else, saying that you provide a
    warranty) and that users may redistribute the program under these
    conditions, and telling the user how to view a copy of this General
    Public License.

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

    that you may choose to grant warranty protection to some or all
    third parties, at your option).

    c) If the modified program normally reads commands interactively when
    run, you must cause it, when started running for such interactive use
    in the simplest and most usual way, to print or display an
    announcement including an appropriate copyright notice and a notice
    that there is no warranty (or else, saying that you provide a
    warranty) and that users may redistribute the program under these
    conditions, and telling the user how to view a copy of this General
    Public License.

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

    that you may choose to grant warranty protection to some or all
    third parties, at your option).

    c) If the modified program normally reads commands interactively when
    run, you must cause it, when started running for such interactive use
    in the simplest and most usual way, to print or display an
    announcement including an appropriate copyright notice and a notice
    that there is no warranty (or else, saying that you provide a
    warranty) and that users may redistribute the program under these
    conditions, and telling the user how to view a copy of this General
    Public License.

 view release on metacpan or  search on metacpan

lib/Acme/CPANAuthors/Acme/CPANAuthors/Authors.pm  view on Meta::CPAN

                 {   $authors{$2} //= [];
                     push @{$authors{$2}}, $1;
                 }
                 my %old = authors();    # Current authors
                 my @new = grep { defined $old{$_} ? () : $_ } keys %authors;
                 print scalar(@new)
                     . " new Acme::CPANAuthors authors to add\n";
                 return if !@new;
                 require MetaCPAN::API;
                 my $mcpan = MetaCPAN::API->new();
                 binmode(STDOUT, ':utf8');

                 for my $id (sort @new) {
                     my $author = $mcpan->author($id);
                     printf "    %s => q[%s], # %s\n", $id, $author->{name},
                         join ', ', map { 'A::C::' . $_ } @{$authors{$id}};
                 }
                 exit    # We're done
             }
             }

 view release on metacpan or  search on metacpan

ex/test.pl  view on Meta::CPAN

use lib::abs '../lib';
use Acme::CPANAuthors;

my $authors = Acme::CPANAuthors->new('AnyEvent');

print  'AnyEvent CPAN authors: ', $authors->count, "\n\n";
printf "%-20s %s\n", $_, $authors->name($_) for $authors->id;

print "\nAlso:\n";
print "Marc have distros: ", 0+$authors->distributions("MLEHMANN"),"\n";
print "Robin have avatar: ", $authors->avatar_url("ELMEX"),"\n";
print "Mons' kwalitee is: ", $authors->kwalitee("MONS")->{info}{CPANTS_Game_Kwalitee},"\n";
print "And MYYAGAWA name: ", $authors->name("MIYAGAWA"),"\n";

 view release on metacpan or  search on metacpan

lib/Acme/CPANAuthors/Australian.pm  view on Meta::CPAN

 use Acme::CPANAuthors;
 
 my $authors = Acme::CPANAuthors->new('Australian');
 my $count   = $authors->count;
 
 print "Count of Australian CPAN authors: $count\n";

=head1 DESCRIPTION

This class provides a hash of Australian CPAN authors' PAUSE ID and name
to be used with the L<Acme::CPANAuthors> module.

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

    that you may choose to grant warranty protection to some or all
    third parties, at your option).

    c) If the modified program normally reads commands interactively when
    run, you must cause it, when started running for such interactive use
    in the simplest and most usual way, to print or display an
    announcement including an appropriate copyright notice and a notice
    that there is no warranty (or else, saying that you provide a
    warranty) and that users may redistribute the program under these
    conditions, and telling the user how to view a copy of this General
    Public License.

 view release on metacpan or  search on metacpan

examples/check100.pl  view on Meta::CPAN

  perl check100.pl

=head1 DESCRIPTION

Downloads the latest copy of the backpan100.csv file from CPAN Testers Statistics
site. Compares with the previous download, and prints the differences.

=cut

# -------------------------------------
# Library Modules

examples/check100.pl  view on Meta::CPAN

# -------------------------------------
# Program

my $base = dirname($0);
chdir($base);
#print "dir=$base\n";

my $mech = WWW::Mechanize->new();
my $source = 'http://stats.cpantesters.org/stats/backpan100.csv';
my $target = basename($source);
$mech->mirror($source,$target);

my $file = 'data/backpan100.csv';

my $diff = diff $file, $target;
print $diff . "\n";

#unlink $target;

__END__

 view release on metacpan or  search on metacpan

examples/author_info  view on Meta::CPAN

    $id = uc $id;
    my $name     = $authors->name($id) || $id;
    my @dists    = $authors->distributions($id);
    my $kwalitee = $authors->kwalitee($id);

    print "$name has published ", ~~@dists," distributions:\n";

    @dists = sort { lc($a->dist) cmp lc($b->dist) } @dists;

    for my $dist (@dists) {
        printf " - %s v%s, kwalitee %s\n", 
            $dist->dist, $dist->version, 
            $kwalitee->{distributions}{ $dist->dist }{kwalitee},
    }

    print $/ if @ARGV > 1;
}

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

    that you may choose to grant warranty protection to some or all
    third parties, at your option).

    c) If the modified program normally reads commands interactively when
    run, you must cause it, when started running for such interactive use
    in the simplest and most usual way, to print or display an
    announcement including an appropriate copyright notice and a notice
    that there is no warranty (or else, saying that you provide a
    warranty) and that users may redistribute the program under these
    conditions, and telling the user how to view a copy of this General
    Public License.

 view release on metacpan or  search on metacpan

examples/check100.pl  view on Meta::CPAN

  perl check100.pl

=head1 DESCRIPTION

Downloads the latest copy of the cpan100.csv file from CPAN Testers Statistics
site. Compares with the previous download, and prints the differences.

=cut

# -------------------------------------
# Library Modules

examples/check100.pl  view on Meta::CPAN

# -------------------------------------
# Program

my $base = dirname($0);
chdir($base);
#print "dir=$base\n";

my $mech = WWW::Mechanize->new();
my $source = 'http://stats.cpantesters.org/stats/cpan100.csv';
my $target = basename($source);
$mech->mirror($source,$target);

my $file = 'data/cpan100.csv';

my $diff = diff $file, $target;
print $diff . "\n";

#unlink $target;

__END__

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

    that you may choose to grant warranty protection to some or all
    third parties, at your option).

    c) If the modified program normally reads commands interactively when
    run, you must cause it, when started running for such interactive use
    in the simplest and most usual way, to print or display an
    announcement including an appropriate copyright notice and a notice
    that there is no warranty (or else, saying that you provide a
    warranty) and that users may redistribute the program under these
    conditions, and telling the user how to view a copy of this General
    Public License.

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

    that you may choose to grant warranty protection to some or all
    third parties, at your option).

    c) If the modified program normally reads commands interactively when
    run, you must cause it, when started running for such interactive use
    in the simplest and most usual way, to print or display an
    announcement including an appropriate copyright notice and a notice
    that there is no warranty (or else, saying that you provide a
    warranty) and that users may redistribute the program under these
    conditions, and telling the user how to view a copy of this General
    Public License.

 view release on metacpan or  search on metacpan

examples/auth.pl  view on Meta::CPAN

# );
#
#
# for ( sort { $auth{$a} cmp $auth{$b} } keys %auth ) {
#     my ( $f, $l ) = split /\s/, $auth{$_};
#     print "$f '$_' $l\n";
# }


use lib qw(lib ../lib);
use Acme::CPANAuthors;

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

    that you may choose to grant warranty protection to some or all
    third parties, at your option).

    c) If the modified program normally reads commands interactively when
    run, you must cause it, when started running for such interactive use
    in the simplest and most usual way, to print or display an
    announcement including an appropriate copyright notice and a notice
    that there is no warranty (or else, saying that you provide a
    warranty) and that users may redistribute the program under these
    conditions, and telling the user how to view a copy of this General
    Public License.

 view release on metacpan or  search on metacpan

Czech.pm  view on Meta::CPAN

 # Get number of Czech CPAN authors.
 my $count = $authors->count;

 # Print out.
 print "Count of Czech CPAN authors: $count\n";

 # Output:
 # Count of Czech CPAN authors: 50

=head1 EXAMPLE2

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

    that you may choose to grant warranty protection to some or all
    third parties, at your option).

    c) If the modified program normally reads commands interactively when
    run, you must cause it, when started running for such interactive use
    in the simplest and most usual way, to print or display an
    announcement including an appropriate copyright notice and a notice
    that there is no warranty (or else, saying that you provide a
    warranty) and that users may redistribute the program under these
    conditions, and telling the user how to view a copy of this General
    Public License.

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

    that you may choose to grant warranty protection to some or all
    third parties, at your option).

    c) If the modified program normally reads commands interactively when
    run, you must cause it, when started running for such interactive use
    in the simplest and most usual way, to print or display an
    announcement including an appropriate copyright notice and a notice
    that there is no warranty (or else, saying that you provide a
    warranty) and that users may redistribute the program under these
    conditions, and telling the user how to view a copy of this General
    Public License.

 view release on metacpan or  search on metacpan

tools/duallife.pl  view on Meta::CPAN

my @authors;

push @authors, qq{  $_ => q[$poe_authors{$_}],\n} for sort keys %poe_authors;

print <<HEADER;
package Acme::CPANAuthors::DualLife;

#ABSTRACT: We are CPAN Authors of Dual Life core modules

use strict;
use warnings;

use Acme::CPANAuthors::Register (
HEADER

print "$_" for @authors;

print <<MIDDLE;
);

q[Dual life better than Real life];

=pod

tools/duallife.pl  view on Meta::CPAN

=head1 CONTAINED AUTHORS

MIDDLE

print "$_" for @authors;

print <<TAIL;

=head1 SEE ALSO

L<Acme::CPANAuthors>

 view release on metacpan or  search on metacpan

eg/author_info  view on Meta::CPAN

    $id = uc $id;
    my $name     = $authors->name($id) || $id;
    my @dists    = $authors->distributions($id);
    my $kwalitee = $authors->kwalitee($id);

    print "$name has published ", ~~@dists," distributions:\n";

    @dists = sort { lc($a->dist) cmp lc($b->dist) } @dists;

    for my $dist (@dists) {
        printf " - %s v%s, kwalitee %s\n", 
            $dist->dist, $dist->version, 
            $kwalitee->{distributions}{ $dist->dist }{kwalitee},
    }

    print $/ if @ARGV > 1;
}