Admin Control Panel v2.0

✎ Editing: Utils.pm ← Back

package KL::Utils;

use strict;

my $DEBUG_MODE = defined($ENV{'KLI_DEBUG_ENABLED'}) && $ENV{'KLI_DEBUG_ENABLED'} eq 'yes' ? 1 : 0;

my $BOLD = "";
my $NORMAL = "";
my $UNDERLINE = "";

if ( -t STDOUT and not defined $ENV{'ANSI_COLORS_DISABLED'} ) {
    $BOLD = "\e\[1m";
    $NORMAL = "\e[0m";
    $UNDERLINE = "\e[4m";
}

sub is_freebsd
{
    return ($^O =~ /^freebsd$/i) ? 1 : 0;
}

sub is_linux
{
    return ($^O =~ /^linux$/i) ? 1 : 0;
}

sub debug_mode
{
    my $mode = shift;

$DEBUG_MODE = $mode if defined $mode;

return $DEBUG_MODE;
}

sub get_os_name
{
    my $name = "unknown";

if ( $^O =~ /linux/i )  {
        if ( -f '/etc/redhat-release' ) {
            $name = read_file('/etc/redhat-release');
        } elsif ( -f '/etc/SuSE-release' ) {
            $name = read_file('/etc/SuSE-release');
        } elsif ( -f '/etc/debian_version' ) {
            $name = "Debian " . read_file('/etc/debian_version');
        }
    } elsif ( $^O =~ /sunos/i ) {
        $name = `uname -prs`;
    } elsif ( $^O =~ /[hp-ux,bsd]/i ) {
        $name = `uname -rs`;
    }

$name =~ s/\n.*//g; # keep only first line
    chomp $name;
    return $name;
}

# Standard formatted output
sub output
{
    my $text = translate_string(@_) . "\n";

my $margin = 75 - 1;
    my ($para, $accum, $outstr);

foreach $para (split ("\n", $text))
    {
        $accum = '';

my $length = 0;
        foreach my $word (split(/\s+/, $para))
        {
            my $noesc = $word;
            if ($BOLD ne '') {
                $noesc =~ s/\Q$BOLD\E|\Q$NORMAL\E|\Q$UNDERLINE\E//g;
            }

if ($length + length($noesc) > $margin) {
                $accum .= "\n";
                $length = 0;
            }

if ($length > 0) {
                $accum .= ' ' . $word;
                $length += length($noesc) + 1;
            } else {
                $accum .= $word;
                $length += length($noesc);
            }
        }

$outstr .= $accum . "\n";
    }

print $outstr if defined $outstr;
    return 1;
}

sub header
{
    my $title = shift;
    chomp $title;

print "\n";
 if ( $BOLD ne '' ) {
 output("%1\n", $title);
 } else {
 output("%1\n%2\n", $title, '=' x length($title));
 }
 print "\n";
}

# Debug output
sub debug
{
    return if not $DEBUG_MODE;

my $msg = shift;

print translate_string("DEBUG: ") . "$msg\n";
}

# Terminate installation process
sub fatal
{
    my $exit_code = shift;

output "\nFatal error: " . translate_string(@_) . "\n";

exit $exit_code;
}

# Generate a warning
sub warning
{
 output "\nWarning: " . translate_string(@_) . "\n";
}

sub error
{
 output "\nError: " . translate_string(@_) . "\n";
}

# Replace %1, %2 etc. by args.
# Args can contain %1 too, but they should not be replaced
sub translate_string
{
    my ($str, @args) = @_;

# First, convert color sequences
 $str =~ s//$BOLD/g;
 $str =~ s//$UNDERLINE/g;
 $str =~ s/<\/(B|U)>/$NORMAL/g;

for ( my $i = 0; $i < scalar @args; $i++ )
 {
 warn ("Empty argument $i in string '$str'\n") if !defined $args[$i];
 my $pattern = "%" . ($i + 1);
 $str =~ s/$pattern/$args[$i]/g;
 }

return $str;
}

