1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
package Test::Utils;
use strict;
use Exporter;
use Test::More;
use FileHandle;
use File::Spec::Functions qw( :ALL );
use File::Temp;
use File::Slurper qw(read_text);
use Config;
use vars qw( @EXPORT @ISA );
use Mail::Mbox::MessageParser;
@ISA = qw( Exporter );
@EXPORT = qw( Do_Diff Module_Installed %PROGRAMS $TEMPDIR
No_such_file_or_directory $single_quote $command_separator
$set_env perl_with_inc catbin
);
use vars qw( $TEMPDIR %PROGRAMS $single_quote $command_separator $set_env );
$TEMPDIR = File::Temp::tempdir();
if ($^O eq 'MSWin32')
{
$set_env = 'set';
$single_quote = '"';
$command_separator = '&';
}
else
{
$set_env = '';
$single_quote = "'";
$command_separator = '';
}
%PROGRAMS = (
'gzip' => '/usr/cs/contrib/bin/gzip',
'compress' => '/usr/cs/contrib/bin/gzip',
'bzip' => undef,
'bzip2' => undef,
'lzip' => undef,
'xz' => undef,
);
# ---------------------------------------------------------------------------
sub Do_Diff
{
my $filename = shift;
my $output_filename = shift;
local $Test::Builder::Level = 2;
my @data1 = read_text($filename, undef, 1);
my @data2 = read_text($output_filename, undef, 1);
is_deeply(\@data1,\@data2,"$filename compared to $output_filename");
}
# ---------------------------------------------------------------------------
sub Module_Installed
{
my $module_name = shift;
$module_name =~ s#::#/#g;
$module_name .= '.pm';
foreach my $inc (@INC)
{
return 1 if -e catfile($inc,$module_name);
}
return 0;
}
# ---------------------------------------------------------------------------
sub No_such_file_or_directory
{
my $filename = 0;
$filename++ while -e $filename;
local $!;
my $foo = new FileHandle;
$foo->open($filename);
die q{Couldn't determine local text for "No such file or directory"}
if $! eq '';
return $!;
}
# ---------------------------------------------------------------------------
sub perl_with_inc
{
my $path_to_perl = $Config{perlpath};
my @standard_inc = split /###/, `"$path_to_perl" -e '\$" = "###";print "\@INC"'`;
my @extra_inc;
foreach my $inc (@INC)
{
push @extra_inc, "$single_quote$inc$single_quote" unless grep { /^$inc$/ } @standard_inc;
}
if (@extra_inc)
{
local $" = ' -I';
return qq{"$path_to_perl" -I@extra_inc};
}
else
{
return qq{"$path_to_perl"};
}
}
# ---------------------------------------------------------------------------
# Unfortunately ExtUtils::Command::cat() doesn't do binmode
sub catbin
{
local $/ = \4096;
binmode STDOUT;
foreach my $arg (@ARGV) {
open IN, $arg or die "Can't open $arg: $!";
binmode IN;
print while <IN>;
}
}
1;
|
