Perl常用函数集

#!/usr/bin/perl -w

package Common;

use vars qw(@ISA @EXPORT @EXPORT_OK);
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
	isScmDebug enableScmDebug debug info warn error fatal
	isDefinedInEnv environ setenv ipaddress
	isEmpty isBlank isNotBlank isTrue isFalse firstLetter lastLetter
	trim ltrim rtrim lstrip rstrip
	formatTime compareDate countTime
	containsInArray saveArrayToFile
	fexists rm rename cp filesize modifiedTime readToArrayWithIndex readToArrayWithPattern containsInFile readLineInFile replaceLineInFile commentLineInFile writeTo
	try catch registerBeforeProcess registerAfterProcess registerErrorHandler invoke
);

###################################################################################
## Below includes scm debug/log related functions
sub isScmDebug
{
	return &isDefinedInEnv("BMC_DEBUG");
}

sub enableScmDebug
{
	&setenv("BMC_DEBUG", 1);
}

sub debug
{
	my (@messages) = @_;
	if(&isScmDebug()){
		foreach (@messages){
			print("BMC Debug: $_\n");
		}
	}
}

sub info
{
	my (@messages) = @_;
	foreach (@messages){
		print("BMC Info: $_\n");
	}
}

sub warn
{
	my (@messages) = @_;
	foreach (@messages){
		print("BMC Warn: $_\n");
	}
}

sub error
{
	my (@messages) = @_;
	foreach (@messages){
		print("BMC Error: $_\n");
	}
}

sub fatal
{
	my (@messages) = @_;
	foreach (@messages){
		print("BMC Fatal Error: $_\n");
	}
	die("Script exit due to above BMC FATAL ERRORs, please contact your SCM admin!");
}

###################################################################################
## Below includes string related functions
sub isDefinedInEnv
{
	my $envvar = shift;
	if(defined($ENV{$envvar}) && int($ENV{$envvar}) > 0){
		return 1;
	}
	else{
		return 0;
	}
}

#this function can check environment vars given a list of names, it will return the first matched value in environment
sub environ
{
	my @envvars = @_;
	foreach (@envvars){
		if(&isDefinedInEnv($_)){
			return $ENV{$_};
		}
	}
	return "";
}

sub setenv
{
	my ($envvar, $envval) = @_;
	$ENV{$envvar} = $envval;
}

sub ipaddress
{
	my ($hostname) = shift;
	my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($hostname);
	debug("name: $name");
	my ($a , $b , $c , $d) = unpack('C4', $addrs[0]);
	debug("$a.$b.$c.$d");
	return "$a.$b.$c.$d";
}

###################################################################################
## Below includes string related functions
sub isEmpty
{
	my $string = shift @_;
	if(!defined($string) || length($string) == 0){
		return 1;
	}
	return 0;
}

sub isBlank
{
	my $string = shift;
	return &isEmpty(&trim($string));
}

sub isNotBlank
{
	my $string = shift;
	return !&isEmpty(&trim($string));
}

sub isTrue
{
	my $str = shift;
	if(&isEmpty($str)){ return 0; }
	if(uc($str) eq "TRUE" || uc($str) eq "YES" || lc($str) eq "y"){ return 1;}
	return 0;
}

sub isFalse
{
	my $str = shift;
	if(&isEmpty($str)){ return 1; }
	if(uc($str) eq "FALSE" || uc($str) eq "NO" || lc($str) eq "n"){ return 1;}
	return 0;
}

sub firstLetter
{
	my $str = shift;
	return substr($str, 0, 1);  
}

sub lastLetter
{
	my $str = shift;
	return substr($str, -1);  
}

# Perl trim function to remove whitespace from the start and end of the string
sub trim
{
	my $string = shift @_;
	$string =~ s/^\s+//;
	$string =~ s/\s+$//;
	return $string;
}

# Left trim function to remove leading whitespace
sub ltrim
{
	my $string = shift @_;
	$string =~ s/^\s+//;
	return $string;
}

