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