view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
my $version;
{
local $^W;
$ExtUtils::MakeMaker::VERSION = eval $ExtUtils::MakeMaker::VERSION;
}
$version_from = File::Spec->catfile(split m{/}, "lib/Games/Mahjongg/Solver/deBondt/FFI.pm");
unshift @INC, "lib";
my $version = MM->parse_version($version_from); # MM is in MakeMaker
if ($trial) {
$version .= "-TRIAL";
if ($trial > 1) {
view release on metacpan or search on metacpan
some special caveats and setup required, this is covered as a separate topic.
=item Split attributes
A "split" attribute is available only to datatypes I<number> and I<int>. An
attribute that is split maintains two separate values for the attribute, a
"real value" and a "current value" (or simply the "value"). An attribute that
is split in this way has the following properties:
=over 4
view release on metacpan or search on metacpan
MapGen/Editor.pm view on Meta::CPAN
type => "text",
desc => "The %-chance of a door occuring between a room tile and a corridor tile where there is already an opening. The percentages are listed as a four touple: door-chance, secret, stuck, locked (e.g., 95,2,25,50 means there's a 95% c...
name => 'open_room_corridor_door_percent',
default => '95, 2, 25, 50',
disable => { generator_plugins => sub { (grep {$_ eq "BasicDoors"} @{$_[0]}) ? 0:1 } },
convert => sub { my @a = split m/\D+/, $_[0]; { door=>$a[0], secret=>$a[1], stuck=>$a[2], locked=>$a[3] } },
trevnoc => sub { join(", ", @{$_[0]}{qw( door secret stuck locked )}) },
matches => [sub { (grep {$_ >= 0 and $_ <= 100} $_[0] =~ m/^(\d+)\s*,\s*(\d+)\s*,\s*(\d+)\s*,\s*(\d+)$/) == 4 }],
fixes => [sub { $_[0] =~ s/[^\d,\s]+//g }], },
{ mnemonic => "Closed Room-Corridor: ",
type => "text",
desc => "The %-chance of a door occuring between a room tile and a corridor tile where there isn't an opening. The percentages are listed as a four touple: door-chance, secret, stuck, locked.",
name => 'closed_room_corridor_door_percent',
default => '5, 95, 10, 30',
disable => { generator_plugins => sub { (grep {$_ eq "BasicDoors"} @{$_[0]}) ? 0:1 } },
convert => sub { my @a = split m/\D+/, $_[0]; { door=>$a[0], secret=>$a[1], stuck=>$a[2], locked=>$a[3] } },
trevnoc => sub { join(", ", @{$_[0]}{qw( door secret stuck locked )}) },
matches => [sub { (grep {$_ >= 0 and $_ <= 100} $_[0] =~ m/^(\d+)\s*,\s*(\d+)\s*,\s*(\d+)\s*,\s*(\d+)$/) == 4 }],
fixes => [sub { $_[0] =~ s/[^\d,\s]+//g }], },
{ mnemonic => "Open Corridor-Corridor: ",
type => "text",
desc => "The %-chance of a door occuring between a corridor tile and a corridor tile where there is already an opening. The percentages are listed as a four touple: door-chance, secret, stuck, locked.",
name => 'open_corridor_corridor_door_percent',
default => '1, 10, 25, 50',
disable => { generator_plugins => sub { (grep {$_ eq "BasicDoors"} @{$_[0]}) ? 0:1 } },
convert => sub { my @a = split m/\D+/, $_[0]; { door=>$a[0], secret=>$a[1], stuck=>$a[2], locked=>$a[3] } },
trevnoc => sub { join(", ", @{$_[0]}{qw( door secret stuck locked )}) },
matches => [sub { (grep {$_ >= 0 and $_ <= 100} $_[0] =~ m/^(\d+)\s*,\s*(\d+)\s*,\s*(\d+)\s*,\s*(\d+)$/) == 4 }],
fixes => [sub { $_[0] =~ s/[^\d,\s]+//g }], },
{ mnemonic => "Closed Corridor-Corridor: ",
type => "text",
desc => "The %-chance of a door occuring between a corridor tile and a corridor tile where there isn't an opening. The percentages are listed as a four touple: door-chance, secret, stuck, locked.",
name => 'closed_corridor_corridor_door_percent',
default => '1, 95, 10, 30',
disable => { generator_plugins => sub { (grep {$_ eq "BasicDoors"} @{$_[0]}) ? 0:1 } },
convert => sub { my @a = split m/\D+/, $_[0]; { door=>$a[0], secret=>$a[1], stuck=>$a[2], locked=>$a[3] } },
trevnoc => sub { join(", ", @{$_[0]}{qw( door secret stuck locked )}) },
matches => [sub { (grep {$_ >= 0 and $_ <= 100} $_[0] =~ m/^(\d+)\s*,\s*(\d+)\s*,\s*(\d+)\s*,\s*(\d+)$/) == 4 }],
fixes => [sub { $_[0] =~ s/[^\d,\s]+//g }], },
{ mnemonic => "Max Span: ",
view release on metacpan or search on metacpan
Modified tests to have better coverage over code
Removed from setProperty tag check on compose _tagCheck handles it
3/30/08
Integrated isType, and type(move|point|stone) methods
Added edit.t test (removal and split methods)
Fixed Bugs when during test writing
3/31/08
Added inherit.t
Fixed some bugs related to inherited tags
view release on metacpan or search on metacpan
t/00-create.t view on Meta::CPAN
for ( glob("$_/*"), glob("$_/.*") ) {
next if m{/\.\.?$};
if ( -d ) {
push(@_,$_) unless m{/CVS$};
} elsif ( m{\.pm$} ) {
($_) = join("::", map { split m{/+}, $_ } m{^lib/(.*)\.pm});
push(@res, $_);
} else {
print;
};
};
view release on metacpan or search on metacpan
scripts/generate_index.pl view on Meta::CPAN
use WWW::RT::CPAN;
my ($github_user, $github_repo);
if (my $repo = $ENV{GITHUB_REPOSITORY}) {
($github_user, $github_repo) = split m{/}, $repo, 2;
} else {
die 'What repo are you?';
}
my $package_name = $github_repo;
view release on metacpan or search on metacpan
scripts/generate_index.pl view on Meta::CPAN
use WWW::RT::CPAN;
my ($github_user, $github_repo);
if (my $repo = $ENV{GITHUB_REPOSITORY}) {
($github_user, $github_repo) = split m{/}, $repo, 2;
} else {
die 'What repo are you?';
}
my $package_name = $github_repo;
view release on metacpan or search on metacpan
lib/Geo/Coder/YahooJapan.pm view on Meta::CPAN
$response or return undef;
my $content = $response->content;
my @items = ();
@_ = split m|<item>|, $content;
scalar @_ == 0 and return undef;
while ( $content =~ m|<item>(.+?)</item>|sg ) {
my $item_content = $1;
view release on metacpan or search on metacpan
lib/Geo/Google.pm view on Meta::CPAN
my @subpaths = $panel =~ m#(<table class="(ddrsteps(?: pw)?|ddwpt_table|dirsegment)".+?</table>\s*</div>)#gs; #ddspt_table
#my ( $subpanel ) = $response_json->{'panel'} =~ m#<table class="ddrsteps pw">(.+)</table>#s;
foreach my $subpath ( @subpaths ) {
my @segments = split m#</tr>\s*<tr#s, $subpath;
foreach my $segment ( @segments ) {
#skip irrelevant waypoint rows
if ( $subpath =~ m#ddwpt_table#s && $segment !~ m#ddptlnk#s ) { next }
my ( $id, $pointIndex ) = $segment =~ m#id="(.+?)" polypoint="(.+?)"#s;
view release on metacpan or search on metacpan
lib/Geo/IPfree.pm view on Meta::CPAN
my @data;
while (<DATA>) {
last if m{^__END__};
chomp;
push @data, split m{ }, $_, 2;
}
%countrys = @data;
}
sub new {
view release on metacpan or search on metacpan
lib/Geo/LibProj/cs2cs.pm view on Meta::CPAN
# assemble cs2cs call line
for my $key (keys %$params) {
delete $params->{$key} unless defined $params->{$key};
}
my @source_crs = split m/ /, $source_crs // 'undef';
my @target_crs = split m/ /, $target_crs // 'undef';
$self->{cmd} = $self->_cmd();
$self->{call} = [$self->{cmd}, %$params, @source_crs, '+to', @target_crs, '-'];
$self->_ffi_init($source_crs, $target_crs, $params);
view release on metacpan or search on metacpan
lib/Geo/WKT.pm view on Meta::CPAN
$string && $string =~ m/^polygon\(\((.+)\)\)$/i
or return undef;
my @poly;
foreach my $poly (split m/\)\s*\,\s*\(/, $1)
{ my @points = map +[split " ", $_, 2], split /\s*\,\s*/, $poly;
push @poly, \@points;
}
Geo::Surface->new(@poly, proj => $proj);
view release on metacpan or search on metacpan
lib/Geoffrey/Converter/Pg.pm view on Meta::CPAN
my ( $self, $ar_raw_data ) = @_;
return [] if scalar @{$ar_raw_data} == 0;
my $table_row = shift @{$ar_raw_data};
$table_row->{sql} =~ s/^.*(CREATE|create) .*\(//g;
my $columns = [];
for ( split m/,/, $table_row->{sql} ) {
s/^\s*(.*)\s*$/$1/g;
my $rx_not_null = 'NOT NULL';
my $rx_primary_key = 'PRIMARY KEY';
my $rx_default = 'SERIAL|DEFAULT';
my $rx_column_values = qr/($rx_not_null)*\s($rx_primary_key)*.*($rx_default \w{1,})*/;
lib/Geoffrey/Converter/Pg.pm view on Meta::CPAN
( $column[$I_CONST_LENGTH_VALUE] ? ( length => $column[$I_CONST_LENGTH_VALUE] ) : () ),
( $column[$I_CONST_NOT_NULL_VALUE] ? ( not_null => $column[$I_CONST_NOT_NULL_VALUE] ) : () ),
( $column[$I_CONST_PRIMARY_KEY_VALUE] ? ( primary_key => $column[$I_CONST_PRIMARY_KEY_VALUE] ) : () ),
( $column[$I_CONST_DEFAULT_VALUE] ? ( default => $column[$I_CONST_DEFAULT_VALUE] ) : () ),
};
} ## end for ( split m/,/, $table_row...)
return $columns;
} ## end sub colums_information
sub index_information {
my ( $self, $ar_raw_data ) = @_;
my @mapped = ();
for ( @{$ar_raw_data} ) {
next if !$_->{sql};
my ($s_columns) = $_->{sql} =~ m/\((.*)\)$/;
my @columns = split m/,/, $s_columns;
s/^\s+|\s+$//g for @columns;
push @mapped, { name => $_->{name}, table => $_->{tbl_name}, columns => \@columns };
} ## end for ( @{$ar_raw_data} )
return \@mapped;
} ## end sub index_information
view release on metacpan or search on metacpan
lib/Geoffrey/Converter/SQLite.pm view on Meta::CPAN
my ( $self, $ar_raw_data ) = @_;
return [] if scalar @{$ar_raw_data} == 0;
my $table_row = shift @{$ar_raw_data};
$table_row->{sql} =~ s/^.*(CREATE|create) (.*)\(/$2/g;
my $columns = [];
for ( split m/,/, $table_row->{sql} ) {
s/^TABLE\s+\S+\s+\((.*)/$1/g;
s/^\s*(.*)\s*$/$1/g;
my $rx_not_null = 'NOT NULL';
my $rx_primary_key = 'PRIMARY KEY';
my $rx_default = 'AUTOINCREMENT|DEFAULT';
lib/Geoffrey/Converter/SQLite.pm view on Meta::CPAN
my ( $self, $ar_raw_data ) = @_;
my @mapped = ();
for ( @{$ar_raw_data} ) {
next if !$_->{sql};
my ($s_columns) = $_->{sql} =~ m/\((.*)\)$/;
my @columns = split m/,/, $s_columns;
s/^\s+|\s+$//g for @columns;
push @mapped,
{
name => $_->{name},
table => $_->{tbl_name},
view release on metacpan or search on metacpan
lib/Getopt/Auto.pm view on Meta::CPAN
}
_trace("Splitting $arg into its components");
my @args;
foreach my $char ( split m{}smx, substr $arg, 1 ) {
$char = "-$char";
push @args, $char;
$args->{$char}++;
$args->{$arg}++;
}
lib/Getopt/Auto.pm view on Meta::CPAN
# Check --foo=bar syntax use
my $arg_eq;
if ( $argv =~ m{=}smx ) {
# Assign-type option: --foo=bar
( $argv, $arg_eq ) = split m{=}smx, $argv;
unshift @ARGV, $arg_eq;
_trace("Option $argv has assignment");
_trace_argv();
}
lib/Getopt/Auto.pm view on Meta::CPAN
Getopt::Auto::_trace("Shorthelp is: $shorthelp");
# This suports options of the form "-f, --foo"
my $sub;
my @nosub;
my @opts = split m{,\s*}smx, $text;
foreach my $name (@opts) {
$name =~ s{\A(\w<)?([\w_-]+)>?}{$2}smx;
if ( $name =~ m{\s}smx ) {
Getopt::Auto::_trace("$name dropped, has spaces");
next;
view release on metacpan or search on metacpan
lib/Getopt/Chain/Builder.pm view on Meta::CPAN
elsif ( $path =~ m/^\s*\*\s*$/ ) { # "*"
$matcher = qr/(.*)/;
$control{arguments_from_1} = 1;
}
elsif ( $path =~ s/\s+--\s*$// ) { # "xyzzy --"
$matcher = [ split m/\s+/, $path ];
$control{terminator} = 1;
}
elsif ( $path =~ m/^\s*--\s*$/ ) { # "--"
$matcher = [];
$control{terminator} = 1;
}
else {
$matcher = [ split m/\s+/, $path ];
}
}
else {
croak "Don't recogonize matcher ($path)";
}
view release on metacpan or search on metacpan
lib/Getopt/LL.pm view on Meta::CPAN
if ($rule_spec->{help}) {
$help_ref->{$rule_name} = $rule_spec->{help};
}
my($rule_name_final, @aliases)
= split m/\|/xms, $rule_name;
# Split out the aliases (which are delimited by |)
# Aliases can also be inside the spec, like this:
# '-arg' => { alias => '-gra' };
lib/Getopt/LL.pm view on Meta::CPAN
my @arguments = ($argument);
if ($is_arg_of_type eq 'short' && $options_ref->{split_multiple_shorts}) {
$argument =~ s/^-//xms;
@arguments = map { "-$_" } split m//xms, $argument;
};
for my $argument (@arguments) {
my $argument_name = $argument;
view release on metacpan or search on metacpan
lib/Getopt/Long/DescriptivePod.pm view on Meta::CPAN
or next VALUE;
$value =~ s{ \r\n | [\n\r] }{\n}xmsg; # compatible \n
$value =~ s{ \A \n* (.*?) \n* \z }{$1}xms; # trim
$value = [
( $key eq 'after' ? q{} : () ),
( split m{ \n }xms, $value ),
( $key eq 'before' ? q{} : () ),
];
}
}
lib/Getopt/Long/DescriptivePod.pm view on Meta::CPAN
my ($newline) = $current_content =~ m{ ( \r\n | [\n\r] ) }xms;
$current_content =~ s{ \r\n | [\n\r] }{\n}xmsg;
my ($newlines_at_eof) = $current_content =~ m{ ( \n+ ) \z }xms;
$newlines_at_eof = length +( $newlines_at_eof || q{} );
$current_content =~ s{ \n+ \z }{}xms;
my @content = split m{ \n }xms, $current_content;
# replace Pod
my $is_found;
my $index = 0;
LINE: while ( $index < @content ) {
view release on metacpan or search on metacpan
t/10fast-export.t view on Meta::CPAN
use Git::FastExport;
# this script tests the parsing of fast-export block data
my @latin = split m!^----\n!m, << 'EOT';
perferendis
sit
praesentium
doloribus
itaque
view release on metacpan or search on metacpan
- add a method to return the references
- add a method to return the commit for a reference
- fix bug where it would not find an object if there was a
mixture of packs and loose objects
- fix bug to do with empty files
- split methods into those that returns sha1s and those that
return objects
- add class to index packs
- make it work under Win32 (thanks to fayland)
0.38 Thu Dec 18 10:26:49 GMT 2008
view release on metacpan or search on metacpan
lib/Git/Raw/Diff.pm view on Meta::CPAN
Similarity to consider a file a copy (default 50).
=item * "break_rewrite_threshold"
Similarity to split modify into delete/add pair (default 60).
=item * "rename_limit"
Maximum similarity sources to examine for a file (default 200).
view release on metacpan or search on metacpan
SVNReplay.pm view on Meta::CPAN
ebegin "mkdir -p $cod";
mkpath($r); # uses umask and 0777 to create
eend 1;
my @split = split m/\//, $r; $r = shift @split; {
ebegin "svn add $r";
$this->logging_systemx(qw(svn add), $r);
eend 1;
# NOTE: SVN apparnetly does this recursively
view release on metacpan or search on metacpan
lib/Git/SVN.pm view on Meta::CPAN
$self->{path_regex} ||= qr{^/\Q@{[$self->path]}\E/};
if (grep /$self->{path_regex}/, keys %$paths) {
return 1;
}
my $c = '';
foreach (split m#/#, $self->path) {
$c .= "/$_";
next unless ($paths->{$c} &&
($paths->{$c}->{action} =~ /^[AR]$/));
if ($self->ra->check_path($self->path, $r) ==
$SVN::Node::dir) {
lib/Git/SVN.pm view on Meta::CPAN
$SVN::Error::handler = $err_handler;
}
return undef unless defined $paths;
# look for a parent from another branch:
my @b_path_components = split m#/#, $self->path;
my @a_path_components;
my $i;
while (@b_path_components) {
$i = $paths->{'/'.join('/', @b_path_components)};
last if $i && defined $i->{copyfrom_path};
view release on metacpan or search on metacpan
lib/GitHub/Crud.pm view on Meta::CPAN
$g->createIssue;
}
sub currentRepo() # Create a github object for the current repo if we are on github actions
{if (my $r = $ENV{GITHUB_REPOSITORY}) # We are on GitHub
{my ($user, $repo) = split m(/), $r, 2;
my $g = GitHub::Crud::new;
$g->userid = $user;
$g->repository = $repo;
$g->personalAccessToken = $ENV{GITHUB_TOKEN};
$g->confessOnFailure = 1;
view release on metacpan or search on metacpan
lib/GitHub/EmptyRepository/Repository.pm view on Meta::CPAN
sub _parse_github_url {
my $self = shift;
my $uri = URI->new(shift);
my @parts = split m{/}, $uri->path;
# paths may or may not have a leading slash (absolute vs relative)
my $user = shift @parts || shift @parts;
my $name = shift @parts;
$name =~ s{\.git}{};
view release on metacpan or search on metacpan
lib/GitHub/MergeVelocity/Repository.pm view on Meta::CPAN
sub _parse_github_url {
my $self = shift;
my $uri = URI->new(shift);
my @parts = split m{/}, $uri->path;
# paths may or may not have a leading slash (absolute vs relative)
my $user = shift @parts || shift @parts;
my $name = shift @parts;
$name =~ s{\.git}{};
view release on metacpan or search on metacpan
even in combination with fillcolor. Thanx to Ryan Schmidt!
2005-12-27 v0.37 Tels 1533 tests - Sing, sing, sing the birthday song...
* correctly handle '\\n' in labels/titles
* Node::Cell: allow 'x' and 'y' as arguments
* Layout: repair split multi-celled nodes after inserting group fillers
* Layout: insert short filler edge pieces on spliced edge for
group layouts (fixes "holes" at the start and end of edges
in ascii layouts with groups)
* Layout: set smaller minimum-size for group cells at non-corners
* Layout: grow group fillers to close gaps between nodes in things like:
view release on metacpan or search on metacpan
if ($line =~ m/^#/ms) {
next;
}
# Process OID.
my ($line_oid, $line_label) = split m/\s+/ms, $line, 2;
my @oid = split m/\./ms, $line_oid;
my $last_oid;
my $act_oid = $EMPTY_STR;
foreach my $oid (@oid) {
if ($act_oid ne $EMPTY_STR) {
$act_oid .= $DOT;
view release on metacpan or search on metacpan
if (! $status) {
err 'Cannot parse edge label.',
'Error', $self->{'_csv'}->error_input,
'String', $edge_label;
}
my %params = map { split m/=/ms, $_ } $self->{'_csv'}->fields;
foreach my $key (keys %params) {
$graph->set_edge_attribute($id1, $id2, $key, $params{$key});
}
return;
}
if (! $status) {
err 'Cannot parse vertex label.',
'Error', $self->{'_csv'}->error_input,
'String', $vertex_label;
}
my %params = map { split m/=/ms, $_ } $self->{'_csv'}->fields;
foreach my $key (keys %params) {
$graph->set_vertex_attribute($id, $key, $params{$key});
}
return;
}
view release on metacpan or search on metacpan
next;
}
# Vertexes.
if ($vertexes) {
my ($id, $vertex_label) = split m/\s+/ms, $line, 2;
if (! defined $vertex_label) {
$vertex_label = $id;
}
$graph->add_vertex($id);
if ($self->{'vertex_callback'}) {
$vertex_label);
}
# Edges.
} else {
my ($id1, $id2, $edge_label) = split m/\s+/ms, $line, 3;
$graph->add_edge($id1, $id2);
if ($self->{'edge_callback'}) {
$self->{'edge_callback'}->($self, $graph, $id1,
$id2, $edge_label);
} else {