package tests::DlfStreamTest;
use strict;
use base qw/ Lire::Test::TestCase /;
use Lire::DlfStore;
use Lire::DlfStream;
use Lire::DlfSchema;
use Lire::Utils qw/tempdir/;
use Lire::I18N;
use Time::Local;
use Cwd 'realpath';
use File::Basename qw/dirname/;
my $time_start = 900_000;
my $time_end = 1_000_000;
my @dlf =
(
{ 'time_start' => $time_start + 100,
'time_end' => undef, 'time_taken' => undef, 'connection_id' => 'an id',
'client_host' => undef, 'user' => undef, 'file' => 10_000,
'file_size' => undef, 'transfer-complete' => undef
},
{ 'time_start' => $time_start,
'time_end' => $time_start + 10,
'time_taken' => 10, 'connection_id' => 'another id',
'client_host' => undef, 'user' => undef, 'file' => undef,
'file_size' => undef, 'transfer-complete' => undef
},
{ 'time_start' => $time_start + 1000,
'time_end' => $time_start + 1001,
'time_taken' => 1, 'connection_id' => 'an id',
'client_host' => undef, 'user' => undef, 'file' => undef,
'file_size' => undef, 'transfer-complete' => undef
},
{ 'time_start' => $time_end,
'time_end' => $time_end + 5,
'time_taken' => 5, 'connection_id' => 'an id',
'client_host' => undef, 'user' => undef, 'file' => undef,
'file_size' => undef, 'transfer-complete' => undef
},
);
sub new {
my $self = shift()->SUPER::new( @_ );
$self->{'tmpdir'} = tempdir( __PACKAGE__ . "XXXXXX",
'CLEANUP' => 1, TMPDIR => 1) ;
return $self;
}
sub set_up {
my $self = $_[0];
shift->SUPER::set_up();
$self->{'cfg'}{'lr_schemas_path'} =
[ realpath( dirname(__FILE__) . "/schemas" ) ];
$self->{'cfg'}{'_lr_config_spec'} = $self->lire_default_config_spec();
# We don't open the store in new() because we need to
# change the configuration before
$self->{'store'} = Lire::DlfStore->open( "$self->{'tmpdir'}/store", 1 )
unless defined $self->{'store'};
$self->{'mock_stream'} = bless { '_name' => "test",
'_store' => $self->{'store'},
'_mode' => "r",
'_sort_spec' => undef,
'_ts_field' => 'time_start',
}, "Lire::DlfStream";
return
}
sub tear_down {
my $self = $_[0];
$self->SUPER::tear_down();
$self->{'store'}{'_dbh'}->rollback;
return;
}
sub test_new {
my $self = $_[0];
# Create
my $s = new Lire::DlfStream( $self->{'store'}, "test", "w" );
$self->assert_isa( 'Lire::DlfStream', $s );
$self->assert_num_equals( 0, $s->nrecords(),
"nrecords() should returns 0 on new stream" );
$self->assert_null( $s->start_time(),
"start_time() should returns undef on new stream" );
$self->assert_null( $s->end_time(),
"start_time() should returns undef on new stream" );
$self->assert_isa( 'DBI::st', $s->{'_sth'} );
$self->assert_null( $s->{'_dlf_reader'}, '_dlf_reader should be undef' );
$self->assert_null( $s->{'_link_sth'}, '_link_sth should be undef' );
$self->assert_str_equals( $self->{'store'}, $s->{'_store'} );
$self->assert_str_equals( 'w', $s->{'_mode'} );
$self->assert_str_equals( 'test', $s->{'_name'} );
$self->assert_str_equals( Lire::DlfSchema::load_schema( 'test' ),
$s->{'_schema'} );
$s->close();
# Open now in read mode
$s = new Lire::DlfStream( $self->{'store'}, "test", "r" );
$self->assert_isa( 'Lire::DlfStream', $s );
$self->assert_num_equals( 0, $s->nrecords() );
$self->assert_isa( 'Lire::DlfResult', $s->{'_dlf_reader'} );
$self->assert_null( $s->{'_sth'}, '_sth should be undef' );
$self->assert_null( $s->{'_link_sth'}, '_link_sth should be undef' );
$s->close();
}
sub test_new_derived {
my $self = $_[0];
my $s = new Lire::DlfStream( $self->{'store'}, "test-derived", "w" );
$self->assert_isa( 'Lire::DlfStream', $s );
$self->assert_isa( 'DBI::st', $s->{'_link_sth'} );
}
sub test_dlf_stats {
my $self = $_[0];
my $s = new Lire::DlfStream( $self->{'store'}, "test", "w" );
$self->assert_isa( 'Lire::DlfStream', $s );
my $i=0;
foreach my $dlf ( @dlf ) {
$s->write_dlf( $dlf );
$i++;
$self->assert_num_equals( $i, $s->nrecords() );
}
$self->assert_num_equals( $time_start, $s->start_time() );
$self->assert_num_equals( $time_end, $s->end_time() );
$s->close();
}
sub test_close {
my $self = $_[0];
my $stream_w = new Lire::DlfStream( $self->{'store'}, "test", "w" );
$stream_w->close();
$self->assert_null( $stream_w->{'_sth'},
"'_sth' attribute isn't undef after calling close()" );
my $stream_r = new Lire::DlfStream( $self->{'store'}, "test", "r" );
$stream_r->close();
$self->assert_null( $stream_r->{'_dlf_query'},
"'_dlf_query' attribute isn't undef after calling close()" );
}
sub test_read_write_dlf {
my $self = $_[0];
my $stream = new Lire::DlfStream( $self->{'store'}, 'test', 'w' );
$self->assert_dies( qr/can't be called on a DlfStream open in 'w' mode/,
sub { $stream->read_dlf() } );
$self->assert_dies( qr/can't be called on a DlfStream open in 'w' mode/,
sub { $stream->read_dlf_aref() } );
foreach my $dlf ( @dlf ) {
$stream->write_dlf( $dlf );
}
$stream->close();
$stream = new Lire::DlfStream( $self->{'store'}, 'test', 'r' );
$self->assert_dies( qr/can't be called on a DlfStream open in 'r' mode/,
sub { $stream->write_dlf() } );
my $id = 1;
foreach my $dlf ( @dlf ) {
my $e_dlf = { %$dlf };
$e_dlf->{'dlf_id'} = $id++;
$e_dlf->{'dlf_source'} = undef;
$self->assert_deep_equals( $e_dlf, $stream->read_dlf() );
}
$self->assert_null( $stream->read_dlf(), "undef expected on EOF" );
}
sub test_clean {
my $self = $_[0];
$self->assert_dies( qr/clean\(\) can't be called.*'r' mode/,
sub { $self->{'mock_stream'}->clean() } );
my $stream = new Lire::DlfStream( $self->{'store'}, 'test', 'w' );
my $mar11_2004 = timelocal( 0, 0, 12, 11, 2, 2004 );
$self->{'store'}->_dbh()->do( "INSERT INTO dlf_test ( time_start ) VALUES ( ? )", {}, $mar11_2004 );
$self->{'store'}->_dbh()->do( "INSERT INTO dlf_test ( time_start ) VALUES ( ? )", {}, $mar11_2004 + 86400 );
$self->assert_num_equals( 2, $stream->nrecords() );
$stream->clean( $mar11_2004 + 86400);
$self->assert_num_equals( 1, $stream->nrecords() );
$stream->clean();
$self->assert_num_equals( 0, $stream->nrecords() );
}
sub test_write_dlf_utf8 {
my $self = $_[0];
return unless $Lire::I18N::USE_ENCODING;
require Encode;
Encode->import( 'is_utf8' );
my $stream = new Lire::DlfStream( $self->{'store'}, 'test', 'w' );
$stream->write_dlf( { "connection_id" => "ISO eacute: \xe9" } );
$stream->close();
my $row = $self->{'store'}->_dbh()->selectrow_hashref( "SELECT connection_id FROM dlf_test" );
$self->assert( ! is_utf8( $row->{'connection_id'} ),
"SQLite driver returned unicode string where a byte-encoded string was expected" );
$self->assert_str_equals( "ISO eacute: \x{c3}\x{a9}", $row->{'connection_id'} );
}
sub test_write_dlf_utf8_nosupport {
my $self = $_[0];
local $Lire::I18N::USE_ENCODING = 0;
my $stream = new Lire::DlfStream( $self->{'store'}, 'test', 'w' );
$stream->write_dlf( { "connection_id" => "ISO eacute: \xe9" } );
$stream->close();
my $row = $self->{'store'}->_dbh()->selectrow_hashref( "SELECT connection_id FROM dlf_test" );
$self->assert_str_equals( "ISO eacute: ?", $row->{'connection_id'} );
}
sub test_write_dlf_extended {
my $self = $_[0];
my $stream = new Lire::DlfStream( $self->{'store'}, 'test-extended', 'w' );
$self->assert_dies( qr/'dlf_id' field must be set when using write_dlf\(\) on an extended schema/,
sub { $stream->write_dlf( {} ) } );
$stream->write_dlf( { 'dlf_id' => 1,
'time_stamp' => 100_000,
'dirname' => 'my dir' } );
$stream->close();
my $dlf = $self->{'store'}->_dbh->selectrow_hashref( 'SELECT * FROM "dlf_test-extended"' );
$self->assert_deep_equals( { 'dlf_id' => 1,
'dlf_source' => undef,
'dirname' => 'my dir' }, $dlf );
}
sub test_write_dlf_derived {
my $self = $_[0];
my $stream = new Lire::DlfStream( $self->{'store'}, 'test-derived', 'w' );
$self->assert_dies( qr/'link_ids' parameter should be an ARRAY reference, not '1'/,
sub { $stream->write_dlf( {}, 1 ) } );
$stream->write_dlf( { 'session_start' => 100_000, } );
$stream->write_dlf( { 'session_start' => 100_001 },
[ 1, 2, 3 ] );
$stream->close();
my $dbh = $self->{'store'}->_dbh();
my $dlf = $dbh->selectall_hashref( 'SELECT * FROM "dlf_test-derived"', 'dlf_id' );
$self->assert_deep_equals( { 1 => { 'dlf_id' => 1,
'dlf_source' => undef,
'connection_id' => undef,
'session_start' => 100_000,
'session_end' => undef,
'session_length' => undef,
'user_class' => undef,
},
2 => { 'dlf_id' => 2,
'dlf_source' => undef,
'connection_id' => undef,
'session_start' => 100_001,
'session_end' => undef,
'session_length' => undef,
'user_class' => undef,
}
}, $dlf );
$dlf = $dbh->selectall_arrayref( 'SELECT * FROM "dlf_test-derived_links"');
$self->assert_deep_equals( [ [ 2, 1 ],
[ 2, 2 ],
[ 2, 3 ] ], $dlf );
}
1;
syntax highlighted by Code2HTML, v. 0.9.1