t/CXGN/indexedlog.t

   1 #!/usr/bin/perl
   2 use strict;
   3 #use warnings;
   4 use English;
   5 use FindBin;
   6
   7 use File::Spec;
   8 use File::Copy;
   9 use File::Temp qw/tempfile/;
  10
  11 use Test::More tests => 31;
  12
  13 BEGIN {
  14   use_ok(  'CXGN::IndexedLog'  );
  15 }
  16
  17 ########### File backend
  18
  19 {
  20   my $testlog_name = File::Spec->catfile($FindBin::Bin,'data','indexedlog.testlog.1');
  21   my (undef,$tempfile) = tempfile(UNLINK=>1);
  22   copy($testlog_name,$tempfile) or die "Could not copy $testlog_name to '$tempfile': $!";
  23
  24   #open a test log file
  25   my $log = CXGN::IndexedLog->open(File => $tempfile);
  26   isa_ok($log,'CXGN::IndexedLog');
  27
  28   $log->append(qw/monkey in the middle/);
  29   $log->append(qw/this is yet another test log message/);
  30   ok(`tail -1 $tempfile | grep 'yet another test log message'`,'append probably works')
  31     or diag "Logfile contents are:\n",`cat $tempfile`;
  32
  33   ok( $log->is_writable, 'this file-based log should be writable' );
  34   chmod 0, $tempfile;
  35   ok( ! $log->is_writable, 'and now file-based log should not be writable' );
  36   chmod 0600, $tempfile;
  37   ok( $log->is_writable, 'and now it should be again' );
  38
  39   #diag `cat $tempfile`;
  40
  41   #test lookup on both the existing handle and a new handle
  42   foreach my $log2 ($log, CXGN::IndexedLog->open(File => $tempfile)) {
  43     my %logrecord = $log2->lookup(content => 'monkey in');
  44     my ($hostname) = `hostname -s`;
  45     my $username = getpwuid($UID);
  46     chomp $hostname;
  47     is($logrecord{host},$hostname,'lookup gets correct hostname');
  48     is($logrecord{user},$username,'lookup gets correct username');
  49     is($logrecord{progname},$FindBin::Script,'lookup gets correct program name');
  50     is($logrecord{pid},$PID,'lookup gets correct PID');
  51     is($logrecord{content},'monkey in the middle','lookup gets correct content');
  52
  53   }
  54 }
  55
  56
  57 ############ DB backend
  58
  59 SKIP: {
  60   skip ', set IDXL_DB_TEST=1 to test IndexedLog DB backend', 15 unless $ENV{IDXL_DB_TEST};
  61
  62   require CXGN::DB::Connection;
  63   my $dbh = CXGN::DB::Connection->new;
  64   #open a test log db.  this will probably
  65   my $log = CXGN::IndexedLog->open('DB', $dbh, 'cxgn_indexedlog_test_feel_free_to_delete_me');
  66   isa_ok($log,'CXGN::IndexedLog');
  67   ok( $log->is_writable, 'db table should be writable' );
  68
  69   $log->append(qw/monkey in the middle/);
  70   $log->append(qw/this is yet another test log message/);
  71
  72   #test lookup on both the existing handle and a new handle
  73   foreach my $log2 ($log, CXGN::IndexedLog->open('DB', $dbh, 'cxgn_indexedlog_test_feel_free_to_delete_me')) {
  74     my %logrecord = $log2->lookup(content => 'monkey in');
  75     my ($hostname) = `hostname -s`;
  76     my $username = getpwuid($UID);
  77     chomp $hostname;
  78     is($logrecord{host},$hostname,'lookup gets correct hostname');
  79     is($logrecord{user},$username,'lookup gets correct username');
  80     is($logrecord{progname},$FindBin::Script,'lookup gets correct program name');
  81     is($logrecord{pid},$PID,'lookup gets correct PID');
  82     is($logrecord{content},'monkey in the middle','lookup gets correct content');
  83
  84     ok( $log2->is_writable, 'db table should be writable' );
  85   }
  86
  87   #test reset
  88   $log->reset;
  89   is($log->lookup(content => 'monkey in'),undef,'reset deletes everything');
  90
  91
  92   $dbh->disconnect;
  93 };
  94