Permalink
Browse files

initial commit

  • Loading branch information...
0 parents commit 46f8b66586fcf96391365594bea4f23e376475e3 @garu committed Dec 17, 2010
Showing with 440 additions and 0 deletions.
  1. +5 −0 Changes
  2. +11 −0 MANIFEST
  3. +9 −0 MANIFEST.bak
  4. +23 −0 Makefile.PL
  5. +49 −0 README
  6. +12 −0 ignore.txt
  7. +244 −0 lib/Sub/Frequency.pm
  8. +10 −0 t/00-load.t
  9. +11 −0 t/01-can.t
  10. +23 −0 t/02-coerce.t
  11. +13 −0 t/manifest.t
  12. +18 −0 t/pod-coverage.t
  13. +12 −0 t/pod.t
@@ -0,0 +1,5 @@
+Revision history for Sub::Frequency
+
+0.01 2010-12-17
+ First version, released on an unsuspecting world.
+
@@ -0,0 +1,11 @@
+Changes
+lib/Sub/Frequency.pm
+Makefile.PL
+MANIFEST
+README
+t/00-load.t
+t/01-can.t
+t/02-coerce.t
+t/manifest.t
+t/pod-coverage.t
+t/pod.t
@@ -0,0 +1,9 @@
+Changes
+lib/Sub/Frequency.pm
+Makefile.PL
+MANIFEST
+README
+t/00-load.t
+t/manifest.t
+t/pod-coverage.t
+t/pod.t
@@ -0,0 +1,23 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'Sub::Frequency',
+ AUTHOR => q{Breno G. de Oliveira <garu@cpan.org>},
+ VERSION_FROM => 'lib/Sub/Frequency.pm',
+ ABSTRACT_FROM => 'lib/Sub/Frequency.pm',
+ ($ExtUtils::MakeMaker::VERSION >= 6.3002
+ ? ('LICENSE'=> 'perl')
+ : ()),
+ PL_FILES => {},
+ PREREQ_PM => {
+ 'Test::More' => 0.90,
+ 'Scalar::Util' => 0,
+ 'Carp' => 0,
+ 'parent' => 0,
+ 'Exporter' => 0,
+ },
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+ clean => { FILES => 'Sub-Frequency-*' },
+);
49 README
@@ -0,0 +1,49 @@
+Sub::Frequency - Run code blocks according to a given probability
+
+This Perl module provides a small DSL to deal with an event's frequency,
+or likelyness of happening. Potential aplications include games,
+pseudo-random events and anything that may or may not run with a
+given probability.
+
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the
+perldoc command.
+
+ perldoc Frequency
+
+You can also look for information at:
+
+ RT, CPAN's request tracker
+ http://rt.cpan.org/NoAuth/Bugs.html?Dist=Frequency
+
+ AnnoCPAN, Annotated CPAN documentation
+ http://annocpan.org/dist/Frequency
+
+ CPAN Ratings
+ http://cpanratings.perl.org/d/Frequency
+
+ Search CPAN
+ http://search.cpan.org/dist/Frequency/
+
+
+LICENSE AND COPYRIGHT
+
+Copyright (C) 2010 Breno G. de Oliveira, Tiago Peczenyj
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of either: the GNU General Public License as published
+by the Free Software Foundation; or the Artistic License.
+
+See http://dev.perl.org/licenses/ for more information.
+
@@ -0,0 +1,12 @@
+blib*
+Makefile
+Makefile.old
+Build
+Build.bat
+_build*
+pm_to_blib*
+*.tar.gz
+.lwpcookies
+cover_db
+pod2htm*.tmp
+Sub-Frequency-*
@@ -0,0 +1,244 @@
+package Sub::Frequency;
+use strict;
+use warnings;
+
+use Scalar::Util 'looks_like_number';
+use Carp 'croak';
+
+use parent 'Exporter';
+our @EXPORT = qw(
+ always normally usually sometimes maybe
+ rarely seldom never with_probability
+);
+our @EXPORT_OK = @EXPORT;
+
+
+our $VERSION = '0.01';
+
+
+sub always (&) { $_[0]->() }
+
+
+sub normally (&) { with_probability( 0.75, @_ ) }
+*usually = \&normally;
+
+
+sub sometimes (&) { with_probability( 0.5, @_ ) }
+*maybe = \&sometimes;
+
+
+sub rarely (&) { with_probability( 0.25, @_ ) }
+*seldom = \&rarely;
+
+
+sub never (&) { return }
+
+
+sub with_probability ($;&) {
+ my ($probability, $code) = @_;
+
+ $probability = _coerce($probability)
+ unless looks_like_number($probability);
+
+ $code->() if rand() <= $probability;
+}
+
+sub _coerce {
+ my $thing = shift;
+
+ # matches N%, .N% and N.N%
+ if ( $thing =~ m/^\s*(\d+|\d*\.\d+)\s*%\s*$/ ) {
+ return $1 / 100;
+ }
+ else {
+ croak "'$thing' does not look like a number or a percentage.";
+ }
+}
+
+42;
+__END__
+=head1 NAME
+
+Sub::Frequency - Run code blocks according to a given probability
+
+=head1 SYNOPSIS
+
+ use Sub::Frequency;
+
+ always {
+ # code here will always run
+ };
+
+ usually {
+ # code here will run 75% of the time
+ # 'normally' also works
+ };
+
+ sometimes {
+ # code here will run 50% of the time
+ # 'maybe' also works
+ };
+
+ rarely {
+ # code here will run 25% of the time
+ # 'seldom' also works
+ };
+
+ never {
+ # code here will never run
+ };
+
+You can also specify your own probability for the code to run:
+
+ with_probability 0.42 => sub {
+ ...
+ };
+
+
+=head1 DESCRIPTION
+
+This module provides a small DSL to deal with an event's frequency,
+or likelyness of happening.
+
+Potential aplications include games, pseudo-random events and anything
+that may or may not run with a given probability.
+
+=head1 EXPORTS
+
+All functions are exported by default using L<Exporter>.
+
+If you need to rename any of the keywords, consider using
+L<Sub::Import> to get L<Sub::Exporter>'s flexibility.
+
+
+=head2 always (&)
+
+Takes a mandatory subroutine and executes it every time.
+
+
+=head2 usually (&)
+
+=head2 normally (&)
+
+Takes a mandatory subroutine and executes it with a probability of 75%.
+
+
+=head2 sometimes (&)
+
+=head2 maybe (&)
+
+Takes a mandatory subroutine and executes it with a probability of 50%.
+
+
+=head2 rarely (&)
+
+=head2 seldom (&)
+
+Takes a mandatory subroutine and executes it with a probability of 25%.
+
+
+=head2 never (&)
+
+Takes a mandatory subroutine and does nothing.
+
+
+=head2 with_probability ($;&)
+
+Takes a probability and a subroutine, and executes the subroutine
+with the given probability.
+
+The probability may be a real number between 0 and 1, or a
+percentage, passed as a string:
+
+ with_probability 0.79 => \&foo;
+
+ with_probability '79%' => \&bar;
+
+
+Also, for greater flexibility, spaces around the number are trimmed,
+and we don't care about leading zeros:
+
+ with_probability .04 => \&baz;
+
+ with_probability ' .4 % ' => \&something;
+
+
+And you can, of course, replace the C<< => >> with a C<,>:
+
+ with_probability 20, {
+ say "Mutley, do something!"
+ };
+
+
+=head1 DIAGNOSTICS
+
+I<< "'$foo' does not look like a number or a percentage." >>
+
+B<Hint:> Are you using something other than '.' as your floating point
+separator?
+
+This coercion error may occur when you try passing a scalar to
+with_probability() with something that doesn't look like a number
+or a percentage. Like:
+
+ with_probability 'monkey', { say 'some code' };
+
+In the code above, you should replace 'monkey' with a number
+between 0 and 1, or a percentage string (such as '15%').
+
+
+=head1 AUTHORS
+
+Breno G. de Oliveira, C<< <garu at cpan.org> >>
+
+Tiago Peczenyj
+
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-sub-frequency at rt.cpan.org>, or through
+the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Sub-Frequency>. I will be notified, and then you'll
+automatically be notified of progress on your bug as I make changes.
+
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc Sub::Frequency
+
+
+You can also look for information at:
+
+=over 4
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Sub-Frequency>
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/Sub-Frequency>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Sub-Frequency>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Sub-Frequency/>
+
+=back
+
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2010 Breno G. de Oliveira, Tiago Peczenyj.
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of either: the GNU General Public License as published
+by the Free Software Foundation; or the Artistic License.
+
+See http://dev.perl.org/licenses/ for more information.
+
+
@@ -0,0 +1,10 @@
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok( 'Sub::Frequency' ) || print "Bail out!
+";
+}
+
+diag( "Testing Sub::Frequency $Sub::Frequency::VERSION, Perl $], $^X" );
@@ -0,0 +1,11 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Sub::Frequency;
+
+can_ok 'Sub::Frequency', qw( always normally usually sometimes maybe
+ rarely seldom never with_probability
+ );
+
+done_testing;
Oops, something went wrong.

0 comments on commit 46f8b66

Please sign in to comment.