From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

BRIANDFOY / PerlPowerTools-1.051 / t / uudecode / uudecode.t 

            

              
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

              
use strict;
use Test::More 1;
my $input_name   = 't/data/uuencoded.uu';
END { unlink $input_name }
my $decoded_text = "Paul is dead\n";
my $encoded_text = <<"HERE";
begin %%MODE%% %%FILE%%
-4&%U;"!I<R!D96%D"@``
`
end
HERE
my %SkipModePlatforms = map { $_, 1 } qw(MSWin32);
sub make_input_file {
        my( $filename, $mode ) = @_;
        my $output = $encoded_text;
        $output =~ s/%%FILE%%/$filename/;
        $output =~ s/%%MODE%%/$mode/;
        open my $uu, '>', $input_name;
        print { $uu } $output;
        close $uu;
        }
my( $program ) = grep { -e } map { "$_/uudecode" } qw(bin blib/uudecode);
subtest 'sanity' => sub {
        ok(   -e $program, "program <$program> exists" );
        };
subtest 'decode_to_file' => sub {
        my $output_name = 't/data/decode_to_file.txt';
        my $mode        = '664';
        unlink $input_name;
        ok( ! -e $input_name, "uu file <$input_name> is not there yet (good)" );
        make_input_file( $output_name, $mode );
        ok( -e $input_name, "uu file <$input_name> exists" );
        unlink $output_name;
        ok( ! -e $output_name, "output file <$output_name> does not exist yet" );
        system $^X, $program, $input_name;
        ok(   -e $output_name, "output file <$output_name> now exists" );
        SKIP: {
                skip "Permissions make no sense on $^O", 1
                        if exists $SkipModePlatforms{$^O};
                is(
                        sprintf( '%o', (stat $output_name)[2] & 0777 ),
                        $mode,
                        "output file has the right mode"
                        );
                }
        my $output = do { local( @ARGV, $/ ) = $output_name; <> };
        close ARGV; # windows can't delete the file otherwise
        is( $output, $decoded_text, "Output in <$output_name> is right" );
        unlink $output_name or diag "Unintentionally leaving behind <$output_name>!: $!";
        };
subtest 'decode_to_stdout' => sub {
        my $output_name = '-';
        my $mode        = '664';
        unlink $input_name;
        ok( ! -e $input_name, "uu file <$input_name> is not there yet (good)" );
        make_input_file( $output_name, $mode );
        ok( -e $input_name, "uu file <$input_name> exists" );
        my $output = `"$^X" $program $input_name`;
        is( $output, $decoded_text, "standard output is the right message" );
        };
subtest 'decode_to_other_file' => sub {
        my $output_name = 't/data/decode_to_file.txt';
        my $alt_name    = 't/data/alt_uu_out.txt';
        my $mode        = '444';
        unlink $output_name, $alt_name;
        ok( ! -e $output_name, "output file <$output_name> is not there (good)" );
        ok( ! -e $alt_name,    "output file <$alt_name> is not there yet (good)" );
        unlink $input_name;
        ok( ! -e $input_name, "uu file <$input_name> is not there yet (good)" );
        make_input_file( $output_name, $mode );
        ok( -e $input_name, "uu file <$input_name> exists" );
        system $^X, $program, '-o', $alt_name, $input_name;
        ok( ! -e $output_name, "output file <$output_name> is not there (good)" );
        ok(   -e $alt_name,    "output file <$alt_name> is now there (good)" );
        SKIP: {
                skip "Permissions make no sense on $^O", 1
                        if exists $SkipModePlatforms{$^O};
                is(
                        sprintf( '%o', (stat $alt_name)[2] & 0777 ),
                        $mode,
                        "output file has the right mode"
                        );
                }
        my $output = do { local( @ARGV, $/ ) = $alt_name; <> };
        is( $output, $decoded_text, "standard output is the right message" );
        unlink $alt_name or diag "Unintentionally leaving behind <$alt_name>! $!";
        subtest 'decode_to_alt_stdout' => sub {
                my $output = `"$^X" $program -o - $input_name`;
                ok( ! -e $output_name, "output file <$output_name> is not there (good)" );
                is( $output, $decoded_text, "standard output is the right message" );
                };
        };
done_testing();