view release on metacpan or search on metacpan
lib/AFS/Command/VOS.pm view on Meta::CPAN
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::Volume->new();
my $entry = AFS::Object::VLDBEntry->new( locked => 0 );
$self->{operation} = "examine";
return unless $self->_parse_arguments(%args);
lib/AFS/Command/VOS.pm view on Meta::CPAN
}
#
# Last possibility (that we know of) -- volume might be
# locked.
#
if ( /LOCKED/ ) {
$entry->_setAttribute( locked => 1 );
next;
}
#
# Actually, this is the last possibility... The volume name
lib/AFS/Command/VOS.pm view on Meta::CPAN
my $self = shift;
my (%args) = @_;
$self->{operation} = "listvldb";
my $locked = 0;
my $result = AFS::Object::VLDB->new();
return unless $self->_parse_arguments(%args);
lib/AFS/Command/VOS.pm view on Meta::CPAN
}
#
# Last possibility (that we know of) -- volume might be
# locked.
#
if ( /LOCKED/ ) {
$entry->_setAttribute( locked => 1 );
$locked++;
}
}
$result->_addVLDBEntry( $entry );
}
$result->_setAttribute( locked => $locked );
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
view all matches for this distribution
view release on metacpan or search on metacpan
examples/cmdebug view on Meta::CPAN
else {
print "none_waiting";
}
if ($lock->{exclLocked}) {
if ($lock->{exclLocked} & constant("WRITE_LOCK")) {
print ", write_locked";
}
if ($lock->{exclLocked} & constant("SHARED_LOCK")) {
print ", upgrade_locked";
}
printf("(pid:%d at:%d)",
$lock->{pid_writer}, $lock->{src_indicator});
}
if ($lock->{readersReading}) {
view all matches for this distribution
view release on metacpan or search on metacpan
examples/v2/kas/examine view on Meta::CPAN
print "\t An unlimited number of unsuccessful authentications is permitted.\n";
}
else {
my $packed = $$entry{'misc_auth_bytes'};
my $pwexpire = (($packed >> 24) & 0xff);
my $is_locked = (($packed >> 16) & 0xff);
my $nfail = (($packed >> 8) & 0xff);
my $locktime = (($packed >> 0) & 0xff);
if (! $pwexpire) { print "\t password will never expire.\n"; }
else { print "\t password will expire: $pwexpire\n"; }
if (! $nfail) { print "\t An unlimited number of unsuccessful authentications is permitted.\n"; }
else { print "\t $nfail consecutive unsuccessful authentications are permitted.\n";
if (! $locktime) { print "\t The lock time for this user is not limited.\n"; }
else { print "\t The lock time for this user is $locktime minutes. !!! umrechnen !!!\n"; }
if (! $is_locked) { print "\t IS_LOCKED: muss noch gecheckt werden !!!\n"; }
else { print "\t IS_LOCKED: uss noch gecheckt werden !!!\n"; }
}
}
my $exp_date = $$entry{'user_expiration'};
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AI/MXNet/KVStore.pm view on Meta::CPAN
Pull a single value or a sequence of values from the store.
Data consistency:
1. this function returns after adding an operator to the engine. But any
further read on out will be blocked until it is finished.
2. pull is always called after all previous push and pull on the same
key are finished.
3. It pulls the newest value from the store.
Parameters
view all matches for this distribution
view release on metacpan or search on metacpan
data/spider.pro view on Meta::CPAN
path(cage, e, building).
path(closet, w, building).
path(building, e, closet) :- at(key, in_hand).
path(building, e, closet) :-
print('The door appears to be locked.'), nl,
fail.
% These facts tell where the various objects in the game are located.
at(ruby, spider).
data/spider.pro view on Meta::CPAN
print('this meadow.'), nl.
describe(building) :-
print('You are in a small building. The exit is to the north.'), nl,
print('There is a barred door to the west, but it seems to be'), nl,
print('unlocked. There is a smaller door to the east.'), nl.
describe(cage) :-
print('You are in a den of the lion! The lion has a lean and'), nl,
print('hungry look. You better get out of here!'), nl.
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AI/TensorFlow/Libtensorflow/Manual/CAPI.pod view on Meta::CPAN
=head2 TF_DequeueNamedTensor
=over 2
Caller must call TF_DeleteTensor() over the returned tensor. If the queue is
empty, this call is blocked.
Tensors are enqueued via the corresponding TF enqueue op.
TODO(hongm): Add support for `timeout_ms`.
=back
lib/AI/TensorFlow/Libtensorflow/Manual/CAPI.pod view on Meta::CPAN
On success, enqueues `tensor` into a TF-managed FifoQueue given by
`tensor_id`, associated with `session`. There must be a graph node named
"fifo_queue_enqueue_<tensor_id>", to be executed by this API call. It reads
from a placeholder node "arg_tensor_enqueue_<tensor_id>".
`tensor` is still owned by the caller. This call will be blocked if the queue
has reached its capacity, and will be unblocked when the queued tensors again
drop below the capacity due to dequeuing.
Tensors are dequeued via the corresponding TF dequeue op.
TODO(hongm): Add support for `timeout_ms`.
view all matches for this distribution
view release on metacpan or search on metacpan
warn "invalid netmask: $e_netmask_s\n" if ($verbose);
return (0, 'invalid netmask');
}
if ($prefix_len < $minimum_prefix_len) {
warn "$e_net_s/$e_netmask_s => $e_nexthop_s blocked, prefix too short\n";
return (0, 'prefix length too short');
}
# the network-netmask pair makes sense: network & netmask == network
if (($e_net_i & $e_netmask) != $e_net_i) {
#print "e_net '$e_net_i' e_netmask '$e_netmask' ANDs to " . ($e_net_i & $e_netmask) . "\n";
warn "$e_net_s/$e_netmask_s => $e_nexthop_s blocked, subnet-netmask pair does not make sense\n" if ($verbose);
return (0, 'invalid subnet-netmask pair');
}
# network is in 44/8
if ($e_net_s !~ /$net_44_regexp/) {
warn "$e_net_s/$e_netmask_s => $e_nexthop_s blocked, non-amprnet address\n" if ($verbose);
return (0, 'net not in 44/8');
}
# nexthop address is not in 44/8
if ($e_nexthop_s =~ /$net_44_regexp/) {
warn "$e_net_s/$e_netmask_s => $e_nexthop_s blocked, nexthop is within amprnet\n" if ($verbose);
return (0, 'nexthop is in 44/8');
}
# nexthop address does not point to self
if (defined $my_addresses{$e_nexthop_s}) {
warn "$e_net_s/$e_netmask_s => $e_nexthop_s blocked, local gw\n" if ($verbose);
return (0, 'local gw');
}
return (1, 'ok');
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/API/Instagram/User.pm view on Meta::CPAN
This reference contains two keys:
B<outgoing_status:> Authenticated user relationship to the user. Can be C<follows>, C<requested>, C<none>.
B<incoming_status:> A user's relationship to the authenticated user. Can be C<followed_by>, C<requested_by>, C<blocked_by_you>, C<none>.
$user->relationship('follow');
When an B<action> (as parameter) is given, it sends a request to modify the relationship to the given one.
view all matches for this distribution
view release on metacpan or search on metacpan
applications/htmlroot/cgi-bin/moderator/sessions.pl view on Meta::CPAN
use vars qw($PROGNAME);
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
$PROGNAME = "sessions.pl";
my $prgtext = "Blocked Sessions";
my $version = do { my @r = (q$Revision: 3.002.003$ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r }; # must be all on one line or MakeMaker will get confused.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
use CGI;
applications/htmlroot/cgi-bin/moderator/sessions.pl view on Meta::CPAN
# Debug information
print "<pre>pagedir : $pagedir<br>pageset : $pageset<br>debug : $debug<br>CGISESSID : $sessionID<br>action : $action<br>session ID : $CsessionID<br>URL ... : $urlAccessParameters</pre>" if ( $debug eq 'T' );
if ( defined $sessionID and ! defined $errorUserAccessControl ) {
my ($matchingSessionDetails, $matchingSessionsBlocked, $matchingSessionsActive, $matchingSessionsExpired, $matchingSessionsEmpty, $navigationBar);
my $urlWithAccessParameters = $ENV{SCRIPT_NAME} . "?pagedir=$pagedir&pageset=$pageset&debug=$debug&CGISESSID=$sessionID";
if ($action eq 'deleteView') {
$htmlTitle = "Delete Session '$CsessionID'";
applications/htmlroot/cgi-bin/moderator/sessions.pl view on Meta::CPAN
my $colspan = 7 + $actionPressend;
my $table = "\n <table width=\"100%\" align=\"center\" border=\"0\" cellpadding=\"1\" cellspacing=\"1\" bgcolor=\"$COLORSTABLE{TABLE}\">\n";
my $header = " <tr><th> Session ID </th><th> Remote User </th><th> Name </th><th> IP address </th><th> Activated </th><th> Login Trials </th><th> eTime </th>$actionHeader</tr>\n";
$matchingSessionsBlocked = "$table <tr bgcolor=\"$COLORSTABLE{NOBLOCK}\"><th colspan=\"$colspan\">Blocked Sessions</th></tr>\n$header";
$matchingSessionsActive = "$table <tr bgcolor=\"$COLORSTABLE{NOBLOCK}\"><th colspan=\"$colspan\">Active Sessions</th></tr>\n$header";
$matchingSessionsExpired = "$table <tr bgcolor=\"$COLORSTABLE{NOBLOCK}\"><th colspan=\"$colspan\">Expired Sessions</th></tr>\n$header";
$matchingSessionsEmpty = "$table <tr bgcolor=\"$COLORSTABLE{NOBLOCK}\"><th colspan=\"$colspan\">Empty Sessions</th></tr>\n$header";
my ($numberRecordsIntoQueryBlocked, $numberRecordsIntoQueryActive, $numberRecordsIntoQueryExpired, $numberRecordsIntoQueryEmpty);
$numberRecordsIntoQueryBlocked = $numberRecordsIntoQueryActive = $numberRecordsIntoQueryExpired = $numberRecordsIntoQueryEmpty = 0;
my $currentTime = time();
my $solaris = (-e '/usr/sbin/nslookup') ? 1 : 0; # solaris
@cgisessPathFilenames = glob("$CGISESSPATH/cgisess_*");
applications/htmlroot/cgi-bin/moderator/sessions.pl view on Meta::CPAN
}
my $currentSession = " <tr bgcolor=\"$COLORSTABLE{STARTBLOCK}\"><td>$CsessionID</td><td>$remoteUser</td><td>$username</td><td>$remoteAddr</td><td>$activated</td><td align=\"right\">$loginTrials</td><td>" .scalar(localtime($sessionAti...
if ( $loginTrials >= 3) {
$numberRecordsIntoQueryBlocked++;
$matchingSessionsBlocked .= $currentSession;
} elsif (defined $sessionAtime and defined $sessionEtime and ($sessionAtime + $sessionEtime) <= $currentTime) {
$numberRecordsIntoQueryExpired++;
$matchingSessionsExpired .= $currentSession;
} elsif (defined $loggedIn and $loggedIn) {
$numberRecordsIntoQueryActive++;
applications/htmlroot/cgi-bin/moderator/sessions.pl view on Meta::CPAN
$matchingSessionsEmpty .= " <tr bgcolor=\"$COLORSTABLE{STARTBLOCK}\"><td>$CsessionID</td><td> </td><td> </td><td>$remoteAddr</td><td> </td><td align=\"right\"> </td><td>" .scalar(localtime($sessionAtime)). "</td...
}
}
}
$matchingSessionsBlocked .= " <tr><td colspan=\"$colspan\">No blocked sessions found for any user</td></tr>\n" unless ( $numberRecordsIntoQueryBlocked );
$matchingSessionsBlocked .= " </table>\n";
$matchingSessionsActive .= " <tr><td colspan=\"$colspan\">No active sessions found for any user</td></tr>\n" unless ( $numberRecordsIntoQueryActive );
$matchingSessionsActive .= " </table>\n";
$matchingSessionsExpired .= " <tr><td colspan=\"$colspan\">No expired sessions found for any user</td></tr>\n" unless ( $numberRecordsIntoQueryExpired );
applications/htmlroot/cgi-bin/moderator/sessions.pl view on Meta::CPAN
} elsif ($action eq 'unblock') {
my $cgisessFilename = "cgisess_$CsessionID";
if (-e "$CGISESSPATH/$cgisessFilename") {
unlink ($CGISESSPATH.'/'.$cgisessFilename);
$htmlTitle = "Session '$cgisessFilename' unblocked";
} else {
$htmlTitle = "Session '$cgisessFilename' not unblocked, doesn't exist";
}
}
# HTML - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
applications/htmlroot/cgi-bin/moderator/sessions.pl view on Meta::CPAN
HTML
} else {
print <<HTML;
<tr><td>
<table border="0" cellspacing="0" cellpadding="0" align="center">
<tr align="center"><td><br>$matchingSessionsBlocked</td></tr>
<tr align="center"><td><br>$matchingSessionsActive</td></tr>
<tr align="center"><td><br>$matchingSessionsExpired</td></tr>
<tr align="center"><td><br>$matchingSessionsEmpty</td></tr>
</table>
</td></tr>
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AWS/IP.pm view on Meta::CPAN
# time passes, cache has expired
$aws_ip_data = $aws->get_raw_data; # auto refreshes
=head2 DESCRIPTION
AWS L<publish|https://ip-ranges.amazonaws.com/ip-ranges.json> their IP ranges, which periodically change. This module downloads and serializes the IP ranges into a Perl data hash reference. It caches the data, and if the cache expires, re-downloads a...
=head2 new ($cache_timeout_secs, [$cache_path])
Creates a new AWS::IP object and sets up the cache. Requires an number for the cache timeout seconds. Optionally takes a cache path argument. If no cache path is supplied, AWS::IP will use a random temp directory. If you want to reuse the cache over ...
view all matches for this distribution
view release on metacpan or search on metacpan
share/AXLSoap.xsd view on Meta::CPAN
<xsd:enumeration value="Route Group Name and Directory Number are not allowed in the same search."/>
<xsd:enumeration value="user is not member of super user group. Cannot add to groups the roles which are only accessible to super users"/>
<xsd:enumeration value="Only super users can update members of super user groups"/>
<xsd:enumeration value="Users who are not super users cannot add him/herself to groups"/>
<xsd:enumeration value="Propagation failed for some devices. See log for a list of failed devices."/>
<xsd:enumeration value="Change failed - Credential locked. Please contact your administrator."/>
<xsd:enumeration value="Change failed - Credential locked due to inactivity. Please contact your administrator."/>
<xsd:enumeration value="Unknown credential validation error. Please contact your administrator."/>
<xsd:enumeration value="Wrong Credential."/>
<xsd:enumeration value="Administrative Lock."/>
<xsd:enumeration value="Hack Lock."/>
<xsd:enumeration value="Inactive Lock."/>
share/AXLSoap.xsd view on Meta::CPAN
<xsd:enumeration value="The URL needs to begin with either http:// or https://"/>
<xsd:enumeration value="The URL hostname should be a valid hostname or IP address, with an optional port value"/>
<xsd:enumeration value="Cannot add parameters to an IP Phone Service that is an EnterpriseSubscription service. Include all parameters in the Service URL"/>
<xsd:enumeration value="Remote Destination can not be empty."/>
<xsd:enumeration value="Remote Destination must be a phone number or URI."/>
<xsd:enumeration value="Cannot use a Blocked type list for fkCallerFilterList_Allowed"/>
<xsd:enumeration value="Cannot use an Allowed type list for fkCallerFilterList_Blocked"/>
<xsd:enumeration value="Check the type of device specified in fkDevice_DualMode. Remote Destionations other than Dual Mode must use fkDevice_RemoteDestinationTemplate."/>
<xsd:enumeration value="The specified Remote Destination already exists."/>
<xsd:enumeration value="CallerFilterList must belong to same EndUser as the Remote Destination."/>
<xsd:enumeration value="A Dual Mode remote destination already exists for this device."/>
<xsd:enumeration value="Remote Destination must reference a Remote Destionation Profile or Dual Mode device."/>
view all matches for this distribution
view release on metacpan or search on metacpan
fortune/jackbauer view on Meta::CPAN
%
When Jack Bauer masturbates he doesn't touch himself at all. He just threatens his balls.
%
Jack Bauer's HIV positive. Nobody screws Jack Bauer and lives.
%
If Jack and MacGyver were locked in a room together, Jack would make a bomb out of MacGyver and get out.
%
Barry Bonds was on steroids. Steroids are on Jack Bauer.
%
Jack Bauer was originally casted as the lead in the movie "Robo Cop," but was later fired because the director realized that Jack didn't need to wear the suite to look intimidating.
%
fortune/jackbauer view on Meta::CPAN
%
Jack Bauer's buddylist contains the name and location of every known terrorist, but rather than getting online, he likes to figure it out on his own.
%
Paul Revere's message was actually a secret code for "Jack Bauer is coming! Jack Bauer is coming!"
%
Jack Bauer has Xenu locked in his trunk.
%
Jack Bauer never watched "A-Team" back in the 80's. He lost interest immediately because no one on that show ever died, and vowed that one day he would make a TV show that was the complete opposite.
%
Anytime Jack Bauer makes a list, when he gets to #24 his trigger finger twitches.
%
view all matches for this distribution
view release on metacpan or search on metacpan
devdata/https_mojolicious.io_blog_2017_12_14_day-14-you-promised-to-call view on Meta::CPAN
</div>
<div class="post-thumb">
<!-- theme suggests 1300x500 -->
<img alt="Two hands with interlocked pinkies, a pinky swear" src="/blog/2017/12/14/day-14-you-promised-to-call/pinky_swear.jpg">
</div>
<div class="post-content">
<section id="section-1">
devdata/https_mojolicious.io_blog_2017_12_14_day-14-you-promised-to-call view on Meta::CPAN
<section id="section-2">
<h2>Background</h2>
<p>"Normal" Perl code runs synchronously: it does each step it is told to, one at a time, and only that. This is also known as "blocking", since the program cannot do anything else.</p>
<p>The essence of a non-blocking code framework is that if you are waiting for something, you can register with the framework what to do when that thing happens. It can then do other processing tasks in the meantime. This means you don't have lot...
<p>Originally this was done just using callbacks, but this lead to what is known as "callback hell": each callback contains the next callback, at an increasing level of indentation. Even harder to keep track of is if the functions are kept ...
<p>Promises are used to easily add processing steps to a transaction: one can keep adding code for what to do "then" - after a previous stage has finished. Best of all, each "callback" is small and separate, with each one placed i...
view all matches for this distribution
view release on metacpan or search on metacpan
devdata/https_mojolicious.io_blog_2018_12_20_testing-dancer_ view on Meta::CPAN
->finish_ok;
done_testing;
</code></pre>
<p>Unlike the previous examples, this time the connection stays open (but blocked) between method calls.
Per the protocol of the example, we first send a greeting to the Dancer app as a JSON document.
Since so much real-world websocket usage is just serialized JSON messages, Mojolicious provides many JSON-over-WebSocket conveniences.
One such convenience is a virtual websocket frame type that takes a data structure and serializes it as JSON before actually sending it as a text frame.</p>
<p>We then wait to get a message in response with <code>message_ok</code>.
view all matches for this distribution
view release on metacpan or search on metacpan
devdata/http_advent.perldancer.org_2018_20 view on Meta::CPAN
->json_message_is({hello => 'browser!'})
->finish_ok;
done_testing;</pre>
<p>Unlike the previous examples, this time the connection stays open (but blocked) between method calls.
Per the protocol of the example, we first send a greeting to the Dancer app as a JSON document.
Since so much real-world websocket usage is just serialized JSON messages, Mojolicious provides many JSON-over-WebSocket conveniences.
One such convenience is a virtual websocket frame type that takes a data structure and serializes it as JSON before actually sending it as a text frame.</p>
<p>We then wait to get a message in response with <code>message_ok</code>.
In this case, we expect the application to greet us by calling us "browser!".
view all matches for this distribution
view release on metacpan or search on metacpan
before, the stricken wolf rolling in agony behind him. Three others
tried it in sharp succession; and one after the other they drew back,
streaming blood from slashed throats or shoulders.
This was sufficient to fling the whole pack forward, pell-mell, crowded
together, blocked and confused by its eagerness to pull down the
prey. Buck's marvellous quickness and agility stood him in good stead.
Pivoting on his hind legs, and snapping and gashing, he was everywhere
at once, presenting a front which was apparently unbroken so swiftly did
he whirl and guard from side to side. But to prevent them from getting
behind him, he was forced back, down past the pool and into the creek
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/MetaSyntactic/vim.pm view on Meta::CPAN
inputrestore
inputsave
inputsecret
insert
isdirectory
islocked
items
join
keys
len
libcall
view all matches for this distribution
view release on metacpan or search on metacpan
Playwright.pm view on Meta::CPAN
'I have to pick up my daughter after work.' => 'k', 'Do you think anyone will notice?' => 'l',
"Not if you expect to go out in public." => 'm', 'Hey, I like this song.' => 'n',
'That is too expensive for me.' => 'o', 'Says who?' => 'p',
"I don't like it when you touch me there." => 'q', 'I know, but I never liked it.' => 'r',
'Hot enough for you?' => 's', 'I had spaghetti for dinner three times last week.' => 't',
'I could have sworn I locked the door.' => 'u', 'Have you seen my keys?' => 'v',
'I saw it over there.' => 'w', 'Do these pants make my butt look big?' => 'x',
'Putting on a little weight, I see.' => 'y', "Say that again and I'll smack you." => 'z',
'I am an excellent driver.' => '`', 'You drive too fast.' => '1',
'I love pizza.' => '2', 'Not nearly as much as you do.' => '3',
'Come over here and sit on my lap.' => '4', 'Not a chance in hell.' => '5',
view all matches for this distribution
view release on metacpan or search on metacpan
local/lib/perl5/Future/Mutex.pm view on Meta::CPAN
first is finished. These situations call for a mutual-exclusion lock, or
"mutex".
A C<Future::Mutex> instance provides one basic operation, which will execute a
given block of code which returns a future, and itself returns a future to
represent that. The mutex can be in one of two states; either unlocked or
locked. While it is unlocked, requests to execute code are handled
immediately. Once a block of code is invoked, the mutex is now considered to
be locked, causing any subsequent requests to invoke code to be queued behind
the first one, until it completes. Once the initial code indicates completion
(by its returned future providing a result or failing), the next queued code
is invoked.
=cut
local/lib/perl5/Future/Mutex.pm view on Meta::CPAN
=head2 new
$mutex = Future::Mutex->new
Returns a new C<Future::Mutex> instance. It is initially unlocked.
=cut
sub new
{
local/lib/perl5/Future/Mutex.pm view on Meta::CPAN
=head2 enter
$f = $mutex->enter( \&code )
Returns a new C<Future> that represents the eventual result of calling the
code. If the mutex is currently unlocked, the code will be invoked
immediately. If it is currently locked, the code will be queued waiting for
the next time it becomes unlocked.
The code is invoked with no arguments, and is expected to return a C<Future>.
The eventual result of that future determines the result of the future that
C<enter> returned.
view all matches for this distribution
view release on metacpan or search on metacpan
=head2 zip
B<Input:> Two or more arrayrefs. A number of equal sized arrays
containing numbers, strings or anything really.
B<Output:> An array of those input arrays zipped (interlocked, merged) into each other.
print join " ", zip( [1,3,5], [2,4,6] ); # 1 2 3 4 5 6
print join " ", zip( [1,4,7], [2,5,8], [3,6,9] ); # 1 2 3 4 5 6 7 8 9
Example:
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acrux/Util.pm view on Meta::CPAN
=item binmode
Set the layers to write the file with. The default will be something sensible on your platform
=item locked
This argument is a boolean option, defaulted to false (C<0>).
Setting this argument to true (C<1>) will ensure an that existing file will not be overwritten
=item mode
lib/Acrux/Util.pm view on Meta::CPAN
# Get binmode layer, mode and perms
my $bm = $args->{binmode} // ':raw'; # read in :raw by default
my $perms = $args->{perms} // 0666; # set file permissions
my $mode = $args->{mode} // O_WRONLY | O_CREAT;
$mode |= O_APPEND if $args->{append};
$mode |= O_EXCL if $args->{locked};
# Open filehandle
my $fh;
if (ref($file)) {
$fh = $file;
view all matches for this distribution
view release on metacpan or search on metacpan
t/60-recursion-test.t view on Meta::CPAN
dbug_ok (0, "Advanced::Config contents have been loaded into memory!");
DBUG_LEAVE (3);
}
my $val = $cfg->get_value ("recursion");
dbug_ok ( (defined $val && $val eq "OK"), "Recursion was blocked!");
$val = $cfg->get_value ("recursion2");
dbug_ok ( (defined $val && $val eq " OK"), "Recursion2 was blocked!");
# Since I didn't count the test cases, must end my program
# with a call to this method. Can't do tests in END anymore!
done_testing ();
view all matches for this distribution
view release on metacpan or search on metacpan
get_av|5.006000|5.003007|p
getc|5.003007||Viu
get_c_backtrace|5.021001||Vi
get_c_backtrace_dump|5.021001||V
get_context|5.006000|5.006000|nu
getc_unlocked|5.003007||Viu
get_cv|5.006000|5.003007|p
get_cvn_flags|5.009005|5.003007|p
get_cvs|5.011000|5.003007|p
getcwd_sv|5.007002|5.007002|
get_db_sub|||iu
PERL_MALLOC_WRAP|5.009002|5.009002|Vn
PerlMem_calloc|5.006000||Viu
PerlMem_free|5.005000||Viu
PerlMem_free_lock|5.006000||Viu
PerlMem_get_lock|5.006000||Viu
PerlMem_is_locked|5.006000||Viu
PerlMem_malloc|5.005000||Viu
PERL_MEMORY_DEBUG_HEADER_SIZE|5.019009||Viu
PerlMemParse_calloc|5.006000||Viu
PerlMemParse_free|5.006000||Viu
PerlMemParse_free_lock|5.006000||Viu
PerlMemParse_get_lock|5.006000||Viu
PerlMemParse_is_locked|5.006000||Viu
PerlMemParse_malloc|5.006000||Viu
PerlMemParse_realloc|5.006000||Viu
PerlMem_realloc|5.005000||Viu
PerlMemShared_calloc|5.006000||Viu
PerlMemShared_free|5.006000||Viu
PerlMemShared_free_lock|5.006000||Viu
PerlMemShared_get_lock|5.006000||Viu
PerlMemShared_is_locked|5.006000||Viu
PerlMemShared_malloc|5.006000||Viu
PerlMemShared_realloc|5.006000||Viu
Perl_mfree|5.006000||Viu
PERL_MG_UFUNC|5.007001||Viu
Perl_modf|5.006000||Viu
putc|5.003007||Viu
put_charclass_bitmap_innards|5.021004||Viu
put_charclass_bitmap_innards_common|5.023008||Viu
put_charclass_bitmap_innards_invlist|5.023008||Viu
put_code_point|5.021004||Viu
putc_unlocked|5.003007||Viu
putenv|5.005000||Viu
put_range|5.019009||Viu
putw|5.003007||Viu
pv_display|5.006000|5.003007|p
pv_escape|5.009004|5.003007|p
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Algorithm/Bertsekas.pm view on Meta::CPAN
my $decimals; # the number of digits after the decimal point
my ( $array1_size, $array2_size, $min_size, $max_size, $original_max_size );
my ( $need_transpose, $inicial_price, $iter_count_global, $iter_count_local );
my ( $epsilon_scaling, $max_epsilon_scaling, $max_matrix_value, $target, $output );
my ( %index_correlation, %assignned_object, %assignned_person, %price_object );
my ( %objects_desired_by_this, %locked_list, %seen_person, %seen_assignned_objects );
sub auction { # => default values
my %args = ( matrix_ref => undef, # reference to array: matrix N x M
maximize_total_benefit => 0, # 0: minimize_total_benefit ; 1: maximize_total_benefit
inicial_stepsize => undef, # auction algorithm terminates with a feasible assignment if the problem data are integer and stepsize < 1/min(N,M)
lib/Algorithm/Bertsekas.pm view on Meta::CPAN
%index_correlation = ();
%assignned_object = ();
%assignned_person = ();
%price_object = ();
%objects_desired_by_this = ();
%locked_list = ();
%seen_person = ();
my @matrix_input = @{$args{matrix_ref}}; # Input: Reference to the input matrix (NxM) = $min_size x $max_size
$array1_size = $#matrix_input + 1;
lib/Algorithm/Bertsekas.pm view on Meta::CPAN
$Opt02ValForPersonI, defined $Opt02ObjForPersonI ? $Opt02ObjForPersonI : '',
$Opt03ValForPersonI, defined $Opt03ObjForPersonI ? $Opt03ObjForPersonI : '';
}
}
if ( not @updated_price and not $locked_list{$person} ) # if all prices are outdated
{
for my $object ( 0 .. $max_size - 1 ) # generate new list
{
next if ( defined $current_value{$object} );
lib/Algorithm/Bertsekas.pm view on Meta::CPAN
$objects_desired_by_this{$person}{$Opt01ObjForPersonI} = $current_value{$Opt01ObjForPersonI}; # add information about the most desired objects
$objects_desired_by_this{$person}{$Opt02ObjForPersonI} = $current_value{$Opt02ObjForPersonI} if (defined $Opt02ObjForPersonI);
$objects_desired_by_this{$person}{$Opt03ObjForPersonI} = $current_value{$Opt03ObjForPersonI} if (defined $Opt03ObjForPersonI);
$locked_list{$person} = 1 if ( $epsilon_scaling > (1/10) * $max_epsilon_scaling and ($Opt03ValForPersonI - $Opt01ValForPersonI_new_list) > $min_size * $epsilon );
$locked_list{$person} = 1 if ( $epsilon_scaling > (3/10) * $max_epsilon_scaling ); # Lock the old list. Is this the minimum value to find a possible solution?
delete $locked_list{$person} if ( $epsilon == 1/(1+$min_size) ); # Otherwise unlock the person's old list in the last $epsilon_scaling round.
}
if ( $verbose >= 8 ){
my @old_list = sort { $a <=> $b } @objects_with_greater_benefits;
my @new_list = sort { $a <=> $b } keys %{$objects_desired_by_this{$person}};
@updated_price = sort { $a <=> $b } @updated_price;
my @best_3_objects = ( $Opt01ObjForPersonI, $Opt02ObjForPersonI, $Opt03ObjForPersonI );
my $msg = $locked_list{$person} ? '[locked list] ' : '';
@objects_with_same_values = sort { $a <=> $b } @objects_with_same_values;
$this_person_can_choose_n_different_objects{$person}{'objects'} = \@objects_with_same_values; #reference to an array
printf $output "<> PersonI = %3s ; %3s objects desired by this person (old list) = (@old_list) ; objects whose current values are still updated = (@updated_price) : %2s >= 1 ? \n", $person, scalar @old_list, scalar @updated_price;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Algorithm/DiffOld.pm view on Meta::CPAN
interface, which uses a comparison function rather than a key generating
function.
Because each of the lines in one array have to be compared with each
of the lines in the other array, this does M*N comparisons. This can
be very slow. I clocked it at taking 18 times as long as the stock
version of Algorithm::Diff for a 4000-line file. It will get worse
quadratically as array sizes increase.
=head1 SYNOPSIS
view all matches for this distribution
view release on metacpan or search on metacpan
get_av|5.006000|5.003007|p
getc|5.003007||Viu
get_c_backtrace|5.021001||Vi
get_c_backtrace_dump|5.021001||V
get_context|5.006000|5.006000|nu
getc_unlocked|5.003007||Viu
get_cv|5.006000|5.003007|p
get_cvn_flags|5.009005|5.003007|p
get_cvs|5.011000|5.003007|p
getcwd_sv|5.007002|5.007002|
get_db_sub|||iu
PERL_MALLOC_WRAP|5.009002|5.009002|Vn
PerlMem_calloc|5.006000||Viu
PerlMem_free|5.005000||Viu
PerlMem_free_lock|5.006000||Viu
PerlMem_get_lock|5.006000||Viu
PerlMem_is_locked|5.006000||Viu
PerlMem_malloc|5.005000||Viu
PERL_MEMORY_DEBUG_HEADER_SIZE|5.019009||Viu
PerlMemParse_calloc|5.006000||Viu
PerlMemParse_free|5.006000||Viu
PerlMemParse_free_lock|5.006000||Viu
PerlMemParse_get_lock|5.006000||Viu
PerlMemParse_is_locked|5.006000||Viu
PerlMemParse_malloc|5.006000||Viu
PerlMemParse_realloc|5.006000||Viu
PerlMem_realloc|5.005000||Viu
PerlMemShared_calloc|5.006000||Viu
PerlMemShared_free|5.006000||Viu
PerlMemShared_free_lock|5.006000||Viu
PerlMemShared_get_lock|5.006000||Viu
PerlMemShared_is_locked|5.006000||Viu
PerlMemShared_malloc|5.006000||Viu
PerlMemShared_realloc|5.006000||Viu
PERL_MG_UFUNC|5.007001||Viu
Perl_modf|5.006000|5.006000|n
PERL_MULTICONCAT_HEADER_SIZE|5.027006||Viu
putc|5.003007||Viu
put_charclass_bitmap_innards|5.021004||Viu
put_charclass_bitmap_innards_common|5.023008||Viu
put_charclass_bitmap_innards_invlist|5.023008||Viu
put_code_point|5.021004||Viu
putc_unlocked|5.003007||Viu
putenv|5.005000||Viu
put_range|5.019009||Viu
putw|5.003007||Viu
pv_display|5.006000|5.003007|p
pv_escape|5.009004|5.003007|p
view all matches for this distribution
view release on metacpan or search on metacpan
get_av|5.006000|5.003007|p
getc|5.003007||Viu
get_c_backtrace|5.021001||Vi
get_c_backtrace_dump|5.021001||V
get_context|5.006000|5.006000|nu
getc_unlocked|5.003007||Viu
get_cv|5.006000|5.003007|p
get_cvn_flags|5.009005|5.003007|p
get_cvs|5.011000|5.003007|p
getcwd_sv|5.007002|5.007002|
get_db_sub|||iu
PERL_MALLOC_WRAP|5.009002|5.009002|Vn
PerlMem_calloc|5.006000||Viu
PerlMem_free|5.005000||Viu
PerlMem_free_lock|5.006000||Viu
PerlMem_get_lock|5.006000||Viu
PerlMem_is_locked|5.006000||Viu
PerlMem_malloc|5.005000||Viu
PERL_MEMORY_DEBUG_HEADER_SIZE|5.019009||Viu
PerlMemParse_calloc|5.006000||Viu
PerlMemParse_free|5.006000||Viu
PerlMemParse_free_lock|5.006000||Viu
PerlMemParse_get_lock|5.006000||Viu
PerlMemParse_is_locked|5.006000||Viu
PerlMemParse_malloc|5.006000||Viu
PerlMemParse_realloc|5.006000||Viu
PerlMem_realloc|5.005000||Viu
PerlMemShared_calloc|5.006000||Viu
PerlMemShared_free|5.006000||Viu
PerlMemShared_free_lock|5.006000||Viu
PerlMemShared_get_lock|5.006000||Viu
PerlMemShared_is_locked|5.006000||Viu
PerlMemShared_malloc|5.006000||Viu
PerlMemShared_realloc|5.006000||Viu
PERL_MG_UFUNC|5.007001||Viu
Perl_modf|5.006000|5.006000|n
PERL_MULTICONCAT_HEADER_SIZE|5.027006||Viu
putc|5.003007||Viu
put_charclass_bitmap_innards|5.021004||Viu
put_charclass_bitmap_innards_common|5.023008||Viu
put_charclass_bitmap_innards_invlist|5.023008||Viu
put_code_point|5.021004||Viu
putc_unlocked|5.003007||Viu
putenv|5.005000||Viu
put_range|5.019009||Viu
putw|5.003007||Viu
pv_display|5.006000|5.003007|p
pv_escape|5.009004|5.003007|p
view all matches for this distribution
view release on metacpan or search on metacpan
example/15.pl view on Meta::CPAN
$self->{zero_at} = $move;
}
sub lock {
my $self = shift;
my $count = 1;
my $number_locked = 20000;
if ($self->{board}->[0]->[0] == 1) {
$self->{locked}->[0]->[0] = 1;
$number_locked = $number_locked - 100;
}
else {
for my $i (0..3) {
for my $j (0..3) {
if (($self->{board}->[$i]->[$j]) == 1) {
return $number_locked + $i + $j;
}
}
}
}
if ($self->{board}->[0]->[1] == 2) {
$self->{locked}->[0]->[1] = 1;
$number_locked = $number_locked - 100;
}
else {
for my $i (0..3) {
for my $j (0..3) {
if (($self->{board}->[$i]->[$j]) == 2) {
return $number_locked + $i;
}
}
}
}
if (($self->{board}->[0]->[2] == 3) && ($self->{board}->[0]->[3] == 4)) {
$self->{locked}->[0]->[2] = 1;
$self->{locked}->[0]->[3] = 1;
$number_locked = $number_locked - 200;
}
else {
for my $i (0..3) {
for my $j (0..3) {
if (($self->{board}->[$i]->[$j]) == 3) {
return $number_locked + $i;
}
}
}
}
if ($self->{board}->[1]->[0] == 5) {
$self->{locked}->[1]->[0] = 1;
$number_locked = $number_locked - 100;
}
else {
for my $i (1..3) {
for my $j (0..3) {
if (($self->{board}->[$i]->[$j]) == 5) {
return $number_locked + $i + $j;
}
}
}
}
if ($self->{board}->[1]->[1] == 6) {
$self->{locked}->[1]->[1] = 1;
$number_locked = $number_locked - 100;
}
else {
for my $i (1..3) {
for my $j (0..3) {
if (($self->{board}->[$i]->[$j]) == 6) {
return $number_locked + $i;
}
}
}
}
if (($self->{board}->[1]->[2] == 7) && ($self->{board}->[1]->[3] == 8)) {
$self->{locked}->[1]->[2] = 1;
$self->{locked}->[1]->[3] = 1;
$number_locked = $number_locked - 200;
}
else {
for my $i (1..3) {
for my $j (0..3) {
if (($self->{board}->[$i]->[$j]) == 7) {
return $number_locked + $i;
}
}
}
}
}
example/15.pl view on Meta::CPAN
my $self = shift;
return $self->lock;
}
sub distance_to_final_state {
my $self = shift;
$self->{number_locked} = $self->lock;
foreach my $i (0..3) {
foreach my $j (0..3) {
if (($self->{board}->[$i]->[$j]) &&
(($j+1) + ($i*4) != $self->{board}->[$i]->[$j])) {
return (1 + $self->{number_locked}, 1 + $self->{number_locked});
}
}
}
return (0,0);
}
example/15.pl view on Meta::CPAN
sub next_moves {
my $self = shift;
my @moves;
if ($self->{zero_at}->[0] > 0) {
if (!(
$self->{locked}->[$self->{zero_at}->[0]-1]->[$self->{zero_at}->[1]]
))
{
push @moves, [$self->{zero_at}->[0]-1,$self->{zero_at}->[1]];
}
}
if ($self->{zero_at}->[0] < 3) {
push @moves, [$self->{zero_at}->[0]+1,$self->{zero_at}->[1]];
}
if ($self->{zero_at}->[1] > 0) {
if (!(
$self->{locked}->[$self->{zero_at}->[0]]->[$self->{zero_at}->[1]-1]
))
{
push @moves, [$self->{zero_at}->[0],$self->{zero_at}->[1]-1];
}
}
view all matches for this distribution