1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
package common;
use diagnostics;
use strict;
use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int $cancel $SECTORSIZE);
@ISA = qw(Exporter);
%EXPORT_TAGS = (
common => [ qw(_ __ min max sum bool member divide is_empty_array_ref add2hash set_new set_add round_up round_down first second top uniq translate untranslate) ],
functional => [ qw(fold_left) ],
file => [ qw(dirname basename touch 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;
$SECTORSIZE = 512;
1;
sub _ { my $s = shift @_; sprintf translate($s), @_ }
sub __ { $_[0] }
sub min { fold_left(sub { $a < $b ? $a : $b }, @_) }
sub max { fold_left(sub { $a > $b ? $a : $b }, @_) }
sub sum { fold_left(sub { $a + $b }, @_) }
sub first { $_[0] }
sub second { $_[1] }
sub top { $_[$#_] }
sub uniq { my %l; @l{@_} = (); keys %l }
sub add2hash { my ($a, $b) = @_; while (my ($k, $v) = each %{$b || {}}) { $a->{$k} ||= $v } }
sub member { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 }
sub dirname { @_ == 1 or die "usage: dirname <name>\n"; local $_ = shift; s|[^/]*/*\s*$||; s|(.)/*$|$1|; $_ || '.' }
sub basename { @_ == 1 or die "usage: basename <name>\n"; local $_ = shift; s|/*\s*$||; s|.*/||; $_ }
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 = <F>; wantarray ? @l : join '', @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 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) }
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 touch {
my $f = shift;
unless (-e $f) {
local *F;
open F, ">$f";
}
my $now = time;
utime $now, $now, $f;
}
sub fold_left(&$@) {
my $f = shift;
local $a = shift;
foreach $b (@_) { $a = &$f() }
$a
}
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 }
sub translate {
my ($s) = @_;
unless (defined %po::I18N::I18N) {
if (my ($lang) = substr($ENV{LC_ALL} || $ENV{LANGUAGE} || $ENV{LC_MESSAGES} || $ENV{LANG} || '', 0, 2)) {
local $SIG{__DIE__} = 'none';
eval { require "po/$lang.pm" };
}
}
$po::I18N::I18N{$s} || $s;
}
sub untranslate($@) {
my $s = shift;
foreach (@_) { translate($_) eq $s and return $_ }
die "untranslate failed";
}
|
