line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
######################
|
2
|
|
|
|
|
|
|
# SIMPLE FILES::Spec #
|
3
|
|
|
|
|
|
|
######################
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
package LibZip::File::Spec ;
|
6
|
|
|
|
|
|
|
#use strict qw( vars subs ) ;
|
7
|
|
|
|
|
|
|
|
8
|
2
|
|
|
2
|
|
19
|
no warnings ;
|
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
11355
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
my %module = (MacOS => 'Mac',
|
11
|
|
|
|
|
|
|
MSWin32 => 'Win32',
|
12
|
|
|
|
|
|
|
os2 => 'OS2',
|
13
|
|
|
|
|
|
|
VMS => 'VMS',
|
14
|
|
|
|
|
|
|
epoc => 'Unix',
|
15
|
|
|
|
|
|
|
NetWare => 'Win32', # Yes, File::Spec::Win32 works on NetWare.
|
16
|
|
|
|
|
|
|
dos => 'OS2', # Yes, File::Spec::OS2 works on DJGPP.
|
17
|
|
|
|
|
|
|
cygwin => 'Unix');
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
my $module = $module{$^O} || 'Unix';
|
21
|
|
|
|
|
|
|
|
22
|
1
|
|
|
1
|
|
2
|
sub splitpath { &{"splitpath_$module"}(@_); } ;
|
|
1
|
|
|
|
|
7
|
|
23
|
1
|
|
|
1
|
|
2
|
sub catpath { &{"catpath_$module"}(@_); } ;
|
|
1
|
|
|
|
|
5
|
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub splitpath_Unix {
|
27
|
1
|
|
|
1
|
|
3
|
my ($self,$path, $nofile) = @_;
|
28
|
|
|
|
|
|
|
|
29
|
1
|
|
|
|
|
4
|
my ($volume,$directory,$file) = ('','','');
|
30
|
|
|
|
|
|
|
|
31
|
1
|
50
|
|
|
|
3
|
if ( $nofile ) {
|
32
|
0
|
|
|
|
|
0
|
$directory = $path;
|
33
|
|
|
|
|
|
|
}
|
34
|
|
|
|
|
|
|
else {
|
35
|
1
|
|
|
|
|
6
|
$path =~ m|^ ( (?: .* / (?: \.\.?\Z(?!\n) )? )? ) ([^/]*) |xs;
|
36
|
1
|
|
|
|
|
3
|
$directory = $1;
|
37
|
1
|
|
|
|
|
4
|
$file = $2;
|
38
|
|
|
|
|
|
|
}
|
39
|
|
|
|
|
|
|
|
40
|
1
|
|
|
|
|
5
|
return ($volume,$directory,$file);
|
41
|
|
|
|
|
|
|
}
|
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub catpath_Unix {
|
44
|
1
|
|
|
1
|
|
3
|
my ($self,$volume,$directory,$file) = @_;
|
45
|
|
|
|
|
|
|
|
46
|
1
|
50
|
33
|
|
|
11
|
if ( $directory ne '' &&
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
47
|
|
|
|
|
|
|
$file ne '' &&
|
48
|
|
|
|
|
|
|
substr( $directory, -1 ) ne '/' &&
|
49
|
|
|
|
|
|
|
substr( $file, 0, 1 ) ne '/'
|
50
|
|
|
|
|
|
|
) {
|
51
|
0
|
|
|
|
|
0
|
$directory .= "/$file" ;
|
52
|
|
|
|
|
|
|
}
|
53
|
|
|
|
|
|
|
else {
|
54
|
1
|
|
|
|
|
2
|
$directory .= $file ;
|
55
|
|
|
|
|
|
|
}
|
56
|
|
|
|
|
|
|
|
57
|
1
|
|
|
|
|
4
|
return $directory ;
|
58
|
|
|
|
|
|
|
}
|
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub splitpath_Win32 {
|
61
|
0
|
|
|
0
|
|
0
|
my ($self,$path, $nofile) = @_;
|
62
|
0
|
|
|
|
|
0
|
my ($volume,$directory,$file) = ('','','');
|
63
|
0
|
0
|
|
|
|
0
|
if ( $nofile ) {
|
64
|
0
|
|
|
|
|
0
|
$path =~
|
65
|
|
|
|
|
|
|
m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? )
|
66
|
|
|
|
|
|
|
(.*)
|
67
|
|
|
|
|
|
|
}xs;
|
68
|
0
|
|
|
|
|
0
|
$volume = $1;
|
69
|
0
|
|
|
|
|
0
|
$directory = $2;
|
70
|
|
|
|
|
|
|
}
|
71
|
|
|
|
|
|
|
else {
|
72
|
0
|
|
|
|
|
0
|
$path =~
|
73
|
|
|
|
|
|
|
m{^ ( (?: [a-zA-Z]: |
|
74
|
|
|
|
|
|
|
(?:\\\\|//)[^\\/]+[\\/][^\\/]+
|
75
|
|
|
|
|
|
|
)?
|
76
|
|
|
|
|
|
|
)
|
77
|
|
|
|
|
|
|
( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? )
|
78
|
|
|
|
|
|
|
(.*)
|
79
|
|
|
|
|
|
|
}xs;
|
80
|
0
|
|
|
|
|
0
|
$volume = $1;
|
81
|
0
|
|
|
|
|
0
|
$directory = $2;
|
82
|
0
|
|
|
|
|
0
|
$file = $3;
|
83
|
|
|
|
|
|
|
}
|
84
|
|
|
|
|
|
|
|
85
|
0
|
|
|
|
|
0
|
return ($volume,$directory,$file);
|
86
|
|
|
|
|
|
|
}
|
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub catpath_Win32 {
|
89
|
0
|
|
|
0
|
|
0
|
my ($self,$volume,$directory,$file) = @_;
|
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# If it's UNC, make sure the glue separator is there, reusing
|
92
|
|
|
|
|
|
|
# whatever separator is first in the $volume
|
93
|
0
|
0
|
0
|
|
|
0
|
$volume .= $1
|
94
|
|
|
|
|
|
|
if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
|
95
|
|
|
|
|
|
|
$directory =~ m@^[^\\/]@s
|
96
|
|
|
|
|
|
|
) ;
|
97
|
|
|
|
|
|
|
|
98
|
0
|
|
|
|
|
0
|
$volume .= $directory ;
|
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
# If the volume is not just A:, make sure the glue separator is
|
101
|
|
|
|
|
|
|
# there, reusing whatever separator is first in the $volume if possible.
|
102
|
0
|
0
|
0
|
|
|
0
|
if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
|
|
|
|
0
|
|
|
|
|
103
|
|
|
|
|
|
|
$volume =~ m@[^\\/]\Z(?!\n)@ &&
|
104
|
|
|
|
|
|
|
$file =~ m@[^\\/]@
|
105
|
|
|
|
|
|
|
) {
|
106
|
0
|
|
|
|
|
0
|
$volume =~ m@([\\/])@ ;
|
107
|
0
|
0
|
|
|
|
0
|
my $sep = $1 ? $1 : '\\' ;
|
108
|
0
|
|
|
|
|
0
|
$volume .= $sep ;
|
109
|
|
|
|
|
|
|
}
|
110
|
|
|
|
|
|
|
|
111
|
0
|
|
|
|
|
0
|
$volume .= $file ;
|
112
|
|
|
|
|
|
|
|
113
|
0
|
|
|
|
|
0
|
return $volume ;
|
114
|
|
|
|
|
|
|
}
|
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
sub splitpath_Mac {
|
117
|
0
|
|
|
0
|
|
0
|
my ($self,$path, $nofile) = @_;
|
118
|
0
|
|
|
|
|
0
|
my ($volume,$directory,$file);
|
119
|
|
|
|
|
|
|
|
120
|
0
|
0
|
|
|
|
0
|
if ( $nofile ) {
|
121
|
0
|
|
|
|
|
0
|
( $volume, $directory ) = $path =~ m|^((?:[^:]+:)?)(.*)|s;
|
122
|
|
|
|
|
|
|
}
|
123
|
|
|
|
|
|
|
else {
|
124
|
0
|
|
|
|
|
0
|
$path =~
|
125
|
|
|
|
|
|
|
m|^( (?: [^:]+: )? )
|
126
|
|
|
|
|
|
|
( (?: .*: )? )
|
127
|
|
|
|
|
|
|
( .* )
|
128
|
|
|
|
|
|
|
|xs;
|
129
|
0
|
|
|
|
|
0
|
$volume = $1;
|
130
|
0
|
|
|
|
|
0
|
$directory = $2;
|
131
|
0
|
|
|
|
|
0
|
$file = $3;
|
132
|
|
|
|
|
|
|
}
|
133
|
|
|
|
|
|
|
|
134
|
0
|
0
|
|
|
|
0
|
$volume = '' unless defined($volume);
|
135
|
0
|
0
|
0
|
|
|
0
|
$directory = ":$directory" if ( $volume && $directory ); # take care of "HD::dir"
|
136
|
0
|
0
|
|
|
|
0
|
if ($directory) {
|
137
|
|
|
|
|
|
|
# Make sure non-empty directories begin and end in ':'
|
138
|
0
|
0
|
|
|
|
0
|
$directory .= ':' unless (substr($directory,-1) eq ':');
|
139
|
0
|
0
|
|
|
|
0
|
$directory = ":$directory" unless (substr($directory,0,1) eq ':');
|
140
|
|
|
|
|
|
|
} else {
|
141
|
0
|
|
|
|
|
0
|
$directory = '';
|
142
|
|
|
|
|
|
|
}
|
143
|
0
|
0
|
|
|
|
0
|
$file = '' unless defined($file);
|
144
|
|
|
|
|
|
|
|
145
|
0
|
|
|
|
|
0
|
return ($volume,$directory,$file);
|
146
|
|
|
|
|
|
|
}
|
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
sub catpath_Mac {
|
149
|
0
|
|
|
0
|
|
0
|
my ($self,$volume,$directory,$file) = @_;
|
150
|
|
|
|
|
|
|
|
151
|
0
|
0
|
0
|
|
|
0
|
if ( (! $volume) && (! $directory) ) {
|
152
|
0
|
0
|
|
|
|
0
|
$file =~ s/^:// if $file;
|
153
|
0
|
|
|
|
|
0
|
return $file ;
|
154
|
|
|
|
|
|
|
}
|
155
|
|
|
|
|
|
|
|
156
|
0
|
|
|
|
|
0
|
my $path = $volume; # may be ''
|
157
|
0
|
0
|
|
|
|
0
|
$path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
|
158
|
|
|
|
|
|
|
|
159
|
0
|
0
|
|
|
|
0
|
if ($directory) {
|
160
|
0
|
|
|
|
|
0
|
$directory =~ s/^://; # remove leading ':' if any
|
161
|
0
|
|
|
|
|
0
|
$path .= $directory;
|
162
|
0
|
0
|
|
|
|
0
|
$path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
|
163
|
|
|
|
|
|
|
}
|
164
|
|
|
|
|
|
|
|
165
|
0
|
0
|
|
|
|
0
|
if ($file) {
|
166
|
0
|
|
|
|
|
0
|
$file =~ s/^://; # remove leading ':' if any
|
167
|
0
|
|
|
|
|
0
|
$path .= $file;
|
168
|
|
|
|
|
|
|
}
|
169
|
|
|
|
|
|
|
|
170
|
0
|
|
|
|
|
0
|
return $path;
|
171
|
|
|
|
|
|
|
}
|
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
sub splitpath_OS2 {
|
174
|
0
|
|
|
0
|
|
0
|
my ($self,$path, $nofile) = @_;
|
175
|
0
|
|
|
|
|
0
|
my ($volume,$directory,$file) = ('','','');
|
176
|
0
|
0
|
|
|
|
0
|
if ( $nofile ) {
|
177
|
0
|
|
|
|
|
0
|
$path =~
|
178
|
|
|
|
|
|
|
m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? )
|
179
|
|
|
|
|
|
|
(.*)
|
180
|
|
|
|
|
|
|
}xs;
|
181
|
0
|
|
|
|
|
0
|
$volume = $1;
|
182
|
0
|
|
|
|
|
0
|
$directory = $2;
|
183
|
|
|
|
|
|
|
}
|
184
|
|
|
|
|
|
|
else {
|
185
|
0
|
|
|
|
|
0
|
$path =~
|
186
|
|
|
|
|
|
|
m{^ ( (?: [a-zA-Z]: |
|
187
|
|
|
|
|
|
|
(?:\\\\|//)[^\\/]+[\\/][^\\/]+
|
188
|
|
|
|
|
|
|
)?
|
189
|
|
|
|
|
|
|
)
|
190
|
|
|
|
|
|
|
( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? )
|
191
|
|
|
|
|
|
|
(.*)
|
192
|
|
|
|
|
|
|
}xs;
|
193
|
0
|
|
|
|
|
0
|
$volume = $1;
|
194
|
0
|
|
|
|
|
0
|
$directory = $2;
|
195
|
0
|
|
|
|
|
0
|
$file = $3;
|
196
|
|
|
|
|
|
|
}
|
197
|
|
|
|
|
|
|
|
198
|
0
|
|
|
|
|
0
|
return ($volume,$directory,$file);
|
199
|
|
|
|
|
|
|
}
|
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
sub catpath_OS2 {
|
202
|
0
|
|
|
0
|
|
0
|
my ($self,$volume,$directory,$file) = @_;
|
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
# If it's UNC, make sure the glue separator is there, reusing
|
205
|
|
|
|
|
|
|
# whatever separator is first in the $volume
|
206
|
0
|
0
|
0
|
|
|
0
|
$volume .= $1
|
207
|
|
|
|
|
|
|
if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
|
208
|
|
|
|
|
|
|
$directory =~ m@^[^\\/]@s
|
209
|
|
|
|
|
|
|
) ;
|
210
|
|
|
|
|
|
|
|
211
|
0
|
|
|
|
|
0
|
$volume .= $directory ;
|
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
# If the volume is not just A:, make sure the glue separator is
|
214
|
|
|
|
|
|
|
# there, reusing whatever separator is first in the $volume if possible.
|
215
|
0
|
0
|
0
|
|
|
0
|
if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
|
|
|
|
0
|
|
|
|
|
216
|
|
|
|
|
|
|
$volume =~ m@[^\\/]\Z(?!\n)@ &&
|
217
|
|
|
|
|
|
|
$file =~ m@[^\\/]@
|
218
|
|
|
|
|
|
|
) {
|
219
|
0
|
|
|
|
|
0
|
$volume =~ m@([\\/])@ ;
|
220
|
0
|
0
|
|
|
|
0
|
my $sep = $1 ? $1 : '/' ;
|
221
|
0
|
|
|
|
|
0
|
$volume .= $sep ;
|
222
|
|
|
|
|
|
|
}
|
223
|
|
|
|
|
|
|
|
224
|
0
|
|
|
|
|
0
|
$volume .= $file ;
|
225
|
|
|
|
|
|
|
|
226
|
0
|
|
|
|
|
0
|
return $volume ;
|
227
|
|
|
|
|
|
|
}
|
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
sub splitpath_VMS {
|
230
|
0
|
|
|
0
|
|
0
|
my($self,$path) = @_;
|
231
|
0
|
|
|
|
|
0
|
my($dev,$dir,$file) = ('','','');
|
232
|
|
|
|
|
|
|
|
233
|
0
|
|
|
|
|
0
|
vmsify($path) =~ /(.+:)?([\[<].*[\]>])?(.*)/s;
|
234
|
0
|
|
0
|
|
|
0
|
return ($1 || '',$2 || '',$3);
|
|
|
|
0
|
|
|
|
|
235
|
|
|
|
|
|
|
}
|
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
sub catpath_VMS {
|
238
|
0
|
|
|
0
|
|
0
|
my($self,$dev,$dir,$file) = @_;
|
239
|
0
|
0
|
|
|
|
0
|
if ($dev =~ m|^/+([^/]+)|) { $dev = "$1:"; }
|
|
0
|
|
|
|
|
0
|
|
240
|
0
|
0
|
0
|
|
|
0
|
else { $dev .= ':' unless $dev eq '' or $dev =~ /:\Z(?!\n)/; }
|
241
|
0
|
0
|
0
|
|
|
0
|
if (length($dev) or length($dir)) {
|
242
|
0
|
0
|
|
|
|
0
|
$dir = "[$dir]" unless $dir =~ /[\[<\/]/;
|
243
|
0
|
|
|
|
|
0
|
$dir = vmspath($dir);
|
244
|
|
|
|
|
|
|
}
|
245
|
0
|
|
|
|
|
0
|
"$dev$dir$file";
|
246
|
|
|
|
|
|
|
}
|
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
##########################
|
249
|
|
|
|
|
|
|
# LIBZIP::FILE::BASENAME #
|
250
|
|
|
|
|
|
|
##########################
|
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
package LibZip::File::Basename ;
|
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
my(@ISA, $VERSION, $Fileparse_fstype, $Fileparse_igncase);
|
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
$VERSION = "2.71";
|
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
sub fileparse {
|
259
|
3
|
|
|
3
|
|
6
|
my($fullname,@suffices) = @_;
|
260
|
3
|
|
|
|
|
7
|
my($fstype,$igncase) = ($Fileparse_fstype, $Fileparse_igncase);
|
261
|
3
|
|
|
|
|
4
|
my($dirpath,$tail,$suffix,$basename);
|
262
|
3
|
|
|
|
|
6
|
my($taint) = substr($fullname,0,0); # Is $fullname tainted?
|
263
|
|
|
|
|
|
|
|
264
|
3
|
50
|
|
|
|
11
|
if ($fstype =~ /^VMS/i) {
|
265
|
0
|
0
|
|
|
|
0
|
if ($fullname =~ m#/#) { $fstype = '' } # We're doing Unix emulation
|
|
0
|
|
|
|
|
0
|
|
266
|
|
|
|
|
|
|
else {
|
267
|
0
|
|
|
|
|
0
|
($dirpath,$basename) = ($fullname =~ /^(.*[:>\]])?(.*)/s);
|
268
|
0
|
|
0
|
|
|
0
|
$dirpath ||= ''; # should always be defined
|
269
|
|
|
|
|
|
|
}
|
270
|
|
|
|
|
|
|
}
|
271
|
3
|
50
|
|
|
|
30
|
if ($fstype =~ /^MS(DOS|Win32)|epoc/i) {
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
272
|
0
|
|
|
|
|
0
|
($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/s);
|
273
|
0
|
0
|
|
|
|
0
|
$dirpath .= '.\\' unless $dirpath =~ /[\\\/]\z/;
|
274
|
|
|
|
|
|
|
}
|
275
|
|
|
|
|
|
|
elsif ($fstype =~ /^os2/i) {
|
276
|
0
|
|
|
|
|
0
|
($dirpath,$basename) = ($fullname =~ m#^((?:.*[:\\/])?)(.*)#s);
|
277
|
0
|
0
|
|
|
|
0
|
$dirpath = './' unless $dirpath; # Can't be 0
|
278
|
0
|
0
|
|
|
|
0
|
$dirpath .= '/' unless $dirpath =~ m#[\\/]\z#;
|
279
|
|
|
|
|
|
|
}
|
280
|
|
|
|
|
|
|
elsif ($fstype =~ /^MacOS/si) {
|
281
|
0
|
|
|
|
|
0
|
($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/s);
|
282
|
0
|
0
|
|
|
|
0
|
$dirpath = ':' unless $dirpath;
|
283
|
|
|
|
|
|
|
}
|
284
|
|
|
|
|
|
|
elsif ($fstype =~ /^AmigaOS/i) {
|
285
|
0
|
|
|
|
|
0
|
($dirpath,$basename) = ($fullname =~ /(.*[:\/])?(.*)/s);
|
286
|
0
|
0
|
|
|
|
0
|
$dirpath = './' unless $dirpath;
|
287
|
|
|
|
|
|
|
}
|
288
|
|
|
|
|
|
|
elsif ($fstype !~ /^VMS/i) { # default to Unix
|
289
|
3
|
|
|
|
|
14
|
($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#s);
|
290
|
3
|
50
|
33
|
|
|
13
|
if ($^O eq 'VMS' and $fullname =~ m:^(/[^/]+/000000(/|$))(.*):) {
|
291
|
|
|
|
|
|
|
# dev:[000000] is top of VMS tree, similar to Unix '/'
|
292
|
|
|
|
|
|
|
# so strip it off and treat the rest as "normal"
|
293
|
0
|
|
|
|
|
0
|
my $devspec = $1;
|
294
|
0
|
|
|
|
|
0
|
my $remainder = $3;
|
295
|
0
|
|
|
|
|
0
|
($dirpath,$basename) = ($remainder =~ m#^(.*/)?(.*)#s);
|
296
|
0
|
|
0
|
|
|
0
|
$dirpath ||= ''; # should always be defined
|
297
|
0
|
|
|
|
|
0
|
$dirpath = $devspec.$dirpath;
|
298
|
|
|
|
|
|
|
}
|
299
|
3
|
50
|
|
|
|
9
|
$dirpath = './' unless $dirpath;
|
300
|
|
|
|
|
|
|
}
|
301
|
|
|
|
|
|
|
|
302
|
3
|
50
|
|
|
|
7
|
if (@suffices) {
|
303
|
0
|
|
|
|
|
0
|
$tail = '';
|
304
|
0
|
|
|
|
|
0
|
foreach $suffix (@suffices) {
|
305
|
0
|
0
|
|
|
|
0
|
my $pat = ($igncase ? '(?i)' : '') . "($suffix)\$";
|
306
|
0
|
0
|
|
|
|
0
|
if ($basename =~ s/$pat//s) {
|
307
|
0
|
|
|
|
|
0
|
$taint .= substr($suffix,0,0);
|
308
|
0
|
|
|
|
|
0
|
$tail = $1 . $tail;
|
309
|
|
|
|
|
|
|
}
|
310
|
|
|
|
|
|
|
}
|
311
|
|
|
|
|
|
|
}
|
312
|
|
|
|
|
|
|
|
313
|
3
|
50
|
|
|
|
7
|
$tail .= $taint if defined $tail; # avoid warning if $tail == undef
|
314
|
3
|
50
|
|
|
|
14
|
wantarray ? ($basename .= $taint, $dirpath .= $taint, $tail)
|
315
|
|
|
|
|
|
|
: ($basename .= $taint);
|
316
|
|
|
|
|
|
|
}
|
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
sub dirname {
|
319
|
2
|
|
|
2
|
|
8
|
my($basename,$dirname) = fileparse($_[0]);
|
320
|
2
|
|
|
|
|
3
|
my($fstype) = $Fileparse_fstype;
|
321
|
|
|
|
|
|
|
|
322
|
2
|
50
|
|
|
|
22
|
if ($fstype =~ /VMS/i) {
|
323
|
0
|
0
|
|
|
|
0
|
if ($_[0] =~ m#/#) { $fstype = '' }
|
|
0
|
|
|
|
|
0
|
|
324
|
0
|
|
0
|
|
|
0
|
else { return $dirname || $ENV{DEFAULT} }
|
325
|
|
|
|
|
|
|
}
|
326
|
2
|
50
|
|
|
|
16
|
if ($fstype =~ /MacOS/i) {
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
327
|
0
|
0
|
0
|
|
|
0
|
if( !length($basename) && $dirname !~ /^[^:]+:\z/) {
|
328
|
0
|
|
|
|
|
0
|
$dirname =~ s/([^:]):\z/$1/s;
|
329
|
0
|
|
|
|
|
0
|
($basename,$dirname) = fileparse $dirname;
|
330
|
|
|
|
|
|
|
}
|
331
|
0
|
0
|
|
|
|
0
|
$dirname .= ":" unless $dirname =~ /:\z/;
|
332
|
|
|
|
|
|
|
}
|
333
|
|
|
|
|
|
|
elsif ($fstype =~ /MS(DOS|Win32)|os2/i) {
|
334
|
0
|
|
|
|
|
0
|
$dirname =~ s/([^:])[\\\/]*\z/$1/;
|
335
|
0
|
0
|
|
|
|
0
|
unless( length($basename) ) {
|
336
|
0
|
|
|
|
|
0
|
($basename,$dirname) = fileparse $dirname;
|
337
|
0
|
|
|
|
|
0
|
$dirname =~ s/([^:])[\\\/]*\z/$1/;
|
338
|
|
|
|
|
|
|
}
|
339
|
|
|
|
|
|
|
}
|
340
|
|
|
|
|
|
|
elsif ($fstype =~ /AmigaOS/i) {
|
341
|
0
|
0
|
|
|
|
0
|
if ( $dirname =~ /:\z/) { return $dirname }
|
|
0
|
|
|
|
|
0
|
|
342
|
0
|
|
|
|
|
0
|
chop $dirname;
|
343
|
0
|
0
|
|
|
|
0
|
$dirname =~ s#[^:/]+\z## unless length($basename);
|
344
|
|
|
|
|
|
|
}
|
345
|
|
|
|
|
|
|
else {
|
346
|
2
|
|
|
|
|
17
|
$dirname =~ s:(.)/*\z:$1:s;
|
347
|
2
|
100
|
|
|
|
6
|
unless( length($basename) ) {
|
348
|
1
|
|
|
|
|
3
|
local($LibZip::File::Basename::Fileparse_fstype) = $fstype;
|
349
|
1
|
|
|
|
|
2
|
($basename,$dirname) = fileparse $dirname;
|
350
|
1
|
|
|
|
|
10
|
$dirname =~ s:(.)/*\z:$1:s;
|
351
|
|
|
|
|
|
|
}
|
352
|
|
|
|
|
|
|
}
|
353
|
|
|
|
|
|
|
|
354
|
2
|
|
|
|
|
6
|
$dirname;
|
355
|
|
|
|
|
|
|
}
|
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
sub fileparse_set_fstype {
|
358
|
2
|
|
|
2
|
|
6
|
my @old = ($Fileparse_fstype, $Fileparse_igncase);
|
359
|
2
|
50
|
|
|
|
10
|
if (@_) {
|
360
|
2
|
|
|
|
|
40
|
$Fileparse_fstype = $_[0];
|
361
|
2
|
|
|
|
|
33
|
$Fileparse_igncase = ($_[0] =~ /^(?:MacOS|VMS|AmigaOS|os2|RISCOS|MSWin32|MSDOS)/i);
|
362
|
|
|
|
|
|
|
}
|
363
|
2
|
50
|
|
|
|
12
|
wantarray ? @old : $old[0];
|
364
|
|
|
|
|
|
|
}
|
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
fileparse_set_fstype $^O;
|
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
####################
|
369
|
|
|
|
|
|
|
# LIBZIPFILE::PATH #
|
370
|
|
|
|
|
|
|
####################
|
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
package LibZip::File::Path ;
|
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
my $Is_VMS = $^O eq 'VMS';
|
375
|
|
|
|
|
|
|
my $Is_MacOS = $^O eq 'MacOS';
|
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
sub mkpath {
|
378
|
2
|
|
|
2
|
|
6
|
my($paths, $verbose, $mode) = @_;
|
379
|
|
|
|
|
|
|
# $paths -- either a path string or ref to list of paths
|
380
|
|
|
|
|
|
|
# $verbose -- optional print "mkdir $path" for each directory created
|
381
|
|
|
|
|
|
|
# $mode -- optional permissions, defaults to 0777
|
382
|
2
|
50
|
|
|
|
7
|
local($")=$Is_MacOS ? ":" : "/";
|
383
|
2
|
50
|
|
|
|
6
|
$mode = 0777 unless defined($mode);
|
384
|
2
|
50
|
|
|
|
8
|
$paths = [$paths] unless ref $paths;
|
385
|
2
|
|
|
|
|
3
|
my(@created,$path);
|
386
|
2
|
|
|
|
|
5
|
foreach $path (@$paths) {
|
387
|
2
|
50
|
33
|
|
|
15
|
$path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT
|
388
|
|
|
|
|
|
|
# Logic wants Unix paths, so go with the flow.
|
389
|
2
|
100
|
|
|
|
110
|
next if -d $path;
|
390
|
1
|
|
|
|
|
5
|
my $parent = LibZip::File::Basename::dirname($path);
|
391
|
1
|
50
|
33
|
|
|
19
|
unless (-d $parent or $path eq $parent) {
|
392
|
0
|
|
|
|
|
0
|
push(@created,mkpath($parent, $verbose, $mode));
|
393
|
|
|
|
|
|
|
}
|
394
|
1
|
50
|
|
|
|
3
|
print "mkdir $path\n" if $verbose;
|
395
|
1
|
50
|
|
|
|
96
|
unless (mkdir($path,$mode)) {
|
396
|
0
|
|
|
|
|
0
|
my $e = $!;
|
397
|
|
|
|
|
|
|
# allow for another process to have created it meanwhile
|
398
|
|
|
|
|
|
|
#croak "mkdir $path: $e" unless -d $path;
|
399
|
|
|
|
|
|
|
}
|
400
|
1
|
|
|
|
|
4
|
push(@created, $path);
|
401
|
|
|
|
|
|
|
}
|
402
|
2
|
|
|
|
|
18
|
@created;
|
403
|
|
|
|
|
|
|
}
|
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
sub carp {
|
406
|
0
|
0
|
|
0
|
|
0
|
warn join("\n", @_) . "\n" if !$LibZip::END ;
|
407
|
|
|
|
|
|
|
}
|
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
sub rmtree {
|
410
|
2
|
|
|
2
|
|
4
|
my($roots, $verbose, $safe) = @_;
|
411
|
2
|
|
|
|
|
3
|
my(@files);
|
412
|
2
|
|
|
|
|
3
|
my($count) = 0;
|
413
|
2
|
|
50
|
|
|
10
|
$verbose ||= 0;
|
414
|
2
|
|
50
|
|
|
8
|
$safe ||= 0;
|
415
|
|
|
|
|
|
|
|
416
|
2
|
50
|
33
|
|
|
14
|
if ( defined($roots) && length($roots) ) {
|
417
|
2
|
100
|
|
|
|
8
|
$roots = [$roots] unless ref $roots;
|
418
|
|
|
|
|
|
|
}
|
419
|
|
|
|
|
|
|
else {
|
420
|
0
|
|
|
|
|
0
|
carp "No root path(s) specified\n";
|
421
|
0
|
|
|
|
|
0
|
return 0;
|
422
|
|
|
|
|
|
|
}
|
423
|
|
|
|
|
|
|
|
424
|
2
|
|
|
|
|
2
|
my($root);
|
425
|
2
|
|
|
|
|
3
|
foreach $root (@{$roots}) {
|
|
2
|
|
|
|
|
5
|
|
426
|
2
|
50
|
|
|
|
4
|
if ($Is_MacOS) {
|
427
|
0
|
0
|
|
|
|
0
|
$root = ":$root" if $root !~ /:/;
|
428
|
0
|
|
|
|
|
0
|
$root =~ s#([^:])\z#$1:#;
|
429
|
|
|
|
|
|
|
} else {
|
430
|
2
|
|
|
|
|
6
|
$root =~ s#/\z##;
|
431
|
|
|
|
|
|
|
}
|
432
|
2
|
50
|
|
|
|
37
|
(undef, undef, my $rp) = lstat $root or next;
|
433
|
2
|
|
|
|
|
3
|
$rp &= 07777; # don't forget setuid, setgid, sticky bits
|
434
|
2
|
100
|
|
|
|
6
|
if ( -d _ ) {
|
435
|
|
|
|
|
|
|
# notabene: 0777 is for making readable in the first place,
|
436
|
|
|
|
|
|
|
# it's also intended to change it to writable in case we have
|
437
|
|
|
|
|
|
|
# to recurse in which case we are better than rm -rf for
|
438
|
|
|
|
|
|
|
# subtrees with strange permissions
|
439
|
1
|
50
|
33
|
|
|
30
|
chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
|
|
|
50
|
|
|
|
|
|
440
|
|
|
|
|
|
|
or carp "Can't make directory $root read+writeable: $!"
|
441
|
|
|
|
|
|
|
unless $safe;
|
442
|
|
|
|
|
|
|
|
443
|
1
|
50
|
|
|
|
49
|
if (opendir my $d, $root) {
|
444
|
|
|
|
|
|
|
#no strict 'refs';
|
445
|
1
|
50
|
33
|
|
|
2
|
if (!defined ${"\cTAINT"} or ${"\cTAINT"}) {
|
|
1
|
|
|
|
|
13
|
|
|
1
|
|
|
|
|
9
|
|
446
|
|
|
|
|
|
|
# Blindly untaint dir names
|
447
|
0
|
|
|
|
|
0
|
@files = map { /^(.*)$/s ; $1 } readdir $d;
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
448
|
|
|
|
|
|
|
} else {
|
449
|
1
|
|
|
|
|
23
|
@files = readdir $d;
|
450
|
|
|
|
|
|
|
}
|
451
|
1
|
|
|
|
|
20
|
closedir $d;
|
452
|
|
|
|
|
|
|
}
|
453
|
|
|
|
|
|
|
else {
|
454
|
0
|
|
|
|
|
0
|
carp "Can't read $root: $!";
|
455
|
0
|
|
|
|
|
0
|
@files = ();
|
456
|
|
|
|
|
|
|
}
|
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
# Deleting large numbers of files from VMS Files-11 filesystems
|
459
|
|
|
|
|
|
|
# is faster if done in reverse ASCIIbetical order
|
460
|
1
|
50
|
|
|
|
4
|
@files = reverse @files if $Is_VMS;
|
461
|
1
|
50
|
|
|
|
5
|
($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
|
462
|
1
|
50
|
|
|
|
6
|
if ($Is_MacOS) {
|
463
|
0
|
|
|
|
|
0
|
@files = map("$root$_", @files);
|
464
|
|
|
|
|
|
|
} else {
|
465
|
1
|
|
|
|
|
14
|
@files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
|
466
|
|
|
|
|
|
|
}
|
467
|
1
|
|
|
|
|
12
|
$count += rmtree(\@files,$verbose,$safe);
|
468
|
1
|
0
|
33
|
|
|
4
|
if ($safe &&
|
|
|
0
|
|
|
|
|
|
469
|
|
|
|
|
|
|
($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
|
470
|
0
|
0
|
|
|
|
0
|
print "skipped $root\n" if $verbose;
|
471
|
0
|
|
|
|
|
0
|
next;
|
472
|
|
|
|
|
|
|
}
|
473
|
1
|
50
|
0
|
|
|
4
|
chmod 0777, $root
|
474
|
|
|
|
|
|
|
or carp "Can't make directory $root writeable: $!"
|
475
|
|
|
|
|
|
|
if $force_writeable;
|
476
|
1
|
50
|
|
|
|
3
|
print "rmdir $root\n" if $verbose;
|
477
|
1
|
50
|
|
|
|
148
|
if (rmdir $root) {
|
478
|
1
|
|
|
|
|
5
|
++$count;
|
479
|
|
|
|
|
|
|
}
|
480
|
|
|
|
|
|
|
else {
|
481
|
0
|
|
|
|
|
0
|
carp "Can't remove directory $root: $!";
|
482
|
0
|
0
|
|
|
|
0
|
chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
|
|
|
0
|
|
|
|
|
|
483
|
|
|
|
|
|
|
or carp("and can't restore permissions to "
|
484
|
|
|
|
|
|
|
. sprintf("0%o",$rp) . "\n");
|
485
|
|
|
|
|
|
|
}
|
486
|
|
|
|
|
|
|
}
|
487
|
|
|
|
|
|
|
else {
|
488
|
1
|
0
|
0
|
|
|
4
|
if ($safe &&
|
|
|
0
|
33
|
|
|
|
|
489
|
|
|
|
|
|
|
($Is_VMS ? !&VMS::Filespec::candelete($root)
|
490
|
|
|
|
|
|
|
: !(-l $root || -w $root)))
|
491
|
|
|
|
|
|
|
{
|
492
|
0
|
0
|
|
|
|
0
|
print "skipped $root\n" if $verbose;
|
493
|
0
|
|
|
|
|
0
|
next;
|
494
|
|
|
|
|
|
|
}
|
495
|
1
|
50
|
0
|
|
|
4
|
chmod 0666, $root
|
496
|
|
|
|
|
|
|
or carp "Can't make file $root writeable: $!"
|
497
|
|
|
|
|
|
|
if $force_writeable;
|
498
|
1
|
50
|
|
|
|
4
|
print "unlink $root\n" if $verbose;
|
499
|
|
|
|
|
|
|
# delete all versions under VMS
|
500
|
1
|
|
|
|
|
2
|
for (;;) {
|
501
|
1
|
50
|
|
|
|
83
|
unless (unlink $root) {
|
502
|
0
|
|
|
|
|
0
|
carp "Can't unlink file $root: $!";
|
503
|
0
|
0
|
|
|
|
0
|
if ($force_writeable) {
|
504
|
0
|
0
|
|
|
|
0
|
chmod $rp, $root
|
505
|
|
|
|
|
|
|
or carp("and can't restore permissions to "
|
506
|
|
|
|
|
|
|
. sprintf("0%o",$rp) . "\n");
|
507
|
|
|
|
|
|
|
}
|
508
|
0
|
|
|
|
|
0
|
last;
|
509
|
|
|
|
|
|
|
}
|
510
|
1
|
|
|
|
|
2
|
++$count;
|
511
|
1
|
50
|
33
|
|
|
7
|
last unless $Is_VMS && lstat $root;
|
512
|
|
|
|
|
|
|
}
|
513
|
|
|
|
|
|
|
}
|
514
|
|
|
|
|
|
|
}
|
515
|
|
|
|
|
|
|
|
516
|
2
|
|
|
|
|
9
|
$count;
|
517
|
|
|
|
|
|
|
}
|
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
# my ( $volumeName, $dirName, $fileName ) = LibZip::File::Spec->splitpath('./LibZipData.pm');
|
521
|
|
|
|
|
|
|
# print "$volumeName, $dirName, $fileName\n" ;
|
522
|
|
|
|
|
|
|
#
|
523
|
|
|
|
|
|
|
# $dirName = LibZip::File::Spec->catpath( $volumeName, $dirName, '' );
|
524
|
|
|
|
|
|
|
# print "$dirName\n" ;
|
525
|
|
|
|
|
|
|
#
|
526
|
|
|
|
|
|
|
# my $d = LibZip::File::Basename::dirname('./asdasd/fl.txt') ;
|
527
|
|
|
|
|
|
|
# print "$d\n" ;
|
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
#######
|
530
|
|
|
|
|
|
|
# END #
|
531
|
|
|
|
|
|
|
#######
|
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
1;
|
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
|