view release on metacpan or search on metacpan
lib/A1z/HTML5/Template.pm view on Meta::CPAN
# include write_file if you submit form to the same file ( TemplateAdmin.cgi )
say $h->body_article(
header => "<a href='$sys{cgiurl}/TemplateAdmin.cgi' title='Refresh to get the latest/saved content'>Refresh</a> ",
content => $h->write_file( file => "/absolute/path/to/app/open_file_example.txt")
);
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Devel/CheckLib.pm view on Meta::CPAN
=head2 assert_lib
This takes several named parameters, all of which are optional, and dies
with an error message if any of the libraries listed can
not be found. B<Note>: dying in a Makefile.PL or Build.PL may provoke
a 'FAIL' report from CPAN Testers' automated smoke testers. Use
C<check_lib_or_exit> instead.
The named parameters are:
=over
inc/Devel/CheckLib.pm view on Meta::CPAN
# borrowed from Text::ParseWords
sub _parse_line {
my($delimiter, $keep, $line) = @_;
my($word, @pieces);
no warnings 'uninitialized'; # we will be testing undef strings
while (length($line)) {
# This pattern is optimised to be stack conservative on older perls.
# Do not refactor without being careful and testing it on very long strings.
# See Perl bug #42980 for an example of a stack busting input.
$line =~ s/^
(?:
# double quoted string
(") # $quote
inc/Devel/CheckLib.pm view on Meta::CPAN
=head1 PLATFORMS SUPPORTED
You must have a C compiler installed. We check for C<$Config{cc}>,
both literally as it is in Config.pm and also in the $PATH.
It has been tested with varying degrees of rigorousness on:
=over
=item gcc (on Linux, *BSD, Mac OS X, Solaris, Cygwin)
inc/Devel/CheckLib.pm view on Meta::CPAN
=head1 WARNINGS, BUGS and FEEDBACK
This is a very early release intended primarily for feedback from
people who have discussed it. The interface may change and it has
not been adequately tested.
Feedback is most welcome, including constructive criticism.
Bug reports should be made using L<http://rt.cpan.org/> or by email.
When submitting a bug report, please include the output from running:
inc/Devel/CheckLib.pm view on Meta::CPAN
David Golden E<lt>dagolden@cpan.orgE<gt>
Yasuhiro Matsumoto E<lt>mattn@cpan.orgE<gt>
Thanks to the cpan-testers-discuss mailing list for prompting us to write it
in the first place;
to Chris Williams for help with Borland support;
to Tony Cook for help with Microsoft compiler command-line options
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AAC/Pvoice/Panel.pm view on Meta::CPAN
$self->{tls}->Add($rowsizer, 0, wxALIGN_CENTRE, 0);
$self->{textrowsizer} = $rowsizer;
$self->{text}->SetValue(my $x = $self->RetrieveText);
$self->{text}->SetStyle(0, length($self->{text}->GetValue), $self->{ta});
$self->{text}->Refresh(); # Added to test it on the Mercury...added text
# isn't visible there...
}
$self->{title}->SetBackgroundColour($self->BackgroundColour) unless $self->{disabletitle};
$self->{tls}->AddGrowableCol(0);
lib/AAC/Pvoice/Panel.pm view on Meta::CPAN
sub DisplayAddText
{
my $self = shift;
push @{$self->{displaytextsave}}, $_[0];
$self->{text}->AppendText($_[0]);
$self->{text}->Refresh(); # Added to test it on the Mercury...added text
# isn't visible there...
}
sub SpeechAddText
{
lib/AAC/Pvoice/Panel.pm view on Meta::CPAN
{
my $self = shift;
$self->{displaytextsave}=[];
$self->{speechtextsave}=[];
$self->{text}->SetValue('');
$self->{text}->Refresh(); # Added to test it on the Mercury...added text
# isn't visible there...
}
sub BackspaceText
{
my $self = shift;
pop @{$self->{displaytextsave}};
pop @{$self->{speechtextsave}};
$self->{text}->SetValue(my $x = $self->RetrieveText);
$self->{text}->SetStyle(0, length($self->{text}->GetValue), $self->{ta});
$self->{text}->Refresh(); # Added to test it on the Mercury...added text
# isn't visible there...
}
sub SpeechRetrieveText
{
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AC/MrGamoo/FileList.pm view on Meta::CPAN
);
=head1 IMPORTANT
You can fire up the system, and get the servers talking to each other, and
perform some limited tests without this file.
But you must provide this file in order to actually run map/reduce jobs.
=head1 DESCRIPTION
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AC/Yenta/Store/Tokyo.pm view on Meta::CPAN
package AC::Yenta::Store::Tokyo;
use AC::Yenta::Debug 'tokyo';
use strict;
# does not work on sparc (tests sigbus)
# new version does not compile with gcc 3.4.3
#
# faster average performance than BDB
# worse worst-case performance than BDB
view all matches for this distribution
view release on metacpan or search on metacpan
lib/ACH/Generator.pm view on Meta::CPAN
May 2006
=head1 DESCRIPTION
ACH::Generator is a simple, generic subclass of ACH used to generate ACH files.
It's intentional use is for testing purposes ONLY. ACH-Generator will allow a
developer to create an ACH formatted file.
=head1 USING ACH-Generator
use ACH::Generator;
lib/ACH/Generator.pm view on Meta::CPAN
}
=head2 CAVEATS
This package is created for testing purposes only. It shouldn't be used
for production programs or scripts. There are other commercial products
out there that may be a more efficient solution for accomplishing your
goals.
All records in an ACH file must be formatted in the following sequence
view all matches for this distribution
view release on metacpan or search on metacpan
lib/ACH/Parser.pm view on Meta::CPAN
May 2006
=head1 DESCRIPTION
ACH::Parser is a simple, generic ACH file to ACH object parser.
It's intentional use is for testing purposes ONLY. ACH-Parser will
allow a developer to look at the particular fields in an ACH formatted
file.
=head1 USING ACH-Parser
lib/ACH/Parser.pm view on Meta::CPAN
}
=head2 CAVEATS
This package is created for testing purposes only. It shouldn't be used
for production programs or scripts. There are other commercial products
out there that may be a more efficient solution for accomplishing your
goals.
All records in an ACH file must be formatted in the following sequence
view all matches for this distribution
view release on metacpan or search on metacpan
May 2006
=head1 DESCRIPTION
ACH is a simple, generic perl object that contains the data necesary to
create an ACH file. It's intentional use is for testing purposes ONLY.
ACH will allow a developer to manipulate specific data fields in an ACH
formatted object.
=head1 USING ACH
}
=head2 CAVEATS
This package is created for testing purposes only. It shouldn't be used
for production programs or scripts. There are other commercial products
out there that may be a more efficient solution for accomplishing your
goals.
All records in an ACH file must be formatted in the following sequence
view all matches for this distribution
view release on metacpan or search on metacpan
lib/ACME/CPANPLUS/Module/With/Core/PreReq.pm view on Meta::CPAN
package ACME::CPANPLUS::Module::With::Core::PreReq;
$ACME::CPANPLUS::Module::With::Core::PreReq::VERSION = '0.06';
#ABSTRACT: Fake module with a prereq that is a core module for testing CPANPLUS
use strict;
use warnings;
qq[Nobody here but us chickens];
lib/ACME/CPANPLUS/Module/With/Core/PreReq.pm view on Meta::CPAN
=encoding UTF-8
=head1 NAME
ACME::CPANPLUS::Module::With::Core::PreReq - Fake module with a prereq that is a core module for testing CPANPLUS
=head1 VERSION
version 0.06
lib/ACME/CPANPLUS/Module/With/Core/PreReq.pm view on Meta::CPAN
cpanp -i ACME::CPANPLUS::Module::With::Core::PreReq
=head1 DESCRIPTION
ACME::CPANPLUS::Module::With::Core::PreReq is a fake module that has a prerequisite of a core module
so I can test something in L<CPANPLUS> and L<CPANPLUS::YACSmoke>
No moving parts and nothing to see.
=head1 AUTHOR
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..1\n"; }
END {print "not ok 1\n" unless $loaded;}
use ACME::Error::31337;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
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..1\n"; }
END {print "not ok 1\n" unless $loaded;}
use ACME::Error::Coy;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
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..1\n"; }
END {print "not ok 1\n" unless $loaded;}
use ACME::Error::HTML;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
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..1\n"; }
END {print "not ok 1\n" unless $loaded;}
use ACME::Error::IgpayAtinlay;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
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..1\n"; }
END {print "not ok 1\n" unless $loaded;}
use ACME::Error::Translate;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
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..1\n"; }
END {print "not ok 1\n" unless $loaded;}
use ACME::Error;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
view all matches for this distribution
view release on metacpan or search on metacpan
lib/ACME/QuoteDB.pm view on Meta::CPAN
my $sq = ACME::QuoteDB->new;
print $sq->get_quote;
# examples are based on quotes data in the test database.
# (see tests t/data/)
# get specific quote based on basic text search.
# search all 'ralph' quotes for string 'wookie'
print $sq->get_quotes_contain({
Contain => 'wookie',
lib/ACME/QuoteDB.pm view on Meta::CPAN
=head1 LOADING QUOTES
In order to actually use this module, one has to load quotes content,
hopefully this is relativly easy,... (see t/01-load_quotes.t in tests)
=over 4
=item 1 add_quote, one record at a time, probably within an iteration loop
see L</add_quote>
=item 1 (Batch Load) load quotes from a csv file. (tested with comma and tab delimiters)
format of file must be as follows: (headers)
"Quote", "Attribution Name", "Attribution Source", "Category", "Rating"
for example:
lib/ACME/QuoteDB.pm view on Meta::CPAN
"Sideshow Bob has no decency. He called me Chief Piggum. (laughs) Oh wait, I get it, he's all right.","Chief Wiggum","The Simpsons","Humor",8
=item 1 if these dont suit your needs, ACME::QuoteDB::LoadDB is sub-classable,
so one can extract data anyway they like and populate the db themselves.
(there is a test that illustrates overriding the stub method, 'dbload')
you need to populate a record data structure:
$self->set_record(quote => q{}); # mandatory
$self->set_record(name => q{}); # mandatory
lib/ACME/QuoteDB.pm view on Meta::CPAN
# Attr
# Quote
# Catg
# QuoteCatg
pod tests incorrectly state, Attr, Quote and Catg are subroutines, well they
are,... (as aliases) but act on a different object.
TODO: explore the above (is this a bug, if so, who's?, version effected,
create use case, etc)
lib/ACME/QuoteDB.pm view on Meta::CPAN
(Since the local mode is sqlite3, the file doesn't even need to exist, just
needs read/write access to the path on the filesystem)
Set the environmental variable:
$ENV{ACME_QUOTEDB_PATH} (untested on windows)
(this has to be set before trying a database load and also (everytime before
using this module, obviouly)
Something such as:
lib/ACME/QuoteDB.pm view on Meta::CPAN
=item 1 add a dump backup to csv
a backup mechanism for your db to a regular text csv file.
=item 1 clean up tests 'skip if module X' not installed
(one of sqlite3 or mysql is required). currently dies if DBD::SQLite not
installed
=item 1 support multiple categories from LoadDB
lib/ACME/QuoteDB.pm view on Meta::CPAN
Q: Why did you put it in the ACME namespace?
A: Seemed appropriate. I emailed modules@cpan.org and didn't get a
different reaction.
Q: Why did you write this?
A: At a past company, a team I worked on a project with had a test suite,
in which at the completion of successful tests (100%), a 'wisenheimer'
success message would be printed. (Like a quote or joke or the like)
(Interestingly, it added a 'fun' factor to testing, not that one is needed
of course ;). It was hard to justify spending company time to find and
add decent content to the hand rolled process, this would have helped.
Q: Don't you have anything better to do, like some non-trivial work?
A: Yup
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
my $self = $class->new(@_);
my $who = $self->_caller;
#-------------------------------------------------------------
# all of the following checks should be included in import(),
# to allow "eval 'require Module::Install; 1' to test
# installation of Module::Install. (RT #51267)
#-------------------------------------------------------------
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AE/AdHoc.pm view on Meta::CPAN
use warnings;
use strict;
=head1 NAME
AE::AdHoc - Simplified interface for tests/examples of AnyEvent-related code.
=head1 NON-DESCRIPTION
This module is NOT for introducing oneself to AnyEvent, despite the mention of
"simplified". More over, it REQUIRES knowledge of what a conditional variable,
lib/AE/AdHoc.pm view on Meta::CPAN
Suppose we have a subroutine named C<do_stuff( @args, $subref )>
that is designed to run under AnyEvent. As do_stuff may have to wait for
some external events to happen, it does not return a value right away.
Instead, it will call C<$subref-E<gt>( $results )> when stuff is done.
Now we need to test do_stuff, so we set up an event loop. We also need a timer,
because a test that runs forever is annoying. So the script goes like this:
use AnyEvent;
# set up event loop
my $cv = AnyEvent->condvar;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AFS/Command/VOS.pm view on Meta::CPAN
next if /Getting volume listing/;
#
# This code parses the volume header information. If we match
# this line, then we go after the information we expect to be
# right after it. We also test for this first, because we
# might very well have several of these chunks of data for RO
# volumes.
#
if ( /^\*{4}/ ) {
lib/AFS/Command/VOS.pm view on Meta::CPAN
#
# Next we are looking for the number of sites, and then we'll
# suck that data in as well.
#
# NOTE: Because there is more interesting data after the
# locations, we fall through to the next test once we are done
# parsing them.
#
if ( /^\s+number of sites ->\s+(\d+)/ ) {
while ( defined($_ = $self->{handle}->getline()) ) {
view all matches for this distribution
view release on metacpan or search on metacpan
src/Monitor.pm view on Meta::CPAN
afsmonitor
rxdebug
udebug
cmdebug
scout
xstat_fs_test
xstat_cm_test
);
# Other items we are prepared to export if requested
@EXPORT_OK = qw(
src/Monitor.pm view on Meta::CPAN
my $result = do_scout(\%subreq);
return $result;
}
}
sub xstat_fs_test {
my %subreq;
return eval {
while (@_) {
$_ = shift;
src/Monitor.pm view on Meta::CPAN
}
else {
$subreq{$_} = 1;
}
}
my $result = do_xstat_fs_test(\%subreq);
return $result;
}
}
sub xstat_cm_test {
my %subreq;
return eval {
while (@_) {
$_ = shift;
src/Monitor.pm view on Meta::CPAN
}
else {
$subreq{$_} = 1;
}
}
my $result = do_xstat_cm_test(\%subreq);
return $result;
}
}
view all matches for this distribution
view release on metacpan or search on metacpan
t/lib/Test/RRA.pm view on Meta::CPAN
# Helper functions for test programs written in Perl.
#
# This module provides a collection of helper functions used by test programs
# written in Perl. This is a general collection of functions that can be used
# by both C packages with Automake and by stand-alone Perl modules. See
# Test::RRA::Automake for additional functions specifically for C Automake
# distributions.
#
t/lib/Test/RRA.pm view on Meta::CPAN
# two digits for the minor version, including a leading zero if necessary,
# so that it will sort properly.
$VERSION = '5.05';
}
# Skip this test unless author tests are requested. Takes a short description
# of what tests this script would perform, which is used in the skip message.
# Calls plan skip_all, which will terminate the program.
#
# $description - Short description of the tests
#
# Returns: undef
sub skip_unless_author {
my ($description) = @_;
if (!$ENV{AUTHOR_TESTING}) {
plan skip_all => "$description only run for author";
}
return;
}
# Skip this test unless doing automated testing or release testing. This is
# used for tests that should be run by CPAN smoke testing or during releases,
# but not for manual installs by end users. Takes a short description of what
# tests this script would perform, which is used in the skip message. Calls
# plan skip_all, which will terminate the program.
#
# $description - Short description of the tests
#
# Returns: undef
sub skip_unless_automated {
my ($description) = @_;
for my $env (qw(AUTOMATED_TESTING RELEASE_TESTING AUTHOR_TESTING)) {
t/lib/Test/RRA.pm view on Meta::CPAN
}
plan skip_all => "$description normally skipped";
return;
}
# Attempt to load a module and skip the test if the module could not be
# loaded. If the module could be loaded, call its import function manually.
# If the module could not be loaded, calls plan skip_all, which will terminate
# the program.
#
# The special logic here is based on Test::More and is required to get the
t/lib/Test/RRA.pm view on Meta::CPAN
};
$error = $@;
$sigdie = $SIG{__DIE__} || undef;
}
# If the use failed for any reason, skip the test.
if (!$result || $error) {
my $name = length($version) > 0 ? "$module $version" : $module;
plan skip_all => "$name required for test";
}
# If the module set $SIG{__DIE__}, we cleared that via local. Restore it.
## no critic (Variables::RequireLocalizedPunctuationVars)
if (defined($sigdie)) {
t/lib/Test/RRA.pm view on Meta::CPAN
Allbery Allbery's DESC bareword sublicense MERCHANTABILITY NONINFRINGEMENT
rra-c-util
=head1 NAME
Test::RRA - Support functions for Perl tests
=head1 SYNOPSIS
use Test::RRA
qw(skip_unless_author skip_unless_automated use_prereq);
# Skip this test unless author tests are requested.
skip_unless_author('Coding style tests');
# Skip this test unless doing automated or release testing.
skip_unless_automated('POD syntax tests');
# Load modules, skipping the test if they're not available.
use_prereq('Perl6::Slurp', 'slurp');
use_prereq('Test::Script::Run', '0.04');
=head1 DESCRIPTION
This module collects utility functions that are useful for Perl test
scripts. It assumes Russ Allbery's Perl module layout and test
conventions and will only be useful for other people if they use the
same conventions.
=head1 FUNCTIONS
t/lib/Test/RRA.pm view on Meta::CPAN
=over 4
=item skip_unless_author(DESC)
Checks whether AUTHOR_TESTING is set in the environment and skips the
whole test (by calling C<plan skip_all> from Test::More) if it is not.
DESC is a description of the tests being skipped. A space and C<only run
for author> will be appended to it and used as the skip reason.
=item skip_unless_automated(DESC)
Checks whether AUTHOR_TESTING, AUTOMATED_TESTING, or RELEASE_TESTING are
set in the environment and skips the whole test (by calling C<plan
skip_all> from Test::More) if they are not. This should be used by tests
that should not run during end-user installs of the module, but which
should run as part of CPAN smoke testing and release testing.
DESC is a description of the tests being skipped. A space and C<normally
skipped> will be appended to it and used as the skip reason.
=item use_prereq(MODULE[, VERSION][, IMPORT ...])
Attempts to load MODULE with the given VERSION and import arguments. If
this fails for any reason, the test will be skipped (by calling C<plan
skip_all> from Test::More) with a skip reason saying that MODULE is
required for the test.
VERSION will be passed to C<use> as a version bareword if it looks like a
version number. The remaining IMPORT arguments will be passed as the
value of an array.
t/lib/Test/RRA.pm view on Meta::CPAN
Test::More(3), Test::RRA::Automake(3), Test::RRA::Config(3)
This module is maintained in the rra-c-util package. The current version
is available from L<http://www.eyrie.org/~eagle/software/rra-c-util/>.
The functions to control when tests are run use environment variables
defined by the L<Lancaster
Consensus|https://github.com/Perl-Toolchain-Gang/toolchain-site/blob/master/lancaster-consensus.md>.
=cut
view all matches for this distribution
view release on metacpan or search on metacpan
src/inc/Test/Builder.pm view on Meta::CPAN
$self->no_plan;
}
elsif( $cmd eq 'skip_all' ) {
return $self->skip_all($arg);
}
elsif( $cmd eq 'tests' ) {
if( $arg ) {
return $self->expected_tests($arg);
}
elsif( !defined $arg ) {
die "Got an undefined number of tests. Looks like you tried to ".
"say how many tests you plan to run but made a mistake.\n";
}
elsif( !$arg ) {
die "You said to run 0 tests! You've got to run something.\n";
}
}
else {
require Carp;
my @args = grep { defined } ($cmd, $arg);
src/inc/Test/Builder.pm view on Meta::CPAN
return 1;
}
my $Expected_Tests = 0;
sub expected_tests {
my($self, $max) = @_;
if( defined $max ) {
$Expected_Tests = $max;
$Have_Plan = 1;
src/inc/Test/Builder.pm view on Meta::CPAN
exit(0);
}
sub ok {
my($self, $test, $name) = @_;
# $test might contain an object which we don't want to accidentally
# store, so we turn it into a boolean.
$test = $test ? 1 : 0;
unless( $Have_Plan ) {
require Carp;
Carp::croak("You tried to run a test without a plan! Gotta have a plan.");
}
lock $Curr_Test;
$Curr_Test++;
$self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;
You named your test '$name'. You shouldn't use numbers for your test names.
Very confusing.
ERR
my($pack, $file, $line) = $self->caller;
src/inc/Test/Builder.pm view on Meta::CPAN
my $out;
my $result = {};
share($result);
unless( $test ) {
$out .= "not ";
@$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 );
}
else {
@$result{ 'ok', 'actual_ok' } = ( 1, $test );
}
$out .= "ok";
$out .= " $Curr_Test" if $self->use_numbers;
src/inc/Test/Builder.pm view on Meta::CPAN
$Test_Results[$Curr_Test-1] = $result;
$out .= "\n";
$self->_print($out);
unless( $test ) {
my $msg = $todo ? "Failed (TODO)" : "Failed";
$self->diag(" $msg test ($file at line $line)\n");
}
return $test ? 1 : 0;
}
sub is_eq {
my($self, $got, $expect, $name) = @_;
local $Level = $Level + 1;
if( !defined $got || !defined $expect ) {
# undef only matches undef and nothing else
my $test = !defined $got && !defined $expect;
$self->ok($test, $name);
$self->_is_diag($got, 'eq', $expect) unless $test;
return $test;
}
return $self->cmp_ok($got, 'eq', $expect, $name);
}
src/inc/Test/Builder.pm view on Meta::CPAN
my($self, $got, $expect, $name) = @_;
local $Level = $Level + 1;
if( !defined $got || !defined $expect ) {
# undef only matches undef and nothing else
my $test = !defined $got && !defined $expect;
$self->ok($test, $name);
$self->_is_diag($got, '==', $expect) unless $test;
return $test;
}
return $self->cmp_ok($got, '==', $expect, $name);
}
src/inc/Test/Builder.pm view on Meta::CPAN
my($self, $got, $dont_expect, $name) = @_;
local $Level = $Level + 1;
if( !defined $got || !defined $dont_expect ) {
# undef only matches undef and nothing else
my $test = defined $got || defined $dont_expect;
$self->ok($test, $name);
$self->_cmp_diag('ne', $got, $dont_expect) unless $test;
return $test;
}
return $self->cmp_ok($got, 'ne', $dont_expect, $name);
}
src/inc/Test/Builder.pm view on Meta::CPAN
my($self, $got, $dont_expect, $name) = @_;
local $Level = $Level + 1;
if( !defined $got || !defined $dont_expect ) {
# undef only matches undef and nothing else
my $test = defined $got || defined $dont_expect;
$self->ok($test, $name);
$self->_cmp_diag('!=', $got, $dont_expect) unless $test;
return $test;
}
return $self->cmp_ok($got, '!=', $dont_expect, $name);
}
src/inc/Test/Builder.pm view on Meta::CPAN
return $ok;
}
{
local $^W = 0;
my $test = $this =~ /$usable_regex/ ? 1 : 0;
$test = !$test if $cmp eq '!~';
$ok = $self->ok( $test, $name );
}
unless( $ok ) {
$this = defined $this ? "'$this'" : 'undef';
my $match = $cmp eq '=~' ? "doesn't match" : "matches";
src/inc/Test/Builder.pm view on Meta::CPAN
sub cmp_ok {
my($self, $got, $type, $expect, $name) = @_;
my $test;
{
local $^W = 0;
local($@,$!); # don't interfere with $@
# eval() sometimes resets $!
$test = eval "\$got $type \$expect";
}
local $Level = $Level + 1;
my $ok = $self->ok($test, $name);
unless( $ok ) {
if( $type =~ /^(eq|==)$/ ) {
$self->_is_diag($got, $type, $expect);
}
src/inc/Test/Builder.pm view on Meta::CPAN
my($self, $why) = @_;
$why ||= '';
unless( $Have_Plan ) {
require Carp;
Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
}
lock($Curr_Test);
$Curr_Test++;
src/inc/Test/Builder.pm view on Meta::CPAN
my($self, $why) = @_;
$why ||= '';
unless( $Have_Plan ) {
require Carp;
Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
}
lock($Curr_Test);
$Curr_Test++;
src/inc/Test/Builder.pm view on Meta::CPAN
sub _print {
my($self, @msgs) = @_;
# Prevent printing headers when only compiling. Mostly for when
# tests are deparsed with B::Deparse
return if $^C;
local($\, $", $,) = (undef, ' ', '');
my $fh = $self->output;
src/inc/Test/Builder.pm view on Meta::CPAN
my $fh;
unless( UNIVERSAL::isa($file_or_fh, 'GLOB') ) {
$fh = do { local *FH };
open $fh, ">$file_or_fh" or
die "Can't open test output log $file_or_fh: $!";
}
else {
$fh = $file_or_fh;
}
return $fh;
}
unless( $^C ) {
# We dup STDOUT and STDERR so people can change them in their
# test suites while still getting normal test output.
open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!";
open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!";
# Set everything to unbuffered else plain prints to STDOUT will
# come out in the wrong order from our own prints.
src/inc/Test/Builder.pm view on Meta::CPAN
select $old_fh;
}
sub current_test {
my($self, $num) = @_;
lock($Curr_Test);
if( defined $num ) {
unless( $Have_Plan ) {
require Carp;
Carp::croak("Can't change the current test number without a plan!");
}
$Curr_Test = $num;
if( $num > @Test_Results ) {
my $start = @Test_Results ? $#Test_Results + 1 : 0;
for ($start..$num-1) {
my %result;
share(%result);
%result = ( ok => 1,
actual_ok => undef,
reason => 'incrementing test number',
type => 'unknown',
name => undef
);
$Test_Results[$_] = \%result;
}
src/inc/Test/Builder.pm view on Meta::CPAN
my @caller = CORE::caller($self->level + $height + 1);
return wantarray ? @caller : $caller[0];
}
sub _sanity_check {
_whoa($Curr_Test < 0, 'Says here you ran a negative number of tests!');
_whoa(!$Have_Plan and $Curr_Test,
'Somehow your tests ran without a plan!');
_whoa($Curr_Test != @Test_Results,
'Somehow you got a different number of results than tests ran!');
}
sub _whoa {
my($check, $desc) = @_;
src/inc/Test/Builder.pm view on Meta::CPAN
my $num_failed = grep !$_->{'ok'}, @Test_Results[0..$Expected_Tests-1];
$num_failed += abs($Expected_Tests - @Test_Results);
if( $Curr_Test < $Expected_Tests ) {
$self->diag(<<"FAIL");
Looks like you planned $Expected_Tests tests but only ran $Curr_Test.
FAIL
}
elsif( $Curr_Test > $Expected_Tests ) {
my $num_extra = $Curr_Test - $Expected_Tests;
$self->diag(<<"FAIL");
Looks like you planned $Expected_Tests tests but ran $num_extra extra.
FAIL
}
elsif ( $num_failed ) {
$self->diag(<<"FAIL");
Looks like you failed $num_failed tests of $Expected_Tests.
FAIL
}
if( $Test_Died ) {
$self->diag(<<"FAIL");
Looks like your test died just after $Curr_Test.
FAIL
_my_exit( 255 ) && return;
}
src/inc/Test/Builder.pm view on Meta::CPAN
elsif ( $Skip_All ) {
_my_exit( 0 ) && return;
}
elsif ( $Test_Died ) {
$self->diag(<<'FAIL');
Looks like your test died before it could output anything.
FAIL
}
else {
$self->diag("No tests run!\n");
_my_exit( 255 ) && return;
}
}
END {
view all matches for this distribution
view release on metacpan or search on metacpan
test_minimal.pl view on Meta::CPAN
# Teste
print " relu(5) = " . relu(5) . " (esperado: 5)\n";
print " relu(-3) = " . relu(-3) . " (esperado: 0)\n";
print " tanh(0) = " . tanh_simple(0) . " (esperado: ~0)\n";
print "\n2. Agora testando o módulo...\n";
# Tente carregar o módulo
eval {
# Adiciona lib ao @INC
unshift @INC, 'lib';
require AI::ActivationFunctions;
print " â Módulo carregado\n";
# Testa uma função
my $test = AI::ActivationFunctions::relu(10);
print " â relu(10) = $test\n";
1;
} or do {
print " â Erro: $@\n";
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AI/Calibrate.pm view on Meta::CPAN
=head1 SYNOPSIS
use AI::Calibrate ':all';
... train a classifier ...
... test classifier on $points ...
$calibrated = calibrate($points);
=head1 DESCRIPTION
Classifiers usually return some sort of an instance score with their
lib/AI/Calibrate.pm view on Meta::CPAN
Support vector machines have a similar problem. Both classifier types should
be calibrated before their scores are used as probability estimates.
This module calibrates classifier scores using a method called the Pool
Adjacent Violators (PAV) algorithm. After you train a classifier, you take a
(usually separate) set of test instances and run them through the classifier,
collecting the scores assigned to each. You then supply this set of instances
to the calibrate function defined here, and it will return a set of ranges
mapping from a score range to a probability estimate.
For example, assume you have the following set of instance results from your
lib/AI/Calibrate.pm view on Meta::CPAN
.7 > SCORE >= .45 prob = 2/3
.45 > SCORE >= .3 prob = 3/4
.2 > SCORE >= .7 prob = 3/4
.02 > SCORE prob = 0
For a realistic example of classifier calibration, see the test file
t/AI-Calibrate-NB.t, which uses the AI::NaiveBayes1 module to train a Naive
Bayes classifier then calibrates it using this module.
=cut
view all matches for this distribution
view release on metacpan or search on metacpan
#!/usr/bin/perl
# This script is a fairly simple demonstration of how AI::Categorizer
# can be used. There are lots of other less-simple demonstrations
# (actually, they're doing much simpler things, but are probably
# harder to follow) in the tests in the t/ subdirectory. The
# eg/categorizer script can also be a good example if you're willing
# to figure out a bit how it works.
#
# This script reads a training corpus from a directory of plain-text
# documents, trains a Naive Bayes categorizer on it, then tests the
# categorizer on a set of test documents.
use strict;
use AI::Categorizer;
use AI::Categorizer::Collection::Files;
use AI::Categorizer::Learner::NaiveBayes;
unless @ARGV == 1;
my $corpus = shift;
my $training = File::Spec->catfile( $corpus, 'training' );
my $test = File::Spec->catfile( $corpus, 'test' );
my $cats = File::Spec->catfile( $corpus, 'cats.txt' );
my $stopwords = File::Spec->catfile( $corpus, 'stopwords' );
my %params;
if (-e $stopwords) {
# type (any Collection subclass). Or you could create each Document
# object manually. Or you could let the KnowledgeSet create the
# Collection objects for you.
$training = AI::Categorizer::Collection::Files->new( path => $training, %params );
$test = AI::Categorizer::Collection::Files->new( path => $test, %params );
# We turn on verbose mode so you can watch the progress of loading &
# training. This looks nicer if you have Time::Progress installed!
print "Loading training set\n";
print "Training categorizer\n";
my $l = AI::Categorizer::Learner::NaiveBayes->new( verbose => 1 );
$l->train( knowledge_set => $k );
print "Categorizing test set\n";
my $experiment = $l->categorize_collection( collection => $test );
print $experiment->stats_table;
# If you want to get at the specific assigned categories for a
my $doc = AI::Categorizer::Document->new
( content => "Hello, I am a pretty generic document with not much to say." );
my $h = $l->categorize( $doc );
print ("For test document:\n",
" Best category = ", $h->best_category, "\n",
" All categories = ", join(', ', $h->categories), "\n");
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AI/Chat.pm view on Meta::CPAN
creating content that is immediately engaging with a
lighthearted, storytelling style".
=item debug
Used for testing. If set to any true value, the prompt method
will return details of the error encountered instead of C<undef>
=back
=head2 prompt
view all matches for this distribution
view release on metacpan or search on metacpan
Instance/Instance.pm view on Meta::CPAN
=head1 DESCRIPTION
This class is just a simple Perl wrapper around a C struct embodying a
single training instance. Its purpose is to reduce memory usage. In
a "typical" training set with about 1000 instances, memory usage can
be reduced by about a factor of 5 (from 43.7M to 8.2M in my test
program).
A fairly tight loop is also implemented that helps speed up the
C<train()> AI::DecisionTree method by about a constant factor of 4.
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AI/Embedding.pm view on Meta::CPAN
# TODO:
# Make 'headers' use $header{$self->{'api'}}
# Currently hard coded to OpenAI
# Added purely for testing - IGNORE!
sub _test {
my $self = shift;
# return $self->{'api'};
return $header{$self->{'api'}};
}
lib/AI/Embedding.pm view on Meta::CPAN
return $response if defined $verbose;
return undef;
}
# Return Test Embedding
sub test_embedding {
my ($self, $text, $dimension) = @_;
$self->{'error'} = '';
$dimension = 1536 unless defined $dimension;
lib/AI/Embedding.pm view on Meta::CPAN
api => 'OpenAI',
key => 'your-api-key'
);
my $csv_embedding = $embedding->embedding('Some sample text');
my $test_embedding = $embedding->test_embedding('Some sample text');
my @raw_embedding = $embedding->raw_embedding('Some sample text');
my $cmp = $embedding->comparator($csv_embedding2);
my $similarity = $cmp->($csv_embedding1);
lib/AI/Embedding.pm view on Meta::CPAN
It is not normally necessary to use this method as the Embedding will almost always be used as a single homogeneous unit.
If the method call fails it sets the L</"error"> message and returns C<undef>. If the optional C<verbose> parameter is true, the complete L<HTTP::Tiny> response object is also returned to aid with debugging issues when using this module.
=head2 test_embedding
my $test_embedding = $embedding->test_embedding('Some text passage', $dimensions);
Used for testing code without making a chargeable call to the API.
Provides a CSV string of the same size and format as L<embedding> but with meaningless random data.
Returns a random embedding. Both parameters are optional. If a text string is provided, the returned embedding will always be the same random embedding otherwise it will be random and different every time. The C<dimension> parameter controls the n...
lib/AI/Embedding.pm view on Meta::CPAN
=head1 ACKNOWLEDGEMENTS
Thanks to the help and support provided by members of Perl Monks L<https://perlmonks.org/>.
Especially L<Ken Cotterill (KCOTT)|https://metacpan.org/author/KCOTT> for assistance with unit tests and L<Hugo van der Sanden (HVDS)|https://metacpan.org/author/HVDS> for suggesting the current C<comparator> implementaion.
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2023 by Ian Boddison.
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AI/Evolve/Befunge.pm view on Meta::CPAN
probably wondering, once you get them, what do you do with them?
Well, once you get some critters that perform well, you can always
write up a production program which creates the Physics and Critter
objects and runs them directly, over and over and over to your heart's
content. After you have reached your goal, you need not continue to
evolve or test new critters.
=head1 CONFIG FILE
You can find an example config file ("example.conf") in the source
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install/Makefile.pm view on Meta::CPAN
my @c = caller();
if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
}
# In automated testing, always use defaults
if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) {
local $ENV{PERL_MM_USE_DEFAULT} = 1;
goto &ExtUtils::MakeMaker::prompt;
} else {
goto &ExtUtils::MakeMaker::prompt;
inc/Module/Install/Makefile.pm view on Meta::CPAN
sub inc {
my $self = shift;
$self->makemaker_args( INC => shift );
}
my %test_dir = ();
sub _wanted_t {
/\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1;
}
sub tests_recursive {
my $self = shift;
if ( $self->tests ) {
die "tests_recursive will not work if tests are already defined";
}
my $dir = shift || 't';
unless ( -d $dir ) {
die "tests_recursive dir '$dir' does not exist";
}
%test_dir = ();
require File::Find;
File::Find::find( \&_wanted_t, $dir );
$self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
}
sub write {
my $self = shift;
die "&Makefile->write() takes no arguments\n" if @_;
inc/Module/Install/Makefile.pm view on Meta::CPAN
my $args = $self->makemaker_args;
$args->{DISTNAME} = $self->name;
$args->{NAME} = $self->module_name || $self->name;
$args->{VERSION} = $self->version;
$args->{NAME} =~ s/-/::/g;
if ( $self->tests ) {
$args->{test} = { TESTS => $self->tests };
}
if ( $] >= 5.005 ) {
$args->{ABSTRACT} = $self->abstract;
$args->{AUTHOR} = $self->author;
}
inc/Module/Install/Makefile.pm view on Meta::CPAN
local *MAKEFILE;
open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
my $makefile = do { local $/; <MAKEFILE> };
close MAKEFILE or die $!;
$makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
$makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
$makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
$makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
$makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
view all matches for this distribution