"Fossies" - the Fresh Open Source Software Archive

Member "sendpage-1.001001/t/05_Sendpage-Queue.t" (16 Apr 2009, 2419 Bytes) of package /linux/privat/old/sendpage-1.001001.tar.gz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 # -*- Mode: CPerl -*-
    2 # Sendpage-Queue.t -- unit test for Sendpage::Queue
    3 # $Id: 05_Sendpage-Queue.t 319 2009-04-16 19:19:06Z keescook $
    4 #
    5 # Copyright (C)  2006  Zak B. Elep
    6 # zakame@spunge.org, http://zakame.spunge.org
    7 #
    8 # This program is free software; you can redistribute it and/or modify
    9 # it under the terms of the GNU General Public License as published by
   10 # the Free Software Foundation; either version 2 of the License,
   11 # or (at your option) any later version.
   12 #
   13 # This program is distributed in the hope that it will be useful, but
   14 # WITHOUT ANY WARRANTY; without even the implied warranty of
   15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16 # GNU General Public License for more details.
   17 #
   18 # You should have received a copy of the GNU General Public License
   19 # along with this program; if not, write to the Free Software Foundation, Inc.,
   20 # 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
   21 #
   22 # After installation, run as `perl Sendpage-Queue.t'
   23 
   24 use strict;
   25 use warnings;
   26 
   27 use Test::More tests => 55;
   28 BEGIN { use_ok( 'Sendpage::Queue' ) or die }
   29 
   30 CONSTRUCTOR: {
   31     # make the tempdir
   32     use File::Temp qw/ tempfile tempdir /;
   33     my $dir   = tempdir( CLEANUP => 1 );
   34 
   35     # populate tempdir with files
   36     my @tempfiles;
   37     (undef, $tempfiles[ $_ ]) = tempfile( sprintf("q%02dXXXXXX", $_), UNLINK => 1, DIR => $dir )
   38 	foreach 0 .. 10;
   39 
   40     my $queue = new Sendpage::Queue $dir;
   41     isa_ok( $queue, 'Sendpage::Queue' );
   42 
   43     my @functions = qw( file ready getReadyFile fileToss fileDone
   44 			getNewFile doneNewFile lockFile unlockFile
   45 			lockQueue unlockQueue createUniqueName );
   46     can_ok( $queue, $_ ) foreach @functions;
   47 
   48     # is the queue ready?
   49     cmp_ok( $queue->ready, '==', $#tempfiles,
   50 	    qq(queue is ready) );
   51 
   52     # test the queue in action
   53     my $i = 0;
   54     my %seen;
   55     while ($queue->ready) {
   56 	my $fname = $queue->file;
   57 	my $fh    = $queue->getReadyFile;
   58 
   59 	my $test;
   60 	unless (defined $seen{$fname}) {
   61 	    $test = qq(read file() $tempfiles[$i]);
   62 	} else {
   63 	    $test = qq(reread file $tempfiles[$i]);
   64 	}
   65 
   66 	$seen{$fname}++;
   67 	like( $tempfiles[$i],
   68 	      qr/$fname/,
   69 	      $test );
   70 
   71 	my $string = <$fh>;
   72 	if (defined($string) and $string =~ /test/) {
   73 	    ok( $queue->fileToss,
   74 		qq(tossed $tempfiles[$i]) );
   75 	    $i++;
   76 	} else {
   77 	    print $fh "this is a test";
   78 	    ok( $queue->fileDone,
   79 		qq(testing $tempfiles[$i]) );
   80 	}
   81     }
   82 }
   83 
   84 # /* vim: set filetype=perl : */