This file is indexed.

/usr/share/perl5/File/Remove.pm is in libfile-remove-perl 1.57-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
package File::Remove;

use 5.00503;
use strict;
use warnings;

use vars qw{ $VERSION @ISA @EXPORT_OK };
use vars qw{ $DEBUG $unlink $rmdir    };
BEGIN {
	$VERSION   = '1.57';
	# $VERSION   = eval $VERSION;
	@ISA       = qw{ Exporter };
	@EXPORT_OK = qw{ remove rm clear trash };
}

use File::Path ();
use File::Glob ();
use File::Spec 3.29 ();
use Cwd        3.29 ();

# $debug variable must be set before loading File::Remove.
# Convert to a constant to allow debugging code to be pruned out.
use constant DEBUG    => !! $DEBUG;

# Are we on VMS?
# If so copy File::Path and assume VMS::Filespec is loaded
use constant IS_VMS   => !! ( $^O eq 'VMS' );

# Are we on Mac?
# If so we'll need to do some special trash work
use constant IS_MAC   => !! ( $^O eq 'darwin' );

# Are we on Win32?
# If so write permissions does not imply deletion permissions
use constant IS_WIN32 => !! ( $^O =~ /^MSWin/ or $^O eq 'cygwin' );

# If we ever need a Mac::Glue object we will want to cache it.
my $glue;





#####################################################################
# Main Functions

my @CLEANUP = ();

sub clear (@) {
	my @files = expand( @_ );

	# Do the initial deletion
	foreach my $file ( @files ) {
		next unless -e $file;
		remove( \1, $file );
	}

	# Delete again at END-time.
	# Save the current PID so that forked children
	# won't delete things that the parent expects to
	# live until their end-time.
	push @CLEANUP, map { [ $$, $_ ] } @files;
}

END {
	foreach my $file ( @CLEANUP ) {
		next unless $file->[0] == $$;
		next unless -e $file->[1];
		remove( \1, $file->[1] );
	}
}

# Acts like unlink would until given a directory as an argument, then
# it acts like rm -rf ;) unless the recursive arg is zero which it is by
# default
sub remove (@) {
	my $recursive = (ref $_[0] eq 'SCALAR') ? shift : \0;
    my $opts = (ref $_[0] eq 'HASH') ? shift : { glob => 1 };
	my @files     = _expand_with_opts ($opts, @_);

	# Iterate over the files
	my @removes;
	foreach my $path ( @files ) {
		# need to check for symlink first
		# could be pointing to nonexisting/non-readable destination
		if ( -l $path ) {
			print "link: $path\n" if DEBUG;
			if ( $unlink ? $unlink->($path) : unlink($path) ) {
				push @removes, $path;
			}
			next;
		}
		unless ( -e $path ) {
			print "missing: $path\n" if DEBUG;
			push @removes, $path; # Say we deleted it
			next;
		}
		my $can_delete;
		if ( IS_VMS ) {
			$can_delete = VMS::Filespec::candelete($path);
		} elsif ( IS_WIN32 ) {
			# Assume we can delete it for the moment
			$can_delete = 1;
		} elsif ( -w $path ) {
			# We have write permissions already
			$can_delete = 1;
		} elsif ( $< == 0 ) {
			# Unixy and root
			$can_delete = 1;
		} elsif ( (lstat($path))[4] == $< ) {
			# I own the file
			$can_delete = 1;
		} else {
			# I don't think we can delete it
			$can_delete = 0;
		}
		unless ( $can_delete ) {
			print "nowrite: $path\n" if DEBUG;
			next;
		}

		if ( -f $path ) {
			print "file: $path\n" if DEBUG;
			unless ( -w $path ) {
				# Make the file writable (implementation from File::Path)
				(undef, undef, my $rp) = lstat $path or next;
				$rp &= 07777; # Don't forget setuid, setgid, sticky bits
				$rp |= 0600;  # Turn on user read/write
				chmod $rp, $path;
			}
			if ( $unlink ? $unlink->($path) : unlink($path) ) {
				# Failed to delete the file
				next if -e $path;
				push @removes, $path;
			}

		} elsif ( -d $path ) {
			print "dir: $path\n" if DEBUG;
			my $dir = File::Spec->canonpath($path);

			# Do we need to move our cwd out of the location
			# we are planning to delete?
			my $chdir = _moveto($dir);
			if ( length $chdir ) {
				chdir($chdir) or next;
			}

			if ( $$recursive ) {
				if ( File::Path::rmtree( [ $dir ], DEBUG, 0 ) ) {
					# Failed to delete the directory
					next if -e $path;
					push @removes, $path;
				}

			} else {
				my ($save_mode) = (stat $dir)[2];
				chmod $save_mode & 0777, $dir; # just in case we cannot remove it.
				if ( $rmdir ? $rmdir->($dir) : rmdir($dir) ) {
					# Failed to delete the directory
					next if -e $path;
					push @removes, $path;
				}
			}

		} else {
			print "???: $path\n" if DEBUG;
		}
	}

	return @removes;
}

