From 5a5ec8d18c04f2077622bce50e7024e0749e4da8 Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Wed, 21 Jul 1999 16:59:18 +0000 Subject: *** empty log message *** --- perl-install/common.pm | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'perl-install/common.pm') diff --git a/perl-install/common.pm b/perl-install/common.pm index c15aafdae..feec2e844 100644 --- a/perl-install/common.pm +++ b/perl-install/common.pm @@ -6,7 +6,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int @ISA = qw(Exporter); %EXPORT_TAGS = ( - common => [ qw(_ __ min max bool member divide is_empty_array_ref round_up round_down first top translate) ], + common => [ qw(_ __ min max bool member divide is_empty_array_ref set_new set_add round_up round_down first second top uniq translate) ], file => [ qw(dirname basename all glob_ cat_ chop_ mode) ], system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_) ], constant => [ qw($printable_chars $sizeof_int $bitof_int $SECTORSIZE) ], @@ -25,7 +25,9 @@ sub __ { $_[0] } sub min { my $min = shift; grep { $_ < $min and $min = $_; } @_; $min } sub max { my $max = shift; grep { $_ > $max and $max = $_; } @_; $max } sub first { $_[0] } +sub second { $_[1] } sub top { $_[$#_] } +sub uniq { my %l; @l{@_} = (); keys %l } sub member { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 } sub dirname { @_ == 1 or die "usage: dirname \n"; local $_ = shift; s|[^/]*/*\s*$||; s|(.)/*$|$1|; $_ || '.' } sub basename { @_ == 1 or die "usage: basename \n"; local $_ = shift; s|/*\s*$||; s|.*/||; $_ } @@ -38,6 +40,9 @@ sub round_up { my ($i, $r) = @_; $i += $r - ($i + $r - 1) % $r - 1; } sub round_down { my ($i, $r) = @_; $i -= $i % $r; } sub is_empty_array_ref { my $a = shift; !defined $a || @$a == 0 } +sub set_new(@) { my %l; @l{@_} = undef; { list => [ @_ ], hash => \%l } } +sub set_add($@) { my $o = shift; foreach (@_) { exists $o->{hash}->{$_} and next; push @{$o->{list}}, $_; $o->{hash}->{$_} = undef } } + sub sync { syscall_('sync') } sub gettimeofday { my $t = pack "LL"; syscall_('gettimeofday', $t, 0) or die "gettimeofday failed: $!\n"; unpack("LL", $t) } -- cgit v1.2.1