Next refresh should show more results. ( run in 1.054 )
view release on metacpan or search on metacpan
examples/postifx-policy-server.pl view on Meta::CPAN
our $pidfile = "/var/run/postfix-policy-server.pid";
our %redirectmap;
# Param1: Client socket
# Param2: hash_ref
sub parse_postfix_input( $$ ) {
my ($socket,$hashref) = @_;
local $/ = "\r\n";
while( my $line = <$socket> ){
chomp( $line );
examples/postifx-policy-server.pl view on Meta::CPAN
$hashref->{$1} = $2;
}
}
}
sub convert_hashref_to_acl($){
my( $hash_ref ) = @_;
my @a;
for( sort( keys %$hash_ref ) ) {
examples/postifx-policy-server.pl view on Meta::CPAN
}
return( join( " ", @a ) );
}
sub process_client($){
my ($socket) = @_;
# Create some stuff
my $accept_acl = ACL->new->generate_required( 'required.txt' )->parse_acl_from_file( { Filename => "acl.permit.txt" } );
my $reject_acl = ACL->new->generate_required( 'required.txt' )->parse_acl_from_file( { Filename => "acl.reject.txt" } );
view release on metacpan or search on metacpan
lib/AE/AdHoc.pm view on Meta::CPAN
no strict 'refs'; ## no critic
no warnings 'prototype'; ## no critic
*{$name} = $code;
};
sub ae_begin(@) { ## no critic
croak("ae_begin called outside ae_recv") unless $cv;
$cv->begin(@_);
};
view release on metacpan or search on metacpan
src/inc/Test/More.pm view on Meta::CPAN
$Test->unlike(@_);
}
sub cmp_ok($$$;$) {
$Test->cmp_ok(@_);
}
view release on metacpan or search on metacpan
t/AI-Calibrate-KL.t view on Meta::CPAN
#########################
use Test::More tests => 4;
BEGIN { use_ok('AI::Calibrate', ':all') };
sub trim($) {
my $string = shift;
$string =~ s/^\s+//;
$string =~ s/\s+$//;
return $string;
}
view release on metacpan or search on metacpan
t/test_io.t view on Meta::CPAN
use PDL::Types;
use PDL::NiceSlice;
$|++;
sub test_Cifar10Rec()
{
GetCifar10();
my $dataiter = mx->io->ImageRecordIter({
path_imgrec => "data/cifar/train.rec",
mean_img => "data/cifar/cifar10_mean.bin",
t/test_io.t view on Meta::CPAN
{
ok($labelcount[$i] == 5000);
}
}
sub test_NDArrayIter()
{
my $datas = ones(PDL::Type->new(6), 2, 2, 1000);
my $labels = ones(PDL::Type->new(6), 1, 1000);
for my $i (0..999)
{
t/test_io.t view on Meta::CPAN
ok($labelcount[$i] == 100);
}
}
}
sub test_MNISTIter()
{
GetMNIST_ubyte();
my $batch_size = 100;
my $train_dataiter = mx->io->MNISTIter({
view release on metacpan or search on metacpan
inc/Test/More.pm view on Meta::CPAN
}
#line 425
sub cmp_ok($$$;$) {
my $tb = Test::More->builder;
$tb->cmp_ok(@_);
}
view release on metacpan or search on metacpan
examples/bp.pl view on Meta::CPAN
#***********************************
sub calcNet()
{
#calculate the outputs of the hidden neurons
#the hidden neurons are tanh
for(my $i = 0;$i<$numHidden;$i++)
examples/bp.pl view on Meta::CPAN
}
}
#************************************
sub calcOverallError()
{
$RMSerror = 0.0;
for(my $i = 0;$i<$numPatterns;$i++)
{
$patNum = $i;
view release on metacpan or search on metacpan
t/auxfunctions.pl view on Meta::CPAN
s/(\.\d{12})\d+/$1/g;
s/---+/---/g;
return $_;
}
sub getfile($) {
my $f = shift;
local *F;
open(F, "<$f") or die "getfile:cannot open $f:$!";
my @r = <F>;
close(F);
return wantarray ? @r : join ('', @r);
}
sub putfile($@) {
my $f = shift;
local *F;
open(F, ">$f") or die "putfile:cannot open $f:$!";
print F '' unless @_;
while (@_) { print F shift(@_) }
view release on metacpan or search on metacpan
lib/AI/NeuralNet/Hopfield.pm view on Meta::CPAN
$self->matrix($matrix);
$self->matrix_rows($args->{row});
$self->matrix_cols($args->{col});
}
sub train() {
my $self = shift;
my @pattern = @_;
if ( ($#pattern + 1) != $self->matrix_rows) {
die "Can't train a pattern of size " . ($#pattern + 1) . " on a hopfield network of size " , $self->matrix_rows;
lib/AI/NeuralNet/Hopfield.pm view on Meta::CPAN
my $m5 = &add($self->matrix, $m4);
$self->matrix($m5);
}
sub evaluate() {
my $self = shift;
my @pattern = @_;
my @output = ();
lib/AI/NeuralNet/Hopfield.pm view on Meta::CPAN
}
}
return @output;
}
sub convert_array() {
my $rows = shift;
my $cols = shift;
my @pattern = @_;
my $result = Math::SparseMatrix->new(1, $cols);
lib/AI/NeuralNet/Hopfield.pm view on Meta::CPAN
}
}
return $result;
}
sub transpose() {
my $matrix = shift;
my $rows = $matrix->{_rows};
my $cols = $matrix->{_cols};
my $inverse = Math::SparseMatrix->new($cols, $rows);
lib/AI/NeuralNet/Hopfield.pm view on Meta::CPAN
}
}
return $inverse;
}
sub multiply() {
my $matrix_a = shift;
my $matrix_b = shift;
my $a_rows = $matrix_a->{_rows};
my $a_cols = $matrix_a->{_cols};
lib/AI/NeuralNet/Hopfield.pm view on Meta::CPAN
}
}
return $result;
}
sub identity() {
my $size = shift;
if ($size < 1) {
die "Identity matrix must be at least of size 1.";
}
lib/AI/NeuralNet/Hopfield.pm view on Meta::CPAN
$result->set($i, $i, 1);
}
return $result;
}
sub subtract() {
my $matrix_a = shift;
my $matrix_b = shift;
my $a_rows = $matrix_a->{_rows};
my $a_cols = $matrix_a->{_cols};
lib/AI/NeuralNet/Hopfield.pm view on Meta::CPAN
}
}
return $result;
}
sub add() {
#weight matrix.
my $matrix_a = shift;
#identity matrix.
my $matrix_b = shift;
lib/AI/NeuralNet/Hopfield.pm view on Meta::CPAN
}
}
return $result;
}
sub dot_product() {
my $matrix_a = shift;
my $matrix_b = shift;
my $a_rows = $matrix_a->{_rows};
my $a_cols = $matrix_a->{_cols};
lib/AI/NeuralNet/Hopfield.pm view on Meta::CPAN
$result += $array_a[$i] * $array_b[$i];
}
return $result;
}
sub packed_array() {
my $matrix = shift;
my @result = ();
for (my $r = 1; $r <= $matrix->{_rows}; $r++) {
for (my $c = 1; $c <= $matrix->{_cols}; $c++) {
lib/AI/NeuralNet/Hopfield.pm view on Meta::CPAN
}
}
return @result;
}
sub get_col() {
my $self = shift;
my $col = shift;
my $matrix = $self->matrix();
lib/AI/NeuralNet/Hopfield.pm view on Meta::CPAN
$new_matrix->set($row, 1, $value);
}
return $new_matrix;
}
sub print_matrix() {
my $matrix = shift;
my $rs = $matrix->{_rows};
my $cs = $matrix->{_cols};
for (my $i = 1; $i <= $rs; $i++) {
view release on metacpan or search on metacpan
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
=cut
sub build_checkBlob_request( $self, %options ) {
croak "Missing required parameter 'digest'"
unless exists $options{ 'digest' };
my $method = 'HEAD';
my $template = URI::Template->new( '/blobs/{digest}' );
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
return $tx
}
sub checkBlob( $self, %options ) {
my $tx = $self->build_checkBlob_request(%options);
my $res = Future::Mojo->new();
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
=cut
sub build_createBlob_request( $self, %options ) {
croak "Missing required parameter 'digest'"
unless exists $options{ 'digest' };
my $method = 'POST';
my $template = URI::Template->new( '/blobs/{digest}' );
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
return $tx
}
sub createBlob( $self, %options ) {
my $tx = $self->build_createBlob_request(%options);
my $res = Future::Mojo->new();
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
Returns a L<< AI::Ollama::GenerateChatCompletionResponse >> on success.
=cut
sub build_generateChatCompletion_request( $self, %options ) {
my $method = 'POST';
my $path = '/chat';
my $url = Mojo::URL->new( $self->server . $path );
my $request = AI::Ollama::GenerateChatCompletionRequest->new( \%options )->as_hash;
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
return $tx
}
sub generateChatCompletion( $self, %options ) {
my $tx = $self->build_generateChatCompletion_request(%options);
my $res = Future::Mojo->new();
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
=back
=cut
sub build_copyModel_request( $self, %options ) {
my $method = 'POST';
my $path = '/copy';
my $url = Mojo::URL->new( $self->server . $path );
my $request = AI::Ollama::CopyModelRequest->new( \%options )->as_hash;
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
return $tx
}
sub copyModel( $self, %options ) {
my $tx = $self->build_copyModel_request(%options);
my $res = Future::Mojo->new();
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
Returns a L<< AI::Ollama::CreateModelResponse >> on success.
=cut
sub build_createModel_request( $self, %options ) {
my $method = 'POST';
my $path = '/create';
my $url = Mojo::URL->new( $self->server . $path );
my $request = AI::Ollama::CreateModelRequest->new( \%options )->as_hash;
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
return $tx
}
sub createModel( $self, %options ) {
my $tx = $self->build_createModel_request(%options);
my $res = Future::Mojo->new();
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
=back
=cut
sub build_deleteModel_request( $self, %options ) {
my $method = 'DELETE';
my $path = '/delete';
my $url = Mojo::URL->new( $self->server . $path );
my $request = AI::Ollama::DeleteModelRequest->new( \%options )->as_hash;
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
return $tx
}
sub deleteModel( $self, %options ) {
my $tx = $self->build_deleteModel_request(%options);
my $res = Future::Mojo->new();
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
Returns a L<< AI::Ollama::GenerateEmbeddingResponse >> on success.
=cut
sub build_generateEmbedding_request( $self, %options ) {
my $method = 'POST';
my $path = '/embeddings';
my $url = Mojo::URL->new( $self->server . $path );
my $request = AI::Ollama::GenerateEmbeddingRequest->new( \%options )->as_hash;
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
return $tx
}
sub generateEmbedding( $self, %options ) {
my $tx = $self->build_generateEmbedding_request(%options);
my $res = Future::Mojo->new();
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
Returns a L<< AI::Ollama::GenerateCompletionResponse >> on success.
=cut
sub build_generateCompletion_request( $self, %options ) {
my $method = 'POST';
my $path = '/generate';
my $url = Mojo::URL->new( $self->server . $path );
my $request = AI::Ollama::GenerateCompletionRequest->new( \%options )->as_hash;
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
return $tx
}
sub generateCompletion( $self, %options ) {
my $tx = $self->build_generateCompletion_request(%options);
my $res = Future::Mojo->new();
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
Returns a L<< AI::Ollama::PullModelResponse >> on success.
=cut
sub build_pullModel_request( $self, %options ) {
my $method = 'POST';
my $path = '/pull';
my $url = Mojo::URL->new( $self->server . $path );
my $request = AI::Ollama::PullModelRequest->new( \%options )->as_hash;
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
return $tx
}
sub pullModel( $self, %options ) {
my $tx = $self->build_pullModel_request(%options);
my $res = Future::Mojo->new();
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
Returns a L<< AI::Ollama::PushModelResponse >> on success.
=cut
sub build_pushModel_request( $self, %options ) {
my $method = 'POST';
my $path = '/push';
my $url = Mojo::URL->new( $self->server . $path );
my $request = AI::Ollama::PushModelRequest->new( \%options )->as_hash;
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
return $tx
}
sub pushModel( $self, %options ) {
my $tx = $self->build_pushModel_request(%options);
my $res = Future::Mojo->new();
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
Returns a L<< AI::Ollama::ModelInfo >> on success.
=cut
sub build_showModelInfo_request( $self, %options ) {
my $method = 'POST';
my $path = '/show';
my $url = Mojo::URL->new( $self->server . $path );
my $request = AI::Ollama::ModelInfoRequest->new( \%options )->as_hash;
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
return $tx
}
sub showModelInfo( $self, %options ) {
my $tx = $self->build_showModelInfo_request(%options);
my $res = Future::Mojo->new();
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
Returns a L<< AI::Ollama::ModelsResponse >> on success.
=cut
sub build_listModels_request( $self, %options ) {
my $method = 'GET';
my $path = '/tags';
my $url = Mojo::URL->new( $self->server . $path );
my $tx = $self->ua->build_tx(
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
return $tx
}
sub listModels( $self, %options ) {
my $tx = $self->build_listModels_request(%options);
my $res = Future::Mojo->new();
lib/AI/Ollama/Client/Impl.pm view on Meta::CPAN
return $res
}
sub validate_response( $self, $payload, $tx ) {
if( $self->validate_responses
and my $openapi = $self->openapi ) {
my $results = $openapi->validate_response($payload, { request => $tx->req });
if( $results->{error}) {
say $results;
say $tx->res->to_string;
};
};
}
sub validate_request( $self, $tx ) {
if( $self->validate_requests
and my $openapi = $self->openapi ) {
my $results = $openapi->validate_request($tx->req);
if( $results->{error}) {
say $results;
view release on metacpan or search on metacpan
examples/NeuralNet/pso_ann.pl view on Meta::CPAN
my $annInputs = "pso.dat";
my $expectedValue = 3.5; # this is the value that we want to train the ANN to produce (just like the example in t/PTO.t)
sub test_fitness_function(@) {
my (@arr) = (@_);
&writeAnnConfig($annConfig, $numInputs, $numHidden, $xferFunc, @arr);
my $netValue = &runANN($annConfig, $annInputs);
print "network value = $netValue\n";
examples/NeuralNet/pso_ann.pl view on Meta::CPAN
##### io #########
sub writeAnnConfig() {
my ($configFile, $inputs, $hidden, $func, @weights) = (@_);
open(ANN, ">$configFile");
print ANN "$inputs $hidden\n";
print ANN "$func\n";
examples/NeuralNet/pso_ann.pl view on Meta::CPAN
}
print ANN "\n";
close(ANN);
}
sub runANN($$) {
my ($configFile, $dataFile) = @_;
my $networkValue = `ann_compute $configFile $dataFile`;
chomp($networkValue);
return $networkValue;
}
view release on metacpan or search on metacpan
examples/snake_labirint.pl view on Meta::CPAN
# copy map to map object
$m->foreach_xy_set( sub { $map[$a][$b] });
my ($path) = $m->astar(@to, @from);
sub swap(\@\@){
@_[0,1] = @_[1,0];;
}
#swap(@to, @from);
$m->draw_path(@to, $path);
view release on metacpan or search on metacpan
lib/AI/TensorFlow/Libtensorflow/Lib.pm view on Meta::CPAN
return "TF_${object_name}$name";
};
}
sub arg(@) {
my $arg = AI::TensorFlow::Libtensorflow::Lib::_Arg->new(
type => shift,
id => shift,
);
return $arg, @_;
view release on metacpan or search on metacpan
#
# but if you change it, you'll also need to change
# the lines that refer to DirDB subsequently,
# including the tieing of %{"caller().'::AIS_STASH'}
sub miniget($$$$){
my($HostName, $PortNumber, $Desired, $agent) = @_;
eval <<'ENDMINIGET';
use Socket qw(:DEFAULT :crlf);
$PortNumber ||= 80;
$agent ||= "$ENV{SERVER_NAME}$ENV{SCRIPT_NAME}";
ENDMINIGET
}
sub housekeeping(){
my @deletia;
my $t = time;
while(($k,$v) = each %Sessions){
};
@Sessions{@deletia} = ();
};
sub redirect($){
print <<EOF;
Location: $_[0]
Content-Type: text/html
<HTML><HEAD><TITLE>Relocate </TITLE>
view release on metacpan or search on metacpan
utils/runDiscovery.pl view on Meta::CPAN
$lbd->performLBD();
############################################################################
# function to output help messages for this program
############################################################################
sub showHelp() {
print "This utility takes an lbd configuration file and outputs\n";
print "the results of lbd to file. The parameters for LBD are\n";
print "specified in the input file. Please see samples/lbd or\n";
print "samples/thresholding for sample input files and descriptions\n";
view release on metacpan or search on metacpan
doc/examples/petmarket/petmarket/api/stringresourcesservice.pm view on Meta::CPAN
}
return \%bundle;
}
sub getAboutUsStrings()
{
my ($self) = @_;
my %strings;
$strings{"HEAD_str"} = "ABOUT US";
doc/examples/petmarket/petmarket/api/stringresourcesservice.pm view on Meta::CPAN
$strings{"url"} = "http://www.macromedia.com";
return \%strings;
}
sub getLegalStrings()
{
my ($self) = @_;
my %strings;
$strings{"HEAD_str"} = "LEGAL INFORMATION";
$strings{"BODY_HTML_str"} = "Copyright © 2001-2002 Macromedia, Inc. All rights reserved. Macromedia, the Macromedia logo, and Flash are trademarks or registered trademarks of Macromedia, Inc.\n \nMany of the images used in this experience were ...
doc/examples/petmarket/petmarket/api/stringresourcesservice.pm view on Meta::CPAN
return \%strings;
}
sub getAffiliateStrings()
{
my ($self) = @_;
my %strings;
$strings{"HEAD_str"} = "SITE DESIGN";
$strings{"BODY_HTML_str"} = "We chose Popular Front to design the Pet Market shopping experience because of their demonstrated ability to enhance user experiences with our technologies. Popular Front has created numerous award-winning solutions t...
view release on metacpan or search on metacpan
lib/AMPR/Rip44.pm view on Meta::CPAN
Figure out local interface IP addresses so that routes to them can be ignored
=cut
sub fill_local_ifs() {
}
=head2 mask2prefix
view release on metacpan or search on metacpan
lib/APISchema/Generator/Markdown/ResourceResolver.pm view on Meta::CPAN
use Class::Accessor::Lite (
new => 1,
ro => [qw(schema)],
);
sub _foreach_properties($$&) {
my ($name_path, $definition, $callback) = @_;
return unless (ref $definition || '') eq 'HASH';
if ($definition->{items}) {
my $items = $definition->{items};
view release on metacpan or search on metacpan
lib/APP/REST/RestTestSuite.pm view on Meta::CPAN
return $fh;
}
sub _trim($) {
return unless ( $_[0] );
my $str = $_[0];
$str =~ s/^\s+//g;
view release on metacpan or search on metacpan
t/compat/base/headers-etag.t view on Meta::CPAN
use APR::HTTP::Headers::Compat;
use HTTP::Headers::ETag;
my $Pool = APR::Pool->new;
sub mk(@) {
my $table = APR::Table::make( $Pool, 10 );
return APR::HTTP::Headers::Compat->new( $table, @_ );
}
my $h = mk;
view release on metacpan or search on metacpan
}
exit $Exit;
sub reindent($) {
my($text) = shift;
$text =~ s/\n/\n /g;
$text =~ s/ /\t/g;
$text;
}
view release on metacpan or search on metacpan
plugins/tools/GrinderCaptureConverter.pl view on Meta::CPAN
my $outfile;
my $format;
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub build_QS_fixed($);
sub output_webtransact();
sub output_list();
sub print_help();
sub print_usage();
sub print_revision();
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Getopt::Long::Configure('bundling');
plugins/tools/GrinderCaptureConverter.pl view on Meta::CPAN
exit(0);
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub output_webtransact() {
open (OUTFILE, ">$outfile") || die ("Could not open webtransact output file");
print OUTFILE "\@URLS = (\n";
for(my $c = 0, my $t = 1; $c < @urlArray; $c++) {
if (! ($urlArray[$c] =~ /(\.(gif|jpg|png|css|ico|js|bmp)|(robots\.txt))$/i) ) {
plugins/tools/GrinderCaptureConverter.pl view on Meta::CPAN
close (OUTFILE);
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub build_QS_fixed($) {
my $tArray = shift;
my $Qs_fixed = '';
if ( defined @$tArray ) {
plugins/tools/GrinderCaptureConverter.pl view on Meta::CPAN
return $theURL;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub output_list() {
open (OUTFILE, ">$outfile") || die ("Could not open list output file");
for(my $c = 0; $c < @urlArray; $c++) {
if (! ($urlArray[$c] =~ /(\.(gif|jpg|png|css|ico|js|bmp)|(robots\.txt))$/i) ) {
my $tUrl = URLDecode($urlArray[$c]);
plugins/tools/GrinderCaptureConverter.pl view on Meta::CPAN
close (OUTFILE);
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub print_usage() {
print "Usage: $PROGNAME \n -i <input-file> \n -o <output-file> \n [-f L|W], W default \n [-v version] \n [-h help]\n\n";
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub print_revision() {
print "\nThis is $PROGNAME, v$version\n";
print "Copyright (c) 2004-2007 Yves Van den Hove\n\n";
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub print_help() {
print_revision();
print_usage();
print "Send an email to yvdhove\@users.sourceforge.net if you have any questions regarding the use of this software.\n";
}
view release on metacpan or search on metacpan
lib/ASP4/ConfigPostProcessor.pm view on Meta::CPAN
return bless \%args, $class;
}# end new()
sub post_process($$);
1;# return true:
view release on metacpan or search on metacpan
lib/AWS/Lambda/Quick/Upload.pm view on Meta::CPAN
my $message = $AWS::CLIWrapper::Error->{Message};
die "AWS CLI failure when calling $method $_[0] '$code': $message";
}
sub encode_json($) {
return JSON::PP->new->ascii->canonical(1)->allow_nonref(1)->encode(shift);
}
sub debug {
my $self = shift;
view release on metacpan or search on metacpan
author/perl-stripper/perl-stripper/handler.pl view on Meta::CPAN
return $res->finalize;
};
my $func = AWS::Lambda::PSGI->wrap($app);
sub handle($payload, $context) {
return $func->($payload);
}
1;
view release on metacpan or search on metacpan
lib/AWS/XRay/Plugin/EC2.pm view on Meta::CPAN
use HTTP::Tiny;
# for test
our $_base_url = "http://169.254.169.254/latest";
sub ID_ADDR() {
return "$_base_url/meta-data/instance-id";
}
sub AZ_ADDR() {
return "$_base_url/meta-data/placement/availability-zone";
}
our $METADATA;
view release on metacpan or search on metacpan
lib/Acme/L337.pm view on Meta::CPAN
package L337;
use strict;
sub translate($string) {
# Common leet
my $tempstring;
$tempstring =~ "tr/[i,I]/!";
$tempstring =~ "tr/[t,T]/7";
$tempstring =~ "tr/[e,E]/3";
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
$default_object ||= $default_class->new;
return $default_object;
}
my $import_called = 0;
sub import() {
$import_called = 1;
my $class = (grep /^-base$/i, @_)
? scalar(caller)
: $_[0];
if (not defined $default_class) {
inc/Test/Base.pm view on Meta::CPAN
$caller =~ s/.*:://;
croak "Too late to call $caller()"
}
}
sub find_my_self() {
my $self = ref($_[0]) eq $default_class
? splice(@_, 0, 1)
: default_object();
return $self, @_;
}
sub blocks() {
(my ($self), @_) = find_my_self(@_);
croak "Invalid arguments passed to 'blocks'"
if @_ > 1;
croak sprintf("'%s' is invalid argument to blocks()", shift(@_))
inc/Test/Base.pm view on Meta::CPAN
}
return (@blocks);
}
sub next_block() {
(my ($self), @_) = find_my_self(@_);
my $list = $self->_next_list;
if (@$list == 0) {
$list = [@{$self->block_list}, undef];
$self->_next_list($list);
inc/Test/Base.pm view on Meta::CPAN
$block->run_filters;
}
return $block;
}
sub first_block() {
(my ($self), @_) = find_my_self(@_);
$self->_next_list([]);
$self->next_block;
}
sub filters_delay() {
(my ($self), @_) = find_my_self(@_);
$self->_filters_delay(defined $_[0] ? shift : 1);
}
sub delimiters() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
my ($block_delimiter, $data_delimiter) = @_;
$block_delimiter ||= $self->block_delim_default;
$data_delimiter ||= $self->data_delim_default;
$self->block_delim($block_delimiter);
$self->data_delim($data_delimiter);
return $self;
}
sub spec_file() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_file(shift);
return $self;
}
sub spec_string() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_string(shift);
return $self;
}
sub filters() {
(my ($self), @_) = find_my_self(@_);
if (ref($_[0]) eq 'HASH') {
$self->_filters_map(shift);
}
else {
inc/Test/Base.pm view on Meta::CPAN
push @$filters, @_;
}
return $self;
}
sub filter_arguments() {
$Test::Base::Filter::arguments;
}
sub have_text_diff {
eval { require Text::Diff; 1 } &&
$Text::Diff::VERSION >= 0.35 &&
$Algorithm::Diff::VERSION >= 1.15;
}
sub is($$;$) {
(my ($self), @_) = find_my_self(@_);
my ($actual, $expected, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ($ENV{TEST_SHOW_NO_DIFFS} or
not defined $actual or
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
inc/Test/Base.pm view on Meta::CPAN
sub END {
run_compare() unless $Have_Plan or $DIED or not $import_called;
}
sub run_compare() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
is($block->$x, $block->$y, $block->name ? $block->name : ());
}
}
}
sub run_is() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_is_deeply() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and exists($block->{$y});
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_like() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_unlike() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
};
}
return $spec;
}
sub _strict_warnings() {
require Filter::Util::Call;
my $done = 0;
Filter::Util::Call::filter_add(
sub {
return 0 if $done;
inc/Test/Base.pm view on Meta::CPAN
$done = 1;
}
);
}
sub tie_output() {
my $handle = shift;
die "No buffer to tie" unless @_;
tie $handle, 'Test::Base::Handle', $_[0];
}
inc/Test/Base.pm view on Meta::CPAN
$ENV{TEST_SHOW_NO_DIFFS} = 1;
}
package Test::Base::Handle;
sub TIEHANDLE() {
my $class = shift;
bless \ $_[0], $class;
}
sub PRINT {
inc/Test/Base.pm view on Meta::CPAN
sub AUTOLOAD {
return;
}
sub block_accessor() {
my $accessor = shift;
no strict 'refs';
return if defined &$accessor;
*$accessor = sub {
my $self = shift;
view release on metacpan or search on metacpan
inc/Test/More.pm view on Meta::CPAN
return $tb->unlike(@_);
}
#line 476
sub cmp_ok($$$;$) {
my $tb = Test::More->builder;
return $tb->cmp_ok(@_);
}