blob: 4c1d0630f7be8b7c6c70d37501373f249819bf67 (
plain)
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
|
# Copyright (C) 2001-2023 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <https://www.gnu.org/licenses/>.
package Automake::General;
use 5.006;
use strict;
use warnings FATAL => 'all';
use Exporter;
use File::Basename;
our @ISA = qw (Exporter);
our @EXPORT = qw (&uniq &none $me);
# Variable we share with the main package. Be sure to have a single
# copy of them: using 'my' together with multiple inclusion of this
# package would introduce several copies.
our $me = basename ($0);
# END
# ---
# Exit nonzero whenever closing STDOUT fails.
sub END
{
# This is required if the code might send any output to stdout
# E.g., even --version or --help. So it's best to do it unconditionally.
if (! close STDOUT)
{
print STDERR "$me: closing standard output: $!\n";
$? = 74; # EX_IOERR
return;
}
}
# @RES
# uniq (@LIST)
# ------------
# Return LIST with no duplicates.
sub uniq (@)
{
my @res = ();
my %seen = ();
foreach my $item (@_)
{
if (! exists $seen{$item})
{
$seen{$item} = 1;
push (@res, $item);
}
}
return wantarray ? @res : "@res";
}
# $RES
# none (&PRED, @LIST)
# ------------
# Return 1 when no element in LIST satisfies predicate PRED otherwise 0.
sub none (&@)
{
my ($pred, @list) = @_;
my $res = 1;
foreach my $item (@list)
{
if ($pred->($item))
{
$res = 0;
last;
}
}
return $res;
}
1; # for require
|
