Perl 공통 함수 세트
13467 단어 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: $_
");
}
}
}
sub info
{
my (@messages) = @_;
foreach (@messages){
print("BMC Info: $_
");
}
}
sub warn
{
my (@messages) = @_;
foreach (@messages){
print("BMC Warn: $_
");
}
}
sub error
{
my (@messages) = @_;
foreach (@messages){
print("BMC Error: $_
");
}
}
sub fatal
{
my (@messages) = @_;
foreach (@messages){
print("BMC Fatal Error: $_
");
}
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
";
}
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__
이 내용에 흥미가 있습니까?
현재 기사가 여러분의 문제를 해결하지 못하는 경우 AI 엔진은 머신러닝 분석(스마트 모델이 방금 만들어져 부정확한 경우가 있을 수 있음)을 통해 가장 유사한 기사를 추천합니다:
File::Temp를 사용하여 Perl에서 잠금 파일 만들기retrieve 명령은 "perl"이라는 단어에 대한 DuckDuckGo 검색의 HTML을 검색하여 $HOME/duckduckperl.html 에 쓰고 이미 있는 경우 이 파일을 덮어씁니다. print 명령은 $HO...
텍스트를 자유롭게 공유하거나 복사할 수 있습니다.하지만 이 문서의 URL은 참조 URL로 남겨 두십시오.
CC BY-SA 2.5, CC BY-SA 3.0 및 CC BY-SA 4.0에 따라 라이센스가 부여됩니다.