# Right trim function to remove trailing whitespace
sub rtrim
{
	my $string = shift @_;
	$string =~ s/\s+$//;
	return $string;
}

sub lstrip
{
	my ($string,$length, $appender) = @_;
	$appender = $appender || ' ';
	local $len = length($string);
	if($len ge $length){ return $string; }
	local $minis = $length - $len;
	return $appender x $minis.$string;
}

sub rstrip
{
	my ($string,$length, $appender) = @_;
	$appender = $appender || ' ';
	local $len = length($string);
	if($len ge $length){ return $string; }
	local $minis = $length - $len;
	return $string.$appender x $minis;
}

###################################################################################
## Below includes date related functions
sub formatTime
{
	local ($format,@time) = @_;
	if(&isEmpty($format)){ $format = "%Y-%m-%d %H:%M:%S"; }
	return strftime($format, @time);
}

sub compareDate
{
	my ($date1, $date2) = @_;
	my ($m1,$d1,$y1) = split(/[-\/]/,$date1,3);
	my ($m2,$d2,$y2) = split(/[-\/]/,$date2,3);
	debug("date1: $m1,$d1,$y1");
	debug("date2: $m2,$d2,$y2");
	if($y1 > $y2){ return 1; }
	elsif($y1 < $y2){ return -1;}
	else{#$y1=$y2
		if($m1>$m2){ return 1; }
		elsif($m1<$m2){ return -1;}
		else{ #$m1=$m2
			if($d1>$d2){ return 1; }
			elsif($d1<$d2){ return -1;}
			else{return 0;}
		}
	}
}

sub countTime
{
	my ($start_time,$end_time) = @_;
	my $spent_time = ($end_time-$start_time);
	debug("spent time: $spent_time");
	my $spent_sec = $spent_time%60;
	my $spent_mm = $spent_time/60;
	my $spent_hr = $spent_mm >= 60 ? int($spent_mm/60) : 0;
	$spent_mm = $spent_mm >= 60 ? $spent_mm%60 : int($spent_mm);
	return ($spent_hr,$spent_mm,$spent_sec);
}

###################################################################################
## Below includes array related functions

#this function used for string comparation
sub containsInArray
{
	my ($elem, @array) = @_;
	if(grep(/$elem/, @array)){ return 1;}
	foreach (@array){
		if($_ =~ /$elem/i){ return 1; }
		if(index(ucfirst($elem), ucfirst($_)) >= 0){ return 1; }
	}
	return 0;
}

sub saveArrayToFile
{
    my ($file, @array) = @_;
	open(FILE, ">$file") || die("Cannot open file: $file");
	foreach $item (@array){
		print FILE "$item\n";
	}
    close(FILE);
}

###################################################################################
## Below includes file related functions
sub fexists
{
	my $file = shift;
	if(-e "$file"){ return 1; }
	return 0;
}

sub cp
{
	my ($filename, $copyname) = @_;
	system("cp $filename $copyname");
}

sub rm
{
	my @files = @_;
	foreach (@files){
		if(-e $_){
			system("rm -rf $_");
			debug("removed file $_");
		}
	}
}

sub rename
{
	my ($filename, $newname) = @_;
	system("mv $filename $newname");
}

sub filesize
{
	my $filename = shift;
	if(&fexists($filename)){
		my @stats = stat($filename);
		return $stats[7];
	}
	return 0; 
}

sub modifiedTime
{
	my $filename = shift;
	if(&fexists($filename)){
		my @stats = stat($filename);
		return $stats[9];
	}
	return ""; 
}

sub readToArrayWithIndex
{
	my ($file,$start_index,$end_index) = @_;
	if(!$start_index){ $start_index=0;}
    my @result = ();
    if(open(FILE, "<$file")){
        @result = <FILE>;
        close(FILE);
    }
	if(!$end_index){$end_index=@result;}
	if($end_index<=0){
		local $len = @result;
		$end_index = $len+$end_index;
	}
    return @result[$start_index..$end_index];
}

