summaryrefslogtreecommitdiffstats
path: root/perl-install/printer
Commit message (Expand)AuthorAgeFilesLines
* re-sync after the big svn lossPascal Rigaux2007-04-259-9737/+0
* add a hint for translatorsThierry Vignaud2006-03-131-0/+2
* try being smarter for translators...Thierry Vignaud2006-03-131-3/+5
* - Improvements and fixes on printer model/driver listing inTill Kamppeter2006-01-211-13/+16
* - Give priority to custom PPD file if printer queue record inTill Kamppeter2006-01-201-9/+11
* - Fixed HPLIP setup when setting up a printer without auto-detectionTill Kamppeter2006-01-201-18/+41
* - Make sure that when a user supplies an updated PPD file, the newTill Kamppeter2006-01-091-0/+28
* - Moved button for daemon-less CUPS client mode to the top of the CUPSTill Kamppeter2006-01-091-12/+12
* adapt to new cat_() only accepting files, ie not doing popen anymorePascal Rigaux2005-11-152-8/+3
* - Fixed setting up printers with pre-made Foomatic PPD inTill Kamppeter2005-10-311-1/+3
* old perl_checker compliancePascal Rigaux2005-10-201-1/+1
* - Let parallel HP printers be set up with HPLIP.Till Kamppeter2005-09-283-782/+204
* - Do not auto-install "sane-frontends" for MF devices.Till Kamppeter2005-09-191-4/+4
* - On USB printer hot-plugging sometimes parallel printers are alsoTill Kamppeter2005-09-171-2/+4
* - Adapted file names to check for to the changes on the HPIJ 0.91-8mdkTill Kamppeter2005-09-161-3/+3
* - Made configuring of auto queue setup mode also during installationTill Kamppeter2005-09-121-3/+3
* - Another 64-bit fix in printerdrake. Now setup of HP's multi-functionTill Kamppeter2005-09-071-2/+2
* - Give also access to the CUPS auto administration dialog duringTill Kamppeter2005-09-071-0/+14
* - Made printerdrake working on 64-bit systems, with /usr/lib64.Till Kamppeter2005-09-063-28/+31
* - Install "desktop-printing" only on sytems with installedTill Kamppeter2005-09-062-4/+12
* - Fixed endless loop when clicking "Back" in model selection, when byTill Kamppeter2005-09-061-1/+2
* - Some fixes in handling unknown printers.Till Kamppeter2005-09-061-3/+8
* - Do not set margins in CUPS when HPIJS is the driver, for this driverTill Kamppeter2005-09-061-7/+15
* - When auto-detecting network printer models via SNMP, guessTill Kamppeter2005-09-061-1/+37
* Corrected typos.Funda Wang2005-09-041-4/+4
* - Made reloading of parallel port kernel modules (for auto-detection)Till Kamppeter2005-09-021-2/+2
* - Make building of main window of printerdrake much faster.Till Kamppeter2005-09-021-1/+3
* - Check for CUPS daemon running without console output.Till Kamppeter2005-09-021-1/+3
* - Let also network printers be found which do not answer to aTill Kamppeter2005-09-021-30/+63
* - Use printer name determined by HPLIP to auto-select PPD file of aTill Kamppeter2005-09-021-1/+2
* - Do not display or use the description field of the IEEE-1284 IDTill Kamppeter2005-09-011-3/+4
* - When having added one's own PPD file now it gets pre-selected in theTill Kamppeter2005-08-311-9/+28
* - Fixed retrieval of parallel port base address.Till Kamppeter2005-08-311-1/+11
* - Fixed parallel printer auto-detection and registered IEEE-1284 IDTill Kamppeter2005-08-311-4/+14
* - Added recording of IEEE-1284 device ID string, for USB printers.Till Kamppeter2005-08-311-1/+2
* - Fixed recognition of alredy set up queues for auto queue setup, forTill Kamppeter2005-08-311-1/+1
* - Support for HPLIP URIs with "?device=...", possible fix for bugTill Kamppeter2005-08-301-4/+15
* - When setting up new queue with HPLIP old HPOJ config was not deletedTill Kamppeter2005-08-301-1/+1
* - Restart CUPS after installing HPLIP for a network printer.Till Kamppeter2005-08-301-12/+16
* - Removed "Do not print testy page" in test page step of add printerTill Kamppeter2005-08-261-4/+4
* - Fixed message window in the case that no local printer was foundTill Kamppeter2005-08-261-0/+1
* - Gutenprint does not print correctly when margins are set in the CUPSTill Kamppeter2005-08-261-19/+45
* - Reverted workarounds for bug #17718, the bug is now really fixed,Till Kamppeter2005-08-241-14/+12
* - Fixed problem of current printer/driver not chosen in printer/driverTill Kamppeter2005-08-241-6/+15
* - Support for one pre-built PPD being linked from multiple printerTill Kamppeter2005-08-241-19/+55
* - Added support for pre-built PPDs for non-PostScript drivers,Till Kamppeter2005-08-241-15/+109
* - Fixed bug #17718 in both printerdrake and scannerdrake.Till Kamppeter2005-08-221-12/+14
* - Removed stuff for automatic print queue setup when starting CUPS.Till Kamppeter2005-08-182-12/+2
* - When printerdrake's first-time dialog appears on plugging a USBTill Kamppeter2005-08-181-26/+51
* - Added automatic setup of Ethernet-connected HP printers with HPLIP.Till Kamppeter2005-08-172-29/+100
generated by cgit v1.2.1 (git 2.21.0) at 2026-02-28 23:00:31 +0000
n599' href='#n599'>599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 
package common; # $Id$

