view release on metacpan or  search on metacpan

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

package Acme::BooK::Is::My::Bitch;
$Acme::BooK::Is::My::Bitch::VERSION = '0.05';
use 5.006;
use warnings;
use strict;

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
    ],
    'thats_nothing' => [
        'Oh, that\'s nothing! You should\'ve seen what I auctioned in %s!',
        'yapc', $de_underscore
    ],
    'code' => [
        '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' => [
         'I think we can solve that with a %s %s %s',
         'sql', ],
    'twisted_perl' => [
        'I\'m pretty sure I could do that just by using %s and %s',
        'opcodes',
    ],
    'words_of_wisdom' => [
        'My grandfather once told me:' . ' %s' x 7,
        'loremipsum',
    ],
    ( # 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();
}

1;    # Magic true value required at end of module

=pod

=encoding iso-8859-1

t/000-report-versions-tiny.t  view on Meta::CPAN

my $v = "\nGenerated by Dist::Zilla::Plugin::ReportVersions::Tiny v1.10\n";

eval {                     # no excuses!
    # report our Perl details
    my $want = '5.006';
    $v .= "perl: $] (wanted $want) on $^O from $^X\n\n";
};
defined($@) and diag("$@");

# Now, our module version dependencies:
sub pmver {
    my ($module, $wanted) = @_;
    $wanted = " (want $wanted)";
    my $pmver;
    eval "require $module;";
    if ($@) {
        if ($@ =~ m/Can't locate .* in \@INC/) {
            $pmver = 'module not found.';
        } else {
            diag("${module}: $@");
            $pmver = 'died during require.';