1package Test::Utils; 2 3use strict; 4use Exporter; 5use Test::More; 6use FileHandle; 7use File::Spec::Functions qw( :ALL ); 8 9use vars qw( @EXPORT @ISA ); 10use Mail::Mbox::MessageParser; 11 12@ISA = qw( Exporter ); 13@EXPORT = qw( Do_Diff Module_Installed %PROGRAMS 14 Broken_Pipe No_such_file_or_directory $single_quote $command_separator 15 $set_env 16); 17 18use vars qw( %PROGRAMS $single_quote $command_separator $set_env ); 19 20if ($^O eq 'MSWin32') 21{ 22 $set_env = 'set'; 23 $single_quote = '"'; 24 $command_separator = '&'; 25} 26else 27{ 28 $set_env = ''; 29 $single_quote = "'"; 30 $command_separator = ''; 31} 32 33%PROGRAMS = ( 34 'gzip' => '/usr/cs/contrib/bin/gzip', 35 'compress' => '/usr/cs/contrib/bin/gzip', 36 'bzip' => undef, 37 'bzip2' => undef, 38); 39 40# --------------------------------------------------------------------------- 41 42sub Do_Diff 43{ 44 my $filename = shift; 45 my $output_filename = shift; 46 47 local $Test::Builder::Level = 2; 48 49 my (@data1,@data2); 50 51 { 52 open IN, $filename; 53 @data1 = <IN>; 54 close IN; 55 } 56 57 { 58 open IN, $output_filename; 59 @data2 = <IN>; 60 close IN; 61 } 62 63 is_deeply(\@data1,\@data2,"$filename compared to $output_filename"); 64} 65 66# --------------------------------------------------------------------------- 67 68sub Module_Installed 69{ 70 my $module_name = shift; 71 72 $module_name =~ s#::#/#g; 73 $module_name .= '.pm'; 74 75 foreach my $inc (@INC) 76 { 77 return 1 if -e catfile($inc,$module_name); 78 } 79 80 return 0; 81} 82 83# --------------------------------------------------------------------------- 84 85sub No_such_file_or_directory 86{ 87 my $filename = 0; 88 89 $filename++ while -e $filename; 90 91 local $!; 92 93 my $foo = new FileHandle; 94 $foo->open($filename); 95 96 die q{Couldn't determine local text for "No such file or directory"} 97 if $! eq ''; 98 99 return $!; 100} 101 102# --------------------------------------------------------------------------- 103 104# I think this works, but I haven't been able to test it because I can't find 105# a system which will report a broken pipe. Also, is there a pure Perl way of 106# doing this? 107sub Broken_Pipe 108{ 109 mkdir catdir('t','temp'), 0700; 110 111 my $script_path = catfile('t','temp','broken_pipe.pl'); 112 my $dev_null = devnull(); 113 114 open F, ">$script_path"; 115 print F<<EOF; 116unless (open B, '-|') 117{ 118 open(F, "|$^X -pe 'print' 2>$dev_null"); 119 print F 'x'; 120 close F; 121 exit; 122} 123EOF 124 close F; 125 126 my $result = `$^X $script_path 2>&1 1>$dev_null`; 127 128 $result = '' unless defined $result; 129 130 return $result; 131} 132 133# --------------------------------------------------------------------------- 134 1351; 136