view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
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
view release on metacpan or search on metacpan
inc/Module/Install/Makefile.pm view on Meta::CPAN
delete $args->{SIGN};
}
# merge both kinds of requires into prereq_pm
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_,
($self->build_requires, $self->requires) );
# merge both kinds of requires into prereq_pm
my $subdirs = ($args->{DIR} ||= []);
if ($self->bundles) {
inc/Module/Install/Makefile.pm view on Meta::CPAN
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
}
my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
if ($self->admin->preop) {
$args{dist} = $self->admin->preop;
}
my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
view release on metacpan or search on metacpan
lib/Acme/Laugh.pm view on Meta::CPAN
sub continuum {
my $chunks = shift || 0;
$chunks = 1 + rand 4 if $chunks < 1;
my $p = 0;
return join '',
map { (my $c, $p) = minichunk(!$p); $c; } 1 .. $chunks;
} ## end sub continuum
sub capitals {
return join '', map { rand > 0.5 ? uc($_) : $_; } split //, shift;
}
sub laugh { return capitals(join '', incipit(), continuum(shift)); }
1; # Magic true value required at end of module
view release on metacpan or search on metacpan
lib/Acme/Lelek.pm view on Meta::CPAN
use Const::Fast;
use Moo;
const my $lek_re => qr/^lek$/i;
const my @leks => qw(lek leK lEk Lek lEK LeK LEk LEK);
const my %octals => map { $leks[$_] => $_ } 0 .. 7;
has base8 => (
is => 'ro',
required => 1,
default => sub {
lib/Acme/Lelek.pm view on Meta::CPAN
sub encode {
my ( $self, $msg ) = @_;
$self->base8->encode($msg)->split('')->grep(qr/[0-7]/)
->map( sub { $leks[$_] } )->unshift('AH Le')->join(' ');
}
sub decode {
my ( $self, $msg ) = @_;
$self->base8->decode(
$msg->split(qr/\s+/)->grep($lek_re)->map(
sub {
$octals{$_};
}
)->join('')
);
view release on metacpan or search on metacpan
lib/Acme/Lexical/Thief.pm view on Meta::CPAN
$vars =~ s/(^\s*|\s*$)//g;
my @vars = split /\s*,\s*/, $vars;
my $MY = PadWalker::peek_my($depth + 2);
my $OUR = PadWalker::peek_our($depth + 2);
return map {
exists $MY->{$_} ? $MY->{$_} :
exists $OUR->{$_} ? $OUR->{$_} :
croak "$KEYWORD($_) failed; caller has no $_ defined";
} @vars;
}
view release on metacpan or search on metacpan
lib/Acme/Lingua/EN/Inflect/Modern.pm view on Meta::CPAN
#pod See L<Lingua::EN::Inflect> for information on using this module, which has an
#pod identical interface.
#pod
#pod =cut
my %todo = map { map { $_ => 1 } @$_ }
values %Lingua::EN::Inflect::EXPORT_TAGS;
for my $routine (keys %todo) {
no strict 'refs';
*{__PACKAGE__ . '::' . $routine} = sub {
view release on metacpan or search on metacpan
lib/Acme/Lingua/ZH/Remix.pm view on Meta::CPAN
# Ignore certain punctuations
$corpus =~ s/(——|──)//gs;
my @xc = split /(?:（(.+?)）|：?「(.+?)ã€|〔(.+?)〕|“(.+?)â€)/, $corpus;
my @phrases = uniq sort grep /.(，|。|？|ï¼)$/,
map {
my @x = split /(，|。|？|ï¼)/, $_;
my @r = ();
while (@x) {
my $s = shift @x;
my $p = shift @x or next;
$s =~ s/^(，|。|？|ï¼|\s)+//;
push @r, "$s$p";
}
@r;
} map {
s/^\s+//;
s/\s+$//;
s/^(.+?) //;
$_;
} grep { $_ } @xc;
view release on metacpan or search on metacpan
devel/build_wikidoc.pl view on Meta::CPAN
use Class::Dot qw(-new :std);
use File::Next 0.40;
use English qw(-no_match_vars);
my %IGNORE_FILE = map {$_ => 1} qw(
Build.PL Makefile.PL
);
my $DIST_MODULE = 'Acme::Locals';
view release on metacpan or search on metacpan
lib/Acme/LookOfDisapproval.pm view on Meta::CPAN
=head1 BACKGROUND
=for stopwords unicode
I wrote this as an exercise in using unicode in code, not just in a string.
Then, it became an interesting learning experience in how to cleanly map to a
core function, and re-exporting symbols.
The first draft did this:
use Carp 'carp';
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
my %WriteMakefileArgs = (
ABSTRACT => $meta->{abstract},
AUTHOR => ($EUMM >= 6.5702 ? $meta->{author} : $meta->{author}[0]),
DISTNAME => $meta->{name},
VERSION => $meta->{version},
EXE_FILES => [ map $_->{file}, values %{ $meta->{x_provides_scripts} || {} } ],
NAME => do { my $n = $meta->{name}; $n =~ s/-/::/g; $n },
test => { TESTS => "t/*.t" },
%dynamic_config,
);
Makefile.PL view on Meta::CPAN
}
{
my ($minperl) = reverse sort(
grep defined && /^[0-9]+(\.[0-9]+)?$/,
map $meta->{prereqs}{$_}{requires}{perl},
qw( configure build runtime )
);
if (defined($minperl))
{
view release on metacpan or search on metacpan
author/ja2kana.pl view on Meta::CPAN
next if /^#/;
my ($en, $kana) = split ',';
$en2kana{lc $en} = $kana;
}
my %skip_word = map { $_ => 1 } qw(
now say new be come see is as
one two three four five
six seven eight nine ten
law raw row whole weigh
hurt hut firm fare flesh
view release on metacpan or search on metacpan
lib/Acme/Lvalue.pm view on Meta::CPAN
};
no strict 'refs';
*{$where . '::' . $what} = $fun;
}
our %builtins = map +($_->[0] => [eval "sub {scalar $_->[0] \$_[0]}", $_->[1]]),
[chr => sub { ord $_[0] }],
[cos => sub { acos $_[0] }],
[defined =>
sub {
$_[0]
view release on metacpan or search on metacpan
BleedingOpenGL.pm view on Meta::CPAN
GL_ARB_shading_language_100=>'1.4;ARB_shader_objects,ARB_fragment_shader,ARB_vertex_shader', #33
GL_ARB_shader_objects=>'1.4', #30
GL_ARB_shadow=>'1.1;ARB_depth_texture', #23
GL_ARB_shadow_ambient=>'1.1;ARB_shadow,ARB_depth_texture', #23
GL_ARB_texture_border_clamp=>'1.0', #13
GL_ARB_texture_cube_map=>'1.0', #7
GL_ARB_texture_env_add=>'1.0', #6
GL_ARB_texture_env_combine=>'1.1;ARB_multitexture', #17
GL_ARB_texture_env_dot3=>'1.1;ARB_multitexture,ARB_texture_env_combine', #19
GL_ARB_texture_float=>'1.1', #41
GL_ARB_texture_mirrored_repeat=>'1.0', #21
BleedingOpenGL.pm view on Meta::CPAN
GL_EXT_shadow_funcs=>'1.1;ARB_depth_texture,ARB_shadow', #267
GL_EXT_stencil_wrap=>'1.0', #176
GL_EXT_subtexture=>'1.0', #9
GL_EXT_texture=>'1.0', #4
GL_EXT_texture3D=>'1.1;EXT_abgr', #6
GL_EXT_texture_cube_map=>'1.0', #6
GL_EXT_texture_env_combine=>'1.0', #158
GL_EXT_texture_env_dot3=>'1.0;EXT_texture_env_combine', #220
GL_EXT_texture_filter_anisotropic=>'1.0', #187
GL_EXT_texture_lod_bias=>'1.0', #186
GL_EXT_texture_mirror_clamp=>'1.0', #298
BleedingOpenGL.pm view on Meta::CPAN
GL_NV_packed_depth_stencil=>'1.0', #226
GL_NV_texgen_reflection=>'1.0', #179
GL_NV_texture_compression_vtc=>'1.0;ARB_texture_compression,EXT_texture_compression_s3tc,ARB_texture_non_power_of_two', #228
GL_NV_texture_expand_normal=>'1.1', #286
GL_NV_texture_rectangle=>'1.0', #229
GL_NV_texture_shader=>'1.0;ARB_multitexture,ARB_texture_cube_map', #230
GL_NV_texture_shader2=>'1.0;NV_texture_shader', #231
GL_NV_texture_shader3=>'1.0;NV_texture_shader2', #265
GL_NV_vertex_program1_1=>'1.0;NV_vertex_program', #266
GL_NV_vertex_program2=>'1.0;NV_vertex_program', #287
GL_NV_vertex_program2_option=>'1.0;ARB_vertex_program', #305
GL_NV_vertex_program3=>'1.0;ARB_vertex_program,NV_vertex_program2_option', #306
GL_S3_s3tc=>'1.1', #276
GL_SGIS_generate_mipmap=>'1.1', #32
GL_SGIS_texture_lod=>'1.1', #24
GL_SGIX_depth_texture=>'1.1', #63
GL_SGIX_shadow=>'1.0', #34
GL_SUN_slice_accum=>'1.0' #258
};
BleedingOpenGL.pm view on Meta::CPAN
glAreTexturesResident_p
glArrayElement
glBegin
glEnd
glBindTexture
glBitmap_s
glBitmap_c
glBitmap_p
glBlendFunc
glCallList
glCallLists_s
glCallLists_c
glCallLists_p
BleedingOpenGL.pm view on Meta::CPAN
glFramebufferTexture2DEXT
glFramebufferTexture3DEXT
glFramebufferRenderbufferEXT
glGetFramebufferAttachmentParameterivEXT_c
glGetFramebufferAttachmentParameterivEXT_s
glGenerateMipmapEXT
glVertexAttrib1dARB
glVertexAttrib1dvARB_c
glVertexAttrib1dvARB_s
glVertexAttrib1dvARB_p
glVertexAttrib1fARB
BleedingOpenGL.pm view on Meta::CPAN
glGetBufferSubDataARB_c
glGetBufferSubDataARB_s
glGetBufferSubDataARB_p
glMapBufferARB_c
glMapBufferARB_p
glUnmapBufferARB
glGetBufferParameterivARB_c
glGetBufferParameterivARB_s
glGetBufferParameterivARB_p
glGetBufferPointervARB_c
glGetBufferPointervARB_s
BleedingOpenGL.pm view on Meta::CPAN
@glu_func = qw(
gluBeginCurve
gluBeginPolygon
gluBeginSurface
gluBeginTrim
gluBuild1DMipmaps_c
gluBuild1DMipmaps_s
gluBuild2DMipmaps_c
gluBuild2DMipmaps_s
gluCylinder
gluDeleteNurbsRenderer
gluDeleteQuadric
gluDeleteTess
gluDisk
BleedingOpenGL.pm view on Meta::CPAN
@glut_func = qw(
done_glutInit
glutAddMenuEntry
glutAddSubMenu
glutAttachMenu
glutBitmapCharacter
glutBitmapHeight
glutBitmapLength
glutBitmapString
glutBitmapWidth
glutButtonBoxFunc
glutChangeToMenuEntry
glutChangeToSubMenu
glutCloseFunc
glutCopyColormap
glutCreateMenu
glutCreateSubWindow
glutCreateWindow
glutDestroyMenu
glutDestroyWindow
BleedingOpenGL.pm view on Meta::CPAN
Button2MotionMask
Button3MotionMask
Button4MotionMask
Button5MotionMask
ButtonMotionMask
KeymapStateMask
ExposureMask
VisibilityChangeMask
StructureNotifyMask
ResizeRedirectMask
SubstructureNotifyMask
SubstructureRedirectMask
FocusChangeMask
PropertyChangeMask
ColormapChangeMask
OwnerGrabButtonMask
KeyPress
KeyRelease
ButtonPress
ButtonRelease
MotionNotify
EnterNotify
LeaveNotify
FocusIn
FocusOut
KeymapNotify
Expose
GraphicsExpose
NoExpose
VisibilityNotify
CreateNotify
DestroyNotify
UnmapNotify
MapNotify
MapRequest
ReparentNotify
ConfigureNotify
ConfigureRequest
BleedingOpenGL.pm view on Meta::CPAN
CirculateRequest
PropertyNotify
SelectionClear
SelectionRequest
SelectionNotify
ColormapNotify
ClientMessage
MappingNotify
LASTEvent
ShiftMask
LockMask
BleedingOpenGL.pm view on Meta::CPAN
FamilyInternet
FamilyDECnet
FamilyChaos
PropertyNewValue
PropertyDelete
ColormapUninstalled
ColormapInstalled
GrabModeSync
GrabModeAsync
GrabSuccess
AlreadyGrabbed
GrabInvalidTime
BleedingOpenGL.pm view on Meta::CPAN
gluLookAt
glAccum
glAlphaFunc
glBegin
glBitmap
glBlendColorEXT
glBlendEquationEXT
glBlendFunc
glCallList
glCallLists
BleedingOpenGL.pm view on Meta::CPAN
Button2MotionMask
Button3MotionMask
Button4MotionMask
Button5MotionMask
ButtonMotionMask
KeymapStateMask
ExposureMask
VisibilityChangeMask
StructureNotifyMask
ResizeRedirectMask
SubstructureNotifyMask
SubstructureRedirectMask
FocusChangeMask
PropertyChangeMask
ColormapChangeMask
OwnerGrabButtonMask
KeyPress
KeyRelease
ButtonPress
ButtonRelease
MotionNotify
EnterNotify
LeaveNotify
FocusIn
FocusOut
KeymapNotify
Expose
GraphicsExpose
NoExpose
VisibilityNotify
CreateNotify
DestroyNotify
UnmapNotify
MapNotify
MapRequest
ReparentNotify
ConfigureNotify
ConfigureRequest
BleedingOpenGL.pm view on Meta::CPAN
CirculateRequest
PropertyNotify
SelectionClear
SelectionRequest
SelectionNotify
ColormapNotify
ClientMessage
MappingNotify
LASTEvent
ShiftMask
LockMask
BleedingOpenGL.pm view on Meta::CPAN
FamilyInternet
FamilyDECnet
FamilyChaos
PropertyNewValue
PropertyDelete
ColormapUninstalled
ColormapInstalled
GrabModeSync
GrabModeAsync
GrabSuccess
AlreadyGrabbed
GrabInvalidTime
BleedingOpenGL.pm view on Meta::CPAN
GLX_BAD_VALUE
GLX_BAD_ENUM
GLXBadContext
GLXBadContextState
GLXBadDrawable
GLXBadPixmap
GLXBadContextTag
GLXBadCurrentWindow
GLXBadRenderRequest
GLXBadLargeRequest
GLXUnsupportedPrivateRequest
BleedingOpenGL.pm view on Meta::CPAN
'glfunctions' => \@gl_func, 'glufunctions' => \@glu_func, 'glutfunctions' => \@glut_func, 'glxfunctions' => \@glx_func,
'oldfunctions' => \@oldfunctions, 'oldconstants' => \@oldconstants,
);
@rename_old = qw(
glBitmap
glCallLists
glClipPlane
glColor3bv
glColor3dv
glColor3fv
BleedingOpenGL.pm view on Meta::CPAN
# NOTE: THIS AUTOLOAD FUNCTION IS FLAWED (but is the best we can do for now).
# Avoid old-style ``&CONST'' usage. Either remove the ``&'' or add ``()''.
if (@_ > 0) {
# Is it an old OpenGL-0.4 function? If so, remap it to newer variant
local($constname);
($constname = $AUTOLOAD) =~ s/.*:://;
if (grep ($_ eq $constname, @rename_old)) {
eval "sub $AUTOLOAD { $AUTOLOAD" . "_s(\@_) }";
goto &$AUTOLOAD;
BleedingOpenGL.pm view on Meta::CPAN
}
return 0;
}
use Import::Into;
*OpenGL::import = sub {
my %known = map { $_ => 1 } qw (OpenGL::Shader::Objects OpenGL::Shader::GLSL OpenGL::Shader::CG OpenGL::Shader::ARB OpenGL::Image::Magick OpenGL::Image::Targa);
shift;
my $target = caller;
die "use Acme::MITHALDU::BleedingOpenGL" if !$known{$target};
__PACKAGE__->import::into($target, @_);
};
view release on metacpan or search on metacpan
inc/Inline.pm view on Meta::CPAN
# P::RD may be in a different PERL5LIB dir to Inline (as happens with cpan smokers).
# Therefore we need to grep for it - otherwise, if P::RD *is* in a different PERL5LIB
# directory the ensuing rebuilt @INC will not include that directory and attempts to use
# Inline::CPP (and perhaps other Inline modules) will fail because P::RD isn't found.
my @_inc = map { "-I$_" }
($inline,
grep {(-d File::Spec->catdir($_,"Inline") or -d File::Spec->catdir($_,"auto","Inline") or -e File::Spec->catdir($_,"Parse/RecDescent.pm"))} @INC);
system $perl, @_inc, "-MInline=_CONFIG_", "-e1", "$dir"
and croak M20_config_creation_failed($dir);
return;
inc/Inline.pm view on Meta::CPAN
*language, $o->{API}{language},
*language_id, $o->{API}{language_id},
*installed, $o->{CONFIG}{_INSTALL_},
*date_compiled, scalar localtime,
*inline_version, $Inline::VERSION,
*ILSM, { map {($_, $o->{INLINE}{"ILSM_$_"})}
(qw( module suffix type ))
},
*Config, { (map {($_,$Config{$_})}
(qw( archname osname osvers
cc ccflags ld so version
))),
(apiversion => $apiversion),
},
inc/Inline.pm view on Meta::CPAN
} split /;/, $ENV{PATH}
:
join ':', grep {/^\// and -d $_ and $< == $> ? 1 : not (-W $_ or -O $_)
} split /:/, $ENV{PATH};
map {($_) = /(.*)/} @INC;
# list cherry-picked from `perldoc perlrun`
delete @ENV{qw(PERL5OPT PERL5SHELL PERL_ROOT IFS CDPATH ENV BASH_ENV)};
$ENV{SHELL} = '/bin/sh' if -x '/bin/sh';
inc/Inline.pm view on Meta::CPAN
<-----------------------End of REPORTBUG Section------------------------------>
END
my %versions;
{
no strict 'refs';
%versions = map {eval "use $_();"; ($_, $ {$_ . '::VERSION'})}
qw (Digest::MD5 Parse::RecDescent
ExtUtils::MakeMaker File::Path FindBin
Inline
);
}
view release on metacpan or search on metacpan
lib/Acme/MUDLike.pm view on Meta::CPAN
our $VERSION = '0.04';
# Todo:
#
# * what would be *really* cool is doing on the fly image generation to draw an overhead map of the program based on a
# graph of which objects reference which other objects and let people go walk around inside of their program
# and then they could fight methods and use global variables as weapons!
#
# * http://zvtm.sourceforge.net/zgrviewer.html or something similar for showing the user the "map" of
# nodes/rooms/whatever made of has-a references or something.
#
# * /goto should put you inside an arbitrary object, /look should list as exits and/or items the object references contained by that object
# in other words, break away from our rigid API for inventory/room/etc.
#
lib/Acme/MUDLike.pm view on Meta::CPAN
my %args = @_;
die "We've already got one" if $continuity;
$password = delete $args{password} if exists $args{password};
$password ||= join('', map { $_->[int rand scalar @$_] } (['a'..'z', 'A'..'Z', '0'..'9']) x 8),
my $staticp = sub {
# warn "staticp: url->path: ``@{[ $_[0]->url->path ]}''";
return 0 if $_[0]->url->path =~ m/\.js$/;
# warn "staticp: dynamic js handling override not engaged";
lib/Acme/MUDLike.pm view on Meta::CPAN
$got_message = 1; # XXX wish this didn't happen for each player but only once after all players got their message
}
sub get_html_messages {
my $self = shift;
return join "<br>\n", map { s{<}{\<}gs; s{\n}{<br>\n}g; $_ } $self->get_messages;
}
sub get_messages {
my $self = shift;
my @ret;
lib/Acme/MUDLike.pm view on Meta::CPAN
while(1) {
$w->next;
# warn "got_message diddled XXX";
# on submitting the form without a JS background post, the poll HTTP connection gets broken
$SIG{PIPE} = 'IGNORE';
$request->print( join "<br>\n", map { s{<}{\<}gs; s{\n}{<br>\n}g; $_ } $self->get_messages );
$request->next;
}
}
if($request->request->url->path =~ m/sendmessage/) {
lib/Acme/MUDLike.pm view on Meta::CPAN
sub _list {
my $self = shift;
my $i = 0;
$self->tell_object(join '',
"Here, you see:\n",
map qq{$_\n},
map { $i . ': ' . $_ }
$self->environment->contents, $self->inventory->contents,
);
}
sub _mark {
lib/Acme/MUDLike.pm view on Meta::CPAN
}
sub _look {
my $self = shift;
my @args = @_;
# $self->tell_object(join '', "Here, you see:\n", map qq{$_\n}, map $_->name, $floor->contents);
$self->tell_object(join '',
"Here, you see:\n",
map qq{$_\n},
map { $_->can('name') ? $_->name : ref($_) }
$self->environment->contents
);
}
sub _inv {
lib/Acme/MUDLike.pm view on Meta::CPAN
sub _inventory {
my $self = shift;
my @args = @_;
$self->tell_object(join '',
"You are holding:\n",
map qq{$_\n},
map { $_->can('name') ? $_->name : ''.$_ }
$self->inventory->contents
);
}
sub _take {
lib/Acme/MUDLike.pm view on Meta::CPAN
/eval package sword; our @ISA = qw/Acme::MUDLike::object/; sub new { my $pack = shift; $pack->SUPER::new(name=>"sword", @_); }
/clone sword
/i
/call sword name
wee, fun! oh, hai everyone!
/eval no strict "refs"; join '', map "$_\n", keys %{"main::"};
/call Acme::MUDLike::player=HASH(0x8985e10) name
=head1 DESCRIPTION
Multi user chat, general purpose object tracer, eval, and give/drop/take/clone/dest/look.
lib/Acme/MUDLike.pm view on Meta::CPAN
},
end: function() {
return this.prevObject || jQuery([]);
},
find: function(t) {
return this.pushStack( jQuery.map( this, function(a){
return jQuery.find(t,a);
}), t );
},
clone: function(deep) {
return this.pushStack( jQuery.map( this, function(a){
var a = a.cloneNode( deep != undefined ? deep : true );
a.$events = null; // drop $events expando to avoid firing incorrect events
return a;
}) );
},
lib/Acme/MUDLike.pm view on Meta::CPAN
if ( !inv && fn(elems[i],i) || inv && !fn(elems[i],i) )
result.push( elems[i] );
return result;
},
map: function(elems, fn) {
// If a string is passed in for the function, make a function
// for it (a handy shortcut)
if ( typeof fn == "string" )
fn = new Function("a","return " + fn);
lib/Acme/MUDLike.pm view on Meta::CPAN
prev: "jQuery.nth(a,2,'previousSibling')",
siblings: "jQuery.sibling(a.parentNode.firstChild,a)",
children: "jQuery.sibling(a.firstChild)"
}, function(i,n){
jQuery.fn[ i ] = function(a) {
var ret = jQuery.map(this,n);
if ( a && typeof a == "string" )
ret = jQuery.multiFilter(a,ret);
return this.pushStack( ret );
};
});
lib/Acme/MUDLike.pm view on Meta::CPAN
var m = re.exec(t);
// If the token match was found
if ( m ) {
// Map it against the token's handler
r = ret = jQuery.map( ret, jQuery.isFunction( jQuery.token[i+1] ) ?
jQuery.token[i+1] :
function(a){ return eval(jQuery.token[i+1]); });
// And remove the token
t = jQuery.trim( t.replace( re, "" ) );
view release on metacpan or search on metacpan
t/Acme-Machi.t view on Meta::CPAN
open my $fh, '>', \ my $my_string;
# Apply affectionate() method, check outputs are randomly generated
#############################################################
my $applying_4_times = join "",
map {;
open $fh, '>', \ $my_string;
$loli->affectionate($fh);
$my_string;
} (1 .. 40);
isnt($applying_4_times, $my_string x 40,
view release on metacpan or search on metacpan
lib/Acme/Magic8Ball.pm view on Meta::CPAN
my $question = shift || return "You must ask a question!";
my @answers = @_;
unless (@answers) {
my $pos = tell DATA;
@answers = map { chomp; $_ } <DATA>;
seek DATA, $pos,0;
}
return $answers[rand @answers] unless $CONSISTENT;
my $hashcode = 0;
view release on metacpan or search on metacpan
$type = 1;
} else {
@players = sort {$b eq $dealer} @players;
$type = 2;
}
my @scores = &{$subs[$type]}(map $points{$_}, @players);
print map "$players[$_]: $scores[$_]\n", (0..3);
push @{$scores{$players[$_]}}, $scores[$_] for (0..3);
foreach my $name (@players) {
print "$name:\n";
print "############\n";
my $total;
print map {$total+=$_; if ($_>0){" $_\n"}else{ " $_\n";}} @{$scores{$name}};
print "--------------\n";
print "Total: $total\n\n";
}
store \%scores, 'mj_scores.dat';
view release on metacpan or search on metacpan
lib/Acme/Marvel/CinematicUniverse/Character.pm.mite.pm view on Meta::CPAN
no strict 'refs';
my $class = shift; $class = ref($class) || $class;
my $linear_isa = mro::get_linear_isa( $class );
return {
BUILD => [
map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
map { "$_\::BUILD" } reverse @$linear_isa
],
DEMOLISH => [
map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
map { "$_\::DEMOLISH" } @$linear_isa
],
HAS_BUILDARGS => $class->can('BUILDARGS'),
HAS_FOREIGNBUILDARGS => $class->can('FOREIGNBUILDARGS'),
};
}
view release on metacpan or search on metacpan
xt/podspell.t view on Meta::CPAN
eval q{ use Test::Spelling };
plan skip_all => q{Test::Spelling is not installed.}
if $@;
add_stopwords( map { /(\w+)/g } <DATA> );
$ENV{LANG} = 'C';
all_pod_files_spelling_ok('lib');
__DATA__
MERCHANTABILITY
view release on metacpan or search on metacpan
lib/Acme/Matrix.pm view on Meta::CPAN
my $delay = $args{delay} ? $args{delay} / 1000 : 0.01;
my $space = " " x ($args{spacing} || 2);
my ($wchar, $hchar) = GetTerminalSize();
$wchar = $wchar * (0.99 / ($args{spacing} || 2));
my %word_lines = (
map { $_ => [] } 0 .. $wchar
);
print "\033[1J";
print "\033[48;5;232m";
while (1) {
for (0..$wchar) {
if (int(rand(5) + 0.5) > 4) {
my $i = 0;
push @{$word_lines{$_}}, (int(rand(1) + 0.5))
? sprintf("\033[38;5;%sm%s", $COLOURS[int(rand(scalar @COLOURS))], $CHARS[int(rand(scalar @CHARS))])
: map { sprintf("\033[38;5;%sm%s", $COLOURS[$i++], $_) } @{ $WORDS[int(rand(scalar @WORDS))] }, $space;
}
print shift(@{$word_lines{$_}}) || $space;
}
print "\n";
select(undef, undef, undef, $delay);
view release on metacpan or search on metacpan
inc/Module/AutoInstall.pm view on Meta::CPAN
use vars qw{$VERSION};
BEGIN {
$VERSION = '1.03';
}
# special map on pre-defined feature sets
my %FeatureMap = (
'' => 'Core Features', # XXX: deprecated
'-core' => 'Core Features',
);
inc/Module/AutoInstall.pm view on Meta::CPAN
my $maxlen = length(
(
sort { length($b) <=> length($a) }
grep { /^[^\-]/ }
map {
ref($_)
? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
: ''
}
map { +{@args}->{$_} }
grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
)[0]
);
while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
inc/Module/AutoInstall.pm view on Meta::CPAN
if (
defined( my $cur = _version_check( _load($mod), $arg ||= 0 ) ) )
{
print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
push @Existing, $mod => $arg;
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
else {
print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
push @required, $mod => $arg;
}
inc/Module/AutoInstall.pm view on Meta::CPAN
) =~ /^[Yy]/
)
)
{
push( @Missing, @required );
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
elsif ( !$SkipInstall
and $default
and $mandatory
and
_prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
=~ /^[Nn]/ )
{
push( @Missing, @required );
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
else {
$DisabledTests{$_} = 1 for map { glob($_) } @tests;
}
}
$UnderCPAN = _check_lock(); # check for $UnderCPAN
inc/Module/AutoInstall.pm view on Meta::CPAN
sub install {
my $class = shift;
my $i; # used below to strip leading '-' from config keys
my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
my ( @modules, @installed );
while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
# grep out those already installed
inc/Module/AutoInstall.pm view on Meta::CPAN
}
$args{test}{TESTS} ||= 't/*.t';
$args{test}{TESTS} = join( ' ',
grep { !exists( $DisabledTests{$_} ) }
map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
my $missing = join( ',', @Missing );
my $config =
join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
if $Config;
view release on metacpan or search on metacpan
t/00-compile.t view on Meta::CPAN
for my $lib (@module_files)
{
# see L<perlfaq8/How can I capture STDERR from an external command?>
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-e', "require q[$lib]"))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
view release on metacpan or search on metacpan
lib/Acme/MetaSyntactic/cyclists.pm view on Meta::CPAN
$$data {names} {world_championships} {road} = do {
my %seen;
join ' ' =>
grep {!$seen {$_} ++}
map {Acme::MetaSyntactic::RemoteList::tr_nonword ($_)}
map {Acme::MetaSyntactic::RemoteList::tr_accent ($_)}
map {/^\s+[0-9]{4}\s+(.*?)\s+[A-Z]{3}$/ ? $1 : ()}
split /\n/ => <<'=cut'};
=pod
2012 Philippe Gilbert BEL
lib/Acme/MetaSyntactic/cyclists.pm view on Meta::CPAN
$$data {names} {tour} = do {
my %seen;
join ' ' =>
grep {!$seen {$_} ++}
map {Acme::MetaSyntactic::RemoteList::tr_nonword ($_)}
map {Acme::MetaSyntactic::RemoteList::tr_accent ($_)}
map {/^\s+[0-9]{4}\s+(.*?)\s+[A-Z]{3}$/ ? $1 : ()}
split /\n/ => <<'=cut'};
=pod
2013 Chris Froome GBR
lib/Acme/MetaSyntactic/cyclists.pm view on Meta::CPAN
$$data {names} {giro} = do {
my %seen;
join ' ' =>
grep {!$seen {$_} ++}
map {Acme::MetaSyntactic::RemoteList::tr_nonword ($_)}
map {Acme::MetaSyntactic::RemoteList::tr_accent ($_)}
map {/^\s+[0-9]{4}\s+(.*?)\s+[A-Z]{3}$/ ? $1 : ()}
split /\n/ => <<'=cut'};
=pod
2013 Vincenzo Nibali ITA
lib/Acme/MetaSyntactic/cyclists.pm view on Meta::CPAN
$$data {names} {vuelta} = do {
my %seen;
join ' ' =>
grep {!$seen {$_} ++}
map {Acme::MetaSyntactic::RemoteList::tr_nonword ($_)}
map {Acme::MetaSyntactic::RemoteList::tr_accent ($_)}
map {/^\s+[0-9]{4}\s+(.*?)\s+[A-Z]{3}$/ ? $1 : ()}
split /\n/ => <<'=cut'};
=pod
2012 Alberto Contador ESP
view release on metacpan or search on metacpan
lib/Acme/MetaSyntactic/ben_and_jerry.pm view on Meta::CPAN
our %Remote = (
source => {
current => 'http://www.benjerry.com/flavors',
},
extract => sub {
return map { s/^10th/Tenth/; s/_+/_/g; s/_$//; $_ }
map { Acme::MetaSyntactic::RemoteList::tr_nonword($_) }
map { Acme::MetaSyntactic::RemoteList::tr_accent($_) }
map { s{(w)/}{$1ith }i; $_ }
$_[0] =~ m{$regex->{$_[1]}}gm;
},
);
1;
view release on metacpan or search on metacpan
t/00-compile.t view on Meta::CPAN
for my $lib (@module_files)
{
# see L<perlfaq8/How can I capture STDERR from an external command?>
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-e', "require q[$lib]"))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
view release on metacpan or search on metacpan
t/00-compile.t view on Meta::CPAN
for my $lib (@module_files)
{
# see L<perlfaq8/How can I capture STDERR from an external command?>
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-e', "require q[$lib]"))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
view release on metacpan or search on metacpan
t/00-compile.t view on Meta::CPAN
for my $lib (@module_files)
{
# see L<perlfaq8/How can I capture STDERR from an external command?>
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-e', "require q[$lib]"))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
view release on metacpan or search on metacpan
dist_author => 'Jerome Quelin <jquelin@cpan.org>',
license => 'perl',
dist_version_from => 'lib/Acme/MetaSyntactic/buzzwords.pm',
add_to_cleanup => [
'Acme-MetaSyntactic-buzzwords-*', 'MANIFEST.bak',
map { ( '*/' x $_ ) . '*~' } 0..5 ],
script_files => [ ],
build_requires => {
'Acme::MetaSyntactic' => 0,
'Test::More' => 0,
},
view release on metacpan or search on metacpan
lib/Acme/MetaSyntactic.pm view on Meta::CPAN
# private class method
sub _find_themes {
my ( $class, @dirs ) = @_;
return
map @$_,
grep { $_->[0] !~ /^[A-Z]/ } # remove the non-theme subclasses
map { [ ( fileparse( $_, qr/\.pm$/ ) )[0] => $_ ] }
map { File::Glob::bsd_glob( File::Spec->catfile( $_, qw( Acme MetaSyntactic *.pm ) ) ) } @dirs;
}
# fetch the list of standard themes
$META{$_} = 0 for keys %{ { __PACKAGE__->_find_themes(@INC) } };