view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) { die <<"END_DIE" }
Please invoke ${\__PACKAGE__} with:
inc/Module/Install.pm view on Meta::CPAN
# If the modification time is only slightly in the future,
# sleep briefly to remove the problem.
my $a = $s - time;
if ( $a > 0 and $a < 5 ) { sleep 5 }
# Too far in the future, throw an error.
my $t = time;
if ( $s > $t ) { die <<"END_DIE" }
Your installer $0 has a modification time in the future ($s > $t).
inc/Module/Install.pm view on Meta::CPAN
# I'm still wondering if we should slurp Makefile.PL to
# get some context or not ...
my ($package, $file, $line) = caller;
die <<"EOT";
Unknown function is found at $file line $line.
Execution of $file aborted due to runtime errors.
If you're a contributor to a project, you may need to install
some Module::Install extensions from CPAN (or other repository).
If you're a user of a module, please contact the author.
EOT
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) { die <<"END_DIE" }
Please invoke ${\__PACKAGE__} with:
view all matches for this distribution
view release on metacpan or search on metacpan
t/00-report-prereqs.t view on Meta::CPAN
$static_prereqs
);
# Add dynamic prereqs to the included modules list (if we can)
my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml';
my $cpan_meta_error;
if ( $source && $HAS_CPAN_META
&& (my $meta = eval { CPAN::Meta->load_file($source) } )
) {
$full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs);
}
else {
$cpan_meta_error = $@; # capture error from CPAN::Meta->load_file($source)
$source = 'static metadata';
}
my @full_reports;
my @dep_errors;
my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs;
# Add static includes into a fake section
for my $mod (@include) {
$req_hash->{other}{modules}{$mod} = 0;
t/00-report-prereqs.t view on Meta::CPAN
$have = "undef" unless defined $have;
push @reports, [$mod, $want, $have];
if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) {
if ( $have !~ /\A$lax_version_re\z/ ) {
push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)";
}
elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) {
push @dep_errors, "$mod version '$have' is not in required range '$want'";
}
}
}
else {
push @reports, [$mod, $want, "missing"];
if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) {
push @dep_errors, "$mod is not installed ($req_string)";
}
}
}
if ( @reports ) {
t/00-report-prereqs.t view on Meta::CPAN
if ( @full_reports ) {
diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports;
}
if ( $cpan_meta_error || @dep_errors ) {
diag "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n";
}
if ( $cpan_meta_error ) {
my ($orig_source) = grep { -f } 'MYMETA.json', 'MYMETA.yml';
diag "\nCPAN::Meta->load_file('$orig_source') failed with: $cpan_meta_error\n";
}
if ( @dep_errors ) {
diag join("\n",
"\nThe following REQUIRED prerequisites were not satisfied:\n",
@dep_errors,
"\n"
);
}
pass('Reported prereqs');
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/ReturnValue.pm view on Meta::CPAN
sub in_file {
my ($self,$file)=@_;
eval { $self->waste_some_cycles($file) };
if ($@) {
push (@{$self->failed},{file=>$file,error=>$@});
}
}
"let's return a strange value from Riga";
lib/Acme/ReturnValue.pm view on Meta::CPAN
C<waste_some_cycles> will also put this data structure into
L<interesting> or L<boring>.
You might want to pack calls to C<waste_some_cycles> into an C<eval>
because PPI dies on parse errors.
=head4 _is_code
Stolen directly from Perl::Critic::Policy::Modules::RequireEndWithOne
as suggested by Chris Dolan.
view all matches for this distribution
view release on metacpan or search on metacpan
CONTRIBUTING view on Meta::CPAN
* Translation
Translations of documentation would be welcome.
For translations of error messages and other strings embedded in the
code, check with me first. Sometimes the English strings may not in
a stable state, so it would be a waste of time translating them.
Coding Style
I tend to write using something approximating the Allman style, using
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/SList/Utilities.pm view on Meta::CPAN
my ($path) = @_;
my $dir = '';
for my $elem (split m{[/\\]}xms, $path) {
if ($elem =~ m{\A \s* \z}xms) {
$! = 33; # Domain error
return;
}
$dir .= $elem.'/';
if ($elem ne '..' and !-d $dir) {
mkdir $dir or return;
view all matches for this distribution
view release on metacpan or search on metacpan
t/000-report-versions.t view on Meta::CPAN
# Create an object from a file
sub read {
my $class = ref $_[0] ? ref shift : shift;
# Check the file
my $file = shift or return $class->_error( 'You did not specify a file name' );
return $class->_error( "File '$file' does not exist" ) unless -e $file;
return $class->_error( "'$file' is a directory, not a file" ) unless -f _;
return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _;
# Slurp in the file
local $/ = undef;
local *CFG;
unless ( open(CFG, $file) ) {
return $class->_error("Failed to open file '$file': $!");
}
my $contents = <CFG>;
unless ( close(CFG) ) {
return $class->_error("Failed to close file '$file': $!");
}
$class->read_string( $contents );
}
t/000-report-versions.t view on Meta::CPAN
sub read_string {
my $class = ref $_[0] ? ref shift : shift;
my $self = bless [], $class;
my $string = $_[0];
unless ( defined $string ) {
return $self->_error("Did not provide a string to load");
}
# Byte order marks
# NOTE: Keeping this here to educate maintainers
# my %BOM = (
t/000-report-versions.t view on Meta::CPAN
# "\377\376" => 'UTF-16LE',
# "\377\376\0\0" => 'UTF-32LE'
# "\0\0\376\377" => 'UTF-32BE',
# );
if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {
return $self->_error("Stream has a non UTF-8 BOM");
} else {
# Strip UTF-8 bom if found, we'll just ignore it
$string =~ s/^\357\273\277//;
}
t/000-report-versions.t view on Meta::CPAN
utf8::decode($string) if HAVE_UTF8;
# Check for some special cases
return $self unless length $string;
unless ( $string =~ /[\012\015]+\z/ ) {
return $self->_error("Stream does not end with newline character");
}
# Split the file into lines
my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
split /(?:\015{1,2}\012|\015|\012)/, $string;
t/000-report-versions.t view on Meta::CPAN
}
return 1;
}
# Set error
sub _error {
$YAML::Tiny::errstr = $_[1];
undef;
}
# Retrieve error
sub errstr {
$YAML::Tiny::errstr;
}
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/AutoInstall.pm view on Meta::CPAN
return
unless system( 'sudo', $^X, $0, "--config=$config",
"--installdeps=$missing" );
print << ".";
*** The 'sudo' command exited with error! Resuming...
.
}
return _prompt(
qq(
view all matches for this distribution
view release on metacpan or search on metacpan
t/00-report-prereqs.t view on Meta::CPAN
$static_prereqs
);
# Add dynamic prereqs to the included modules list (if we can)
my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml';
my $cpan_meta_error;
if ( $source && $HAS_CPAN_META
&& (my $meta = eval { CPAN::Meta->load_file($source) } )
) {
$full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs);
}
else {
$cpan_meta_error = $@; # capture error from CPAN::Meta->load_file($source)
$source = 'static metadata';
}
my @full_reports;
my @dep_errors;
my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs;
# Add static includes into a fake section
for my $mod (@include) {
$req_hash->{other}{modules}{$mod} = 0;
t/00-report-prereqs.t view on Meta::CPAN
$have = "undef" unless defined $have;
push @reports, [$mod, $want, $have];
if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) {
if ( $have !~ /\A$lax_version_re\z/ ) {
push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)";
}
elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) {
push @dep_errors, "$mod version '$have' is not in required range '$want'";
}
}
}
else {
push @reports, [$mod, $want, "missing"];
if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) {
push @dep_errors, "$mod is not installed ($req_string)";
}
}
}
if ( @reports ) {
t/00-report-prereqs.t view on Meta::CPAN
if ( @full_reports ) {
diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports;
}
if ( $cpan_meta_error || @dep_errors ) {
diag "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n";
}
if ( $cpan_meta_error ) {
my ($orig_source) = grep { -f } 'MYMETA.json', 'MYMETA.yml';
diag "\nCPAN::Meta->load_file('$orig_source') failed with: $cpan_meta_error\n";
}
if ( @dep_errors ) {
diag join("\n",
"\nThe following REQUIRED prerequisites were not satisfied:\n",
@dep_errors,
"\n"
);
}
pass('Reported prereqs');
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/Siteswap.pm view on Meta::CPAN
my $pattern = $self->{pattern};
my @throws;
eval { @throws = _pattern_to_throws($pattern) };
if ($@) {
$self->{error} = $@;
return 0;
}
# Check that the numbers / throws == # of balls
my $total = 0;
lib/Acme/Siteswap.pm view on Meta::CPAN
}
}
my $avg = $total / @throws;
unless ($avg == $self->{balls}) {
$self->{error} = "sum of throws / # of throws does not equal # of balls!";
return 0;
}
return $self->_check_timing(@throws);
}
lib/Acme/Siteswap.pm view on Meta::CPAN
}
}
for my $i (0 .. $#throws) {
if ($feeds[$i] != $throw_map[$i]) {
$self->{error} = "Multiple throws would land at the same time.";
return 0;
}
}
return 1;
}
=head2 error
Returns an error message or empty string.
=cut
sub error { $_[0]->{error} || '' }
sub _pattern_to_throws {
my $pattern = shift;
my @throw_set = ();
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) {
die <<"END_DIE";
Please invoke ${\__PACKAGE__} with:
view all matches for this distribution
view release on metacpan or search on metacpan
local/lib/perl5/Future.pm view on Meta::CPAN
occurred. Following this is a list of details about that kind of failure,
whose exact arrangement or structure are determined by the failure category.
For example, L<IO::Async> and L<Net::Async::HTTP> use this convention to
indicate at what stage a given HTTP request has failed:
->fail( $message, http => ... ) # an HTTP-level error during protocol
->fail( $message, connect => ... ) # a TCP-level failure to connect a
# socket
->fail( $message, resolve => ... ) # a resolver (likely DNS) failure
# to resolve a hostname
local/lib/perl5/Future.pm view on Meta::CPAN
$future->cancel
Requests that the future be cancelled, immediately marking it as ready. This
will invoke all of the code blocks registered by C<on_cancel>, in the reverse
order. When called on a convergent future, all its component futures are also
cancelled. It is not an error to attempt to cancel a future that is already
complete or cancelled; it simply has no effect.
Returns the C<$future>.
=cut
local/lib/perl5/Future.pm view on Meta::CPAN
had completed. If the code block throws an exception instead of returning a
value, the sequence future will fail with that exception as its message and no
further values.
As it is always a mistake to call these sequencing methods in void context and lose the
reference to the returned future (because exception/error handling would be
silently dropped), this method warns in void context.
=cut
sub _sequence
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/Spinodal/Utils.pm view on Meta::CPAN
=head2 _check_number
Checks to see if a given scalar is a valid number.
croaks on error.
returns the number asked to check in successful scenarios.
=cut
view all matches for this distribution
view release on metacpan or search on metacpan
(named Number) via method calls.
BTW, when 5 arguments are detected, the first one is a Number object - with the
four IV args that are given explicitly being tacked on behind it.
I'm pretty weak on understanding the finer points of stack manipulation.
I can usually get by via trial-and-error - which is what I've done here.
But if someone can pass on some words of explanation then maybe enough
pennies will drop as to allow me to better comprehend the docs on this.
Is it possible to create a simpler demo of this behaviour - eg by not having
to involve the extra package ("package Number;") in the test scripts ?
view all matches for this distribution
view release on metacpan or search on metacpan
use vars '@ISA';
@ISA = 'Acme::Steganography::Image::Png::RGB::556';
# Raw data in the low bits of a colour image, with Floyd-Steinberg dithering
# to spread the errors around. Share and enjoy, share and enjoy.
sub make_image {
my $self = shift;
# We get a copy to play with
my $raw = $self->raw;
my @rgb = unpack 'x' . ($offset * 3) . 'C3', $raw;
foreach (0..2) {
$rgb[$_] += $this_row->[$x + 1][$_] || 0;
# And this is most definitely an empirical hack, as there seem to be
# big systematic problems if the errors drive things outside the range
# 0-255
if ($rgb[$_] > 255) {
$rgb[$_] = 255;
} elsif ($rgb[$_] < 0) {
$rgb[$_] = 0;
$rgb[0] = ($rgb[0] & 0xE0) | $datum >> 11;
$rgb[1] = ($rgb[1] & 0xE0) | (($datum >> 6) & 0x1F);
$rgb[2] = ($rgb[2] & 0xC0) | ($datum & 0x3F);
substr($raw, $offset * 3, 3, pack 'C3', @rgb);
# Calculate the error and dither it
# 7 x
# 1 5 3
# Note that the backwards dithering is why we need the +1 on the co-ords.
foreach (0..2) {
my $error = ($rgb_ideal[$_] - $rgb[$_]) / 16;
$this_row->[$x][$_] += $error * 7;
$next_row->[$x + 2][$_] += $error * 3;
$next_row->[$x + 1][$_] += $error * 5;
$next_row->[$x][$_] += $error;
}
}
}
$img->read(data=>$raw, type => 'raw', xsize => $xsize,
=item Acme::Steganography::Image::Png::RGB::556FS
Stuffs your data into a sample image, using the low order bits of each colour.
2 bytes of your data are stored in each pixel, 5 bits in Red and Green, 6 in
Blue. Changing the value of pixels to store data is adding error to the image,
in this case rather a lot of error. To attempt to conceal some of the
graininess Floyd-Steinberg dithering is used to spread the errors around. It's
not perfect, but effects are quite interesting, producing a reasonably nice
dithered image.
=back
view all matches for this distribution
view release on metacpan or search on metacpan
docs/SubmittingPatches.pod view on Meta::CPAN
differs substantially from the prior version, can be found on Usenet
archives back into the late 80's. Consider it like good Netiquette,
but for code.
Oh, another thing. I am picky about whitespaces. Make sure your
changes do not trigger errors with the sample pre-commit hook shipped
in templates/hooks--pre-commit. To help ensure this does not happen,
run git diff --check on your changes before you commit.
=head2 (2) Generate your patch using git tools out of your commits.
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) { die <<"END_DIE" }
Please invoke ${\__PACKAGE__} with:
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/Sub/Parms.pm view on Meta::CPAN
} else {
$token .= $ch;
}
}
if ($escape_next) {
die("Syntax error in BindParms spec: $raw_spec\n");
}
$spec = reverse $upend_spec;
$spec_tokens->{$spec_key} = $token . $quote;
} else {
die("Syntax error in BindParms spec: $raw_spec\n");
}
} else {
die("Syntax error in BindParms spec: $raw_spec\n");
}
}
return $spec_tokens;
}
lib/Acme/Sub/Parms.pm view on Meta::CPAN
# As each line of the BindParms block is processed the two parameters for each line are passed to the bind_spec
# method for evaluation. bind_spec should return a string containing any Perl code generated as a result of
# the bind specification.
#
# Good style dictates that the returned output should be *ONE* line (it could be a very *long* line)
# so that line numbering in the source file is preserved for any error messages.
#
sub bind_spec {
my $self = shift;
my ($raw_spec, $field_name) = @_;
lib/Acme/Sub/Parms.pm view on Meta::CPAN
}
######################
# callback="some_subroutine"
if ($spec_tokens->{'callback'}) {
$output .= "\{ my (\$callback_is_valid, \$callback_error) = "
. $spec_tokens->{'callback'}
. "(\'$field_name\', \$Acme::Sub::Parms::args\{\'$field_name\'\}, \\\%Acme::Sub::Parms::args);"
. "unless (\$callback_is_valid) { require Carp; Carp::croak(\"$field_name error: \$callback_error\"); }} ";
$has_side_effects = 1;
}
######################
# required
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) { die <<"END_DIE" }
Please invoke ${\__PACKAGE__} with:
inc/Module/Install.pm view on Meta::CPAN
# If the modification time is only slightly in the future,
# sleep briefly to remove the problem.
my $a = $s - time;
if ( $a > 0 and $a < 5 ) { sleep 5 }
# Too far in the future, throw an error.
my $t = time;
if ( $s > $t ) { die <<"END_DIE" }
Your installer $0 has a modification time in the future ($s > $t).
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/Syntax/Python.pm view on Meta::CPAN
_debug => $params{debug}
);
filter_add(bless \%context, $class);
}
sub error {
my ($self) = shift;
my ($message) = shift;
my ($line_no) = shift || $self->{last_begin};
die "Error: $message at $self->{_filename} line $line_no.\n"
}
view all matches for this distribution
view release on metacpan or search on metacpan
my($pkg, $file, $line) = caller;
foreach my $v (@_) {
# this is based on the perl 5.6.1 perldoc (perldoc constant)
# not sure why we have to pass $v through a regex -- otherwise,
# it gives us an error that we are trying to modify a constant
# value (which might be due to the pos($v) being modified)
$v =~ m{(.*)};
my $u = $1;
$u =~ s/^::/main::/;
view all matches for this distribution
view release on metacpan or search on metacpan
0.03 2013-06-16T07:37:25Z
- modified POD
0.02 2013-06-16T07:34:30Z
- catch a error
0.01 2013-06-16T06:34:58Z
- original version
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) {
die <<"END_DIE";
Please invoke ${\__PACKAGE__} with:
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/Terror/NL.pm view on Meta::CPAN
package Acme::Terror::NL;
use strict;
use LWP::Simple;
use vars qw($VERSION);
$VERSION = '0.04';
lib/Acme/Terror/NL.pm view on Meta::CPAN
#-------------------------------------------------------------------#
=head1 NAME
Acme::Terror::NL - Fetch the current NL terror alert level
=head1 SYNOPSIS
use Acme::Terror::NL;
my $t = Acme::Terror::NL->new(); # create new Acme::Terror::NL object
my $level = $t->fetch;
print "Current terror alert level is: $level\n";
=head1 DESCRIPTION
Gets the currrent terrorist threat level in the Netherlands.
The levels are either...
CRITICAL - there are strong indications that an attack will occur
SUBSTANTIAL - there is a realistic possibility that an attack will occur
lib/Acme/Terror/NL.pm view on Meta::CPAN
There are "only" four levels present in the Netherlands, unlike, e.g. the
United Kingdom and the United States of America, where there are five.
Thats what you get for being a small country.
This module aims to be compatible with the US version, L<Acme::Terror>,
the UK version, L<Acme::Terror::UK> and the AU version, L<Acme::Terror::AU>.
=head1 METHODS
=head2 new()
use Acme::Terror::NL;
my $t = Acme::Terror::NL->new();
Create a new instance of the Acme:Terror::NL class.
=head2 fetch()
my $threat_level_string = $t->fetch();
print $threat_level_string;
lib/Acme/Terror/NL.pm view on Meta::CPAN
See C<fetch()>, it returns the same.
=head2 level()
my $level = $t->level();
if ($level == Acme::Terror::NL::CRITICAL) {
print "too many L<Acme::Code::FreedomFighter>s!";
}
Return the level of the current terrorist threat as a comparable value.
The values to compare against are,
Acme::Terror::NL::CRITICAL
Acme::Terror::NL::SUBSTANTIAL
Acme::Terror::NL::LIMITED
Acme::Terror::NL::MINIMAL
If it can't retrieve the current level, it will return
Acme::Terror::NL::UNKNOWN
=head1 BUGS
Blame the terrorists! ... or report it to L<http://rt.cpan.org/Public/Dist/Display.html?Name=Acme::Terror::NL>.
=head1 AUTHOR
M. Blom,
E<lt>blom@cpan.orgE<gt>
lib/Acme/Terror/NL.pm view on Meta::CPAN
=head1 SEE ALSO
=over 4
=item * L<Acme::Terror>, L<Acme::Terror::UK>, L<Acme::Terror::AU>
=item * L<http://english.nctb.nl/>
=back
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/Terror/UK.pm view on Meta::CPAN
package Acme::Terror::UK;
## Get and return the current UK terrorist threat status.
## Robert Price - http://www.robertprice.co.uk/
use 5.00503;
use strict;
lib/Acme/Terror/UK.pm view on Meta::CPAN
1;
__END__
=head1 NAME
Acme::Terror::UK - Fetch the current UK terror alert level
=head1 SYNOPSIS
use Acme::Terror::UK;
my $t = Acme::Terror::UK->new(); # create new Acme::Terror::UK object
my $level = $t->fetch;
print "Current terror alert level is: $level\n";
=head1 DESCRIPTION
Gets the currrent terrorist threat level in the UK.
The levels are either...
CRITICAL - an attack is expected imminently
SEVERE - an attack is likely
SUBSTANTIAL - an attack is a strong possibility
MODERATE - an attack is possible but not likely
LOW - an attack is unlikely
This module aims to be compatible with the US version, Acme::Terror
=head1 METHODS
=head2 new()
use Acme::Terror::UK
my $t = Acme::Terror::UK->new();
Create a new instance of the Acme:Terror::UK class.
=head2 fetch()
my $threat_level_string = $t->fetch();
print $threat_level_string;
lib/Acme/Terror/UK.pm view on Meta::CPAN
Return the current threat level as a string.
=head2 level()
my $level = $t->level();
if ($level == Acme::Terror::UK::CRITICAL) {
print "Help, we're all going to die!\n";
}
Return the level of the current terrorist threat as a comparable value.
The values to compare against are,
Acme::Terror::UK::CRITICAL
Acme::Terror::UK::SEVERE
Acme::Terror::UK::SUBSTANTIAL
Acme::Terror::UK::MODERATE
Acme::Terror::UK::LOW
If it can't retrieve the current level, it will return
Acme::Terror::UK::UNKNOWN
=head1 BUGS
This module just screenscrapes the MI5 website so is vulnerable
to breaking if the page design changes.
=head1 SEE ALSO
Acme::Terror
http://www.mi5.gov.uk/
http://www.mi5.gov.uk/output/Page4.html
http://www.intelligence.gov.uk/
http://www.homeoffice.gov.uk/security/current-threat-level/
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/Terror.pm view on Meta::CPAN
package Acme::Terror;
$Acme::Terror::VERSION = '0.01';
use strict;
use LWP::Simple;
use XML::Simple;
=head1 NAME
Acme::Terror - Fetch the current US terror alert level
=head1 VERSION
This document describes version 0.01 of B<Acme::Terror>.
=head1 SYNOPSIS
use Acme::Terror;
my $t = Acme::Terror->new(); # create new Acme::Terror object
my $level = $t->fetch; # fetches current level
print "Current terror alert level is: $level\n"; # prints
=cut
sub new {
my ($class, %args) = @_;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/Test/Buffy.pm view on Meta::CPAN
# should deal with calling subroutines.
sub _do_buffy_test
{
# as we've entered another subroutine we need to increase the
# counter that Test::Builder uses to state where the error
# comes from (so we get an error at the line in your test
# script not from within the call to this routine in 'is_buffy')
# we use a local so that the level is returned to the previous
# value when we exit the subroutine. Note that we can't use
# the ++ operator here as it doesn't do what you might think.
view all matches for this distribution
view release on metacpan or search on metacpan
t/00-report-prereqs.t view on Meta::CPAN
else {
$source = 'static metadata';
}
my @full_reports;
my @dep_errors;
my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs;
# Add static includes into a fake section
for my $mod (@include) {
$req_hash->{other}{modules}{$mod} = 0;
t/00-report-prereqs.t view on Meta::CPAN
$have = "undef" unless defined $have;
push @reports, [$mod, $want, $have];
if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) {
if ( $have !~ /\A$lax_version_re\z/ ) {
push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)";
}
elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) {
push @dep_errors, "$mod version '$have' is not in required range '$want'";
}
}
}
else {
push @reports, [$mod, $want, "missing"];
if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) {
push @dep_errors, "$mod is not installed ($req_string)";
}
}
}
if ( @reports ) {
t/00-report-prereqs.t view on Meta::CPAN
if ( @full_reports ) {
diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports;
}
if ( @dep_errors ) {
diag join("\n",
"\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n",
"The following REQUIRED prerequisites were not satisfied:\n",
@dep_errors,
"\n"
);
}
pass;
view all matches for this distribution
view release on metacpan or search on metacpan
t/00-report-prereqs.t view on Meta::CPAN
else {
$source = 'static metadata';
}
my @full_reports;
my @dep_errors;
my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs;
# Add static includes into a fake section
for my $mod (@include) {
$req_hash->{other}{modules}{$mod} = 0;
t/00-report-prereqs.t view on Meta::CPAN
$have = "undef" unless defined $have;
push @reports, [$mod, $want, $have];
if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) {
if ( $have !~ /\A$lax_version_re\z/ ) {
push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)";
}
elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) {
push @dep_errors, "$mod version '$have' is not in required range '$want'";
}
}
}
else {
push @reports, [$mod, $want, "missing"];
if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) {
push @dep_errors, "$mod is not installed ($req_string)";
}
}
}
if ( @reports ) {
t/00-report-prereqs.t view on Meta::CPAN
if ( @full_reports ) {
diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports;
}
if ( @dep_errors ) {
diag join("\n",
"\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n",
"The following REQUIRED prerequisites were not satisfied:\n",
@dep_errors,
"\n"
);
}
pass;
view all matches for this distribution
view release on metacpan or search on metacpan
--diff=program use diff program and options
--compat-version=version provide compatibility with Perl version
--cplusplus accept C++ comments
--quiet don't output anything except fatal errors
--nodiag don't show diagnostics
--nohints don't show hints
--nochanges don't suggest changes
--nofilter don't filter input files
Using this option instructs F<ppport.h> to leave C++
comments untouched.
=head2 --quiet
Be quiet. Don't print anything except fatal errors.
=head2 --nodiag
Don't output any diagnostic messages. Only portability
alerts will be printed.
PL_defgv|5.004050||p
PL_diehook|5.004050||p
PL_dirty|5.004050||p
PL_dowarn|||pn
PL_errgv|5.004050||p
PL_error_count|5.021008||p
PL_expect|5.021008||p
PL_hexdigit|5.005000||p
PL_hints|5.005000||p
PL_in_my_stash|5.021008||p
PL_in_my|5.021008||p
PadnamelistREFCNT||5.021008|
PerlIO_clearerr||5.007003|
PerlIO_close||5.007003|
PerlIO_context_layers||5.009004|
PerlIO_eof||5.007003|
PerlIO_error||5.007003|
PerlIO_fileno||5.007003|
PerlIO_fill||5.007003|
PerlIO_flush||5.007003|
PerlIO_get_base||5.007003|
PerlIO_get_bufsiz||5.007003|
my_snprintf|5.009004||pvn
my_socketpair||5.007003|n
my_sprintf|5.009003||pvn
my_stat_flags|||
my_stat||5.021008|
my_strerror||5.021001|
my_strftime||5.007002|
my_strlcat|5.009004||pn
my_strlcpy|5.009004||pn
my_unexec|||
my_vsnprintf||5.009004|n
put_range|||
pv_display|5.006000||p
pv_escape|5.009004||p
pv_pretty|5.009004||p
pv_uni_display||5.007003|
qerror|||
qsortsvu|||
quadmath_format_needed|||n
quadmath_format_single|||n
re_compile||5.009005|
re_croak2|||
whichsig_pvn||5.015004|
whichsig_pv||5.015004|
whichsig_sv||5.015004|
whichsig|||
win32_croak_not_implemented|||n
with_queued_errors|||
wrap_op_checker||5.015008|
write_to_stderr|||
xs_boot_epilog|||
xs_handshake|||vn
xs_version_bootcheck|||
yyerror_pvn|||
yyerror_pv|||
yyerror|||
yylex|||
yyparse|||
yyunlex|||
yywarn|||
);
if ($file{changes}) {
if (exists $opt{copy}) {
my $newfile = "$filename$opt{copy}";
if (-e $newfile) {
error("'$newfile' already exists, refusing to write copy of '$filename'");
}
else {
local *F;
if (open F, ">$newfile") {
info("Writing copy of '$filename' with changes to '$newfile'");
print F $c;
close F;
}
else {
error("Cannot open '$newfile' for writing: $!");
}
}
}
elsif (exists $opt{patch} || $opt{changes}) {
if (exists $opt{patch}) {
unless ($patch_opened) {
if (open PATCH, ">$opt{patch}") {
$patch_opened = 1;
}
else {
error("Cannot open '$opt{patch}' for writing: $!");
delete $opt{patch};
$opt{changes} = 1;
goto fallback;
}
}
if (!defined $diff) {
$diff = run_diff('diff', $file, $str);
}
if (!defined $diff) {
error("Cannot generate a diff. Please install Text::Diff or use --copy.");
return;
}
print F $diff;
}
}
unlink $tmp;
}
else {
error("Cannot open '$tmp' for writing: $!");
}
return undef;
}
{
$opt{quiet} and return;
print "*** ", @_, "\n";
}
sub error
{
print "*** ERROR: ", @_, "\n";
}
my %given_hints;
/* It is very unlikely that anyone will try to use this with Perl 6
(or greater), but who knows.
*/
#if PERL_REVISION != 5
# error ppport.h only works with Perl version 5
#endif /* PERL_REVISION != 5 */
#ifndef dTHR
# define dTHR dNOOP
#endif
#ifndef dTHX
# define PL_defgv defgv
# define PL_diehook diehook
# define PL_dirty dirty
# define PL_dowarn dowarn
# define PL_errgv errgv
# define PL_error_count error_count
# define PL_expect expect
# define PL_hexdigit hexdigit
# define PL_hints hints
# define PL_in_my in_my
# define PL_laststatval laststatval
# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
# define PL_in_my D_PPP_my_PL_parser_var(in_my)
# define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
# define PL_error_count D_PPP_my_PL_parser_var(error_count)
#else
/* ensure that PL_parser != NULL and cannot be dereferenced */
/* Replace perl_eval_pv with eval_pv */
#ifndef eval_pv
#if defined(NEED_eval_pv)
static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
static
#else
extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
#endif
#ifdef eval_pv
# undef eval_pv
#endif
#define Perl_eval_pv DPPP_(my_eval_pv)
#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
SV*
DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
{
dSP;
SV* sv = newSVpv(p, 0);
PUSHMARK(sp);
SPAGAIN;
sv = POPs;
PUTBACK;
if (croak_on_error && SvTRUE(GvSV(errgv)))
croak(SvPVx(GvSV(errgv), na));
return sv;
}
# define UVuf "u"
# define UVof "o"
# define UVxf "x"
# define UVXf "X"
# else
# error "cannot define IV/UV formats"
# endif
#endif
#ifndef NVef
# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
view all matches for this distribution