sub rm (@) {
	goto &remove;
}

sub trash (@) {
	local $unlink = $unlink;
	local $rmdir  = $rmdir;

	if ( ref $_[0] eq 'HASH' ) {
		my %options = %{+shift @_};
		$unlink = $options{unlink};
		$rmdir  = $options{rmdir};

	} elsif ( IS_WIN32 ) {
		local $@;
		eval 'use Win32::FileOp ();';
		die "Can't load Win32::FileOp to support the Recycle Bin: \$@ = $@" if length $@;
		$unlink = \&Win32::FileOp::Recycle;
		$rmdir  = \&Win32::FileOp::Recycle;

	} elsif ( IS_MAC ) {
		unless ( $glue ) {
			local $@;
			eval 'use Mac::Glue ();';
			die "Can't load Mac::Glue::Finder to support the Trash Can: \$@ = $@" if length $@;
			$glue = Mac::Glue->new('Finder');
		}
		my $code = sub {
			my @files = map {
				Mac::Glue::param_type(
					Mac::Glue::typeAlias() => $_
				)
			} @_;
			$glue->delete(\@files);
		};
		$unlink = $code;
		$rmdir  = $code;
	} else {
		die "Support for trash() on platform '$^O' not available at this time.\n";
	}

	remove(@_);
}

sub undelete (@) {
	goto &trash;
}





######################################################################
# Support Functions

sub _expand_with_opts {
    my $opts = shift;
    return ($opts->{glob} ? expand(@_) : @_);
}

sub expand (@) {
	map { -e $_ ? $_ : File::Glob::bsd_glob($_) } @_;
}

# Do we need to move to a different directory to delete a directory,
# and if so which.
sub _moveto {
	my $remove = File::Spec->rel2abs(shift);
	my $cwd    = @_ ? shift : Cwd::cwd();

	# Do everything in absolute terms
	$remove = Cwd::abs_path( $remove );
	$cwd    = Cwd::abs_path( $cwd    );

	# If we are on a different volume we don't need to move
	my ( $cv, $cd ) = File::Spec->splitpath( $cwd,    1 );
	my ( $rv, $rd ) = File::Spec->splitpath( $remove, 1 );
	return '' unless $cv eq $rv;

	# If we have to move, it's to one level above the deletion
	my @cd = File::Spec->splitdir($cd);
	my @rd = File::Spec->splitdir($rd);

	# Is the current directory the same as or inside the remove directory?
	unless ( @cd >= @rd ) {
		return '';
	}
	foreach ( 0 .. $#rd ) {
		$cd[$_] eq $rd[$_] or return '';
	}

	# Confirmed, the current working dir is in the removal dir
	pop @rd;
	return File::Spec->catpath(
		$rv,
		File::Spec->catdir(@rd),
		''
	);
}

1;

__END__

=pod

=head1 NAME

File::Remove - Remove files and directories

=head1 VERSION

version 1.57

=head1 SYNOPSIS

    use File::Remove 'remove';

    # removes (without recursion) several files
    remove( '*.c', '*.pl' );

    # removes (with recursion) several directories
    remove( \1, qw{directory1 directory2} );

    # removes (with recursion) several files and directories
    remove( \1, qw{file1 file2 directory1 *~} );

    # removes without globbing:
    remove( \1, {glob => 0}, '*');

    # trashes (with support for undeleting later) several files
    trash( '*~' );

=head1 DESCRIPTION

B<File::Remove::remove> removes files and directories.  It acts like
B</bin/rm>, for the most part.  Although C<unlink> can be given a list
of files, it will not remove directories; this module remedies that.
It also accepts wildcards, * and ?, as arguments for filenames.

B<File::Remove::trash> accepts the same arguments as B<remove>, with
the addition of an optional, infrequently used "other platforms"
hashref.

=head1 SUBROUTINES

=head2 remove

Removes files and directories.  Directories are removed recursively like
in B<rm -rf> if the first argument is a reference to a scalar that
evaluates to true.  If the first argument is a reference to a scalar,
then it is used as the value of the recursive flag.  By default it's
false so only pass \1 to it.

If the next argument is a hash reference then it is a key/values of options.
Currently, there is one supported option of C<<< 'glob' => 0 >>> which prevents
globbing. E.g:

    remove(\1, {glob => 0}, '*');

Will not remove files globbed by '*' and will only remove the file
called asterisk if it exists.