sub readToArrayWithPattern
{
    my ($src,$start_pattern,$end_pattern,$includes_end_pattern) = @_;
    my @res = ();
    open(SRC, "<$src") || die("Cannot open source file: $src");
    my $allow_copy = 0,$at_end_pattern_pos=0;
    if(!$start_pattern){ $allow_copy = 1; }
    while($line = <SRC>){
        if($start_pattern && $line =~ /$start_pattern/){
            $allow_copy = 1;
        }
		if($end_pattern && $line =~ /$end_pattern/){
            $allow_copy = 0;
			if($includes_end_pattern){$at_end_pattern_pos = 1;}
        }
		push(@res, $line) if($allow_copy || $at_end_pattern_pos);
		if($at_end_pattern_pos){ $at_end_pattern_pos = 0;}
    }
    close(SRC);
    return @res;
}

sub containsInFile
{
	my ($file, $pattern) = @_;
	my $result = 0;
    open(FILE, "<$file") || die("Cannot open file: $file");
    while($line = <FILE>){
        if($line =~ /$pattern/){
			&debug("matched line: $line");
            $result = 1;
        }
    }
	close(FILE);
    return $result;
}

sub readLineInFile
{
	my ($file, $pattern) = @_;
	my $result = '';
	&debug($pattern);
    open(FILE, "<$file") || die("Cannot open file: $file");
    while($line = <FILE>){
        if($line =~ /$pattern/){
			&debug("matched line: $line");
            $result = $line;
        }
    }
	close(FILE);
    return $result;
}

sub replaceLineInFile
{
	my ($file, $pattern, $replacement) = @_;
	my $tmp = "$file".".tmp";
    open(FILE, "<$file") || die("Cannot open file: $file");
	open(TMP, ">$tmp") || die("Cannot open file: $tmp");
    while($line = <FILE>){
		&debug("before: $line");
        $line =~ s/$pattern/$replacement/g;
		&debug("after: $line");
		&debug("replaced $pattern with $replacement.");
		print TMP $line;
    }
	close(FILE);
	close(TMP);
    system("mv $tmp $file");
}

sub commentLineInFile
{
	my ($file, $pattern) = @_;
	my $tmp = "$file".".tmp";
    open(FILE, "<$file") || die("Cannot open file: $file");
	open(TMP, ">$tmp") || die("Cannot open file: $tmp");
    while($line = <FILE>){
		&debug("comment line: $line.");
        $line = "# $line";
		print TMP $line;
    }
	close(FILE);
	close(TMP);
    system("mv $tmp $file");
}

sub writeTo
{
	my ($file, @lines) = @_;
	open(FILE, ">$file") || die("Cannot open file $file for write.");
	foreach (@lines){
		print FILE $_;
	}
	close(FILE);
}

###################################################################################
## Below includes callback related functions for advanced users
sub try (&$) {
    my($try,$catch) = @_;
    eval { &$try };
    if ($@) {
        local $_ = $@;
        &$catch;
    }
}
sub catch (&) { shift }

sub registerBeforeProcess
{
	my ($obj, $beforeProcess) = @_;
	$obj->{'before_process'} = $beforeProcess;
}
sub registerAfterProcess
{
	my ($obj, $afterProcess) = @_;
	$obj->{'after_process'} = $afterProcess;
}
sub registerErrorHandler
{
	my ($obj, $errorHandler) = @_;
	$obj->{'error_handler'} = $errorHandler;
}
sub invoke
{
	my ($process, @params) = @_;
	eval{ 
		if($process->{before_process}){
			&$process->{before_process}(@params);
		}
		&$process(@params); 
		if($process->{after_process}){
			&$process->{after_process}(@params);
		}
	};
	if($@){
		&error("error when invoke $process with parameters[@params]");
		&error($@);
		if($process->{error_handler}){
			&$process->{error_handler}($@);
		}
		else{
			&fatal("We cannot handle this error.");
		}
	}
}


1;
__END__