# Load file in .ini format as simple hash
sub load_ini_file
{
    my $filename = shift;
    my $data = {};

return if ! -f $filename;

# read settings data
 open F, "<$filename" or return;
 my $content = join ("", <F>);
 close F;
 $content =~ s/\r//g;

my $section = '';

foreach (split (/\n/, $content)) {
        if (/^\s*\[(.*)\]+\s*$/) {
            $section = $1;
            next;
        }

next if /^\s*[#;].*?$/;
        next if !/^(.*?)=(.*)$/;

$data->{$section} = {} if !defined $data->{$section};

if ( !defined $data->{$section}{$1} ) {
            $data->{$section}{$1} = $2;
            next;
        }

# Create an array ref
        if ( ref $data->{$section}{$1} ne "ARRAY" ) {
            my @arr = ($data->{$section}{$1}, $2);
            $data->{$section}{$1} = \@arr;
        } else {
            push @{$data->{$section}{$1}}, $2;
        }
    }

return $data;
}

# Save file in .ini format from hash
sub save_ini_file
{
    my $filename = shift;
    my $data = shift;

if ( !open FILE, ">$filename" ) {
        return;
    }

foreach my $section (sort keys %{$data}) {
        # save section with empty name fist without section name
        print FILE "[$section]\n" if $section ne '';

foreach my $name (keys %{$data->{$section}}) {
            my $value = $data->{$section}->{$name};
            print FILE "${name}=$value\n";
        }

print FILE "\n";
    }

close FILE;
    return 1;

}

# Asks a question from user, or from autoanswer file
sub ask_question
{
    my ($def_answer, $question, @args) = @_;

my $qtext = translate_string ($question, @args);
    chomp ($qtext);

output ($def_answer ? "$qtext [$def_answer]: " : $qtext);

my $answer = <STDIN>;
 $answer = "" if !defined $answer;
 $answer =~ s/[\r\n]//g;
 $answer = $def_answer if length($answer) == 0;

output "\n";
    return $answer;
}

# select multiply values from list and return as array
sub ask_list
{
    my ($def_answer, $valud_answ, $question, @args) = @_;
    while ( 1 ) {
	my $tmp = ask_question ($def_answer, $question, @args);
        $tmp =~ s/^\s+(.*?)\s+$/$1/;
        my @answ = split(/\s+/, $tmp);
        my %t0=(); my %t1=(); my %t2=();
        for (@$valud_answ, @answ) { $t0{$_}++ && $t1{$_}++ }
        @t2{@answ} = 1;
        delete @t2{@$valud_answ};
        return keys %t1 if !keys %t2;
    }
}

# Ask a 'yes/no' question
sub ask_boolean
{
    while ( 1 ) {
        my $answ = ask_question (@_);

$answ = "yes" if $answ =~ /^yes$/i || $answ =~ /^y$/i;
        $answ = "no"  if $answ =~ /^no$/i  || $answ =~ /^n$/i;

return 1 if $answ eq "yes";
        return 0 if $answ eq "no";

output "Please answer either 'yes' or 'no'.\n";
    }
}

sub shell_escape
{
 my $str = shift;
 $str =~ s/([\&;\`'\\\| "*?~<>^\[\]\{\}\$\n\r])/\\$1/g; #'
 return $str;
}

sub execute
{
    my @args = @_;
    my ($msg, $cmd);

# Escape shell args
    foreach (@args) {
        $_ = shell_escape($_);
    }

$cmd = join(' ', $cmd, @args);

open(FILE,"($cmd 2>&1 ; echo \$?)|")
        or return -128;

my ($ret, $output);
 while (my $line=<FILE>) {
 if (eof FILE) {
 $ret = int($line);
 last;
 }

$output .= $line;
    }
    close(FILE);

return ($ret, $output);
}

# returns directory component from the path
# Copies a file. Returns the error message if failed
sub copy_file
{
    my ($src, $dest) = @_;

# if $dest is a directory, add the source filename
    $dest .= "/$1" if -d $dest && $src =~ /([^\/]+)$/;

open FSRC, "<$src" or return "Could not read file $src: $!";
 open FDST, ">$dest" or return "Could not write file $dest: $!";

binmode FSRC;
    binmode FDST;
    my $length;

while ( ($length = sysread (FSRC, my $data, 8192)) > 0 )
    {
        if ( syswrite (FDST, $data, $length) != $length )
        {
            close FSRC;
            close FDST;

unlink $dest;
            return "Could not write file $dest: $!";
        }
    }

close FSRC;
    close FDST;

if ( !defined $length )
    {
        unlink $dest;
        return "Couldn't read file $src: $!";
    }

# Set the same owner and mode
    my @statinfo = stat ($src);
    if ( @statinfo )
    {
        chown $statinfo[4], $statinfo[5], $dest;
        chmod (($statinfo[2] & 07777), $dest);
    }

return;
}

# Copies the matched files. Returns the error messages array if failed
sub copy_files
{
        my ($srcdir, $destdir, $pattern) = @_;
        my @errormessages;

if ( opendir (DIR, $srcdir) )
        {
                my @files = grep { -f "$srcdir/$_" && /$pattern/i } readdir DIR;
                closedir DIR;

foreach (@files)
                {
                        my $msg = klinstall::copy_file ("$srcdir/$_", "$destdir/$_");
                        push @errormessages, $msg if $msg;
                }
        }
        else
        {
                push @errormessages, "Could not open directory $srcdir: $!";
        }

return @errormessages;
}

sub which
{
    my $cmd = shift;

foreach my $path (split/:/, $ENV{'PATH'}) {
        return "$path/$cmd" if -x "$path/$cmd";
    }
}

sub read_file
{
    my $filename = shift;

open(FILE,"<$filename")
 or return;

my $lines = join ("", <FILE>);
 close(FILE);

return $lines;
}

sub detildefy
{
    my $path = shift;

if ($path =~ /^~(\w*)(.*)$/ ) {
        my $home = $1 eq '' ? (getpwuid $>)[7] : (getpwnam $1)[7];
        $path = $home . $2 if $home;
    }

return $path;
}

Cancel