In list context it returns a list of files/directories removed, in
scalar context it returns the number of files/directories removed.  The
list/number should match what was passed in if everything went well.

=head2 rm

Just calls B<remove>.  It's there for people who get tired of typing
B<remove>.

=head2 clear

The C<clear> function is a version of C<remove> designed for
use in test scripts. It takes a list of paths that it will both
initially delete during the current test run, and then further
flag for deletion at END-time as a convenience for the next test
run.

=head2 trash

Removes files and directories, with support for undeleting later.
Accepts an optional "other platforms" hashref, passing the remaining
arguments to B<remove>.

=over 4

=item Win32

Requires L<Win32::FileOp>.

Installation not actually enforced on Win32 yet, since L<Win32::FileOp>
has badly failing dependencies at time of writing.

=item OS X

Requires L<Mac::Glue>.

=item Other platforms

The first argument to trash() must be a hashref with two keys,
'rmdir' and 'unlink', each referencing a coderef.  The coderefs
will be called with the filenames that are to be deleted.

=back

=head2 expand

B<DO NOT USE.> Kept for legacy.

=head2 undelete

B<DO NOT USE.> Kept for legacy.

=head1 SUPPORT

Bugs should always be submitted via the CPAN bug tracker

L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=File-Remove>

For other issues, contact the maintainer.

=head1 AUTHOR

Adam Kennedy E<lt>adamk@cpan.orgE<gt>

=head1 COPYRIGHT

Taken over by Shlomi Fish (L<http://www.shlomifish.org/>) while disclaiming
all rights and placing his modifications under
CC0/public-domain/MIT/any-other-licence.

Some parts copyright 2006 - 2012 Adam Kennedy.

Taken over by Adam Kennedy E<lt>adamk@cpan.orgE<gt> to fix the
"deep readonly files" bug, and do some package cleaning.

Some parts copyright 2004 - 2005 Richard Soderberg.

Taken over by Richard Soderberg E<lt>perl@crystalflame.netE<gt> to
port it to L<File::Spec> and add tests.

Original copyright: 1998 by Gabor Egressy, E<lt>gabor@vmunix.comE<gt>.

This program is free software; you can redistribute and/or modify it under
the same terms as Perl itself.

=head1 AUTHOR

Shlomi Fish <shlomif@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 1998 by Gabor Egressy.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website
http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Remove or by email to
bug-file-remove@rt.cpan.org.

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan

=head1 SUPPORT

=head2 Perldoc

You can find documentation for this module with the perldoc command.

  perldoc File::Remove

=head2 Websites

The following websites have more information about this module, and may be of help to you. As always,
in addition to those websites please use your favorite search engine to discover more resources.

=over 4

=item *

MetaCPAN

A modern, open-source CPAN search engine, useful to view POD in HTML format.

L<http://metacpan.org/release/File-Remove>

=item *

Search CPAN

The default CPAN search engine, useful to view POD in HTML format.

L<http://search.cpan.org/dist/File-Remove>

=item *

RT: CPAN's Bug Tracker

The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN.

L<https://rt.cpan.org/Public/Dist/Display.html?Name=File-Remove>

=item *

AnnoCPAN

The AnnoCPAN is a website that allows community annotations of Perl module documentation.

L<http://annocpan.org/dist/File-Remove>

=item *

CPAN Ratings

The CPAN Ratings is a website that allows community ratings and reviews of Perl modules.

L<http://cpanratings.perl.org/d/File-Remove>

=item *

CPAN Forum

The CPAN Forum is a web forum for discussing Perl modules.

L<http://cpanforum.com/dist/File-Remove>

=item *

CPANTS

The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution.

L<http://cpants.cpanauthors.org/dist/File-Remove>

=item *

CPAN Testers

The CPAN Testers is a network of smokers who run automated tests on uploaded CPAN distributions.

L<http://www.cpantesters.org/distro/F/File-Remove>

=item *

CPAN Testers Matrix

The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms.

L<http://matrix.cpantesters.org/?dist=File-Remove>

=item *

CPAN Testers Dependencies

The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution.

L<http://deps.cpantesters.org/?module=File::Remove>

=back

=head2 Bugs / Feature Requests

Please report any bugs or feature requests by email to C<bug-file-remove at rt.cpan.org>, or through
the web interface at L<https://rt.cpan.org/Public/Bug/Report.html?Queue=File-Remove>. You will be automatically notified of any
progress on the request by the system.

=head2 Source Code

The code is open to the world, and available for you to hack on. Please feel free to browse it and play
with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull
from your repository :)

L<https://github.com/shlomif/File-Remove>

  git clone git://github.com/shlomif/File-Remove.git

=cut