#!/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__
分享到:
相关推荐
1. **print**:这是最常用的函数之一,用于将数据输出到标准输出或指定的文件句柄。 2. **length**:返回字符串或数组的长度。 3. **join** 和 **split**:这两个函数分别用于连接数组元素成字符串和将字符串分割...
### Perl 函数集详解 #### 一、进程处理函数 ##### 1. 进程启动函数 在Perl中,有几种方法可以启动新的进程。这些函数不仅能够启动新进程,还可以控制它们的行为。 - **`eval`** - **函数名**: `eval` - **...
Perl 常用命令_函数集 Perl 是一种功能强大且灵活的编程语言,提供了许多实用的命令和函数来帮助开发者进行开发。下面将对 Perl 常用命令_函数集进行详细的解释和总结。 一、进程处理函数 进程处理函数是 Perl 中...
Perl进程处理函数、数学函数、字符串处理函数等各类,perl的内置特殊变量还有很多的,例如常用的还有@_、@ARGV、$ARGV、%INC、%ENV等等,有很多,不可能一一列举了,这里给出一个比较有总结性的列表,是chinaunix上...
以上就是Perl正则表达式,常用函数和变量的一些基础知识。通过熟练掌握这些,你可以更高效地处理文本和数据,实现各种复杂的字符串操作。在实际编程中,不断实践和查阅文档是提升Perl正则表达式技能的关键。
部分常用函数包括: - `split`: 将字符串分割成数组。 - `join`: 将数组元素连接成字符串。 - `chomp`: 删除字符串末尾的换行符。 - `uc`, `lc`: 转换字符串为大写或小写。 - `push`, `pop`: 在数组末尾添加或删除...
8. **Perl函数库**:手册中会有详细的函数参考,包括内置函数和一些常用模块的函数,方便查阅和使用。 9. **调试技巧**:学习如何使用perl -d启动调试器,以及如何设置断点、单步执行、查看变量状态等调试方法。 ...
### Perl 常见问题集知识点汇总 #### 一、Perl简介与支持 - **Perl是什么?** - Perl是一种高级、通用且解释型的编程语言。它支持面向过程编程和面向对象编程,并且拥有丰富的文本处理功能。Perl最初是为了简化...
Perl社区维护了一份详细的《perl FAQ》(常问问题集),涵盖了从语言基础到高级特性的各种问题,是学习和解决问题的重要资源。常见问题包括变量作用域、引用、模块使用、文件处理、正则表达式等。通过深入阅读和实践...
综上所述,"vfp自定义函数集"是一个涵盖汉字处理的全面工具包,它可能包含了上述各种功能的实现,以帮助开发者在VFP环境中更好地处理汉字相关的任务。通过学习和理解这些自定义函数,我们可以提升在VFP项目中处理...
《perl入门第四版》可能是本书籍的名字,它提供了关于Perl语言的基本概念、语法和常用函数的详细介绍。这可能包括变量声明、数据类型(如标量、数组、哈希)、流程控制(条件语句、循环结构)、文件操作、正则表达式...
ActivePerl包含了Perl运行时环境和许多常用的CPAN(Comprehensive Perl Archive Network)模块,使得开发者可以无需手动编译就能使用各种Perl库。这个版本号表明它是5.6.x系列的一个较旧版本,可能不包含后来的一些...
在安装ActivePerl-5.26_Win_x64后,用户可以获得完整的Perl环境,包括Perl解释器和许多常用的Perl模块。这使得开发者能够在Windows平台上编写和执行Perl脚本,而无需关心编译或其他低级细节。ActivePerl还提供了一个...
- `perlfunc`:列出Perl内置函数及其用法。 - `perlquick`、`perlretut`:提供Perl正则表达式教程。 #### 三、Perl程序结构 一个典型的Perl脚本包含以下部分: - **第一行(Shebang行)**:指定Perl解释器的...
通过《Programming Perl》第三版,读者不仅可以掌握Perl的基本语法和常用库,还能了解到更高级的编程技巧和最佳实践。这本书是Perl程序员的必备参考,无论是初学者还是经验丰富的开发者,都能从中受益匪浅。
Perl支持多种数据库接口,最常用的是DBI(Database Interface)。DBI提供了一个标准的API,使得程序员可以方便地与各种数据库系统(如MySQL, PostgreSQL, Oracle等)交互。使用DBI,首先需要加载适当的数据库驱动...
- **第15章:Unicode**: 介绍 Perl 中如何处理 Unicode 字符集,以及相关的字符串操作函数。 - **第16章:进程间通信**: 探讨 Perl 中的进程间通信(IPC)机制,包括管道、信号和共享内存等。 - **第17章:线程**: 详细说明...
通过以上介绍,我们可以看到Perl/Tk提供了一套强大的工具集,用于构建各种各样的图形用户界面。无论是简单的文本显示还是复杂的用户交互,Perl/Tk都能胜任。掌握这些基础知识后,开发者就可以开始探索更多高级功能,...