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

BRIANDFOY / PerlPowerTools-1.049 / bin / basename 

            

              
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

              
#!/usr/bin/perl
=begin metadata
Name: basename
Description: print the basename of a file
Author: Abigail, perlpowertools@abigail.be
License: perl
=end metadata
=cut
use strict;
use File::Basename qw(basename fileparse);
use Getopt::Std qw(getopts);
my $Program = basename($0);
our $VERSION = '1.5';
getopts('') or usage();
my $path = shift;
usage() unless defined $path;
my $suffix = shift;
usage() if @ARGV;
if (!length($path)) {
    print "\n";
    exit;
}
$path =~ s/\/+/\//g;  # "///" -> "/"
if ($path eq '/') {
    print "/\n";
    exit;
}
$path =~ s/\/\Z//;  #  "a/" -> "a"
my @parsed = fileparse($path);
my $name = shift @parsed;
if (defined $suffix) {
    my $i = rindex $name, $suffix;
    my $oklen = length($name) == length($suffix) + $i;
    if ($i > 0 && $oklen) {
        $name = substr $name, 0, $i;
    }
}
print $name, "\n";
exit 0;
sub VERSION_MESSAGE {
    print "$Program version $VERSION\n";
    exit 0;
}
sub usage {
    warn "usage: $Program string [suffix]\n";
    exit 1;
}
__END__
=pod
=head1 NAME
basename - remove directory and suffix from filenames
=head1 SYNOPSIS
basename string [suffix]
=head1 DESCRIPTION
I<basename> prints the file component of a path. A second argument to
I<basename> is interpreted as a suffix to remove from the file.
It is not considered an error if the given suffix does not match the string.
=head2 OPTIONS
I<basename> does not accept any options.
=head1 ENVIRONMENT
The working of I<basename> is not influenced by any environment variables.
=head1 BUGS
I<basename> has no known bugs.
=head1 STANDARDS
This I<basename> implementation is compliant with the B<IEEE Std1003.2-1992>
specification, also known as B<POSIX.2>.
This I<basename> implementation is compatible with the
B<OpenBSD> implementation.
=head1 AUTHOR
The Perl implementation of I<basename> was written by Abigail,
I<perlpowertools@abigail.be>.
=head1 COPYRIGHT and LICENSE
This program is copyright by Abigail 1999.
This program is free and open software. You may use, copy, modify, distribute
and sell this program (and any modified variants) in any way you wish,
provided you do not restrict others to do the same.
=cut