use diagnostics;
use strict;
use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int $cancel $SECTORSIZE %compat_arch);

@ISA = qw(Exporter);
%EXPORT_TAGS = (
    common     => [ qw(__ may_apply even odd arch better_arch compat_arch min max sqr sum and_ or_ if_ sign product bool invbool listlength bool2text bool2yesno text2bool to_int to_float ikeys member divide is_empty_array_ref is_empty_hash_ref add2hash add2hash_ set_new set_add round round_up round_down first second top uniq translate untranslate warp_text formatAlaTeX formatLines deref next_val_in_array) ],
    functional => [ qw(fold_left compose mapgrep map_index grep_index find_index map_each grep_each list2kv map_tab_hash mapn mapn_ difference2 before_leaving catch_cdie cdie combine) ],
    file       => [ qw(dirname basename touch all glob_ cat_ cat__ output symlinkf chop_ mode typeFromMagic expand_symlinks) ],
    system     => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ salt getVarsFromSh setVarsInSh setVarsInShMode setVarsInCsh substInFile availableMemory availableRamMB removeXiBSuffix formatXiB template2file template2userfile update_userkderc list_skels formatTime formatTimeRaw unix2dos setVirtual isCdNotEjectable) ],
    constant   => [ qw($printable_chars $sizeof_int $bitof_int $SECTORSIZE %compat_arch) ],
);
@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;


#-#####################################################################################
#- Globals
#-#####################################################################################
$printable_chars = "\x20-\x7E";
$sizeof_int      = psizeof("i");
$bitof_int       = $sizeof_int * 8;
$SECTORSIZE      = 512;
%compat_arch     = ( #- compatibilty arch mapping.
		     'noarch'  => undef,
		     'i386'    => 'noarch',
		     'i486'    => 'i386',
		     'i586'    => 'i486',
		     'i686'    => 'i586',
		     'i786'    => 'i686',
		     'k6'      => 'i586',
		     'k7'      => 'k6',
		     'k8'      => 'k7',
		     'ppc'     => 'noarch',
		     'alpha'   => 'noarch',
		     'sparc'   => 'noarch',
		     'sparc32' => 'sparc',
		     'sparc64' => 'sparc32',
		   );

#-#####################################################################################
#- Functions
#-#####################################################################################

sub fold_left(&@) {
    my $f = shift;
    local $a = shift;
    foreach $b (@_) { $a = &$f() }
    $a
}

