throw results from the 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

Acme-MomoiroClover

2 results

		# 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

Acme-Numbers

1 match

lib/Acme/Numbers.pm view on Meta::CPAN

    $method    =~ s/.*://;   # strip fully-qualified portion
    my $val;
    # nasty override - we should probably have a 
    # generic major or minor currency indicator
    # if we could store and propogate the currency
    # then we could also throw errors at mismatched 
    # units e.g five.pounds.and.fifty.cents
    # but maybe also print out the correct sigil
    # e.g $5.50
    $method = 'pounds' if $method eq 'dollars';
    $method = 'pence'  if $method eq 'cents';

view all matches for this distribution

Acme-OneHundredNotOut

1 match

OneHundredNotOut.pm view on Meta::CPAN

I'm extremely happy to have been involved in that, and hope I didn't
start the project off on too much of a bad footing. It looks to be doing
fine now, at least.

I was still interested in how they're going to make the Perl 6 parser
work, (I still am, but don't have enough time to throw at the problem)
and with my linguistic background I've always been interested in writing
parsers in general. So early on I started trying to write a
L<Perl6::Tokener>, which is now unfortunately quite obsolete, with the
intention of writing a parser later on. For most of 2002, my whiteboard
at home was covered with sketches of the Perl 6 grammar.

view all matches for this distribution

Acme-People-Happy

1 match

		# 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

Acme-Perl-Consensual

1 match

		# 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

Acme-Perl-VM

1 match

	# 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

Acme-Pi-Abrahamic

1 match

		# 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

Acme-Pinoko

1 match

		# 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

Acme-Playwright

1 match

Playwright.pm view on Meta::CPAN

    'That is quite a collection you have there.'             => '=', 'Please stop hitting me with that pickle.'               => '~',
    'Why would I want to do that?'                           => '!', 'I asked nicely.'                                        => '@',
    'Look at all those chickens!'                            => '#', 'This is taking too long.'                               => '$',
    "I've been trying to learn that for ages."               => '%', 'How many times?'                                        => '^',
    'Eight or nine, I think.'                                => '&', 'Not unless you want me to cry.'                         => '*',
    'I hope she likes it.'                                   => '(', 'She will, especially if you throw it at her.'           => ')',
    'He never stops complaining!'                            => '_', "Sure, just wait until he isn't looking."                => '+',
    'Why does that smell like cheese?'                       => '[', "I'm not sure I've ever seen anything that ugly."        => '{',
    'How may of those do you have?'                          => ']', 'Lots more than you do.'                                 => '}',
    'I would love to.'                                       => '\\','I can think of nothing I would like better.'            => '|',
    'No, it is too soon for that.'                           => ';', 'She thinks I dance funny.'                              => ':',

view all matches for this distribution

Acme-PrettyCure

4 results

		# 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

Acme-Replica

1 match

		# 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

Acme-ReturnValue

1 match

t/pms/Envolve.pm view on Meta::CPAN




=head1 EXCEPTIONS

Currently this module doesn't throw any exceptions.


=head1 TODO

Nothing is planned until Envolve releases more functionality.

view all matches for this distribution

Acme-Signature-Arity

3 results

lib/Acme/Signature/Arity.pm view on Meta::CPAN

=item * a character representing the slurping behaviour, might be '@' or '%', or nothing (undef?) if it's
just a fixed list of scalar parameters

=back

This can also throw exceptions. That should only happen if you give it something that isn't
a coderef, or if internals change enough that the entirely-unjustified assumptions made by
this module are somehow no longer valid. Maybe they never were in the first place.

=cut

view all matches for this distribution

Acme-Siteswap

1 match

lib/Acme/Siteswap.pm view on Meta::CPAN


=over 4

=item pattern

Mandatory.  The siteswap pattern.  Should be a series of throws.

=item balls

Mandatory.  The number of balls in the pattern.

lib/Acme/Siteswap.pm view on Meta::CPAN


sub valid {
    my $self = shift;
    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;
    for my $t (@throws) {
        if (ref $t eq 'ARRAY') {
            foreach my $m_t (@$t) {
                $total += $m_t;
            }
        }
        else {
            $total += $t;
        }
    }

    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);
}

