view release on metacpan or  search on metacpan

t/22processes.t  view on Meta::CPAN

SKIP: {
    skip "Unable to locate config file [$config]", 19   unless(-f $config);

    ### Prepare object
    my $obj;
    unlink($output)  if(-f $output);
    ok( $obj = CPAN::Testers::Data::Addresses->new(config => $config, output => $output), "got object" );

    ### Test Underlying Process Methods

    $obj->load_addresses;
    is_deeply( $obj->{$_}, $results{$_}, ".. load - $_") for(qw(parsed_map stored_map pause_map cpan_map address_map unparsed_map));
    #diag("$_:" . Dumper($obj->{$_}))    for(qw(parsed_map stored_map pause_map cpan_map address_map unparsed_map));
    #diag("$_:" . Dumper($obj->{$_}))    for(qw(unparsed_map));

    $obj->match_addresses;
    is_deeply( $obj->{result}{NOEMAIL}, undef, '.. load - NOEMAIL');

    $obj->print_addresses;
    $obj = undef;

    my $text = read_file($output);
    unlike($text, qr/ERRORS:/, '.. found no errors');
    like($text, qr/MATCH:/,    '.. found matches');
    like($text, qr/PATTERNS:/, '.. found patterns');

    ### Test Direct Process Methods

    # test update process
    my $f = 't/_DBDIR/update.txt';
    write_file($f,'2975970,02975970-b19f-3f77-b713-d32bba55d77f,200901021220,0,0,barbie@missbarbell.co.uk,Barbie,BARBIE');
    $obj = CPAN::Testers::Data::Addresses->new(config => $config, update => $f);

    my $dbh = $obj->dbh;
    my @ct1 = $dbh->get_query('array','select count(*) from tester_profile');
    $obj->process;
    my @ct2 = $dbh->get_query('array','select count(*) from tester_profile');
    is($ct2[0]->[0] - $ct1[0]->[0], 1, '.. 1 address added');

    # test search process
    unlink($output)  if(-f $output);
    ok( $obj = CPAN::Testers::Data::Addresses->new(config => $config, output => $output), "got object" );
    $dbh = $obj->dbh;
    $obj->process;
    $obj = undef;

    $text = read_file($output);
    unlike($text, qr/ERRORS:/, '.. found no errors');
    like($text, qr/MATCH:/,    '.. found matches');
    like($text, qr/PATTERNS:/, '.. found patterns');

    # test reindex
    ok( $obj = CPAN::Testers::Data::Addresses->new(config => $config, reindex => 1), "got object" );
    is( $obj->_lastid, 0, "before reindex" );
    $obj->process;
    is( $obj->_lastid, 2975969, "after reindex" );


    #TODO:
    #$obj = CPAN::Testers::Data::Addresses->new(config => 't/test-config.ini', backup => 1);
}