view release on metacpan or search on metacpan
lib/Algorithm/BellmanFord.pm view on Meta::CPAN
}
$nodeStr = $lines[$links + 1];
chomp ($nodeStr);
@nodes12 = split(',',$nodeStr);
@startNode;
@endNode;
$infinity = "122.0";
$lenOfFile = @lines;
$m = 0;
for ($t = $links + 2; $t < $lenOfFile-1; $t++) {
$lines[$t] =~/^path ([a-z]),([a-z])/;
$startEndNode[$m] = "$1,$2";
$m++;
}
foreach $pair (@startEndNode) {
$pair =~/([a-z]),([a-z])/;
$root = $1;
$destination = $2;
print "\nWelcome to My Bellman algorithm we find solution for source = $1 and destination = $2\n";
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Algorithm/Bertsekas.pm view on Meta::CPAN
$max_epsilon_scaling = 2 + int( log( (1+$min_size) * $epsilon )/log($factor) ); # print "\n \$max_epsilon_scaling = $max_epsilon_scaling \n";
my $feasible_assignment_condition = 0;
# The preceding observations suggest the idea of epsilon-scaling, which consists of applying the algorithm several times,
# starting with a large value of epsilon and successively reducing epsilon until it is less than some critical value.
while( $epsilon >= 1/(1+$min_size) and $max_size >= 2 ){
$epsilon_scaling++;
$iter_count_local = 0;
lib/Algorithm/Bertsekas.pm view on Meta::CPAN
=head1 SYNOPSIS
### --- simple and direct application --- ###
### --- start --- ###
#!/usr/bin/perl
use strict;
use warnings FATAL => 'all';
lib/Algorithm/Bertsekas.pm view on Meta::CPAN
2. Towards auction algorithms for large dense assignment problems (2008).
Libor Bus and Pavel Tvrdik
https://pdfs.semanticscholar.org/b759/b8fb205df73c810b483b5be2b1ded62309b4.pdf
3. https://github.com/EvanOman/AuctionAlgorithmCPP/blob/master/auction.cpp
This Perl algorithm started from this C++ implementation.
4. https://en.wikipedia.org/wiki/Assignment_problem
5. https://en.wikipedia.org/wiki/Auction_algorithm
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/AutoInstall.pm view on Meta::CPAN
my $makeflags = $CPAN::Config->{make_install_arg} || '';
$CPAN::Config->{make_install_arg} =
join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
# don't show start-up info
$CPAN::Config->{inhibit_startup_message} = 1;
# set additional options
while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
( $args{$opt} = $arg, next )
if $opt =~ /^force$/; # pseudo-option
view all matches for this distribution
view release on metacpan or search on metacpan
third parties under the terms of this General Public License (except
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
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
view all matches for this distribution
view release on metacpan or search on metacpan
Examples/BitVectorDemo.pl view on Meta::CPAN
# 0110000101100001011000010110000101100001000010100000101001101010
# 0110101001101010011010100110101001101010011010100110101001101010
# 0110101001101010011010100110101001101010011010100110101001101010
# 0000101000001010
print "\nExperiment with closing a file object and start extracting bitvectors from the file from the beginning again:\n";
$bv->close_file_handle();
$bv = Algorithm::BitVector->new( filename => 'testinput.txt' );
$bv1 = $bv->read_bits_from_file(64);
print "Here are all the first 64 bits read from the file again after the file object was closed and opened again:\n";
print "$bv1\n"; # 0100000100100000011010000111010101101110011001110111001001111001
view all matches for this distribution
view release on metacpan or search on metacpan
* - varint encoding number of hash functions
* - varint encoding significant_bits
* - X bytes - whatever the length in bytes for the bitmap is */
char *cur;
char *start;
const uint64_t plength = MAX_VARINT_LENGTH /* length of packet, this number */
+ bl->nbytes /* the actual data size */
+ MAX_VARINT_LENGTH /* k */
+ MAX_VARINT_LENGTH; /* significant_bits */
*out_len = (size_t)plength; /* to be revised further down */
start = cur = malloc(*out_len);
if (!cur) {
*out_len = 0;
*out = 0;
return 1;
}
S_uint64_to_varint((unsigned char **)&cur, (uint64_t)bl->significant_bits);
memcpy(cur, bl->bitmap, bl->nbytes);
cur += bl->nbytes;
*out_len = (size_t)(cur-start) + 1;
return 0;
}
bloom_t *
view all matches for this distribution
view release on metacpan or search on metacpan
BreakOverlappingRectangles.xs view on Meta::CPAN
#define IDOFFSET (sizeof(NV) * 4)
#define BRUTEFORCECUTOFF 40
#if 1
#define DP(f)
#define DUMP(msg, av, start)
#define my_assert(a) assert(a)
#else
#define my_assert(a) if(!(a)) _failed_assertion(aTHX_ #a, __LINE__, __FILE__)
#define DP(f) f
#define DUMP(msg, av, start) _dump(aTHX_ (msg), (av), (start))
static void
_dump(pTHX_ char *msg, AV *rects, I32 start) {
I32 end = av_len(rects) + 1;
SV **svs = AvARRAY(rects);
I32 i;
fprintf (stderr, "%s = start: %d, end: %d", msg, start, end);
for (i = start; i < end; i++) {
SV *sv = svs[i];
if (SvOK(sv)) {
STRLEN len, j;
NV* nv = (NV*)SvPV(svs[i], len);
IV* iv = (IV*)(SvPV_nolen(svs[i]) + IDOFFSET);
BreakOverlappingRectangles.xs view on Meta::CPAN
sort_inplace(pTHX_ double **v, int size) {
sortsv((SV**)v, size, (SVCOMPARE_t)&double_cmp);
}
static NV
find_best_cut(pTHX_ AV *rects, I32 start, I32 end, int dir, NV *bestv) {
NV **v0, **v1, **vc0, **vc1;
NV v, med, best;
int op, cl;
int i;
SV **svs;
I32 size = end - start;
my_assert(bestv);
DUMP("fbc in", rects, start);
DP(fprintf(stderr, "end: %d\n", end));
Newx(v0, size + 1, NV *);
Newx(v1, size + 1, NV *);
v0[size] = v1[size] = NULL;
vc0 = v0; vc1 = v1;
svs = AvARRAY(rects) + start;
size = end - start;
for (i = 0; i < size; i++) {
NV *nv = (NV*)SvPV_nolen(svs[i]);
if (dir == 'x') {
v0[i] = nv + X0;
BreakOverlappingRectangles.xs view on Meta::CPAN
return best;
}
static void
_break(pTHX_ AV *rects, I32 start, AV *parts);
static void
_brute_force_merge(pTHX_ AV *rects, I32 start, AV *parts) {
I32 i, len;
for (i = start; i <= av_len(rects); i++) {
SV *svr = (AvARRAY(rects))[i];
I32 j;
for (j=0; j <= av_len(parts);) {
NV *r = (NV*) SvPV_nolen(svr);
SV *svp = (AvARRAY(parts))[j];
BreakOverlappingRectangles.xs view on Meta::CPAN
for (i = av_len(parts); i >= 0; i--)
av_push(rects, av_pop(parts));
*/
if ((len = av_len(parts)) >= 0) {
SV **svrs, **svps;
I32 start = av_len(rects) + 1;
av_extend(rects, start + len);
svrs = AvARRAY(rects) + start;
svps = AvARRAY(parts);
AvFILLp(parts) = -1;
AvFILLp(rects) = start + len;
do {
svrs[len] = svps[len];
svps[len] = &PL_sv_undef;
} while (--len >= 0);
}
}
static void
_brute_force_break(pTHX_ AV *rects, I32 start, AV *parts) {
I32 i, j, end1;
DUMP("bfb in", rects, start);
end1 = av_len(rects);
if (end1 < start + 1)
return;
if (end1 - start > 2 * BRUTEFORCECUTOFF ) {
SV **svs;
I32 end;
I32 middle = (start + end1 + 1) / 2;
_break(aTHX_ rects, middle, parts);
svs = AvARRAY(rects);
end = av_len(rects) + 1;
i = start;
j = end;
while (i < middle && j > middle) {
j--;
SV *tmp = svs[i];
svs[i] = svs[j];
svs[j] = tmp;
i++;
}
middle = start + end - middle;
_break(aTHX_ rects, middle, parts);
end = av_len(rects);
if ((end - start) > (end1 - start) * 1.2)
return _break(aTHX_ rects, start, parts);
while (end-- >= middle)
av_push(parts, av_pop(rects));
return _brute_force_merge(aTHX_ rects, start, parts);
}
while (--end1 >= start) {
SV *last, *next;
SV **svs;
DP(fprintf(stderr, "bfb: start: %d, end1: %d, end: %d\n", start, end1, av_len(rects) + 1));
svs = AvARRAY(rects);
last = svs[AvFILLp(rects)];
svs[AvFILLp(rects)--] = &PL_sv_undef;
next = svs[end1];
BreakOverlappingRectangles.xs view on Meta::CPAN
}
return;
}
static void
_break(pTHX_ AV *rects, I32 start, AV *parts) {
NV bestx, bestxx, besty, bestyy, div;
int off;
I32 i, j, middle, end;
SV **svs;
DUMP("break", rects, start);
while (1) {
end = av_len(rects) + 1;
if ((end - start) <= BRUTEFORCECUTOFF)
return _brute_force_break(aTHX_ rects, start, parts);
bestx = find_best_cut(aTHX_ rects, start, end, 'x', &bestxx);
besty = ((bestx == 0) ? 1 : find_best_cut(aTHX_ rects, start, end, 'y', &bestyy));
if (bestx < besty) {
off = X0;
div = bestxx;
DP(fprintf(stderr, "cutting at x=%.0f, best=%.2f\n", bestxx, bestx));
BreakOverlappingRectangles.xs view on Meta::CPAN
div = bestyy;
DP(fprintf(stderr, "cutting at y=%.0f, best=%.2f\n", bestyy, besty));
}
svs = AvARRAY(rects);
i = start;
middle = end;
while (i < middle) {
SV *sv = svs[i];
NV n0 = ((NV*)SvPV_nolen(sv))[off];
if (n0 < div) {
BreakOverlappingRectangles.xs view on Meta::CPAN
}
else
i++;
}
DUMP("b0", rects, start);
if (middle == start || middle == end)
return _brute_force_break(aTHX_ rects, start, parts);
_break(aTHX_ rects, middle, parts);
DUMP("b1", rects, start);
svs = AvARRAY(rects);
end = av_len(rects) + 1;
i = start;
j = end;
while (i < middle && j > middle) {
j--;
SV *tmp = svs[i];
svs[i] = svs[j];
svs[j] = tmp;
i++;
}
DUMP("b2", rects, start);
end += start - middle;
off += 2;
i = start;
middle = end;
DP(fprintf(stderr, "i: %d, middle: %d\n", i, middle));
while (i < middle) {
SV *sv = svs[i];
NV n0 = ((NV*)SvPV_nolen(sv))[off];
BreakOverlappingRectangles.xs view on Meta::CPAN
}
else
i++;
}
DUMP("b3", rects, start);
if (middle == start)
return _brute_force_break(aTHX_ rects, start, parts);
start = middle;
}
/* _break(aTHX_ rects, middle); */
}
MODULE = Algorithm::BreakOverlappingRectangles PACKAGE = Algorithm::BreakOverlappingRectangles
view all matches for this distribution
view release on metacpan or search on metacpan
Bucketizer.pm view on Meta::CPAN
my $round = 0;
my $minbuckets;
my @minitems;
my $start_time = time();
# Run through different setups and determine the one
# requiring a minimum of buckets.
while (my @res = $next->()) {
Bucketizer.pm view on Meta::CPAN
}
++$round;
last if exists $options{maxrounds} and $round >= $options{maxrounds};
last if exists $options{maxtime} and
time() > $start_time + $options{maxtime};
}
# We should have a ideal distribution now, nuke all buckets and refill
$self->{buckets} = [];
$self->{cur_bucket_idx} = 0;
Bucketizer.pm view on Meta::CPAN
=head2 Prefilling Buckets
Sometimes you will have preexisting buckets, which you need to
tell the algorithm
about before it starts adding new items. The C<prefill_bucket()> method
does exactly that, simply putting an item into a specified bucket:
$b->prefill_bucket($bucket_idx, $item, $itemsize);
C<$bucket_idx> is the index of the bucket, starting from 0. Non-existing buckets
are automatically created for you. Make sure you have a consecutive number
of buckets at the end of the prefill.
=head2 Optimize
view all matches for this distribution
view release on metacpan or search on metacpan
third parties under the terms of this General Public License (except
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
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
view all matches for this distribution
view release on metacpan or search on metacpan
third parties under the terms of this General Public License (except
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
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Algorithm/CP/IZ.pm view on Meta::CPAN
$vs->prepare($i);
$i++;
}
if ($max_fail_func) {
return Algorithm::CP::IZ::cs_searchValueSelectorRestartNG(
$array,
$value_selectors,
$find_free_var_id,
$find_free_var_func,
$max_fail_func,
lib/Algorithm/CP/IZ.pm view on Meta::CPAN
return $ret;
}
sub Cumulative {
my $self = shift;
my ($starts, $durations, $resources, $limit) = @_;
validate([$starts, $durations, $resources, $limit, 1],
["vA0", "vA0", "vA0", "V", sub {
@$starts == @$durations && @$durations == @$resources
}],
"Usage: Cumulative([starts], [durations], [resources], limit)");
@$starts = map { ref $_ ? $_ : $self->_const_var(int($_)) } @$starts;
@$durations = map { ref $_ ? $_ : $self->_const_var(int($_)) } @$durations;
@$resources = map { ref $_ ? $_ : $self->_const_var(int($_)) } @$resources;
$limit = ref $limit ? $limit : $self->_const_var(int($limit));
my $pstarts = $self->_create_registered_var_array($starts);
my $pdurs = $self->_create_registered_var_array($durations);
my $pres = $self->_create_registered_var_array($resources);
my $ret = Algorithm::CP::IZ::cs_Cumulative($$pstarts, $$pdurs, $$pres,
scalar(@$starts), $$limit);
return $ret;
}
sub Disjunctive {
my $self = shift;
my ($starts, $durations) = @_;
validate([$starts, $durations, 1],
["vA0", "vA0", sub {
@$starts == @$durations
}],
"Usage: Disjunctive([starts], [durations])");
@$starts = map { ref $_ ? $_ : $self->_const_var(int($_)) } @$starts;
@$durations = map { ref $_ ? $_ : $self->_const_var(int($_)) } @$durations;
my $pstarts = $self->_create_registered_var_array($starts);
my $pdurs = $self->_create_registered_var_array($durations);
my $ret = Algorithm::CP::IZ::cs_Disjunctive($$pstarts, $$pdurs,
scalar(@$starts));
return $ret;
}
sub Regular {
my $self = shift;
lib/Algorithm/CP/IZ.pm view on Meta::CPAN
(If ValueSelector is specified, this parameter is ignored.)
=item MaxFailFunc
CodeRef of subroutine which returns maxfail for restart.
=item NoGoodSet
A Algorithm::CP::IZ::NoGoodSet instance which collects NoGoods.
=item Notify
Specify a notify object receives following notification by search function.
search_start
search_end
before_value_selection
after_value_selection
enter
leave
view all matches for this distribution
view release on metacpan or search on metacpan
template <class Iterator>
inline size_t tokenizeCSV(char *str,
Iterator out, size_t max) {
char *eos = str + std::strlen(str);
char *start = 0;
char *end = 0;
size_t n = 0;
for (; str < eos; ++str) {
while (*str == ' ' || *str == '\t') ++str; // skip white spaces
bool inquote = false;
if (*str == '"') {
start = ++str;
end = start;
for (; str < eos; ++str) {
if (*str == '"') {
str++;
if (*str != '"')
break;
*end++ = *str;
}
inquote = true;
str = std::find(str, eos, ',');
} else {
start = str;
str = std::find(str, eos, ',');
end = str;
}
if (max-- > 1) *end = '\0';
*out++ = start;
++n;
if (max == 0) break;
}
return n;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Algorithm/CheckDigits/M23_002.pm view on Meta::CPAN
=over 4
=item 1
In reverse order, each digit is multiplied by a weight started at 2.
(i.e. the number left from the check digit is multiplied with 2,
the next with 3 and so on).
=item 2
view all matches for this distribution
view release on metacpan or search on metacpan
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..2\n"; }
view all matches for this distribution
view release on metacpan or search on metacpan
benchmarking/BenchAccel.pm view on Meta::CPAN
my ( $code, $secs ) = @_;
$secs ||= 1;
# Warm-up: at least 0.3 s (matches the original Perl bench() helper
# this replaced) so OpenMP thread pools are firmly hot before any
# measurement window starts. Scales up for long budgets -- a 30 s
# measurement gets a 3 s warmup.
my $warmup = $secs * 0.1;
$warmup = 0.3 if $warmup < 0.3;
my $wt0 = time;
$code->() while time - $wt0 < $warmup;
view all matches for this distribution
view release on metacpan or search on metacpan
my $nb = Algorithm::Classifier::NaiveBayes->new;
isa_ok( $nb, 'Algorithm::Classifier::NaiveBayes', 'new' );
is( $nb->{'model'}{'lc_tokens'}, 1, 'lc_tokens defaults to 1' );
is( $nb->{'model'}{'token_splitter'}, '\s+', 'token_splitter defaults to \s+' );
is( $nb->{'model'}{'stop_regex'}, undef, 'stop_regex defaults to undef' );
is( $nb->{'model'}{'total_docs'}, 0, 'total_docs starts at 0' );
is( $nb->{'model'}{'smoothing'}, 'laplace', 'smoothing defaults to laplace' );
is( $nb->{'model'}{'alpha'}, 1, 'alpha defaults to 1 for laplace' );
my $lidstone = Algorithm::Classifier::NaiveBayes->new( 'smoothing' => 'lidstone' );
is( $lidstone->{'model'}{'smoothing'}, 'lidstone', 'smoothing arg is used' );
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/AutoInstall.pm view on Meta::CPAN
my $makeflags = $CPAN::Config->{make_install_arg} || '';
$CPAN::Config->{make_install_arg} =
join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
# don't show start-up info
$CPAN::Config->{inhibit_startup_message} = 1;
# set additional options
while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
( $args{$opt} = $arg, next )
if $opt =~ /^force$/; # pseudo-option
view all matches for this distribution
view release on metacpan or search on metacpan
third parties under the terms of this General Public License (except
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
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
view all matches for this distribution
view release on metacpan or search on metacpan
perl/Record.pm view on Meta::CPAN
while ($line = <$handle>) {
my $count = ($line =~ tr/\t//);
@words = split(/\t/, $line);
chomp @words;
scalar @words == $n or die "Line with " . scalar @words . " columns found (expected $n): $!";
my $start = 0;
for my $key (keys %cols) {
if ($key > $start) {
$start = $key;
}
}
if ($words[0] eq 'EWEIGHT') {
@{$self->{eweight}} = @words[$start+1..$n-1];
}
elsif ($words[0] eq 'EORDER') {
@{$self->{eorder}} = @words[$start+1..$n-1];
}
else {
my @rowdata = ();
my @rowmask = ();
for ($i = 0; $i < $n; $i++) {
view all matches for this distribution
view release on metacpan or search on metacpan
Combinatorics.xs view on Meta::CPAN
/**
* The only algorithms I have found by now are either recursive, or a
* naive wrapper around permutations() that loops over all of them and
* discards the ones with fixed-points.
*
* We take here a mixed-approach, which consists on starting with the
* algorithm in __next_permutation() and tweak a couple of places that
* allow us to skip a significant number of permutations sometimes.
*
* Benchmarking shows this subroutine makes derangements() more than
* two and a half times faster than permutations() for n = 8.
Combinatorics.xs view on Meta::CPAN
return (AV*) sv_2mortal((SV*) subset);
}
/** -------------------------------------------------------------------
*
* XS stuff starts here.
*
*/
MODULE = Algorithm::Combinatorics PACKAGE = Algorithm::Combinatorics
PROTOTYPES: DISABLE
view all matches for this distribution
view release on metacpan or search on metacpan
third parties under the terms of this General Public License (except
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
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
view all matches for this distribution
view release on metacpan or search on metacpan
_invlist_subtract|||
_invlist_union_maybe_complement_2nd|||
_invlist_union|||
_is_uni_FOO||5.017008|
_is_uni_perl_idcont||5.017008|
_is_uni_perl_idstart||5.017007|
_is_utf8_FOO||5.017008|
_is_utf8_mark||5.017008|
_is_utf8_perl_idcont||5.017008|
_is_utf8_perl_idstart||5.017007|
_new_invlist_C_array|||
_new_invlist|||
_pMY_CXT|5.007003||p
_swash_inversion_hash|||
_swash_to_invlist|||
bad_type_gv|||
bad_type_pv|||
bind_match|||
block_end|||
block_gimme||5.004000|
block_start|||
blockhook_register||5.013003|
boolSV|5.004000||p
boot_core_PerlIO|||
boot_core_UNIVERSAL|||
boot_core_mro|||
debop||5.005000|
debprofdump||5.005000|
debprof|||
debstackptrs||5.007003|
debstack||5.007003|
debug_start_match|||
deb||5.007003|v
defelem_target|||
del_sv|||
delete_eval_scope|||
delimcpy||5.004000|n
lex_next_chunk||5.011002|
lex_peek_unichar||5.011002|
lex_read_space||5.011002|
lex_read_to||5.011002|
lex_read_unichar||5.011002|
lex_start||5.009005|
lex_stuff_pvn||5.011002|
lex_stuff_pvs||5.013005|
lex_stuff_pv||5.013006|
lex_stuff_sv||5.011002|
lex_unstuff||5.011002|
pad_add_name_pvs||5.015001|
pad_add_name_pv||5.015001|
pad_add_name_sv||5.015001|
pad_alloc_name|||
pad_alloc|||
pad_block_start|||
pad_check_dup|||
pad_compname_type||5.009003|
pad_findlex|||
pad_findmy_pvn||5.015001|
pad_findmy_pvs||5.015001|
qerror|||
qsortsvu|||
re_compile||5.009005|
re_croak2|||
re_dup_guts|||
re_intuit_start||5.019001|
re_intuit_string||5.006000|
re_op_compile|||
readpipe_override|||
realloc||5.007002|n
reentrant_free||5.019003|
sortsv_flags||5.009003|
sortsv||5.007003|
space_join_names_mortal|||
ss_dup|||
stack_grow|||
start_force|||
start_glob|||
start_subparse||5.004000|
stdize_locale|||
strEQ|||
strGE|||
strGT|||
strLE|||
strnNE|||
study_chunk|||
sub_crush_depth|||
sublex_done|||
sublex_push|||
sublex_start|||
sv_2bool_flags||5.013006|
sv_2bool|||
sv_2cv|||
sv_2io|||
sv_2iuv_common|||
next unless $f =~ /$match/;
print "\n=== $f ===\n\n";
my $info = 0;
if ($API{$f}{base} || $API{$f}{todo}) {
my $base = format_version($API{$f}{base} || $API{$f}{todo});
print "Supported at least starting from perl-$base.\n";
$info++;
}
if ($API{$f}{provided}) {
my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
print "Support by $ppport provided back to perl-$todo.\n";
const line_t ocopline = PL_copline;
COP * const ocurcop = PL_curcop;
const int oexpect = PL_expect;
#if (PERL_BCDVERSION >= 0x5004000)
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
veop, modname, imop);
#else
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
modname, imop);
#endif
PL_expect = oexpect;
PL_copline = ocopline;
PL_curcop = ocurcop;
void
DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
{
va_list args;
va_start(args, ver);
vload_module(flags, name, ver, &args);
va_end(args);
}
#endif
/* Hint: newCONSTSUB
* Returns a CV* as of perl-5.7.1. This return value is not supported
* by Devel::PPPort.
*/
/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
#if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
#if defined(NEED_newCONSTSUB)
static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
static
#else
PL_curstash = PL_curcop->cop_stash = stash;
newSUB(
#if (PERL_BCDVERSION < 0x5003022)
start_subparse(),
#elif (PERL_BCDVERSION == 0x5003022)
start_subparse(0),
#else /* 5.003_23 onwards */
start_subparse(FALSE, 0),
#endif
newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
void
DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
{
va_list args;
va_start(args, pat);
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
void
DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
{
dTHX;
va_list args;
va_start(args, pat);
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
void
DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
{
va_list args;
va_start(args, pat);
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
void
DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
{
dTHX;
va_list args;
va_start(args, pat);
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
SV *sv;
va_list args;
PERL_UNUSED_ARG(err);
va_start(args, pat);
sv = vnewSVpvf(pat, &args);
va_end(args);
sv_2mortal(sv);
warn("%s", SvPV_nolen(sv));
}
* which is why the stack variable has been renamed to 'xdigit'.
*/
#ifndef grok_bin
#if defined(NEED_grok_bin)
static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_bin
# undef grok_bin
#endif
#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
#define Perl_grok_bin DPPP_(my_grok_bin)
#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
UV
DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_2 = UV_MAX / 2;
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Binary number > 0b11111111111111111111111111111111 non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
#endif
#endif
#ifndef grok_hex
#if defined(NEED_grok_hex)
static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_hex
# undef grok_hex
#endif
#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
#define Perl_grok_hex DPPP_(my_grok_hex)
#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
UV
DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_16 = UV_MAX / 16;
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Hexadecimal number > 0xffffffff non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
#endif
#endif
#ifndef grok_oct
#if defined(NEED_grok_oct)
static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_oct
# undef grok_oct
#endif
#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
#define Perl_grok_oct DPPP_(my_grok_oct)
#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
UV
DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_8 = UV_MAX / 8;
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Octal number > 037777777777 non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
{
dTHX;
int retval;
va_list ap;
va_start(ap, format);
#ifdef HAS_VSNPRINTF
retval = vsnprintf(buffer, len, format, ap);
#else
retval = vsprintf(buffer, format, ap);
#endif
int
DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
{
va_list args;
va_start(args, pat);
vsprintf(buffer, pat, args);
va_end(args);
return strlen(buffer);
}
#endif
#endif
#ifndef pv_pretty
#if defined(NEED_pv_pretty)
static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
static
#else
extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
#endif
#ifdef pv_pretty
# undef pv_pretty
#endif
#if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
char *
DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
const STRLEN max, char const * const start_color, char const * const end_color,
const U32 flags)
{
const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
STRLEN escaped;
if (dq == '"')
sv_catpvs(dsv, "\"");
else if (flags & PERL_PV_PRETTY_LTGT)
sv_catpvs(dsv, "<");
if (start_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
if (end_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
view all matches for this distribution
view release on metacpan or search on metacpan
xs/KetamaMD5.c view on Meta::CPAN
SET(b, c, d, a, 9, 21, T64);
#undef SET
/* Then perform the following additions. (That is increment each
of the four registers by the value it had before this block
was started.) */
pms->abcd[0] += a;
pms->abcd[1] += b;
pms->abcd[2] += c;
pms->abcd[3] += d;
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Algorithm/ConstructDFA/XS.pm view on Meta::CPAN
die unless ref $o{is_nullable};
die unless ref $o{is_accepting} or exists $o{final};
die unless ref $o{successors} or ref $o{edges_from};
die unless ref $o{get_label} or ref $o{edges_from};
die unless exists $o{start} or exists $o{many_start};
die if ref $o{is_accepting} and exists $o{final};
die if ref $o{successors} and exists $o{edges_from};
die if ref $o{get_label} and ref $o{edges_from};
my $class = 'Algorithm::ConstructDFA::XS::Synth';
lib/Algorithm/ConstructDFA/XS.pm view on Meta::CPAN
$o{is_accepting} = sub {
grep { $in_final{$_} } @_
};
}
$o{many_start} //= [$o{start}];
my $dfa = _construct_dfa_xs($o{many_start}, $o{get_label},
$o{is_nullable}, $o{successors}, $o{is_accepting});
if (exists $o{edges_from}) {
for (values %$dfa) {
$_->{Combines} = [ grep {
lib/Algorithm/ConstructDFA/XS.pm view on Meta::CPAN
my @todo = map { @$_ } @$roots;
my %seen;
my @args;
my $sm = Data::AutoBimap->new;
my $rm = Data::AutoBimap->new;
my %is_start;
for (my $ix = 0; $ix < @$roots; ++$ix) {
for my $v (@{ $roots->[$ix] }) {
push @{ $is_start{$v} }, $ix + 1;
}
}
while (@todo) {
my $c = pop @todo;
lib/Algorithm/ConstructDFA/XS.pm view on Meta::CPAN
my $is_nullable = !!$nullablef->($c);
my $label = $labelf->($c);
my $label_x = defined $label ? $rm->s2n($label) : undef;
# [vertex, label, nullable, start, successors...]
my @data = ($sm->s2n($c), $label_x, !!$is_nullable, $is_start{$c} // []);
for ($successorsf->($c)) {
push @data, $sm->s2n($_);
push @todo, $_;
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Algorithm/ConstructDFA.pm view on Meta::CPAN
push @todo, $successors->($c) if $nullable->($c);
}
keys %seen;
};
my $start = [
sort { $a cmp $b }
uniq map {
$nullable->($_) ? @{ $all_reachable_and_self->($_) } : $_
}
map { $m->s2n($_) }
@$roots
];
my $start_s = join ' ', @$start;
my @todo = ($start);
my %seen;
my $dfa;
my @accepting_dfa_states;
my %predecessors;
lib/Algorithm/ConstructDFA.pm view on Meta::CPAN
push @todo, keys %{ $predecessors{$c} };
}
map { $_ => 1 } keys %seen;
};
my $o = Data::AutoBimap->new(start => 0);
# Ensure that DFA state 0 is the one that corresponds to no
# vertices in the input graph. This is an API convention and
# does not have significance beyond that.
my $r = { $o->s2n('') => {
Combines => [],
Accepts => $accepting->()
} };
# Ensure start state is 1 also as a convention
$o->s2n($start_s);
while (my ($src, $x) = each %$dfa) {
# Merge dead states
$src = '' unless $reachable{$src};
lib/Algorithm/ConstructDFA.pm view on Meta::CPAN
die unless ref $o{is_nullable};
die unless ref $o{is_accepting} or exists $o{final};
die unless ref $o{successors};
die unless ref $o{get_label};
die unless exists $o{start};
die if ref $o{is_accepting} and exists $o{final};
if (exists $o{final}) {
my %in_final = map { $_ => 1 } @{ $o{final} };
$o{is_accepting} = sub {
grep { $in_final{$_} } @_
};
}
_get_graph($o{start}, $o{get_label}, $o{is_nullable},
$o{successors}, $o{is_accepting});
}
lib/Algorithm/ConstructDFA.pm view on Meta::CPAN
=head1 SYNOPSIS
use Algorithm::ConstructDFA;
my $dfa = construct_dfa(
start => [ $start_vertex ],
is_accepting => sub { grep { $_ eq $final_vertex } @_ },
is_nullable => sub {
$g->has_vertex_attribute($_[0], 'label')
},
successors => sub { $g->successors($_[0]) },
lib/Algorithm/ConstructDFA.pm view on Meta::CPAN
Construct a DFA using the given options.
=over
=item start
An array of start states for the initial configuration of the
automaton.
=item final
An array of final accepting states. This can be used instead
lib/Algorithm/ConstructDFA.pm view on Meta::CPAN
=back
The function returns the DFA as hash reference with integer keys. The
key C<0> is a non-accepting state with no transitions to other states
(the automaton would go into this state if the match has failed). The
key C<1> is the start state. The value of each entry is another hash
reference. As an example:
'1':
Accepts: 1
Combines:
lib/Algorithm/ConstructDFA.pm view on Meta::CPAN
The C<Accepts> key indicates whether this is an accepting state. The
C<Combines> key provides access to the list of states in the input
automaton this DFA state corresponds to. The C<NextOver> field is the
transition table out of this state. This automaton matches any sequence
of zero or more C<b>s. The alphabet also includes the label C<a> but
the automaton moves from the start state over the label C<a> to the
non-accepting sink state C<0> and would never enter an accepting state
after that.
An exception to the rule above is when C<is_accepting> returns a true
value when passed no arguments (i.e., the automaton accepts when it is
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Algorithm/ConstructDFA2.pm view on Meta::CPAN
my @accepting = map { @$_ } $self->_dbh->selectall_array(q{
SELECT state FROM accepting
});
# NOTE: this also renames states in transitions involving
# possible start states, but they would then simply have no
# transitions, which should be fine.
$self->_dbh->do(q{
WITH RECURSIVE all_living(state) AS (
SELECT state FROM accepting
lib/Algorithm/ConstructDFA2.pm view on Meta::CPAN
vertex_matches => sub($vertex, $input) { ... },
storage_dsn => 'dbi:SQLite:dbname=...',
);
my $start_id = $dfa->find_or_create_state_id(qw/ 2 /);
while (my $count = $dfa->compute_some_transitions(1_000)) {
...
}
lib/Algorithm/ConstructDFA2.pm view on Meta::CPAN
=item $dfa->find_or_create_state_id(@vertices)
Given a list of vertices, computes a new state, adds it to the
automaton if it does not already exist, and returns an identifier
for the state. This is used to create a start state in the DFA.
=item $dfa->compute_some_transitions($limit)
Computes up to C<$limit> additional transitions and returns the
number of transitions actually computed. A return value of zero
view all matches for this distribution
view release on metacpan or search on metacpan
third parties under the terms of this General Public License (except
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
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Algorithm/CriticalPath.pm view on Meta::CPAN
{
croak 'Invalid graph type for critical path analysis' ;
} ;
# this is ropey - should use guaranteed unique names
my $start = 'GCP::dummyStart';
my $end = 'GCP::dummyEnd';
# this is ropey, should use a BFS search method to return the depth-ordered rankings of vertices.
my $g = $self->graph()->deep_copy();
lib/Algorithm/CriticalPath.pm view on Meta::CPAN
$g->delete_vertex($s);
}
$i++;
}
# $copy adds in the dummy start and end nodes, so we don't destroy the original.
my $copy = $self->graph()->deep_copy();
$copy->add_weighted_vertex($start,0);
$copy->add_weighted_vertex($end,0);
for my $n ($copy->source_vertices()) {
$copy->add_edge($start, $n);
}
for my $n ($copy->sink_vertices()) {
$copy->add_edge($n,$end);
}
for my $n ($copy->isolated_vertices()) {
$copy->add_edge($start, $n);
$copy->add_edge($n,$end);
}
unshift @rank, [$start];
push @rank, [$end];
my %costToHere = map { $_ => 0 } $copy->vertices();
my %criticalPathToHere;
$criticalPathToHere{$start} = [$start];
for my $row ( @rank ) {
for my $node ( @$row ) {
for my $s ( $copy->successors($node) ) {
if ( $costToHere{$node} + $copy->get_vertex_weight($s) > $costToHere{$s} ) {
lib/Algorithm/CriticalPath.pm view on Meta::CPAN
}
}
}
# we don't want to see the dummy nodes on the returned critical path.
@{$criticalPathToHere{$end}} = grep { $_ ne ${start} && $_ ne ${end} } @{$criticalPathToHere{$end}} ;
$self->vertices(\@{$criticalPathToHere{$end}});
$self->cost($costToHere{$end});
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Algorithm/Cron.pm view on Meta::CPAN
A C<crontab> field containing a single asterisk (C<*>), or a missing named
field, indicates that any value here is included in the scheduled times. To
restrict the schedule, a value or set of values can be provided. This should
consist of one or more comma-separated numbers or ranges, where a range is
given as the start and end points, both inclusive.
hour => "3-6"
hour => "3,4,5,6"
Ranges can also be prefixed by a value to give the increment for values in
lib/Algorithm/Cron.pm view on Meta::CPAN
C<Algorithm::Cron> supports using either UTC or the local timezone when
comparing against the given schedule.
=cut
# mday field starts at 1, others start at 0
my %MIN = (
sec => 0,
min => 0,
hour => 0,
mday => 1,
lib/Algorithm/Cron.pm view on Meta::CPAN
}
return 1;
}
=head2 $time = $cron->next_time( $start_time )
Returns the next scheduled time, as an epoch timestamp, after the given
timestamp. This is a stateless operation; it does not change any state stored
by the C<$cron> object.
lib/Algorithm/Cron.pm view on Meta::CPAN
if( defined $self->{mday} and defined $self->{wday} ) {
# Now it gets tricky because cron allows a match of -either- mday or wday
# rather than requiring both. So we'll work out which of the two is sooner
my $next_time_by_wday;
my @wday_t = @t;
my $wday_restart = 0;
$self->next_time_field( \@wday_t, TM_WDAY ) or $wday_restart = 1;
$next_time_by_wday = $funcs->[BUILD]->( @wday_t );
my $next_time_by_mday;
my @mday_t = @t;
my $mday_restart = 0;
$self->next_time_field( \@mday_t, TM_MDAY ) or $mday_restart = 1;
$next_time_by_mday = $funcs->[BUILD]->( @mday_t );
if( $next_time_by_wday > $next_time_by_mday ) {
@t = @mday_t;
goto RESTART if $mday_restart;
}
else {
@t = @wday_t;
goto RESTART if $wday_restart;
}
}
elsif( defined $self->{mday} ) {
$self->next_time_field( \@t, TM_MDAY ) or goto RESTART;
}
view all matches for this distribution
view release on metacpan or search on metacpan
third parties under the terms of this General Public License (except
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
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
view all matches for this distribution