view release on metacpan or  search on metacpan

lib/Blitz/Validate.pm  view on Meta::CPAN

package Blitz::Validate;

use strict;
use warnings;
use Regexp::Common qw/URI/;

=head1 NAME

Blitz::Validate - Perl module for assisting with the validation of calls to Blitz.io

=cut

=head2 validate

Takes a hash reference of options to be sent to the blitz.io servers
and validates its content. Called before any tests are executed.

Detailed API docs for communicating with the blitz servers can be found here:
https://github.com/mudynamics/blitz-app/wiki/API-Docs

=cut

sub validate {
    my $options = shift;
    my $test_type = shift;
    my $reasons = [];

    # url
    if (!$options->{url}) {
        push @$reasons, "No URL given";
    }
    elsif (! _is_url($options->{url}) ) {
        push @$reasons, "Invalid URL: $options->{url}";
    }

    # pattern
    if ($options->{pattern} && $test_type eq 'rush') {
        if (!$options->{pattern}{iterations} || ! _is_integer($options->{pattern}{iterations}) ) {
            push @$reasons, "Pattern iterations not given or not an integer";
        }
        else {
            $options->{pattern}{iterations} += 0;
        }
        if (! $options->{pattern}{intervals} || ! _is_array($options->{pattern}{intervals}) ) {
            push @$reasons, "Intervals is not an array";
        }
    }
    elsif ($options->{pattern} && $test_type eq 'sprint') {
        push @$reasons, 'Pattern is not a valid options for sprints';
    }

    # region
    if ($options->{region} && $options->{region} !~ /(california|virginia|ireland|singapore|japan)/) {

        push @$reasons, "Invalid region: $options->{region}";
    }

    # ssl
    if ($options->{ssl} && !
        ( $options->{ssl} eq 'tlsv1' || 
          $options->{ssl} eq 'sslv2' ||
          $options->{ssl} eq 'sslv3' ) 
          ){
        push @$reasons, "SSL needs to be one of the following: tlsv1, sslv2, or sslv3";
    }
    
    # data
    if ($options->{content}) {
        if (! _is_hash($options->{content})) {
            push @$reasons, "Content must be a hash";
        }
        elsif ( ! $options->{content}{data} || ! _is_array($options->{content}{data}) ) {
             push @$reasons, "Content hash must have a data key with an array value"; 
        }
    }

    # referer
    if ($options->{referer} && ! _is_url($options->{referer} )) {
        push @$reasons, "Invalid referer URL: " . $options->{referer};
    }
    # string params
    for my $key ('user-agent', 'user') {
        if ($options->{$key} && 
            ( _is_array($options->{$key}) || 
              _is_hash($options->{$key}) ) 
            ) {
                push @$reasons, "Invalid " . $key . ": " . "$options->{$key}";
        }
    }
    
    # integer params
    for my $key ('status', 'timeout') {
        if ($options->{$key} && $options->{$key} !~ /^\d+$/g) {
            push @$reasons, "Invalid " . $key . ": " . "$options->{$key}";
        }
    }
    
    # array params
    for my $key ('cookies', 'headers') {
        if ($options->{$key} && ! _is_array($options->{$key})) {
            push @$reasons, "values to $key not given as an array: " . $options->{$key};
        }