"Fossies" - the Fresh Open Source Software Archive

Member "automake-1.16.3/lib/Automake/General.pm" (19 Nov 2020, 2023 Bytes) of package /linux/misc/automake-1.16.3.tar.xz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "General.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 1.16.2_vs_1.16.3.

    1 # Copyright (C) 2001-2020 Free Software Foundation, Inc.
    2 
    3 # This program is free software; you can redistribute it and/or modify
    4 # it under the terms of the GNU General Public License as published by
    5 # the Free Software Foundation; either version 2, or (at your option)
    6 # any later version.
    7 
    8 # This program is distributed in the hope that it will be useful,
    9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
   10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   11 # GNU General Public License for more details.
   12 
   13 # You should have received a copy of the GNU General Public License
   14 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
   15 
   16 package Automake::General;
   17 
   18 use 5.006;
   19 use strict;
   20 use warnings FATAL => 'all';
   21 
   22 use Exporter;
   23 use File::Basename;
   24 
   25 our @ISA = qw (Exporter);
   26 our @EXPORT = qw (&uniq &none $me);
   27 
   28 # Variable we share with the main package.  Be sure to have a single
   29 # copy of them: using 'my' together with multiple inclusion of this
   30 # package would introduce several copies.
   31 our $me = basename ($0);
   32 
   33 # END
   34 # ---
   35 # Exit nonzero whenever closing STDOUT fails.
   36 sub END
   37 {
   38   # This is required if the code might send any output to stdout
   39   # E.g., even --version or --help.  So it's best to do it unconditionally.
   40   if (! close STDOUT)
   41     {
   42       print STDERR "$me: closing standard output: $!\n";
   43       $? = 74; # EX_IOERR
   44       return;
   45     }
   46 }
   47 
   48 
   49 # @RES
   50 # uniq (@LIST)
   51 # ------------
   52 # Return LIST with no duplicates.
   53 sub uniq (@)
   54 {
   55    my @res = ();
   56    my %seen = ();
   57    foreach my $item (@_)
   58      {
   59        if (! exists $seen{$item})
   60      {
   61        $seen{$item} = 1;
   62        push (@res, $item);
   63      }
   64      }
   65    return wantarray ? @res : "@res";
   66 }
   67 
   68 # $RES
   69 # none (&PRED, @LIST)
   70 # ------------
   71 # Return 1 when no element in LIST satisfies predicate PRED otherwise 0.
   72 sub none (&@)
   73 {
   74   my ($pred, @list) = @_;
   75   my $res = 1;
   76   foreach my $item (@list)
   77     {
   78       if ($pred->($item))
   79         {
   80           $res = 0;
   81           last;
   82         }
   83     }
   84   return $res;
   85 }
   86 
   87 1; # for require