From 5bef71a0c86613f95e154d08b5f8f0cc23226e27 Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Tue, 24 Jul 2001 16:53:54 +0000 Subject: initial commit --- MDK/Common/DataStructure.pm | 42 ++++++++++ MDK/Common/File.pm | 100 ++++++++++++++++++++++++ MDK/Common/Func.pm | 117 ++++++++++++++++++++++++++++ MDK/Common/Math.pm | 65 ++++++++++++++++ MDK/Common/String.pm | 90 ++++++++++++++++++++++ MDK/Common/System.pm | 181 ++++++++++++++++++++++++++++++++++++++++++++ MDK/Common/Various.pm | 32 ++++++++ 7 files changed, 627 insertions(+) create mode 100644 MDK/Common/DataStructure.pm create mode 100644 MDK/Common/File.pm create mode 100644 MDK/Common/Func.pm create mode 100644 MDK/Common/Math.pm create mode 100644 MDK/Common/String.pm create mode 100644 MDK/Common/System.pm create mode 100644 MDK/Common/Various.pm (limited to 'MDK/Common') diff --git a/MDK/Common/DataStructure.pm b/MDK/Common/DataStructure.pm new file mode 100644 index 0000000..8619e03 --- /dev/null +++ b/MDK/Common/DataStructure.pm @@ -0,0 +1,42 @@ +package MDK::Common::DataStructure; + +use MDK::Common::Math; + + +use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK); +@ISA = qw(Exporter); +@EXPORT_OK = qw(ikeys add2hash add2hash_ put_in_hash member invbool listlength strcpy deref is_empty_array_ref is_empty_hash_ref uniq difference2 intersection next_val_in_array list2kv); +%EXPORT_TAGS = (all => [ @EXPORT_OK ]); + + +sub ikeys { my %l = @_; sort { $a <=> $b } keys %l } +sub add2hash { my ($a, $b) = @_; while (my ($k, $v) = each %{$b || {}}) { $a->{$k} ||= $v } $a } +sub add2hash_ { my ($a, $b) = @_; while (my ($k, $v) = each %{$b || {}}) { exists $a->{$k} or $a->{$k} = $v } $a } +sub put_in_hash { my ($a, $b) = @_; while (my ($k, $v) = each %{$b || {}}) { $a->{$k} = $v } $a } +sub member { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 } +sub invbool { my $a = shift; $$a = !$$a; $$a } +sub listlength { scalar @_ } +sub strcpy { substr($_[0], $_[2] || 0, length $_[1]) = $_[1] } +sub deref { ref $_[0] eq "ARRAY" ? @{$_[0]} : ref $_[0] eq "HASH" ? %{$_[0]} : $_[0] } + +sub is_empty_array_ref { my $a = shift; !defined $a || @$a == 0 } +sub is_empty_hash_ref { my $a = shift; !defined $a || keys(%$a) == 0 } + +sub uniq { my %l; @l{@_} = (); keys %l } +sub difference2 { my %l; @l{@{$_[1]}} = (); grep { !exists $l{$_} } @{$_[0]} } +sub intersection { my (%l, @m); @l{@{shift @_}} = (); foreach (@_) { @m = grep { exists $l{$_} } @$_; %l = (); @l{@m} = (); } keys %l } + + +sub next_val_in_array { + my ($v, $l) = @_; + my %l = mapn { @_ } $l, [ @$l[1..$#$l], $l->[0] ]; + $l{$v}; +} + + +sub list2kv { + [ grep_index { MDK::Common::Math::even($::i) } @_ ], + [ grep_index { MDK::Common::Math::odd($::i) } @_ ]; +} + +1; diff --git a/MDK/Common/File.pm b/MDK/Common/File.pm new file mode 100644 index 0000000..834db33 --- /dev/null +++ b/MDK/Common/File.pm @@ -0,0 +1,100 @@ +package MDK::Common::File; + +use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK); +@ISA = qw(Exporter); +@EXPORT_OK = qw(dirname basename cat_ cat__ output linkf symlinkf renamef touch all glob_ substInFile concat_symlink expand_symlinks openFileMaybeCompressed catMaybeCompressed); +%EXPORT_TAGS = (all => [ @EXPORT_OK ]); + +sub dirname { local $_ = shift; s|[^/]*/*\s*$||; s|(.)/*$|$1|; $_ || '.' } +sub basename { local $_ = shift; s|/*\s*$||; s|.*/||; $_ } +sub cat_ { local *F; open F, $_[0] or $_[1] ? die "cat of file $_[0] failed: $!\n" : return; my @l = ; wantarray ? @l : join '', @l } +sub cat__ { my ($f) = @_; my @l = <$f>; wantarray ? @l : join '', @l } +sub output { my $f = shift; local *F; open F, ">$f" or die "output in file $f failed: $!\n"; print F foreach @_; } +sub linkf { unlink $_[1]; link $_[0], $_[1] } +sub symlinkf { unlink $_[1]; symlink $_[0], $_[1] } +sub renamef { unlink $_[1]; rename $_[0], $_[1] } + + +sub touch { + my ($f) = @_; + unless (-e $f) { + local *F; + open F, ">$f"; + } + my $now = time; + utime $now, $now, $f; +} + + +sub all { + my $d = shift; + + local *F; + opendir F, $d or return; + my @l = grep { $_ ne '.' && $_ ne '..' } readdir F; + closedir F; + + @l; +} + +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 substInFile(&@) { + my $f = shift; + foreach my $file (@_) { + if (-e $file) { + local @ARGV = $file; + local ($^I, $_) = ''; + while (<>) { &$f($_); print } + } else { + local *F; my $old = select F; # that way eof return true + local $_ = ''; + &$f($_); + select $old; + eval { output($file, $_) }; + } + } +} + + +sub concat_symlink { + my ($f, $l) = @_; + $l =~ m|^\.\./(/.*)| and return $1; + + $f =~ s|/$||; + while ($l =~ s|^\.\./||) { + $f =~ s|/[^/]+$|| or die "concat_symlink: $f $l\n"; + } + "$f/$l"; +} +sub expand_symlinks { + my ($first, @l) = split '/', $_[0]; + $first eq '' or die "expand_symlinks: $_[0] is relative\n"; + my ($f, $l); + foreach (@l) { + $f .= "/$_"; + $f = concat_symlink($f, "../$l") while $l = readlink $f; + } + $f; +} + + +sub openFileMaybeCompressed { + my ($f) = @_; + -e $f || -e "$f.gz" or die "file $f not found"; + local *F; + open F, -e $f ? $f : "gzip -dc $f.gz|" or die "file $f is not readable"; + *F; +} +sub catMaybeCompressed { cat__(openFileMaybeCompressed($_[0])) } + +1; diff --git a/MDK/Common/Func.pm b/MDK/Common/Func.pm new file mode 100644 index 0000000..55277c9 --- /dev/null +++ b/MDK/Common/Func.pm @@ -0,0 +1,117 @@ +package MDK::Common::Func; + +use MDK::Common::Math; + + +use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK); +@ISA = qw(Exporter); +@EXPORT_OK = qw(fold_left mapn mapn_ map_index grep_index find_index map_each grep_each before_leaving catch_cdie cdie); +%EXPORT_TAGS = (all => [ @EXPORT_OK ]); + + +sub fold_left(&@) { + my ($f, $initial, @l) = @_; + local ($::a, $::b); + $::a = $initial; + foreach $::b (@_) { $::a = &$f() } + $::a +} + +sub smapn { + my $f = shift; + my $n = shift; + my @r = (); + for (my $i = 0; $i < $n; $i++) { push @r, &$f(map { $_->[$i] } @_); } + @r +} +sub mapn(&@) { + my $f = shift; + smapn($f, MDK::Common::Math::min(map { scalar @$_ } @_), @_); +} +sub mapn_(&@) { + my $f = shift; + smapn($f, MDK::Common::Math::max(map { scalar @$_ } @_), @_); +} + + +sub map_index(&@) { + my $f = shift; + my @v; local $::i = 0; + map { @v = &$f($::i); $::i++; @v } @_; +} +sub grep_index(&@) { + my $f = shift; + my $v; local $::i = 0; + grep { $v = &$f($::i); $::i++; $v } @_; +} +sub find_index(&@) { + my $f = shift; + local $_; + for (my $i = 0; $i < @_; $i++) { + $_ = $_[$i]; + &$f and return $i; + } + die "find_index failed in @_"; +} +sub map_each(&%) { + my ($f, %h) = @_; + my @l; + local ($::a, $::b); + while (($::a, $::b) = each %h) { push @l, &$f($::a, $::b) } + @l; +} +sub grep_each(&%) { + my ($f, %h) = @_; + my %l; + local ($::a, $::b); + while (($::a, $::b) = each %h) { $l{$::a} = $::b if &$f($::a, $::b) } + %l; +} + + +sub add_f4before_leaving { + my ($f, $b, $name) = @_; + + unless ($MDK::Common::Func::before_leaving::{$name}) { + no strict 'refs'; + ${"MDK::Common::Func::before_leaving::$name"} = 1; + ${"MDK::Common::Func::before_leaving::list"} = 1; + } + local *N = *{$MDK::Common::Func::before_leaving::{$name}}; + my $list = *MDK::Common::Func::before_leaving::list; + $list->{$b}{$name} = $f; + *N = sub { + my $f = $list->{$_[0]}{$name} or die ''; + $name eq 'DESTROY' and delete $list->{$_[0]}; + goto $f; + } unless defined &{*N}; + +} + +#- ! the functions are not called in the order wanted, in case of multiple before_leaving :( +sub before_leaving(&) { + my ($f) = @_; + my $b = bless {}, 'MDK::Common::Func::before_leaving'; + add_f4before_leaving($f, $b, 'DESTROY'); + $b; +} + +sub catch_cdie(&&) { + my ($f, $catch) = @_; + + local @MDK::Common::Func::cdie_catches; + unshift @MDK::Common::Func::cdie_catches, $catch; + &$f(); +} + +sub cdie { + my ($err, $f) = @_; + foreach (@MDK::Common::Func::cdie_catches) { + $@ = $err; + &{$_}(\$err) and return; + } + die $err; +} + +1; + diff --git a/MDK/Common/Math.pm b/MDK/Common/Math.pm new file mode 100644 index 0000000..5b46f29 --- /dev/null +++ b/MDK/Common/Math.pm @@ -0,0 +1,65 @@ +package MDK::Common::Math; + +use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $PRECISION $PI); +@ISA = qw(Exporter); +@EXPORT_OK = qw($PI even odd sqr sign round round_up round_down divide min max or_ and_ sum product factorize decimal2fraction poly2); +%EXPORT_TAGS = (all => [ @EXPORT_OK ]); + + +$PRECISION = 10; +$PI = 3.1415926535897932384626433832795028841972; + +sub even { $_[0] % 2 == 0 } +sub odd { $_[0] % 2 == 1 } +sub sqr { $_[0] * $_[0] } +sub sign { $_[0] <=> 0 } +sub round { int ($_[0] + 0.5) } +sub round_up { my ($i, $r) = @_; $i = int $i; $i += $r - ($i + $r - 1) % $r - 1; } +sub round_down { my ($i, $r) = @_; $i = int $i; $i -= $i % $r; } +sub divide { my $d = int $_[0] / $_[1]; wantarray ? ($d, $_[0] % $_[1]) : $d } +sub min { my $n = shift; $_ < $n and $n = $_ foreach @_; $n } +sub max { my $n = shift; $_ > $n and $n = $_ foreach @_; $n } +sub or_ { my $n = 0; $n ||= $_ foreach @_; $n } +sub and_{ my $n = 1; $n &&= $_ foreach @_; $n } +sub sum { my $n = 0; $n += $_ foreach @_; $n } +sub product { my $n = 1; $n *= $_ foreach @_; $n } + + +sub factorize { + my ($n) = @_; + my @r = (); + + $n == 1 and return [ 1, 1 ]; + for (my $k = 2; sqr($k) <= $n; $k++) { + my $i = 0; + for ($i = 0; $n % $k == 0; $i++) { $n /= $k; } + $i and push @r, [ $k, $i ]; + } + $n > 1 and push @r, [ $n, 1 ]; + @r; +} + +sub decimal2fraction { # ex: 1.33333333 -> (4, 3) + my $n0 = shift; + my $precision = 10 ** -(shift || $PRECISION); + my ($a, $b) = (int $n0, 1); + my ($c, $d) = (1, 0); + my $n = $n0 - int $n0; + my $k; + until (abs($n0 - $a / $c) < $precision) { + $n = 1 / $n; + $k = int $n; + ($a, $b) = ($a * $k + $b, $a); + ($c, $d) = ($c * $k + $d, $c); + $n -= $k; + } + ($a, $c) +} + +sub poly2 { + my ($a, $b, $c) = @_; + my $d = ($b**2 - 4 * $a * $c) ** 0.5; + (-$b + $d) / 2 / $a, (-$b - $d) / 2 / $a +} + +1; diff --git a/MDK/Common/String.pm b/MDK/Common/String.pm new file mode 100644 index 0000000..74b8e2b --- /dev/null +++ b/MDK/Common/String.pm @@ -0,0 +1,90 @@ +package MDK::Common::String; + +use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK); +@ISA = qw(Exporter); +@EXPORT_OK = qw(bestMatchSentence formatList formatError formatTimeRaw formatLines formatAlaTeX warp_text); +%EXPORT_TAGS = (all => [ @EXPORT_OK ]); + + +# count the number of character that match +sub bestMatchSentence { + + my $best = -1; + my $bestSentence; + my @s = split /\W+/, shift; + foreach (@_) { + my $count = 0; + foreach my $e (@s) { + $count+= length ($e) if /^$e$/; + $count+= length ($e) if /^$e$/i; + $count+= length ($e) if /$e/; + $count+= length ($e) if /$e/i; + } + $best = $count, $bestSentence = $_ if $count > $best; + } + wantarray ? ($bestSentence, $best) : $bestSentence; +} + + +sub formatList { + my $nb = shift; + join(", ", @_ <= $nb ? @_ : (@_[0..$nb-1], '...')); +} +sub formatError { + my ($err) = @_; + $err =~ s/ at .*?$/\./ if !$::testing; + $err; +} +sub formatTimeRaw { + my ($s, $m, $h) = gmtime($_[0]); + sprintf "%d:%02d:%02d", $h, $m, $s; +} +sub formatLines { + my ($t, $tmp); + foreach (split "\n", $_[0]) { + if (/^\s/) { + $t .= "$tmp\n"; + $tmp = $_; + } else { + $tmp = ($tmp ? "$tmp " : ($t && "\n") . $tmp) . $_; + } + } + "$t$tmp\n"; +} +sub formatAlaTeX { + my ($t, $tmp); + foreach (split "\n", $_[0]) { + if (/^$/) { + $t .= ($t && "\n") . $tmp; + $tmp = ''; + } else { + $tmp = ($tmp && "$tmp ") . (/^\s*(.*?)\s*$/)[0]; + } + } + $t . ($t && $tmp && "\n") . $tmp; +} + + + + +sub warp_text { + my ($text, $width) = @_; + $width ||= 80; + + my @l; + foreach (split "\n", $text) { + my $t = ''; + foreach (split /\s+/, $_) { + if (length "$t $_" > $width) { + push @l, $t; + $t = $_; + } else { + $t = "$t $_"; + } + } + push @l, $t; + } + @l; +} + +1; diff --git a/MDK/Common/System.pm b/MDK/Common/System.pm new file mode 100644 index 0000000..c8c4535 --- /dev/null +++ b/MDK/Common/System.pm @@ -0,0 +1,181 @@ +package MDK::Common::System; + +use MDK::Common::Math; +use MDK::Common::File; + + +use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK %compat_arch $printable_chars $sizeof_int $bitof_int); #); +@ISA = qw(Exporter); +@EXPORT_OK = qw(%compat_arch $printable_chars $sizeof_int $bitof_int typeFromMagic list_passwd list_home list_skels syscall_ df sync psizeof availableMemory availableRamMB gettimeofday unix2dos getVarsFromSh setVarsInSh setVarsInShMode setVarsInCsh template2file template2userfile update_userkderc); #); +%EXPORT_TAGS = (all => [ @EXPORT_OK ]); + + +%compat_arch = ( #- compatibilty arch mapping. + 'noarch' => undef, + 'ia32' => 'noarch', + 'i386' => 'ia32', + 'i486' => 'i386', + 'i586' => 'i486', + 'i686' => 'i586', + 'i786' => 'i686', + 'k6' => 'i586', + 'k7' => 'k6', + 'k8' => 'k7', + 'ia64' => 'noarch', + 'ppc' => 'noarch', + 'alpha' => 'noarch', + 'sparc' => 'noarch', + 'sparc32' => 'sparc', + 'sparc64' => 'sparc32', + 'ia64' => 'noarch', + ); + +$printable_chars = "\x20-\x7E"; +$sizeof_int = psizeof("i"); +$bitof_int = $sizeof_int * 8; + +sub typeFromMagic { + my $f = shift; + local *F; sysopen F, $f, 0 or return; + + my $tmp; + M: foreach (@_) { + my ($name, @l) = @$_; + while (@l) { + my ($offset, $signature) = splice(@l, 0, 2); + sysseek(F, $offset, 0) or next M; + sysread(F, $tmp, length $signature); + $tmp eq $signature or next M; + } + return $name; + } + undef; +} + + +sub list_passwd() { + my (@l, @e); + setpwent(); + while (@e = getpwent()) { push @l, [ @e ] } + endpwent(); + @l; +} +sub list_home() { + map { $_->[7] } grep { $_->[2] >= 500 } list_passwd(); +} +sub list_skels { + my ($prefix, $suffix) = @_; + grep { -d $_ && -w $_ } map { "$prefix$_/$suffix" } '/etc/skel', '/root', list_home(); +} + + + +sub syscall_ { + my $f = shift; + + require 'syscall.ph'; + syscall(&{$common::{"SYS_$f"}}, @_) == 0; +} + + +#- return the size of the partition and its free space in KiB +sub df { + my ($mntpoint) = @_; + my ($blocksize, $size, $free); + my $buf = ' ' x 20000; + syscall_('statfs', $mntpoint, $buf) or return; + (undef, $blocksize, $size, $free, undef, undef) = unpack "L!6", $buf; + map { $_ * ($blocksize / 1024) } $size, $free; +} + +sub sync { syscall_('sync') } +sub psizeof { length pack $_[0] } +sub availableMemory() { MDK::Common::Math::sum(map { /(\d+)/ } grep { /^(MemTotal|SwapTotal):/ } MDK::Common::File::cat_("/proc/meminfo")); } +sub availableRamMB() { 4 * MDK::Common::Math::round((-s '/proc/kcore') / 1024 / 1024 / 4); } +sub gettimeofday { my $t = pack "LL"; syscall_('gettimeofday', $t, 0) or die "gettimeofday failed: $!\n"; unpack("LL", $t) } +sub unix2dos { local $_ = $_[0]; s/\015$//mg; s/$/\015/mg; $_ } + + + +sub getVarsFromSh { + my %l; + local *F; open F, $_[0] or return; + local $_; + while () { + s/#.*//; # remove comments + my ($v, $val, $val2) = + /^\s* # leading space + (\w+) = # variable + ( + "([^"]*)" # double-quoted text + | '([^']*)' # single-quoted text + | [^'"\s]+ # normal text + ) + \s*$ # end of line + /x or next; + $l{$v} = defined $val2 ? $val2 : $val; + } + %l; +} + +sub setVarsInSh { + my ($file, $l, @fields) = @_; + setVarsInShMode($file, 0777 ^ umask(), $l, @fields); +} + +sub setVarsInShMode { + my ($file, $mod, $l, @fields) = @_; + @fields = keys %$l unless @fields; + + local *F; + open F, "> $file" or die "cannot create config file $file"; + chmod $mod, $file; + $l->{$_} and print F "$_=$l->{$_}\n" foreach @fields; +} + +sub setVarsInCsh { + my ($file, $l, @fields) = @_; + @fields = keys %$l unless @fields; + + local *F; + open F, "> $_[0]" or die "cannot create config file $file"; + $l->{$_} and print F "setenv $_ $l->{$_}\n" foreach @fields; +} + +sub template2file { + my ($in, $out, %toreplace) = @_; + output $out, map { s/@@@(.*?)@@@/$toreplace{$1}/g; $_ } MDK::Common::File::cat_($in); +} +sub template2userfile { + my ($prefix, $in, $out_rel, $force, %toreplace) = @_; + + foreach (list_skels($prefix, $out_rel)) { + -d MDK::Common::File::dirname($_) or !-e $_ or $force or next; + + template2file($in, $_, %toreplace); + m|/home/(.+?)/| and chown(getpwnam($1), getgrnam($1), $_); + } +} +sub update_userkderc { + my ($file, $category, %subst) = @_; + + output $file, + (map { + my $l = $_; + s/^\s*//; + if (my $i = /^\[$category\]/i ... /^\[/) { + if ($i =~ /E/) { #- for last line of category + $l = join('', map_each { "$::a=$::b\n" } %subst) . $l; + %subst = (); + } elsif (/^(\w*?)=/) { + if (my $e = delete $subst{lc($1)}) { + $l = "$1=$e\n"; + } + } + } + $l; + } MDK::Common::File::cat_($file)), + (%subst && "[$category]\n", map_each { "$::a=$::b\n" } %subst); #- if category has not been found above. +} + +1; diff --git a/MDK/Common/Various.pm b/MDK/Common/Various.pm new file mode 100644 index 0000000..b012343 --- /dev/null +++ b/MDK/Common/Various.pm @@ -0,0 +1,32 @@ +package MDK::Common::Various; + +use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK); +@ISA = qw(Exporter); +@EXPORT_OK = qw(first second top bool to_int to_float bool2text bool2yesno text2bool chomp_ backtrace); +%EXPORT_TAGS = (all => [ @EXPORT_OK ]); + + +sub first { $_[0] } +sub second { $_[1] } +sub top { $_[-1] } + +sub bool { $_[0] ? 1 : 0 } +sub to_int { $_[0] =~ /(\d*)/; $1 } +sub to_float { $_[0] =~ /(\d*(\.\d*)?)/; $1 } +sub bool2text { $_[0] ? "true" : "false" } +sub bool2yesno { $_[0] ? "yes" : "no" } +sub text2bool { my $t = lc($_[0]); $t eq "true" || $t eq "yes" ? 1 : 0 } + +sub chomp_ { my @l = map { my $l = $_; chomp $l; $l } @_; wantarray ? @l : $l[0] } + +sub backtrace { + my $s; + for (my $i = 1; caller($i); $i++) { + my ($package, $file, $line, $func) = caller($i); + $s .= "$func() called from $file:$line\n"; + } + $s; +} + +1; + -- cgit v1.2.1