view release on metacpan or  search on metacpan

t/lib/Test/MaxMind/DB/Writer.pm  view on Meta::CPAN

package Test::MaxMind::DB::Writer;

use strict;
use warnings;

use Test::More;

use Data::Printer;
use File::Temp qw( tempdir );
use List::Util qw( all );
use MaxMind::DB::Writer::Tree;
use Net::Works::Address;
use Net::Works::Network;
use Scalar::Util qw( blessed );
use Test::HexDifferences qw( eq_or_dump_diff );

use Exporter qw( import );
our @EXPORT_OK = qw(
    insert_for_type
    make_tree_from_pairs
    ranges_to_data
    test_iterator_sanity
    test_freeze_thaw
    test_freeze_thaw_optional_params
    test_tree
);

sub test_tree {
    my $insert_pairs   = shift;
    my $expect_pairs   = shift;
    my $desc           = shift;
    my $args           = shift;
    my $skip_dne_tests = shift;

    for my $type (qw( network range )) {

        subtest "$desc - insert_$type " => sub {
            my $tree = make_tree_from_pairs( $type, $insert_pairs, $args );

            _test_expected_data( $tree, $expect_pairs, $desc );

            return if $skip_dne_tests;

            for my $raw (qw( 1.1.1.33 8.9.10.11 ffff::1 )) {
                my $address = Net::Works::Address->new_from_string(
                    string  => $raw,
                    version => ( $raw =~ /::/ ? 6 : 4 ),
                );

                is(
                    $tree->lookup_ip_address($address),
                    undef,
                    "The address $address is not in the tree - $desc"
                );
            }
        };
    }
}

sub make_tree_from_pairs {
    my $type  = shift;
    my $pairs = shift;
    my $args  = shift;

    my $tree = MaxMind::DB::Writer::Tree->new(
        ip_version            => ( $pairs->[0][0] =~ /::/ ? 6 : 4 ),
        record_size           => 24,
        database_type         => 'Test',
        languages             => ['en'],
        description           => { en => 'Test tree' },
        map_key_type_callback => sub { },
        %{ $args || {} },
    );

    for my $pair ( @{$pairs} ) {