view release on metacpan or  search on metacpan

inc/Module/Install/Metadata.pm  view on Meta::CPAN

			'LGPL'                                            => 'lgpl',        1,
			'BSD'                                             => 'bsd',         1,
			'Artistic'                                        => 'artistic',    1,
			'MIT'                                             => 'mit',         1,
			'proprietary'                                     => 'proprietary', 0,
		);
		while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
			$pattern =~ s{\s+}{\\s+}g;
			if ( $license_text =~ /\b$pattern\b/i ) {
				if ( $osi and $license_text =~ /All rights reserved/i ) {
					print "WARNING: 'All rights reserved' in copyright may invalidate Open Source license.\n";
				}
				$self->license($license);
				return 1;
			}
		}
	}

	warn "Cannot determine license info from $_[0]\n";
	return 'unknown';
}

lib/Algorithm/FloodControl.pm  view on Meta::CPAN

        }
        %FLOOD = %{ $_[0] };
    }
    return \%FLOOD;
}

################# OOP ###########################

sub new {
    my $class  = shift;
    my $params = validate @_,
      {
        storage      => { type => OBJECT },
        backend_name => { type => SCALAR, optional => 1 },
        limits       => { type => HASHREF }
      };
    my $self = $class->SUPER::new($params);

    # be default backend will be selected by storage classname. but you can override it
    my $backend_name = __PACKAGE__ . '::Backend::' . ( $self->{backend_name} || ref $self->storage );
    load $backend_name;
    $self->backend_name($backend_name);
    return $self;
}

sub is_user_overrated {
    my ( $self, @params ) = @_;
    my ( $limit, $identifier ) = validate_pos @params, { type => SCALAR }, { type => SCALAR };
    my @configs     = @{ $self->{limits}{$limit} };
    my $max_timeout = 0;
    foreach my $config (@configs) {
        my $prefix  = __PACKAGE__ . '_rc_' . "$identifier|$limit|$config->{period}";
        my $backend = $self->backend_name->new(
            {
                storage => $self->storage,
                expires => $config->{period},
                prefix  => $prefix
            }

lib/Algorithm/FloodControl.pm  view on Meta::CPAN

        my $info = $backend->get_info( $config->{attempts} );
        if ( $info->{size} >= $config->{attempts} && $info->{timeout} > $max_timeout ) {
            $max_timeout = $info->{timeout};
        }
    }
    return $max_timeout;
}

sub get_attempt_count {
    my $self = shift;
    my ( $limit, $identifier ) = validate_pos @_, { type => SCALAR }, { type => SCALAR };
    my %attempts;
    my @configs = @{ $self->{limits}{$limit} };
    foreach my $config (@configs) {
        my $prefix = __PACKAGE__ . '_rc_' . "$identifier|$limit|$config->{period}";
        my $queue  = $self->backend_name->new(
            {
                storage => $self->storage,
                expires => $config->{period},
                prefix  => $prefix
            }
        );
        $attempts{ $config->{period} } = $queue->get_info( $config->{attempts} )->{size};
    }
    return \%attempts;
}

sub register_attempt {
    my $self = shift;
    my ( $limit, $identifier ) = validate_pos @_, { type => SCALAR }, { type => SCALAR };
    my @configs      = @{ $self->{limits}{$limit} };
    my $is_overrated = $self->is_user_overrated(@_);
    foreach my $config (@configs) {
        my $prefix = __PACKAGE__ . '_rc_' . "$identifier|$limit|$config->{period}";
        my $queue  = $self->backend_name->new(
            {
                storage => $self->storage,
                expires => $config->{period},
                prefix  => $prefix
            }
        );
        $queue->increment;
    }
    return $is_overrated;
}

sub forget_attempts {
    my $self = shift;
    my ( $limit, $identifier ) = validate_pos @_, { type => SCALAR }, { type => SCALAR };
    my @configs      = @{ $self->{limits}{$limit} };
    my $is_overrated = $self->is_user_overrated(@_);
    foreach my $config (@configs) {
        my $prefix = __PACKAGE__ . '_rc_' . "$identifier|$limit|$config->{period}";
        my $queue  = $self->backend_name->new(
            {
                storage => $self->storage,
                expires => $config->{period},
                prefix  => $prefix
            }