sub _ {
    my $s = shift @_; my $t = translate($s);
    $t && ref $t or return sprintf $t, @_;
    my ($T, @p) = @$t;
    sprintf $T, @_[@p];
}
#-delete $main::{'_'};
sub __ { $_[0] }
sub even($) { $_[0] % 2 == 0 }
sub odd($)  { $_[0] % 2 == 1 }
sub min { fold_left { $a < $b ? $a : $b } @_ }
sub max { fold_left { $a > $b ? $a : $b } @_ }
sub sum { fold_left { $a + $b } @_ }
sub and_{ fold_left { $a && $b } @_ }
sub or_ { fold_left { $a || $b } @_ }
sub sqr { $_[0] * $_[0] }
sub sign { $_[0] <=> 0 }
sub product { fold_left { $a * $b } @_ }
sub first { $_[0] }
sub second { $_[1] }
sub top { $_[-1] }
sub uniq { my %l; @l{@_} = (); keys %l }
sub to_int { $_[0] =~ /(\d*)/; $1 }
sub to_float { $_[0] =~ /(\d*(\.\d*)?)/; $1 }
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 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 invbool { my $a = shift; $$a = !$$a; $$a }
sub listlength { scalar @_ }
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 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 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 deref { ref $_[0] eq "ARRAY" ? @{$_[0]} : ref $_[0] eq "HASH" ? %{$_[0]} : $_[0] }
sub linkf { unlink $_[1]; link $_[0], $_[1] }
sub symlinkf { unlink $_[1]; symlink $_[0], $_[1] }
sub chop_ { map { my $l = $_; chomp $l; $l } @_ }
sub divide { my $d = int $_[0] / $_[1]; wantarray ? ($d, $_[0] % $_[1]) : $d }
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 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 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 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 unix2dos { local $_ = $_[0]; s/\015$//mg; s/$/\015/mg; $_ }

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 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 may_apply { $_[0] ? $_[0]->($_[1]) : (@_ > 2 ? $_[2] : $_[1]) }

sub if_($@) {
    my $b = shift;
    $b or return ();
    wantarray || @_ <= 1 or die "if_ called in scalar context with more than one argument";
    wantarray ? @_ : $_[0];
}

sub arch() {
    require c;
    c::kernel_arch();
}
sub better_arch {
    my ($new, $old) = @_;
    while ($new && $new ne $old) { $new = $compat_arch{$new} }
    $new;
}
sub compat_arch { better_arch(arch(), $_[0]) }

sub touch {
    my ($f) = @_;
    unless (-e $f) {
	local *F;
	open F, ">$f";
    }
    my $now = time;
    utime $now, $now, $f;
}

sub mapgrep(&@) {
    my $f = shift;
    my @l;
    foreach (@_) {
	my ($b, $v) = $f->($_);
	push @l, $v if $b;
    }
    @l;
}

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 list2kv(@) { [ grep_index { even($::i) } @_ ], [ grep_index { odd($::i) } @_ ] }

sub combine {
    my $nb = shift;
    my @l; while (my @m = splice(@_, 0, $nb)) { push @l, \@m }
    @l;
}

#- pseudo-array-hash :)
sub map_tab_hash(&$@) {
    my ($f, $fields, @tab_hash) = @_;
    my %hash;
    my $key = { map_index {($_, $::i + 1)} @{$fields} };

    for (my $i = 0; $i < @tab_hash; $i += 2) {
	my $h = [$key, @{$tab_hash[$i + 1]}];
	&$f($i, $h) if $f;
	$hash{ $tab_hash[$i] } = $h;
      }
    %hash;
}

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, min(map { scalar @$_ } @_), @_);
}
sub mapn_(&@) {
    my $f = shift;
    smapn($f, max(map { scalar @$_ } @_), @_);
}


sub add_f4before_leaving {
    my ($f, $b, $name) = @_;

    unless ($common::before_leaving::{$name}) {
	no strict 'refs';
	${"common::before_leaving::$name"} = 1;
	${"common::before_leaving::list"} = 1;
    }
    local *N = *{$common::before_leaving::{$name}};
    my $list = *common::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 {}, 'common::before_leaving';
    add_f4before_leaving($f, $b, 'DESTROY');
    $b;
}

sub catch_cdie(&&) {
    my ($f, $catch) = @_;

    local @common::cdie_catches;
    unshift @common::cdie_catches, $catch;
    &$f();
}

sub cdie($;&) {
    my ($err, $f) = @_;
    foreach (@common::cdie_catches) {
	$@ = $err;
	&{$_}(\$err) and return;
    }
    die $err;
}

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 syscall_ {
    my $f = shift;

    require 'syscall.ph';
    syscall(&{$common::{"SYS_$f"}}, @_) == 0;
}

sub salt($) {
    my ($nb) = @_;
    require 'devices.pm';
    open F, devices::make("random") or die "missing random";
    my $s; read F, $s, $nb;
    local $_ = pack "b8" x $nb, unpack "b6" x $nb, $s;
    tr [\0-\x3f] [0-9a-zA-Z./];
    $_;
}

sub makedev { ($_[0] << 8) | $_[1] }
sub unmakedev { $_[0] >> 8, $_[0] & 0xff }

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 translate {
    my ($s) = @_;
    my ($lang) = $ENV{LANGUAGE} || $ENV{LC_MESSAGES} || $ENV{LC_ALL} || $ENV{LANG} || 'en';

    require lang;
    foreach (split ':', $lang) {
	lang::load_po($_) unless defined $po::I18N::{$_};
	if (%{$po::I18N::{$_}}) {
	    return if $s eq '_I18N_';
	    return ${$po::I18N::{$_}}{$s} || $s 
	}
    }
    $s;
}

sub untranslate($@) {
    my $s = shift || return;
    foreach (@_) { translate($_) eq $s and return $_ }
    die "untranslate failed";
}

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;
}

