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