Edit

kc3-lang/automake/lib/Automake/General.pm

Branch :

  • Show log

    Commit

  • Author : Paul Eggert
    Date : 2024-01-01 11:29:06
    Hash : b80b5c47
    Message : maint: make update-copyright

  • lib/Automake/General.pm
  • # Copyright (C) 2001-2024 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