r31501 - in /branches/upstream/libschedule-ratelimiter-perl: ./ current/ current/t/
ryan52-guest at users.alioth.debian.org
ryan52-guest at users.alioth.debian.org
Fri Mar 6 06:52:28 UTC 2009
Author: ryan52-guest
Date: Fri Mar 6 06:52:17 2009
New Revision: 31501
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=31501
Log:
[svn-inject] Installing original source of libschedule-ratelimiter-perl
Added:
branches/upstream/libschedule-ratelimiter-perl/
branches/upstream/libschedule-ratelimiter-perl/current/
branches/upstream/libschedule-ratelimiter-perl/current/Changes
branches/upstream/libschedule-ratelimiter-perl/current/MANIFEST
branches/upstream/libschedule-ratelimiter-perl/current/Makefile.PL
branches/upstream/libschedule-ratelimiter-perl/current/README
branches/upstream/libschedule-ratelimiter-perl/current/RateLimiter.pm
branches/upstream/libschedule-ratelimiter-perl/current/t/
branches/upstream/libschedule-ratelimiter-perl/current/t/1_constructor.t
branches/upstream/libschedule-ratelimiter-perl/current/t/2_single_iterations.t
branches/upstream/libschedule-ratelimiter-perl/current/t/3_zero_seconds.t
branches/upstream/libschedule-ratelimiter-perl/current/t/4_multiple_iterations.t
Added: branches/upstream/libschedule-ratelimiter-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libschedule-ratelimiter-perl/current/Changes?rev=31501&op=file
==============================================================================
--- branches/upstream/libschedule-ratelimiter-perl/current/Changes (added)
+++ branches/upstream/libschedule-ratelimiter-perl/current/Changes Fri Mar 6 06:52:17 2009
@@ -1,0 +1,6 @@
+Revision history for Perl extension Schedule::RateLimiter.
+
+0.01 Wed Dec 3 22:11:53 2003
+ - original version; created by h2xs 1.21 with options
+ -AXn Schedule::RateLimiter
+
Added: branches/upstream/libschedule-ratelimiter-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libschedule-ratelimiter-perl/current/MANIFEST?rev=31501&op=file
==============================================================================
--- branches/upstream/libschedule-ratelimiter-perl/current/MANIFEST (added)
+++ branches/upstream/libschedule-ratelimiter-perl/current/MANIFEST Fri Mar 6 06:52:17 2009
@@ -1,0 +1,9 @@
+Changes
+RateLimiter.pm
+Makefile.PL
+MANIFEST
+README
+t/1_constructor.t
+t/2_single_iterations.t
+t/3_zero_seconds.t
+t/4_multiple_iterations.t
Added: branches/upstream/libschedule-ratelimiter-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libschedule-ratelimiter-perl/current/Makefile.PL?rev=31501&op=file
==============================================================================
--- branches/upstream/libschedule-ratelimiter-perl/current/Makefile.PL (added)
+++ branches/upstream/libschedule-ratelimiter-perl/current/Makefile.PL Fri Mar 6 06:52:17 2009
@@ -1,0 +1,12 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'Schedule::RateLimiter',
+ 'VERSION_FROM' => 'RateLimiter.pm', # finds $VERSION
+ 'PREREQ_PM' => { Time::HiRes => undef,
+ Test::More => undef },
+ ($] >= 5.005 ? ## Add these new keywords supported since 5.005
+ (ABSTRACT_FROM => 'RateLimiter.pm', # retrieve abstract from module
+ AUTHOR => 'Daniel J. Wright <wright at pair.com>') : ()),
+);
Added: branches/upstream/libschedule-ratelimiter-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libschedule-ratelimiter-perl/current/README?rev=31501&op=file
==============================================================================
--- branches/upstream/libschedule-ratelimiter-perl/current/README (added)
+++ branches/upstream/libschedule-ratelimiter-perl/current/README Fri Mar 6 06:52:17 2009
@@ -1,0 +1,62 @@
+Schedule::RateLimiter version 0.01
+==========================
+
+This module provides a way to voluntarily restrict how many times a given
+action may take place within a specified time frame. Such a tool may be useful
+if you have written something which periodically polls some public resource and
+want to ensure that you do not overburden that resource with too many requests.
+
+ # Don't let this event happen more than 5 times in a 60 second period.
+ my $throttle = Schedule::RateLimiter->new ( iterations => 5,
+ seconds => 60 );
+
+ # Cycle forever, but not too fast.
+ while ( $throttle->event() ) {
+ &do_something;
+ }
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ Test::More
+ Time::HiRest
+
+TODO
+
+* Add a constructor parameter that takes number of seconds and iterations and
+normalizes so the number of iterations equals one. This defeats the best fit
+model and gives you the most even fit instead.
+
+* Add a way to find out how much time it will take before the next event may
+run.
+
+* Add support for multiple requirements (for example, 5 in 100 seconds AND 6 in
+120 seconds).
+
+* Add support for a best-fit situation where there are multiple events
+with different restrictions happening together.
+
+* Add support to "roll back" an event that was recorded but did not happen.
+
+* Add support to alter the limits on an object that already has recorded
+events.
+
+
+COPYRIGHT AND LICENCE
+
+This module was authored by Daniel J. Wright (wright at pair.com) for pair
+Networks, Inc.
+
+Copyright (C) 2003 pair Networks, Inc. (www.pair.com)
+
+This module is licensed under the same license at Perl itself.
Added: branches/upstream/libschedule-ratelimiter-perl/current/RateLimiter.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libschedule-ratelimiter-perl/current/RateLimiter.pm?rev=31501&op=file
==============================================================================
--- branches/upstream/libschedule-ratelimiter-perl/current/RateLimiter.pm (added)
+++ branches/upstream/libschedule-ratelimiter-perl/current/RateLimiter.pm Fri Mar 6 06:52:17 2009
@@ -1,0 +1,233 @@
+package Schedule::RateLimiter;
+# $Id: RateLimiter.pm,v 1.1 2003/12/04 23:09:10 wright Exp $
+
+use 5.006;
+use strict;
+use warnings;
+use Time::HiRes;
+
+our $VERSION = 0.01;
+
+return 1;
+
+=head1 NAME
+
+Schedule::RateLimiter - prevent events from happening too quickly.
+
+=head1 SYNOPSIS
+
+ use Schedule::RateLimiter;
+
+ # Don't let this event happen more than 5 times in a 60 second period.
+ my $throttle = Schedule::RateLimiter->new ( iterations => 5,
+ seconds => 60 );
+
+ # Cycle forever, but not too fast.
+ while ( 1 ) {
+ $throttle->event();
+ &do_something;
+ }
+
+
+=head1 DESCRIPTION
+
+This module provides a way to voluntarily restrict how many times a given
+action may take place within a specified time frame. Such a tool may be useful
+if you have written something which periodically polls some public resource and
+want to ensure that you do not overburden that resource with too many requests.
+
+Initially, one might think that solving this problem would be as simple as
+sleeping for the number of seconds divided by the number of iterations in
+between each event. However, that would only be correct if the event took no
+time at all.
+
+If you know exactly how much time each event is going to take then you could
+build an even more complicated one-liner such as this:
+
+ sleep( (seconds / iterations) - single_event_time )
+
+This module is intended to address the other cases when the exact run-time of
+each event is unknown and variable. This module will try very hard to allow an
+event to happen as many times as possible without exceeding the specified
+bounds.
+
+For example, suppose you want to write something that checks an 'incoming'
+directory once a minute for files and then does something with those files if
+it finds any. If it takes you two seconds to process those files, then you
+want to wait 58 seconds before polling the directory again. If it takes 30
+seconds to process those files, then you only want to wait 30 seconds. And if
+it takes 3 minutes, then you want to poll the directory again immediately as
+soon as you are done.
+
+ my $throttle = Schedule::RateLimiter->new ( seconds => 60 );
+ &poll_and_process while ( $throttle->event );
+
+=head1 METHODS
+
+=cut
+
+=head2 C< new() >
+
+Creates and returns a new Schedule::RateLimiter object.
+
+The constructor takes up to three parameters:
+
+=over
+
+=item * block (default: true)
+
+This parameter accepts a true or false value to set the default "block"
+behavior on future calls to event(). It makes it more convenient to turn
+blocking off for an entire object at a time.
+
+=item * iterations (default: 1)
+
+This specifies the number of times an event may take place within the given
+time period. This must be a positive, non-zero integer.
+
+=item * seconds (required)
+
+This specifies the minimum number of seconds that must transpire before we will
+allow (iterations + 1) events to happen. A value of 0 disables throttling.
+You may specify fractional time periods.
+
+=back
+
+B<example>:
+
+ my $throttle = Schedule::RateLimiter->new ( iterations => 2,
+ seconds => 10 );
+
+ # Event 1
+ $throttle->event();
+ # Event 2
+ $throttle->event();
+ # Event 3
+ $throttle->event();
+ # 10 seconds will have transpired since event 1 at this point.
+ # Event 4
+ $throttle->event();
+ # 10 seconds will have transpired since event 2 at this point.
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my %args = @_;
+
+ die "Missing 'seconds' argument" unless defined( $args{seconds} );
+
+ if ( $args{seconds} =~ /[^-\d\.]/ ) {
+ die "'seconds' argument must be numeric";
+ }
+
+ my $iterations = $args{iterations} || 1;
+
+ if ( $iterations =~ /[^-\d\.]/ ) {
+ die "'iterations' argument must be numeric";
+ }
+
+ if ( int($iterations) != $iterations ) {
+ die "'iterations' argument must be integer";
+ }
+
+ die "'iterations' argument must be positive" if $iterations < 0;
+
+ my @list;
+ $#list = $iterations -1;
+
+ bless {
+ current => 0,
+ list => \@list,
+ iterations => $iterations,
+ seconds => $args{seconds},
+ block => ( exists($args{block}) ) ? $args{block} : 1,
+ }, $proto;
+}
+
+=head2 C< event() >
+
+Called to signal the beginning of an event. This method will return true or
+false to indicate if it is ok to proceed with the event. This method uses
+Time::HiRes to do its calculations and sleeping, so the precision of this
+method will be the same as the precision of Time::HiRes on your platform.
+
+Takes one (optional) parameter:
+
+=over
+
+=item * block (default: true)
+
+If set to a false value, this method will do a non-blocking check to see if it
+is ok for the event to occur. If it is not ok, this method will return a false
+value and assume that the event did not take place. Otherwise, this method
+will return a true value and assume that the event did take place.
+
+=back
+
+B<example>:
+
+ # Stop when the code moves too fast.
+ while ( 1 ) {
+ if ($throttle->event( block => 0 )) {
+ &do_something;
+ } else {
+ die 'I went too fast!';
+ }
+ }
+
+=cut
+
+sub event {
+ my $self = shift;
+ my %args = @_;
+
+ my $t = Time::HiRes::time();
+
+ my $last = $self->{list}[$self->{current}] || 0;
+ my $block = exists( $args{block} ) ? $args{block} : $self->{block};
+
+ if ( ($t - $last) < $self->{seconds} ) {
+ return 0 unless $block;
+ Time::HiRes::sleep($self->{seconds} - ($t - $last));
+ }
+
+ $self->{list}[$self->{current}] = $t;
+
+ $self->{current} = ($self->{current}+1) % $self->{iterations};
+
+ return 1;
+}
+
+=head1 BUGS
+
+This module needs to keep a record of when every iteration took place, so if
+you are allowing a large number of iterations to happen in the given time
+period, this could potentially use a lot of memory.
+
+=head1 KNOWN ISSUES
+
+If you have multiple iterations that typically happen very quickly, and you
+want to limit them in a long period of time, they will "clump" together. That
+is, they all happen at just about the same time, and then the system waits for
+a long period before doing the same "clump" again. That's just the nature of
+the best-fit algorithm. Anything that is done to try to separate single events
+with longer waits than necessary will potentially create a sub-optimal
+situation if an event in the future takes longer than expected. If you really
+want all of your events to start at even time periods apart from each other,
+then set the number of iterations to 1 and adjust the number of seconds
+accordingly.
+
+=head1 AUTHOR
+
+Daniel J. Wright, E<lt>wright at pair.comE<gt>
+
+=head1 SEE ALSO
+
+The POE module provides a more heavyweight solution to this problem as well.
+
+L<perl>.
+
+=cut
Added: branches/upstream/libschedule-ratelimiter-perl/current/t/1_constructor.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libschedule-ratelimiter-perl/current/t/1_constructor.t?rev=31501&op=file
==============================================================================
--- branches/upstream/libschedule-ratelimiter-perl/current/t/1_constructor.t (added)
+++ branches/upstream/libschedule-ratelimiter-perl/current/t/1_constructor.t Fri Mar 6 06:52:17 2009
@@ -1,0 +1,39 @@
+#use Test::More qw( no_plan );
+use Test::More tests => 11;
+
+use Schedule::RateLimiter;
+ok(1, 'Did the Schedule::RateLimiter module load?'); # If we made it this far, we're ok.
+
+#########################
+
+# Insert your test code below, the Test module is use()ed here so read
+# its man page ( perldoc Test ) for help writing this test script.
+
+
+my $throttle = Schedule::RateLimiter->new( seconds => 60, iterations => 1 );
+ok( ref( $throttle ), 'Did we construct an object?' );
+
+is( $throttle->{seconds}, 60, 'Did the seconds value get set correctly?' );
+is( $throttle->{iterations}, 1, 'Did the iterations value get set correctly?' );
+
+$throttle = Schedule::RateLimiter->new( seconds => 60 );
+is( $throttle->{iterations}, 1, 'Did the default iterations value get set correctly?' );
+
+eval { $throttle = Schedule::RateLimiter->new() };
+ok( $@ =~ /Missing 'seconds' argument/, 'Did we throw an error when seconds was missing?' );
+
+eval { $throttle = Schedule::RateLimiter->new( seconds => 30, iterations => 1.000005 ) };
+ok( $@ =~ /'iterations' argument must be integer/, "Did we throw an error when iterations was fractional? $@" );
+
+eval { $throttle = Schedule::RateLimiter->new( seconds => 30, iterations => -10 ) };
+ok( $@ =~ /'iterations' argument must be positive/, 'Did we throw an error when iterations was negative?' );
+
+eval { $throttle = Schedule::RateLimiter->new( seconds => 30, iterations => 'ten' ) };
+ok( $@ =~ /'iterations' argument must be numeric/, 'Did we throw an error when iterations was a string?' );
+
+eval { $throttle = Schedule::RateLimiter->new( seconds => 30, iterations => '1 hundred' ) };
+ok( $@ =~ /'iterations' argument must be numeric/, 'Did we throw an error when iterations was numeric and string?' );
+
+eval { $throttle = Schedule::RateLimiter->new( seconds => 'thirty' ) };
+ok( $@ =~ /'seconds' argument must be numeric/, "Did we throw an error when seconds was a string? $@" );
+
Added: branches/upstream/libschedule-ratelimiter-perl/current/t/2_single_iterations.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libschedule-ratelimiter-perl/current/t/2_single_iterations.t?rev=31501&op=file
==============================================================================
--- branches/upstream/libschedule-ratelimiter-perl/current/t/2_single_iterations.t (added)
+++ branches/upstream/libschedule-ratelimiter-perl/current/t/2_single_iterations.t Fri Mar 6 06:52:17 2009
@@ -1,0 +1,43 @@
+#use Test::More qw( no_plan );
+use Test::More tests => 11;
+
+use Schedule::RateLimiter;
+ok(1, 'Did the Schedule::RateLimiter module load?'); # If we made it this far, we're ok.
+
+#########################
+
+
+# Blocking mode unspecified (default: blocking)
+my $throttle = Schedule::RateLimiter->new( seconds => 999999, iterations => 1 );
+
+ok( $throttle->event( block => 0 ), 'Did the first event return success?' );
+
+ok( ! $throttle->event( block => 0 ), 'Did the second event fail?' );
+
+eval { local $SIG{ALRM}= sub{ die 'alarm1' }; alarm( 2 ); $throttle->event(); alarm( 0 ) };
+ok( $@ =~ /alarm1/i, "Did an implicit blocking event hang?" );
+
+eval { local $SIG{ALRM}= sub{ die 'alarm2' }; alarm( 2 ); $throttle->event( block => 1); alarm( 0 ) };
+ok( $@ =~ /alarm2/i, "Did an explicit blocking event hang?" );
+
+# Blocking mode specified to block.
+$throttle = Schedule::RateLimiter->new( seconds => 999999, iterations => 1, block => 1 );
+
+ok( $throttle->event( block => 0 ), 'Did the first event return success?' );
+
+ok( ! $throttle->event( block => 0 ), 'Did the second event fail?' );
+
+eval { local $SIG{ALRM}= sub{ die 'alarm1' }; alarm( 2 ); $throttle->event(); alarm( 0 ) };
+ok( $@ =~ /alarm1/i, "Did an implicit blocking event hang when blocking is explicitly on?" );
+
+
+# Blocking mode specified to non-block.
+$throttle = Schedule::RateLimiter->new( seconds => 999999, iterations => 1, block => 0 );
+
+ok( $throttle->event( block => 0 ), 'Did the first event return success?' );
+
+ok( ! $throttle->event( block => 0 ), 'Did the second event fail?' );
+
+eval { local $SIG{ALRM}= sub{ die 'alarm3' }; alarm( 10 ); $throttle->event(); alarm( 0 ) };
+ok( $@ !~ /alarm3/i, "Did an implicit non-blocking event hang?" );
+
Added: branches/upstream/libschedule-ratelimiter-perl/current/t/3_zero_seconds.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libschedule-ratelimiter-perl/current/t/3_zero_seconds.t?rev=31501&op=file
==============================================================================
--- branches/upstream/libschedule-ratelimiter-perl/current/t/3_zero_seconds.t (added)
+++ branches/upstream/libschedule-ratelimiter-perl/current/t/3_zero_seconds.t Fri Mar 6 06:52:17 2009
@@ -1,0 +1,15 @@
+#use Test::More qw( no_plan );
+use Test::More tests => 22;
+
+use Schedule::RateLimiter;
+ok(1, 'Did the Schedule::RateLimiter module load?'); # If we made it this far, we're ok.
+
+#########################
+
+my $throttle = Schedule::RateLimiter->new( seconds => 0, iterations => 1 );
+ok ( ref( $throttle ), 'Did we build a zero-second Schedule::RateLimiter?' );
+
+for ( 1.. 20 ) {
+ ok ( $throttle->event(block => 0), "Test 0-second Throttle: $_" );
+}
+
Added: branches/upstream/libschedule-ratelimiter-perl/current/t/4_multiple_iterations.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libschedule-ratelimiter-perl/current/t/4_multiple_iterations.t?rev=31501&op=file
==============================================================================
--- branches/upstream/libschedule-ratelimiter-perl/current/t/4_multiple_iterations.t (added)
+++ branches/upstream/libschedule-ratelimiter-perl/current/t/4_multiple_iterations.t Fri Mar 6 06:52:17 2009
@@ -1,0 +1,20 @@
+#use Test::More qw( no_plan );
+use Test::More tests => 202;
+
+use Schedule::RateLimiter;
+ok(1, 'Did the Schedule::RateLimiter module load?'); # If we made it this far, we're ok.
+
+#########################
+
+my $throttle = Schedule::RateLimiter->new( seconds => 99999999, iterations => 100 );
+ok ( ref( $throttle ), 'Did we build an Schedule::RateLimiter with more than one iteration?' );
+for ( 1 .. 100 ) {
+ ok ( $throttle->event( block => 0 ), "Was event $_ allowed to run?" );
+}
+for ( 101 .. 200 ) {
+ ok (! $throttle->event( block => 0 ), "Was event $_ dis-allowed to run?" );
+}
+
+
+
+
More information about the Pkg-perl-cvs-commits
mailing list