view release on metacpan or  search on metacpan

t/01_tasks.t  view on Meta::CPAN

        note
            "test that 2 different queue instances can both add to the same queue"
            ;
        my $dbh2
            = DBI->connect( $dsn, $user, $passwd,
            { RaiseError => 0, PrintError => 0, AutoCommit => 1 } )
            or die "Could not connect to DB $dsn" ;
        my $another_q = App::Basis::Queue->new(
            dbh    => $dbh2,
            prefix => $test_q,
            debug  => 0
        ) ;
        my $q3 = "$qname/three" ;

        # now queue and another_q both know the same queue queue_names
        # create a new queue via queue
        $queue->add(
            queue => $q3,
            data  => { number => 3, note => 'queue' }
        ) ;

# at this point another_q does not know of the q3 queue, what happens if I add to it?
        my $status = $another_q->add(
            queue => $q3,
            data  => { number => 4, note => 'another_q' }
        ) ;
        ok( $status, "added via another queue instance" ) ;

        $queue->add(
            queue => $q3,
            data  => { number => 5, note => 'queue' }
        ) ;
        my $stats = $another_q->stats( queue => $q3 ) ;
        ok( $stats->{unprocessed} == 3, "second instance has valid stats" ) ;
    } ;

# -----------------------------------------------------------------------------
    subtest "remove_queue\n" => sub {
        my $resp = $queue->remove_queue( queue => $queue_two ) ;
        ok( $resp, "Removed $queue_two and its entries" ) ;
    } ;

# -----------------------------------------------------------------------------
# subtest "add many items\n" => sub {
#     my $loop = $add_items ;
#     note "add $loop items" ;
#     my $start = [gettimeofday] ;
#     my $count ;
#     # eval {
#       $dbh->begin_work ; # start a transaction
#     foreach my $i ( 1 .. $loop ) {
#         my $resp = $queue->add(
#             queue => $qname,
#             data  => { number => $i, desc => "test data" }
#         ) ;
#         $count++ if ($resp) ;
#     }
#     # $dbh->commit ;
#     # } ;
#     # if( $@) {
#     #     say STDERR "Error: during adding many items" ;
#     # }
#     my $elapsed = tv_interval($start) ;
#     ok( $count == $loop, "added $loop items" ) ;
#     my $rate = $count / $elapsed ;
#     ok( $rate > 5, "Insert rate > 5 per second" ) ;
#     note sprintf( "thats %.2f per second (%d in %ds)",
#         $rate, $count, $elapsed ) ;
# } ;

# -----------------------------------------------------------------------------
    subtest "wildcards\n" => sub {
        $queue->add(
            queue => "/wild/1",
            data  => { number => 12, data => "test data" }
        ) ;
        $queue->add(
            queue => "/wild/two",
            data  => { number => 12, data => "test data" }
        ) ;
        my $size = $queue->queue_size( queue => "/wild/*" ) ;
        ok( $size == 2, "two items in /wild/*" ) ;

        # process 1 thing
        $queue->process(
            queue    => "/wild/*",
            count    => 1,
            callback => \&pass_item
        ) ;
        $size = $queue->queue_size( queue => "/wild/*" ) ;
        ok( $size == 1, "processed one item from /wild/*" ) ;

        # process 1 thing
        $queue->process(
            queue    => "/wild/*",
            count    => 1,
            callback => \&pass_item
        ) ;
        $size = $queue->queue_size( queue => "/wild/*" ) ;
        ok( $size == 0, "nothing left in /wild/*" ) ;
    } ;

# -----------------------------------------------------------------------------

    subtest "cleanup\n" => sub {

# we could unlink the table if using sqlite, but it may be a general purpose one
# and obviously we cannot unlink postgreSQL or mysql so lets not even bother

        $queue->remove_tables() ;

        # check we have removed the table
        my $table_name = $test_q . "_queue" ;
        my ( $ret, $err )
            = query_db( $dbh, "SELECT * from $table_name LIMIT 1;" ) ;
        ok( !$ret && !$err, "Table $table_name has been removed" ) ;
        # OK really remove the file
        if ( $dsn =~ /:SQLite:(.*)/ ) {
            my $file = $1 ;
            unlink($1) ;
        }