Group
Extension

Test-BDD-Cucumber-Definitions/lib/Test/BDD/Cucumber/Definitions/Struct.pm

package Test::BDD::Cucumber::Definitions::Struct;

use strict;
use warnings;

use DDP ( show_unicode => 1 );
use Exporter qw(import);
use JSON::Path qw(jpath jpath1);
use JSON::XS;
use List::Util qw(any all);
use Test::BDD::Cucumber::Definitions qw(S :validator);
use Test::More;
use Try::Tiny;

our $VERSION = '0.41';

our @EXPORT_OK = qw(Struct);

# Enable JSONPath Embedded Perl Expressions
$JSON::Path::Safe = 0;    ## no critic (Variables::ProhibitPackageVars)

## no critic [Subroutines::RequireArgUnpacking]

sub Struct {
    return __PACKAGE__;
}

sub read_http_response_content_as_json {
    my $self = shift;

    S->{Struct} = __PACKAGE__;

    # Clean data
    S->{_Struct}->{data} = undef;

    my $error;

    S->{_Struct}->{data} = try {
        decode_json( S->{HTTP}->content() );
    }
    catch {
        $error = "Could not read http response content as JSON: $_[0]";

        return;
    };

    if ( !ok( !$error, qq{Http response content was read as JSON} ) ) {
        diag($error);
        diag( 'Http response content = ' . np S->{HTTP}->content );

        return;
    }

    return 1;
}

sub read_file_content_as_json {
    my $self = shift;

    S->{Struct} = __PACKAGE__;

    # Clean data
    S->{_Struct}->{data} = undef;

    my $error;

    S->{_Struct}->{data} = try {
        decode_json( S->{File}->content );
    }
    catch {
        $error = "Could not read file content as JSON: $_[0]";

        return;
    };

    if ( !ok( !$error, qq{File content was read as JSON} ) ) {
        diag($error);
        diag( 'File content = ' . np S->{File}->content );

        return;
    }

    return 1;
}

sub read_zip_archive_members_as_list {
    my $self = shift;

    S->{Struct} = __PACKAGE__;

    # Clean data
    S->{_Struct}->{data} = undef;

    my @members = S->{Zip}->member_names();

    S->{_Struct}->{data} = \@members;

    pass('Zip archive members was read as list');

    return 1;
}

sub read_base_response_as_struct {
    my $self = shift;

    S->{Struct} = __PACKAGE__;

    # Clean data
    S->{_Struct}->{data} = S->{Base}->response();

    pass('Base response was read as struct');

    return 1;
}

sub data_element_eq {
    my $self = shift;
    my ( $jsonpath, $value ) = validator_ns->(@_);

    my $result = jpath1( S->{_Struct}->{data}, $jsonpath );

    is( $result, $value, qq{Struct data element "$jsonpath" eq "$value"} );

    diag( 'Data = ' . np S->{_Struct}->{data} );

    return;
}

sub data_list_any_eq {
    my $self = shift;
    my ( $jsonpath, $value ) = validator_ns->(@_);

    my @result = jpath( S->{_Struct}->{data}, $jsonpath );

    my $ok = any { $_ eq $value } @result;

    ok( $ok, qq{Struct data list "$jsonpath" any eq "$value"} );

    diag( 'List = ' . np @result );
    diag( 'Data = ' . np S->{_Struct}->{data} );

    return;
}

sub data_element_re {
    my $self = shift;
    my ( $jsonpath, $regexp ) = validator_nr->(@_);

    my $result = jpath1( S->{_Struct}->{data}, $jsonpath );

    like(
        $result,
        qr/$regexp/,    ## no critic [RegularExpressions::RequireExtendedFormatting]
        qq{Struct data element "$jsonpath" re "$regexp"}
    );

    diag( 'Data = ' . np S->{_Struct}->{data} );

    return;
}

sub data_list_any_re {
    my $self = shift;
    my ( $jsonpath, $regexp ) = validator_nr->(@_);

    my @result = jpath( S->{_Struct}->{data}, $jsonpath );

    my $ok = any {/$regexp/x} @result;

    ok( $ok, qq{Struct data list "$jsonpath" any re "$regexp"} );

    diag( 'List = ' . np @result );
    diag( 'Data = ' . np S->{_Struct}->{data} );

    return;
}

sub data_list_count {
    my $self = shift;
    my ( $jsonpath, $count ) = validator_ni->(@_);

    my @result = jpath( S->{_Struct}->{data}, $jsonpath );

    is( scalar @result, $count, qq{Struct data list "$jsonpath" count "$count"} );

    diag( 'List = ' . np @result );
    diag( 'Data = ' . np S->{_Struct}->{data} );

    return;
}

sub data_element_key {
    my $self = shift;
    my ( $jsonpath, $value ) = validator_ns->(@_);

    my $result = jpath1( S->{_Struct}->{data}, $jsonpath );

    if (   ok( $result, qq{Struct data element "$jsonpath" exists} )
        && is( ref $result, 'HASH', qq{Struct data element "$jsonpath" is a hash} )
        && ok( exists $result->{$value}, qq{Struct data element "$jsonpath" contains key "$value"} ) )
    {
        return 1;
    }

    diag( "Element = " . np $result );
    diag( 'Data = ' . np S->{_Struct}->{data} );

    return;
}

sub data_list_all_key {
    my $self = shift;
    my ( $jsonpath, $value ) = validator_ns->(@_);

    my @result = jpath( S->{_Struct}->{data}, $jsonpath );

    if (   ok( @result, qq{Struct data list "$jsonpath" is not empty} )
        && ok( ( all { ref $_ eq 'HASH' } @result ),    qq{Struct data list "$jsonpath" is a list of hashes} )
        && ok( ( all { exists $_->{$value} } @result ), qq{Struct data list "$jsonpath" all contains key "$value"} ) )
    {
        return 1;
    }

    diag( "List = " . np @result );
    diag( 'Data = ' . np S->{_Struct}->{data} );

    return;
}

sub data_element {
    my $self = shift;
    my ($jsonpath) = validator_n->(@_);

    return jpath1( S->{_Struct}->{data}, $jsonpath );
}

1;


Powered by Groonga
Maintained by Kenichi Ishigaki <ishigaki@cpan.org>. If you find anything, submit it on GitHub.