| # Copyright (C) 2001-2025 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; |
| |
| 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 |