sub formatAlaTeX($) {
    my ($t, $tmp);
    foreach (split "\n", $_[0]) {
	if (/^$/) {
	    $t .= ($t && "\n") . $tmp;
	    $tmp = '';
	} else {
	    $tmp = ($tmp && "$tmp ") . first(/^\s*(.*?)\s*$/);
	}
    }
    $t . ($t && $tmp && "\n") . $tmp;
}

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 getVarsFromSh($) {
    my %l;
    local *F; open F, $_[0] or return;
    local $_;
    while (<F>) {
	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} = $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; $_ } cat_($in);
}
sub template2userfile {
    my ($prefix, $in, $out_rel, $force, %toreplace) = @_;

    foreach (list_skels($prefix, $out_rel)) {
	-d 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;
      } cat_($file)),
	(%subst && "[$category]\n", map_each { "$::a=$::b\n" } %subst); #- if category has not been found above.
}

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 best_match {
    my ($str, @lis) = @_;
    my @words = split /\W+/, $str;
    my ($max, $res) = 0;

    foreach (@lis) {
	my $count = 0;
	foreach my $i (@words) {
	    $count++ if /$i/i;
	}
	$max = $count, $res = $_ if $count >= $max;
    }
    $res;
}

sub bestMatchSentence {

    my $best = -1;
    my $bestSentence;
    my @s = split /\W+/, shift;
    foreach (@_) {
	my $count = 0;
	foreach my $e (@s) {
	    $count++ if /$e/i;
	}
	$best = $count, $bestSentence = $_ if $count > $best;
    }
    $bestSentence;
}

# count the number of character that match
sub bestMatchSentence2 {

    my $best = -1;
    my $bestSentence;
    my @s = split /\W+/, shift;
    foreach (@_) {
	my $count = 0;
	foreach my $e (@s) {
	    $count+= length ($e) if /$e/i;
	}
	$best = $count, $bestSentence = $_ if $count > $best;
    }
    $bestSentence;
}

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 availableMemory() { sum map { /(\d+)/ } grep { /^(MemTotal|SwapTotal):/ } cat_("/proc/meminfo"); }
sub availableRamMB()  { 
    my $s = 4 * round((-s '/proc/kcore') / 1024 / 1024 / 4);
    #- HACK HACK: if i810 and memsize
    require detect_devices;
    return $s - 1 if $s == 128 && grep { $_->{driver} =~ /i810/ } detect_devices::probeall();
    $s;
}

sub setVirtual($) {
    my $vt = '';
    local *C;
    sysopen C, "/dev/console", 2 or die "failed to open /dev/console: $!";
    ioctl(C, c::VT_GETSTATE(), $vt) or die "ioctl VT_GETSTATE failed";
    ioctl(C, c::VT_ACTIVATE(), $_[0]) or die "ioctl VT_ACTIVATE failed";
    ioctl(C, c::VT_WAITACTIVE(), $_[0]) or die "ioctl VT_WAITACTIVE failed";
    unpack "S", $vt;
}


sub removeXiBSuffix($) {
    local $_ = shift;

    /(\d+)k$/i and return $1 * 1024;
    /(\d+)M$/i and return $1 * 1024 * 1024;
    /(\d+)G$/i and return $1 * 1024 * 1024 * 1024;
    $_;
}
sub formatXiB {
    my ($newnb, $newbase) = (@_, 1);
    my ($nb, $base);
    my $decr = sub { 
	($nb, $base) = ($newnb, $newbase);
	$base >= 1024 ? ($newbase = $base / 1024) : ($newnb = $nb / 1024);
    };
    foreach ('', _("KB"), _("MB"), _("GB")) {
	$decr->(); 
	if ($newnb < 1 && $newnb * $newbase < 1) {
	    my $v = $nb * $base;
	    my $s = $v < 10 && int(10 * $v - 10 * int($v));
	    return int($v) . ($s ? ".$s" : '') . $_;
	}
    }
    int($newnb * $newbase) . _("TB");
}

sub truncate_list {
    my $nb = shift;
    @_ <= $nb ? @_ : (@_[0..$nb-1], '...');
}

sub formatTime {
    my ($s, $m, $h) = gmtime($_[0]);
    if ($h) {
	sprintf "%02d:%02d", $h, $m;
    } elsif ($m > 1) {
	_("%d minutes", $m);
    } elsif ($m == 1) {
	_("1 minute");
    } else {
	_("%d seconds", $s);
    }
}
sub formatTimeRaw {
    my ($s, $m, $h) = gmtime($_[0]);
    sprintf "%d:%02d:%02d", $h, $m, $s;
}

#- 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 "L6", $buf;
    map { $_ * ($blocksize / 1024) } $size, $free;
}

sub next_val_in_array {
    my ($v, $l) = @_;
    my %l = mapn { @_ } $l, [ @$l[1..$#$l], $l->[0] ];
    $l{$v};
}

sub isCdNotEjectable { scalar(grep { /ram3/ } cat_("/proc/mounts")) == 0 }


#-######################################################################################
#- Wonderful perl :(
#-######################################################################################
1; #
generated by cgit v1.2.1 (git 2.21.0) at 2026-02-28 23:00:28 +0000