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
|
use strict;
use warnings;
use Test::More tests => 50;
use Test::NoWarnings;
use lib './lib';
use File::Util qw
(
SL NL escape_filename ebcdic
valid_filename strip_path needs_binmode
);
my $f = File::Util->new();
# check asignability
my $NL = NL; my $SL = SL;
# newlines
ok NL eq $NL, 'NL constant matches variable';
# path seperator
ok SL eq $SL, 'SL constant matches variable';
# test file escaping with substitute escape char
# with additional char to escape as well.
ok escape_filename( q[./foo/bar/baz.t/], '+', '.' ) eq '++foo+bar+baz+t+',
'escaped filename with custom escape';
# test file escaping with defaults
ok escape_filename(q[.\foo\bar\baz.t]) eq '._foo_bar_baz.t',
'escaped filename with defaults';
# path stripping in general
is strip_path(__FILE__), '004_portable.t', 'stripped path to this file OK';
is strip_path('C:\foo'), 'foo', 'stripped path to abs win path OK';
is strip_path('C:\foo\bar\baz.txt'), 'baz.txt',
'stripped path to deeper abs win path OK';
# illegal filename character intolerance
ok !valid_filename(qq[?foo]), qq[?foo is NOT a valid filename];
ok !valid_filename(qq[>foo]), qq[>foo is NOT a valid filename];
ok !valid_filename(qq[<foo]), qq[<foo is NOT a valid filename];
ok !valid_filename(qq[<foo]), qq[<foo is NOT a valid filename];
ok !valid_filename(qq[<foo]), qq[<foo is NOT a valid filename];
ok !valid_filename(qq[<foo]), qq[<foo is NOT a valid filename];
ok !valid_filename(qq[:foo]), qq[:foo is NOT a valid filename];
ok !valid_filename(qq[*foo]), qq[*foo is NOT a valid filename];
ok !valid_filename(qq[/foo]), qq[/foo is NOT a valid filename];
ok !valid_filename(qq[\\foo]), qq[\\foo is NOT a valid filename];
ok !valid_filename(qq["foo]), qq["foo is NOT a valid filename];
ok !valid_filename(qq[\tfoo]), qq[\\tfoo is NOT a valid filename];
ok !valid_filename(qq[\013foo]), qq[\\013foo is NOT a valid filename];
ok !valid_filename(qq[\012foo]), qq[\\012foo is NOT a valid filename];
ok !valid_filename(qq[\015foo]), qq[\\015foo is NOT a valid filename];
# strange but legal filename character tolerance
ok valid_filename(q['foo]), q['foo is a valid filename] ;
ok valid_filename(';foo'), ';foo is a valid filename' ;
ok valid_filename('$foo'), '$foo is a valid filename' ;
ok valid_filename('%foo'), '%foo is a valid filename' ;
ok valid_filename('`foo'), '`foo is a valid filename' ;
ok valid_filename('!foo'), '!foo is a valid filename' ;
ok valid_filename('@foo'), '@foo is a valid filename' ;
ok valid_filename('#foo'), '#foo is a valid filename' ;
ok valid_filename('^foo'), '^foo is a valid filename' ;
ok valid_filename('&foo'), '&foo is a valid filename' ;
ok valid_filename('-foo'), '-foo is a valid filename' ;
ok valid_filename('_foo'), '_foo is a valid filename' ;
ok valid_filename('+foo'), '+foo is a valid filename' ;
ok valid_filename('=foo'), '=foo is a valid filename' ;
ok valid_filename('(foo'), '(foo is a valid filename' ;
ok valid_filename(')foo'), ')foo is a valid filename' ;
ok valid_filename('{foo'), '{foo is a valid filename' ;
ok valid_filename('}foo'), '}foo is a valid filename' ;
ok valid_filename('[foo'), '[foo is a valid filename' ;
ok valid_filename(']foo'), ']foo is a valid filename' ;
ok valid_filename('~foo'), '~foo is a valid filename' ;
ok valid_filename('.foo'), '.foo is a valid filename' ;
ok valid_filename( q/;$%`!@#^&-_+=(){}[]~baz.foo'/ ),
q/;$%`!@#^&-_+=(){}[]~baz.foo' is a valid filename/;
ok valid_filename('C:\foo'), 'C:\foo is a valid filename';
# these tests are here for coverage purposes. Since they are more or less
# constants, based only on the host OS, there's no point in testing them
# against anything other than the testing File::Util already did in order
# to determine the values of these constants. We just test to make sure
# the value is either 1 or 0
ok needs_binmode =~ /^[10]$/, 'needs_binmode is 1 or 0';
ok ebcdic =~ /^[10]$/, 'ebcdic is 1 or 0';
# directory listing tests...
# remove '.' and '..' directory entries
ok( sub{
( $f->_dropdots( qw/. .. foo/ ) )[0] eq 'foo'
? 'dots removed'
: 'failed to remove dots'
}->() eq 'dots removed', 'removed fsdots OK' );
exit;
|