sub _check_timing {
    my ($self, @throws) = @_;
    
    # foreach non-zero throw, mark where the ball will next be
    # thrown and make sure that each throw is fed.
    my @throw_map = map { ref $_ eq 'ARRAY' ? scalar(@$_) 
                                            : ( $_ > 0 ? 1 : 0 ) } @throws;
    my @feeds = (0) x scalar @throws;
    for my $i (0 .. $#throws) {
        my @subthrows = ref $throws[$i] eq 'ARRAY' ? @{$throws[$i]} 
                                                   : ($throws[$i]);
        
        foreach my $throw (@subthrows) {
            next if $throws[$i] == 0;
            my $next_thrown = ($i + $throw) % scalar @throws;
            $feeds[$next_thrown]++;
        }
    }

    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;
}

lib/Acme/Siteswap.pm view on Meta::CPAN


=cut

sub error { $_[0]->{error} || '' }

sub _pattern_to_throws {
    my $pattern = shift;

    my @throw_set = ();

    while ($pattern =~ m/
			# next block of non-multiplex throws
			(?: \G (\d+) ) 
			# or the next multiplex throw
			| (?: \G \[(\d+)\] )
			# or the end of the pattern
			| (?: \G \z )
			/xmg) {
        if ( defined $1 ) {
            push (@throw_set,  split (//, $1));
        }
        elsif ( defined $2 ) {
            push (@throw_set, [ split(//, $2) ]);
        }
        else {
            # if we never get here, the pattern had an issue
            return @throw_set;
        }
    }
		
    die "unable to parse pattern: $pattern";
}

sub _max_throw {
    my ($throws) = @_;

    my $max_throw = reduce { 
        my $a_1 = ( ref $a eq 'ARRAY' ? max(@$a) : $a );
        my $b_1 = ( ref $b eq 'ARRAY' ? max(@$b) : $b );
        $a_1 >= $b_1 ? $a_1 : $b_1;
    } @$throws;

    # if our pattern is a 1-length multiplex pattern, 
    # reduce returns the first element, so correct for
    # that here
    $max_throw = max(@$max_throw) if ref $max_throw eq 'ARRAY';

    return $max_throw;
}

# extend the pattern by the number of throws equal to the biggest
# throw in the pattern, to ensure that every throw in the pattern
# lands at least once.
sub _expand_throws {
    my ($throws) = @_;
    my $max_throw = _max_throw($throws);
	
    foreach my $i (0 .. $max_throw) {
        # if it's a multiplex throw, we want to copy it
        my $t = ref $throws->[$i] eq 'ARRAY' ? [@{$throws->[$i]}] 
                                             : $throws->[$i];
        push @$throws, $t; 
    }
    return $throws;
}

=head1 AUTHORS

Luke Closs, C<< <cpan at 5thplane dut com> >>

view all matches for this distribution

Acme-Sort-Bogosort

1 match

};

like(
    $caught,
    qr/requires two/,
    "compare() throws exception if given other than two args to compare."
);


note( "Testing Acme::Sort::Bogosort::is_ordered() -- Default ascending order." );
my $compare = \&Acme::Sort::Bogosort::compare;

    Acme::Sort::Bogosort::is_ordered( [ qw/ A B C D E / ] );
} catch { $caught = $_ };
like( 
    $caught, 
    qr/expects a coderef/, 
    "is_ordered() throws exception when not handed a coderef as first param."
);

undef $caught;
try {
    Acme::Sort::Bogosort::is_ordered( $compare, qw/ A B C D E / );
} catch { $caught = $_ };
like(
    $caught,
    qr/expects an arrayref/,
    "is_ordered() throws an exception when not handed an arrayref as second param."
);

note "Testing Acme::Sort::Bogosort::bogosort().";
my @unsorted = shuffle( 'A' .. 'E' );
my @sorted = bogosort( @unsorted );

view all matches for this distribution

Acme-Sort-Bozo

1 match

};

like(
    $caught,
    qr/requires two/,
    "compare() throws exception if given other than two args to compare."
);


note( "Testing Acme::Sort::Bozo::is_ordered() -- Default ascending order." );
my $compare = \&Acme::Sort::Bozo::compare;

    Acme::Sort::Bozo::is_ordered( [ qw/ A B C D E / ] );
} catch { $caught = $_ };
like( 
    $caught, 
    qr/expects a coderef/, 
    "is_ordered() throws exception when not handed a coderef as first param."
);

undef $caught;
try {
    Acme::Sort::Bozo::is_ordered( $compare, qw/ A B C D E / );
} catch { $caught = $_ };
like(
    $caught,
    qr/expects an arrayref/,
    "is_ordered() throws an exception when not handed an arrayref as second param."
);

note "Testing Acme::Sort::Bozo::swap()";
my $listref = [qw/ A B C D E / ];
my $orig = join '', @{$listref};

view all matches for this distribution

Acme-Sort-Sleep

16 results

A convenient wrapper for calling a C<CODE> reference that is expected to
return a future. In normal circumstances is equivalent to

 $future = $code->( @args )

except that if the code throws an exception, it is wrapped in a new immediate
fail future. If the return value from the code is not a blessed C<Future>
reference, an immediate fail future is returned instead to complain about this
fact.

=cut

Marks that the leaf future is now ready, and provides a list of values as a
result. (The empty list is allowed, and still indicates the future as ready).
Cannot be called on a convergent future.

If the future is already cancelled, this request is ignored. If the future is
already complete with a result or a failure, an exception is thrown.

=cut

sub done
{

=head2 fail

   $future->fail( $exception, @details )

Marks that the leaf future has failed, and provides an exception value. This
exception will be thrown by the C<get> method if called. 

The exception must evaluate as a true value; false exceptions are not allowed.
Further details may be provided that will be returned by the C<failure> method
in list context. These details will not be part of the exception string raised
by C<get>.

If the future is already cancelled, this request is ignored. If the future is
already complete with a result or a failure, an exception is thrown.

=cut

sub fail
{

=head2 on_cancel

   $future->on_cancel( $code )

If the future is not yet ready, adds a callback to be invoked if the future is
cancelled by the C<cancel> method. If the future is already ready, throws an
exception.

If the future is cancelled, the callbacks will be invoked in the reverse order
to that in which they were registered.

scalar context it returns just the first result value.

If the future is ready but failed, this method raises as an exception the
failure string or object that was given to the C<fail> method.

If the future was cancelled an exception is thrown.

If it is not yet ready and is not of a subclass that provides an C<await>
method an exception is thrown. If it is subclassed to provide an C<await>
method then this is used to wait for the future to be ready, before returning
the result or propagating its failure exception.

=cut


In some cases the code should return a future; in some it should return an
immediate result. If a future is returned, the combined future will then wait
for the result of this second one. If the combinined future is cancelled, it
will cancel either the first future or the second, depending whether the first
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

 my $f = Future->die( "This is never going to work" );

This could be considered similarly to a C<die> call.

An C<eval{}> block can be used to turn a C<Future>-returning function that
might throw an exception, into a C<Future> that would indicate this failure.

 my $f = eval { function() } || Future->fail( $@ );

This is neater handled by the C<call> class method, which wraps the call in
an C<eval{}> block and tests the result:

            });

The result of the C<$f> future itself will be the result of the future
returned by the final function, if none of them failed. If any of them fails
it will fail with the same failure. This can be considered similar to normal
exception handling in synchronous code; the first time a function call throws
an exception, the subsequent calls are not made.

=head2 Merging Control Flow

A C<wait_all> future may be used to resynchronise control flow, while waiting

view all matches for this distribution

Acme-Spinodal-Utils

1 match

t/Utils.t view on Meta::CPAN

        is( $total, 10, "Checking that the correct total is returned." );
        is( $err, '', "Checking no error was returned.")
    }
    
    { # Strange args
        throws_ok { Acme::Spinodal::Utils::sum( qw( 1 2 3 Blarg!) ) } qr/does not appear to be a valid number!/, 'Checking an error was returned.';
    }
    
    { # some more intersting numbers
    my $total;
        eval { $total = Acme::Spinodal::Utils::sum( qw( 5 -273.15 3.141592 12321 0 -12.34e56) ) };

view all matches for this distribution

Acme-Sub-Parms

1 match

lib/Acme/Sub/Parms.pod view on Meta::CPAN


=head1 BUGS

You can't used parameters names containing single or double quotes,
whitespace or the '[' character. Line numbering can sometimes get
thrown off a little in error messages and I haven't been able to figure
a fix out yet. 

=head1 TODO

Handle multiline argument declarations. Handle comments on BindParm

view all matches for this distribution

Acme-SuperCollider-Programming

1 match

	# 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

Acme-Testing

1 match

		# 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

Acme-Throw

5 results

lib/Acme/Throw.pm view on Meta::CPAN

use strict;
use warnings;
package Acme::Throw;

# ABSTRACT: For when code makes you want to throw something.

use utf8;

our $MSG;

lib/Acme/Throw.pm view on Meta::CPAN

1 && q{ THIS IS MY RAGE FACE }; # truth
__END__

=head1 NAME

Acme::Throw - For when code makes you want to throw something.

=head1 SYNOPSIS

  use Acme::Throw;
  # code that does stuff...

view all matches for this distribution

Acme-Tools

1 match

t/test_pi.pl view on Meta::CPAN


sub pi_3 { # dart and pythagoras
    for my $n (map 10**$_,0..8){
	my($start,$s)=(time_fp(),0);
	for(1..$n){
	    my($x,$y)=(rand(),rand()); #throw dart
	    ++$s if sqrt($x*$x + $y*$y) < 1;
	}
	my $mypi=4*$s/$n;
	printf "%9d: %30.25f  %30.25f  %5.2fs\n", $n, $mypi, $pi-$mypi, time_fp()-$start;
    }

view all matches for this distribution

Acme-Unicodify

1 match

t/01-ToFromUnicode.t view on Meta::CPAN

    undef,
    'back_to_ascii() handles undef'
);

my $text = <<'END_FILE';
This is a test.  I want to throw in a bogus Unicode character just to validate that it is preserved.
This is line 2
This is a camel: \x{1F42A}
It should stay a camel.
END_FILE

$text = "
This is a test.  I want to throw in a bogus Unicode character just to validate that it is preserved.
This is line 2
This is a camel: \x{1F42A}
It should stay a camel.";

write_text($dir . '/infile.txt', $text);

view all matches for this distribution

Acme-Urinal

1 match

lib/Acme/Urinal.pm view on Meta::CPAN

  my ($resource, $comfort_level) = $self->pick($index);

Allows you to violate the usual algorithm to pick a urinal explicitly. In scalar
context it returns the resource picked. In list context, it returns that and the
comfort level your pick has. If the resource picked is already in use, an
exception will be thrown.

=cut

sub pick {
    my ($self, $i) = @_;

view all matches for this distribution

Acme-UseStrict

1 match

t/02strictness.t view on Meta::CPAN

	*{"bar"} = sub {};
	bar();
}
	'Lives OK';

throws_ok {
	*{"foo"} = sub {};
	foo();
	'USE STRICT';
	*{"bar"} = sub {};
	bar();

view all matches for this distribution

Acme-Voodoo

1 match

lib/Acme/Voodoo.pm view on Meta::CPAN

=head1 ABSTRACT

Voodoo is an Afro-Caribbean religion that mixed practices from the Fon, 
the Nago, the Ibos, Dahomeans, Congos, Senegalese, Haussars, Caplauous, 
Mondungues, Madinge, Angolese, Libyans, Ethiopians and the Malgaches.
With a bit of Roman Catholicism thrown in for good measure. This melange was
brought about by the enforced immigration of African slaves into Haiti during
the period of European colonizaltion of Hispaniola.  The colonists thought that a divided group of different tribes would be easier to enslave; but little 
did they know that the tribes had a common thread. 

In reality the actual religion is called "Vodun", while "Voodoo" is a largely

lib/Acme/Voodoo.pm view on Meta::CPAN


=head2 new()

Creates a voodoo doll object. You must pass the namespace of your subject. If 
your subject isn't within spell distance (the class can't be found) an 
exception will be thrown. Otherwise you get back your doll, an
Acme::Voodoo::Doll object.

    use Acme::Voodoo;
    my $doll = Acme::Voodoo->new( 'CGI' );
    print $doll->header();

view all matches for this distribution

Acme-W

1 match