From e1729dfdb9c341fe0b9fed7d7b0a80691a547d82 Mon Sep 17 00:00:00 2001 From: Chmouel Boudjnah Date: Thu, 1 Jul 1999 12:29:54 +0000 Subject: "See_The_Changelog" --- perl-install/common.pm | 84 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 84 insertions(+) create mode 100644 perl-install/common.pm (limited to 'perl-install/common.pm') diff --git a/perl-install/common.pm b/perl-install/common.pm new file mode 100644 index 000000000..6c12961ef --- /dev/null +++ b/perl-install/common.pm @@ -0,0 +1,84 @@ +package common; + +use diagnostics; +use strict; +use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int $error $cancel $SECTORSIZE); + +@ISA = qw(Exporter); +%EXPORT_TAGS = ( + common => [ qw(min max bool member divide error cancel is_empty_array_ref round_up round_down first top) ], + 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) ], +); +@EXPORT_OK = map { @$_ } values %EXPORT_TAGS; + +$printable_chars = "\x20-\x7E"; +$sizeof_int = psizeof("i"); +$bitof_int = $sizeof_int * 8; +$error = 0; +$cancel = 0; +$SECTORSIZE = 512; + +1; + +sub min { my $min = shift; grep { $_ < $min and $min = $_; } @_; $min } +sub max { my $max = shift; grep { $_ > $max and $max = $_; } @_; $max } +sub first { $_[0] } +sub top { $_[$#_] } +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|.*/||; $_ } +sub error { $error = 1; 0 } +sub cancel { $cancel = 1; 0 } +sub bool { $_[0] ? 1 : 0 } +sub strcpy { substr($_[0], $_[2] || 0, length $_[1]) = $_[1] } +sub cat_ { local *F; open F, $_[0] or $_[1] ? die "cat of file $_[0] failed: $!\n" : return; my @l = ; @l } +sub chop_ { map { my $l = $_; chomp $l; $l } @_ } +sub divide { my $d = int $_[0] / $_[1]; wantarray ? ($d, $_[0] % $_[1]) : $d } +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 sync { syscall_('sync') } +sub gettimeofday { my $t = pack "LL"; syscall_('gettimeofday', $t, 0) or die "gettimeofday: $!\n"; unpack("LL", $t) } + +sub remove_spaces { local $_ = shift; s/^ +//; s/ +$//; $_ } +sub mode { my @l = stat $_[0] or die "unable to get mode of file $_[0]: $!\n"; $l[2] } +sub psizeof { length pack $_[0] } + +sub all { + my $d = shift; + + local *F; + opendir F, $d or die "all: can't opendir $d: $!\n"; + grep { $_ ne '.' && $_ ne '..' } readdir F; +} + +sub glob_ { + my ($d, $f) = ($_[0] =~ /\*/) ? (dirname($_[0]), basename($_[0])) : ($_[0], '*'); + + $d =~ /\*/ and die "glob_: wildcard in directory not handled ($_[0])\n"; + ($f = quotemeta $f) =~ s/\\\*/.*/g; + + $d =~ m|/$| or $d .= '/'; + map { $d eq './' ? $_ : "$d$_" } grep { /$f/ } all($d); +} + + +sub syscall_ { + my $f = shift; + + require 'syscall.ph'; + syscall(&{$common::{"SYS_$f"}}, @_) == 0; +} + + +sub crypt_ { + local $_ = (gettimeofday())[1] % 0x40; + tr [\0-\x3f] [0-9a-zA-Z./]; + crypt($_[0], $_) +} + +sub makedev { ($_[0] << 8) | $_[1] } +sub unmakedev { $_[0] >> 8, $_[0] & 0xff } -- cgit v1.2.1