#!/usr/bin/perl package HelpFuncs; # Port to Unix use Logging; use EncodeBase64; sub negation{ my ($val) = @_; if ($val eq 'true') { return 'false'; } if ($val eq 'false') { return 'true'; } } sub checkValue{ my ($val, $defaultVal, $checkVal) = @_; if( defined $val ) { if ( defined $checkVal ) { return $checkVal if $val eq $checkVal; } else { return $val; } } return $defaultVal; } sub dieWithError{ my( $msg, $errCode ) = @_; $errCode = -1 if not $errCode; log_error( "The program faield with error $errCode", $msg ); my $idx = 1; my $package = 1; my $tab = ' '; my $callstack = ''; while( $package and $idx<15 ) { my ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller($idx); if( $package ) { $tab = $tab . ' '; $callstack .= "\n$tab Stack[$idx]. Sub:$subroutine [Package:$package][Filename:$filename]Line:$line"; } $idx = $idx + 1; } die "\nDie with error:$msg\nCall stack:\n$callstack"; } # Returns string, suitable for using in 'IN ($list)' sql clause sub getSqlList { return join(',', map {"'$_'"} sort {$a <=> $b} @_); } sub blockToNum { my ( $mask ) = @_; my $longMask = unpack( "N", pack( "C4", split( /\./, $mask ) ) ); my $block; for ( $block = 0 ; $block < 32 ; $block = $block + 1 ) { my $tmp = 2**( 32 - $block - 1 ); last if !( $longMask & $tmp ); } return $block; } # # url decode (certificates in Plesk DB encoded by the url encoding) # sub urlDecode { my $url = $_[0]; $url =~ tr/+/ /; $url =~ s/%([a-fA-F0-9]{2,2})/chr(hex($1))/eg; return $url; } sub makeMIMEBase64 { my ($useModule); if (eval "require MIME::Base64") { $useModule = 1; } else { $useModule = 0; } my $this = { 'ENCODE' => sub { my ($text) = @_; if ($useModule) { my $encoded = MIME::Base64::encode($text); chomp $encoded; return $encoded; } else { return EncodeBase64::encode($text); } } }; return $this; } sub randomPasswd { my $len = shift; if ( $len <= 0 ) { $len = 8; } my $symbols = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789'; my $seq_length = length($symbols); my $passwd = ''; for (my $i = 0; $i <= $len; ++$i) { $passwd .= substr($symbols, rand($seq_length), 1); } return $passwd; } sub getUniqueDir{ my( $path, $prefix ) = @_; my $cnt = 1; while( -e "$path/$prefix\[$cnt\]" ){ $cnt += 1; } return "$path/$prefix\[$cnt\]"; } sub deleteFolder{ my( $path ) = @_; opendir( DH, $path ); my $dir; while( ( $dir = readdir( DH ) ) ){ if( not $dir eq '.' and not $dir eq '..' ){ if( -d "$path/$dir" ) { deleteFolder( "$path/$dir" ); if( not rmdir "$path/$dir" ) { Logging::error("Cannot delete directory $path/$dir"); } } else{ unlink "$path/$dir" or Logging::error("Cannot delete file '$path/$dir'"); } } } closedir( DH ); if( not rmdir $path ) { Logging::error("Cannot delete directory $path"); } } sub make_path { my $arg = {}; if (@_ and (ref($_[-1]) =~ /HASH/) ) { $arg = pop @_; } if (exists $arg->{owner} and $arg->{owner} =~ /\D/) { my $uid = (getpwnam $arg->{owner})[2]; if (defined $uid) { $arg->{owner} = $uid; } else { Logging::error("Unable to map $arg->{owner} to a uid, ownership not changed"); delete $arg->{owner}; } } if (exists $arg->{group} and $arg->{group} =~ /\D/) { my $gid = (getgrnam $arg->{group})[2]; if (defined $gid) { $arg->{group} = $gid; } else { Logging::error("Unable to map $arg->{group} to a gid, group ownership not changed"); delete $arg->{group}; } } if (exists $arg->{owner} and not exists $arg->{group}) { $arg->{group} = -1; # chown will leave group unchanged } if (exists $arg->{group} and not exists $arg->{owner}) { $arg->{owner} = -1; # chown will leave owner unchanged } push @_, $arg; _make_path(@_); } sub _make_path { my $arg = pop @_; my @paths = @_; foreach $path (@paths) { next unless defined($path) and length($path); next if -d $path; my @dirs = split ('/', $path); pop @dirs; my $parent = join('/',@dirs); unless (-d $parent or $path eq $parent) { _make_path( $parent, $arg); } if (mkdir $path, (exists $arg->{mode})? $arg->{mode}: 0755) { if( exists $arg->{owner} and exists $arg->{group}) { if (!chown 0+$arg->{owner}, 0+$arg->{group}, $path) { Logging::error("Cannot chown on '$path' to '$arg->{owner}:$arg->{group}'"); } } if (exists $arg->{mode}) { if (!chmod $arg->{mode}, $path) { Logging::error("Cannot chmod on '$path' to $arg->{mode}"); } } } else { Logging::error("Cannot mkdir '$path'"); } } } # ($total, $avail, $mount) = getMountSpace('path') sub getMountSpace { my $mount = shift; my $df = qx( df -P $mount) or die $!; while ( $df =~ /^(\S+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+\%)\s+(\S+)$/gm ) { return (512*$2, 512*(0+$2-$3), 512*$6); } return; } sub epoch2CrDate { my $epoch = shift; unless ( $epoch ) { return '1970-01-01'; } my ($mday, $mon, $year) = (localtime($epoch)) [3 .. 5]; return sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday); } sub getTime { my ($sec, $minute, $hour, $day, $month, $year) = localtime(time); $year+=1900; $sec = "0".$sec if length($sec) < 2; $minute = "0".$minute if length($minute) < 2; $hour = "0".$hour if length($hour) < 2; $day = "0".$day if length($day) < 2; $month++; $month = "0".$month if length($month) < 2; return "$year.$month.$day $hour:$minute:$sec"; } sub getRelativePath { my ($subpath, $path) = @_; if ( !$subpath || !$path) { return; } $subpath =~ /^($path)\/*(.*)/; if ( defined $2 ) { return $2; } return; } my @CHARS = (qw/ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9 _ /); sub mktemp { my $path = shift; $path =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge; return $path; } my $lastId = 0; sub generateProcessId { return $$ . "-" . $lastId++; } # Returns the elements that present in first array, but not in the second. # Arrays must be sorted. # Linear complexity. sub arrayDifference { my ( $a1, $a2 ) = @_; my @ret; my $i1 = 0; my $i2 = 0; while ( $i1 < scalar(@$a1) && $i2 < scalar(@$a2) ) { if ( $a1->[$i1] eq $a2->[$i2] ) { $i1++; $i2++; next; } if ( $a1->[$i1] lt $a2->[$i2] ) { push @ret, $a1->[$i1]; $i1++; next; } if ( $a1->[$i1] gt $a2->[$i2] ) { $i2++; next; } } while ( $i1 < scalar(@$a1) ) { push @ret, $a1->[$i1]; $i1++; } return @ret; } # Returns the elements that present in both arrays # Arrays must be storted # Linear complexity sub arrayIntersection { my ( $a1, $a2 ) = @_; my @ret; my $i1 = 0; my $i2 = 0; while ( $i1 < scalar(@$a1) && $i2 < scalar(@$a2) ) { if ( $a1->[$i1] eq $a2->[$i2] ) { push @ret, $a1->[$i1]; $i1++; $i2++; next; } if ( $a1->[$i1] lt $a2->[$i2] ) { $i1++; next; } if ( $a1->[$i1] gt $a2->[$i2] ) { $i2++; next; } } return @ret; } sub processArray (&@) { my $code = shift; my $result; if( @_ ) { foreach my $value ( @_ ) { $result = $code->($result, $value); } } return $result; } sub min2 { $_[0] <= $_[1] ? $_[0] : $_[1]; } sub max2 { $_[0] <= $_[1] ? $_[1] : $_[0]; } sub getArraySpecialValue { my $code = shift; return processArray {(defined $_[0])? ( (defined $_[1])? $code->($_[0], $_[1]) : $_[0] ) : $_[1]} grep{ defined } @_; } sub Min { return getArraySpecialValue(\&min2,@_); } sub Max { return getArraySpecialValue(\&max2,@_); } 1;