Perl学习笔记(4)——应用实例

Perl学习笔记(4)--应用实例

  • 例1--Perl顶部信息自动生成
  • 例2--分析仿真结果
  • 例3--打包IP的测试用例
    • 产生用例的应用环境
    • 打包IP的测试用例

例1–Perl顶部信息自动生成

#!usr/bin/perl -w
use strict;
use POSIX;

my $cur_time = strftime ("%m/%d/%Y",localtime());
my $file_name;
my $tab = " "x4;
if (@ARGV == 1) {
	$file_name = $ARGV[0];
}
else {
	&help_message();
}

open (LOG,">",$file_name) or die "Can not open $file_name for writing!\n";
my $str = "";
$str .= "#!usr/bin/perl -w\n";
$str .= "use strict;\n";
$str .= "# ---------------------------------------------\n";
$str .= "# Filename	:$file_name			\n";
$str .= "# \n";
$str .= "# Description:					\n";
$str .= "# 						\n";
$str .= "# 						\n";
$str .= "# Author:					\n";
$str .= "# 		XXX				\n";
$str .= "# 				$cur_time	\n";
$str .= "# ---------------------------------------------\n";
$str .= "# $file_name					\n";
print LOG $str;
close LOG;
print "\n The header specified file $file_name has been gegerated!\n\n";

sub help_message {
	print "\nThe $0 script used to generate the head of a perl example file header for training\n\n";
	print "Usage : perl $0 $file_name \n\n";

	print "Example:\n";
	print "${tab}" . "-"x40 . "\n";
	print "${tab}perl $0 ext4.6.pl\n";
	print $tab . " --> generate the header for the specified perl file called ext4.6.pl\n\n";

}

在这里插入图片描述
Perl学习笔记(4)——应用实例_第1张图片

例2–分析仿真结果

产生用例所需的sim_log文件:

#!/usr/bin/perl -w
use strict;
# -------------------------------------------------------
# File name	: gen_sim_logs.pl
#
# Description	:
# 	the script used to generate the simulation
# 	log files by random
#
# -------------------------------------------------------
# gen_sim_logs.pl

# -------------------------------------------------------
# Note:
# 	you need have a reference simulation log file 
# 	to generate some real log files uded for prasing
# --------------------------------------------------------
my $ref_log_file = "ref_simv.log";
my $ref_log = "";
my $out_dir = "./out";
my $log_num = 200;
my $tab = ""x4;
my $verbose = 0;
my $debug = 0;

print "\n";

&obtain_ref_log($ref_log_file);

&gen_real_log_files($ref_log,$log_num,$out_dir);

sub obtain_ref_log {
	my $file = shift ;
	open (LOG,"<",$file) or die "Can not open $file for reading!\n";
	while (defined (my $line = )) {
		$ref_log .= $line;
	}
	close(LOG);
	print "[DEBUG] -- complete to obtain the reference simulation log \n\n";
}

sub gen_real_log_files {
	my ($log, $num, $dir) = @_;
	my $start_val = 2000;
	my $max_val = 500;
	my @cases;
	my $count = 0;
	print "[DEBUG] -- Start to genetate $num log files....\n\n";
	&adjust_out_dir(\$dir);
	while ($count < ($num + 1)) {
		my $case_id = $start_val + int(rand($max_val));
		push (@cases,$case_id);
		$count++;
		&gen_one_log_file($case_id,$log,$dir);
	}
	print "[DEBUG] -- Completed to generate the $num log files into $dir dir\n\n";
}

sub gen_one_log_file {
	my ($id, $log, $dir) = @_;
	my $sim_file = "${dir}/sim_${id}.log";
	my $result = "$log";
	my $status;
	my $max_val = 4000;
	my $rand_val = int (rand($max_val));
	$status = "OK" if ($rand_val > ($max_val / 5));
	$status = "FAIL" if ($rand_val <= ($max_val / 5));
	$result .= &obtain_sim_status ($status,$id);

	# output the generated simulation log for current test
	open (OUT,">",$sim_file) or die "Can not open $sim_file for writing!\n";
	print OUT $result;
	close (OUT);
	print "${tab}[DEBUG] -- the $sim_file has been generated!\n\n" if $verbose;
}

sub obtain_sim_status {
	my ($status,$case_id) = @_;
	my $str = "";
	$str .= "# " . "-"x30 . "\n";
	$str .= "# test_id	: $case_id\n";
	$str .= "# test_status	: $status\n";
	$str .= "# " . "-"x30 . "\n";
	return $str;
}

sub adjust_out_dir {
	my $dir_ref = shift;
	
	$$dir_ref =~ s%\$|/$%%g;
	if (-e $$dir_ref) {
		unlink glob("$$dir_ref/*");
		print "${tab}[DEBUG] -- $$dir_ref dir exist and complete to clean up its content\n\n";
	}
	else {
		mkdir "$$dir_ref", 0755 or die "Can not create $$dir_ref dir!\n";
		print "${tab}[DEBUG] -- $$dir_ref dir do not exist and complete to create it\n\n";
	}
}

Perl学习笔记(4)——应用实例_第2张图片
Perl学习笔记(4)——应用实例_第3张图片

analyze simulation result,识别通过的case,失败的case,计算pass rate,fail rate

#!usr/bin/perl -w
use strict;
# ---------------------------------------------
# Filename	:prase_sim_log_and_gen_report.pl			
# 
# Description:					
# 						
# 						
# Author:					
# 		XXX				
# 				08/07/2020	
# ---------------------------------------------
# prase_sim_log_and_gen_report.pl

use Getopt::Long;
#use Spreadsheet::WriteExcel;

my $log_dir = "./out";
my $report_file = "simulation_report.log";
my $verbose = 0;
my $debug = 0;
my $help = 0;
my $tab = ""x4;			
my $excel_en = 0;
my $info = "[INFO] --";
my $error = "[ERROR] --";
my @pass_cases;
my @fail_cases;
my @unknown_cases;

#parase the input options
GetOptions (
	'log_dir=s'	=> \$log_dir,
	'excel!'	=> \$excel_en,
	'verbose!'	=> \$verbose,
	'debug!'	=> \$debug,
	'help!'		=> \$help,
);

&help_message if $help;

&parse_sim_logs($log_dir);

&gen_report($report_file);

sub parse_sim_logs {
	my $sim_dir = shift;
	print "\n${info} Start to parse the simulation log files in $sim_dir dir \n\n";
	my @sim_files;
	# @sim_files = glob("$sim_dir/*.log");
	opendir DH, $sim_dir or die "Can not open $sim_dir dir for reading1\n";
	while (my $name = readdir DH) {
		$name = "${sim_dir}/${name}";
		push (@sim_files, $name) if $name =~ /\.log$/;
	}
	closedir DH;
	
	if  (!defined $sim_files[0] || $sim_files[0] =~ /^\s*$/) {
		print "${error} Do not obtain valid simulation log files.Exiting...\n\n";
		exit;
	}
	foreach my $sim_file (@sim_files) {
		my $case_id;
		my $status;
		open (SIM,"<",$sim_file) or die "Can not open $sim_file for reading!\n";
		while (defined (my $line = )) {
			chomp $line;
			next if $line =~ /^\s*$/;
			if ($line =~ /^#\s*test_id\s*:\s*(\d+)/) {
				$case_id = $1;
			}
			elsif ($line =~ /^#\s*test_status\s*:\s*(\w+)/) {
				$status = $1;
				$status =~ s/^\s*|\s*$//g;
				last;
			}
		}
		if (defined $case_id && defined $status) {
			if ($status =~ /^ok$/i) {
				push (@pass_cases,$case_id);
			}
			elsif ($status =~ /^fail$/i) {
				push (@fail_cases,$case_id);
			}
			else {
				push (@unknown_cases,$case_id);
			}
		}
		close(SIM);
	}
	print "${info} Complete to parse the simulation log files \n\n";
}

sub gen_report {
	my $out_file = shift;	
	if (!$excel_en) {
		&gen_txt_report($out_file);
	}
	else {
		&gen_excel_report($out_file);
	}
}

sub gen_txt_report {
	my $out_file = shift;
	my $result = "";
	my $pass_rate;
	my $fail_rate;
	my $pass_num = 0;
	my $fail_num = 0;
	my $unknow_num = 0;
	my $case_num = 0;

	print "${info} Start to generate the summary report \n\n";
	$pass_num = @pass_cases if defined $pass_cases[0];
	$fail_num = @fail_cases if defined $fail_cases[0];
	$unknow_num = @unknown_cases if defined $unknown_cases[0];
	$case_num = $pass_num + $fail_num + $unknow_num;
	my $len = length ($case_num);
	if ($case_num == 0) {
		print "${error} Do not obtain any test cases' simulation result.Exiting...\n\n";
		exit;
	}
	$pass_rate = $pass_num / $case_num;
	$fail_rate = $fail_num / $case_num;
	
	$result .= "\n";
	$result .= "#"x80 . "\n";
	$result .= "# The following is the simulation result summary report for project PrjA \n";
	$result .= "#"x80 . "\n";
	$result .= "${tab} Launched $case_num cases totally \n";
	$result .= "${tab}$pass_num case passed\n";
	$result .= "${tab}$fail_num case failed\n";
	$result .= "${tab}pass rate = " . sprintf("%${len}d",$pass_num) . "/ $case_num = ";
	$result .= sprintf("%4.2f\%", ($pass_rate * 100)) . "\n";
	$result .= "${tab}fail rate = " . sprintf("%${len}d",$fail_num) . "/ $case_num = ";
	$result .= sprintf("%4.2f\%", ($fail_rate * 100)) . "\n";
	$result .= "\n";
	$result .= $tab . "-"x50 . "\n";

	if ($pass_num > 0) {
		$result .= "${tab} The following $pass_num test cases passed :\n";
		$result .= &print_array_by_len(\@pass_cases,15);
		$result .= "\n";
	}	
	if ($fail_num > 0) {
		$result .= "${tab} The following $fail_num test cases passed :\n";
		$result .= &print_array_by_len(\@fail_cases,15);
		$result .= "\n";
	}	
	if ($unknow_num > 0) {
		$result .= "${tab} The following $unknow_num test cases' status is ";
		$result .= "unknow and need to be cheked:\n";
		$result .= &print_array_by_len(\@unknown_cases,15);
		$result .= "\n";
	}	
	
	#output the summary report to the specified file
	open (OUT,">",$out_file) or die "Can not open $out_file for writing1\n";
	print OUT $result;
	close(OUT);
	
	print $result;
	print "You also can refer to the summary report from $out_file file\n\n";
}

sub print_array_by_len {
	my ($ref,$len) = @_;
	my $str = "${tab}${tab}";
	my $num =0;
	foreach my $item (@$ref) {
		if ($num > 0 && $num %$len ==0) {
			$str .= "\n${tab}${tab}";
			$num = 0;
		}
	$str .= "${item} ";
	$num += 1;

	}
	$str .= "\n\n";
	return $str;
}
=pod
sub gen_excel_report {
	my $out_name = shift;
	print "${info} Start to generate the excel reprot\n\n";

	$out_name =~ s/^(.*)\.\w+$/${1}\.xls/;
	my $excel_out = Spredsheet::WriteExcel->new($out_name);
	my $worksheet = $excel_out->add_worksheet();
	my $format = $excel_out->add_format();
	my $col;
	$format->set_bold();
	$format->set_color('red');
	$format->set_align('center');

	my $red_format = $excel_out->add_format (color => 'red',
						 align => 'vcenter',
	);
	my $gre_format = $excel_out->add_format (color => 'green',
						 align => 'vcenter',
	);
	my $head_format = $excel_out->add_format (bold => 1,
						 size => 12,
						 color => 'blue',
						 align => 'vcenter',
	);

	$col{"case_id"}		= 0;
	$col{"description"} 	= 1;
	$col{"note"}		= 2;
	$col{"testtatus"}	= 3;
	foreach my $key (keys %col) {
		my $col_num = $col{"$key"};
		$worksheet->write(0,$col_num,$key,$head_format);
	}
	
	my $row_num = 1;
	#fill the passed test patterns result into excel
	if (@pass_case > 0) {
		foreach my $case (@pass_cases) {
			$case = "case_${case}" if $case =~ /^d+$/;
			$worksheet->write($row_num,$col{"case_id"},$case);
			#$worksheet->write($row_num,$col{"teststatus"},"OK");
			$worksheet->write($row_num,$col{"teststatus"},"OK",$gre_format);
			$worksheet->write($row_num,$col{"description"},"the descrption for $case");
			$worksheet->write($row_num,$col{"note"},"the note for $case");
			$row_num ++;
		}
	}
	
	#fill the failed test patterns result into excel
	if (@fail_case > 0) {
		foreach my $case (@fail_cases) {
			$case = "case_${case}" if $case =~ /^d+$/;
			$worksheet->write($row_num,$col{"case_id"},$case);
			#$worksheet->write($row_num,$col{"teststatus"},"OK");
			$worksheet->write($row_num,$col{"teststatus"},"FAIL",$gre_format);
			$worksheet->write($row_num,$col{"description"},"the descrption for $case");
			$worksheet->write($row_num,$col{"note"},"the note for $case");
			$row_num ++;
		}
	}
	#fill the unkonw test patterns result into excel
	if (@unknow_case > 0) {
		foreach my $case (@fail_cases) {
			$case = "case_${case}" if $case =~ /^d+$/;
			$worksheet->write($row_num,$col{"case_id"},$case);
			#$worksheet->write($row_num,$col{"teststatus"},"OK");
			$worksheet->write($row_num,$col{"teststatus"},"UNKNOW",$gre_format);
			$worksheet->write($row_num,$col{"description"},"the descrption for $case");
			$worksheet->write($row_num,$col{"note"},"the note for $case");
			$row_num ++;
		}
	}
	print "${info} The excel report has been written into $out_name\n\n";

}	

=cut

sub help_message {
	print "\nUsage :perl $0 OPTIONS\n\n";
	print "OPTIONS :\n";
	print "-"x50 . "\n";
	print "${tab} -log_dir dir_name	-- specify the log dir that save the simulation\n";
	print "${tab}			   log files.Default is ./out\n";
	print "${tab} -excel		-- generate the log file in the formar of excel file.\n";
	print "${tab}			   Default is text format\n";
	print "${tab} -help		-- print out the help message\n";
	print "${tab} -debug/-verbose	-- control to output some debug information\n";
	print "-"x50 . "\n";
	exit;
}

Perl学习笔记(4)——应用实例_第4张图片

例3–打包IP的测试用例

产生用例的应用环境

#!usr/bin/perl -w
use strict;
use Getopt::Long;
# ---------------------------------------------
# Filename	:gen_test_env.pl			
# 
# Description:					
# 						
# 						
# Author:					
# 		XXX				
# 				08/08/2020	
# ---------------------------------------------
# gen_test_env.pl

# -----------------------------------------------------------			
# case list	: $env_dir/case_list
# cfg_files	: $env_dir/sim_log/log_case_id/*.cfg
# test streams	: $env_dir/test_streams/case_id/stream.mpeg2
# -----------------------------------------------------------
my $env_dir	= "./env_log";
my $case_list	= "case_list";
my $cfg_dir	= "sim_log";
my $stream_dir	= "test_streams";
my $case_num	= 20;
my @cases;
my $help = 0;
my $debug = 0;
my $tab = " "x4;

GetOptions (
	'env_dir=s'	=> \$env_dir,
	'case_list=s'	=> \$case_list,
	'cfg_dir'	=> \$cfg_dir,
	'stream_dir=s'	=> \$case_num,
	'help!'		=> \$help,
	'debug!'	=> \$debug,

);					

&help_message() if $help;

&check_dirs();

&gen_case_list($case_list, $case_num, 3000, 500);

&gen_cfg_files($cfg_dir, \@cases);

&gen_test_streams($stream_dir, \@cases);

print "[INFO] -- Please find the generated test enviromment from $env_dir dir!\n\n";

sub gen_test_streams {
	my ($dir, $list_ref) = @_;
	print "[INFO] -- start to generate the test stream files \n\n";
	foreach my $cur_case (@$list_ref) {
		$cur_case =~ s/^case_//;
		my $cur_dir = "${dir}/case_${cur_case}";
		my $stream_name = "${cur_dir}/stream.mpeg2";
		&adjust_dir($cur_dir);
		&gen_one_stream_file($cur_case, $stream_name);
	}
	print "[INFO] -- complete to generate the test stream files to $dir dir \n\n";
}

sub gen_one_stream_file {
	my ($case, $name) = @_;
	system("touch $name");
	system("echo 'this is the stram file for $case case' > $name ");
	print "${tab}[INFO] -- the test stream file $name for $case case has been generated\n\n" if $debug;
}

sub gen_cfg_files {
	my ($dir,$list_ref) = @_;
	print "[INFO] -- start to generate cfg files \n\n";
	foreach my $case (@$list_ref) {
		$case =~ s/^case_//;
		my $cur_dir = "${dir}/log_case_${case}";
		my $cfg_file = "${cur_dir}/test.cfg";
		&adjust_dir($cur_dir);
		&gen_cfg_content($case, $cfg_file);
	}
	print "[INFO] -- complete to generate cfg files into $dir dir \n\n";
}

sub gen_cfg_content {
	my ($cur_case, $cfg_file) = @_;
	system("touch $cfg_file");
	system("echo 'this is the cfg file for $cur_case case' > $cfg_file");
	print "${tab}[INFO] -- the cfg file $cfg_file for $cur_case case has been generated\n\n" if $debug;
}

# adjust each dirs
sub check_dirs {
	$env_dir =~ s#\$|/$##;
	$case_list = "${env_dir}/${case_list}";
	$cfg_dir = "${env_dir}/${cfg_dir}";
	$stream_dir = "${env_dir}/${stream_dir}";
	&adjust_dir($env_dir);
	&adjust_dir($cfg_dir);
	&adjust_dir($stream_dir);
	
}

sub adjust_dir {
	my $cur_dir = shift;
	if (-e $cur_dir) {
		system("rm -rf $cur_dir/*");
	}
	else {
		system("mkdir $cur_dir");
	}
}

# -----------------------------------------------------------------
# the sub program used to generated the test case list file for
# test the compare_caselist.pl script
#
#
# parameters:
# 	$file		-- the file name that used to save the generated
# 		 	   test case ids
#	$num		-- how many test case ids will be generated
#	$start_val 	-- the test case id's start value
#	$max_val	-- the max value for the rand value
# -----------------------------------------------------------------
#
sub gen_case_list {
	my ($file, $num, $start_val, $max_val) = @_;
	my $case_info = "";
	print "\n[INFO] -- start to generate the test case list file\n\n";
	$case_info .= "# the following is a test case list for our project:\n\n";
	for (my $i = 0; $i < $num ; $i++) {
		my $case_id = $start_val + int(rand($max_val));
		$case_info .= "$case_id "	if (($case_id % 3) == 0);
		$case_info .= "$case_id "	if (($case_id % 3) == 1);
		$case_info .= "$case_id \n\n"	if (($case_id % 3) == 2); 
		push (@cases, $case_id) if (defined $cases[0] && (!(grep {$case_id =~ /^$_$/} @cases)));
		push (@cases, $case_id) if (!defined $cases[0]);
	}
	open (LIST,">", $file) or die "Can not open $file for writing! \n\n";
	print LIST $case_info;
	close (LIST);
	print "[INFO] -- a test case list has been written into $file file. \n\n";

}

sub help_message {
	my $str = "";
	print "\n$0 used to generate the test enviroment for the prepare test patterns for ip deliver script \n\n";
	print "Usage : perl $0 OPTIONS \n\n";
	print "OPTIONS:\n";
	print "-"x40 . "\n";
	print "${tab}-env_dir	env_dir		--specify the generated enviroment path.\n";
	print "${tab}-case_list	list_name	--specify the case list file name.\n";
	print "${tab}-cfg_dir	cfg_dir		--specify the generated cfg file path.\n";
	print "${tab}-stream_dir stream_dir	--specify the generated test stream's path.\n";
	print "${tab}-case_num	case_num	--specify the case number that will be generated for deliver.\n";
	print "${tab}-help			--print out this help info.\n";
	print "${tab}-debug			--print out some info for debug.\n";
	print "-"x40 . "\n";
	exit;
}

Perl学习笔记(4)——应用实例_第5张图片
Perl学习笔记(4)——应用实例_第6张图片

打包IP的测试用例

#!usr/bin/perl -w
use strict;
use Getopt::Long;
# ---------------------------------------------
# Filename	: prepare_tests_for_ip_deliver.pl			
# 
# Description:	
# 	the script used to prepare the test patterns
# 	for ip release				
# 						
# 						
# Author:					
# 		XXX				
# 				08/08/2020	
# ---------------------------------------------

my $output_name	= "test_pattern";
my $tar_format	= "tar";	# .tar.gz or .tar,can be modified by option
my $case_list	= "./env_log/case_list";
my $cfg_dir	= "./env_log/sim_log";
my $stream_path	= "./env_log/test_streams";
my $help = 0;
my $debug = 0;
my $verbose = 0;
my $tab = " "x4;

my @cases;
my $cur_dir;
my $ERROR = "[ERROR] --";
my $INFO = "[INFO] --";
my @not_generated_list;
my @generated_list;

#if (@ARGV > 0) {
GetOptions (
	'package_name=s'=> \$output_name,
	'tar_format=s'	=> \$tar_format,
	'case_list=s'	=> \$case_list,
	'cfg_dir=s'	=> \$cfg_dir,
	'stream_path=s'	=> \$stream_path,
	'help!'		=> \$help,
	'verbose'	=> \$verbose,
	'debug!'	=> \$debug,

);					

$cur_dir = `pwd`;
chomp $cur_dir;
$cur_dir =~ s#\$|/$##;

&adjust_one_dir(\$cfg_dir, $cur_dir) if defined $cfg_dir;
&adjust_one_dir(\$stream_path, $cur_dir) if defined $cur_dir;

$output_name =~ s/^\s*|\s*$//g;
$output_name =~ s#^\.+/|/$##g;

&help_message() if $help;

# --------------------------------------------------------------------
#
# generation flow:
# 1) obtain the case list from case list file
# 2) cp the config file and test stream into a new generated case dir
# 3) output the test pattern package in the specified format
# --------------------------------------------------------------------

&obtain_case_list($case_list);
&gen_testdata(\@cases);

# &gen_report();

# the sub program used to obtain the vaild test patterns from
# the read back line information

sub obtain_one_line_patterns {
	my ($line, $arr_ref) = @_;
	my @cur_cases = split(/\s+/, $line);
	if (defined $cur_cases[0] && $cur_cases[0] !~ /^\s*$/) {
		foreach my $cur_case (@cur_cases) {
			$cur_case =~ s/^\s*|\s*$//g;
			$cur_case =~ s/^case_//;
			push (@$arr_ref, $cur_case) if ($cur_case =~ /^\d+$/);
		}
	}
}

sub gen_testdata {
	my $case_ref = shift;
	print "${INFO} Start to generate each test pattern's testdata \n\n";
	# prepare the tmp dir for testdata generation;
	my $tmp_dir = "./tmp_dir";
	&prepare_out_dir($tmp_dir);
	my $tmp_pkg_dir = "${tmp_dir}/${output_name}";
	&adjust_one_dir(\$tmp_pkg_dir, $cur_dir);
	system ("rm -rf 4{tmp_pkg_dir}/*");
	
	foreach my $cur_case (@$case_ref) {
		my $stream_name;
		$cur_case =~ s/^case_//;
		my $cur_case_dir = "${tmp_pkg_dir}/case_${cur_case}";
		my $cur_cfg_file = "${cfg_dir}/log_case_${cur_case}/test.cfg";
		my $cur_stream_file = "${stream_path}/case_${cur_case}/stream.mpeg2";

		#obtain the config file
		if (-e "$cur_cfg_file") {
			system("mkdir -p ${cur_case_dir}");
			system("cp ${cur_cfg_file} ${cur_case_dir}");
		} 
		else {
			push (@not_generated_list, $cur_case);
			next;	
		}
		
		#obtain the test stream files
		if (-e "${cur_stream_file}") {
			system("cp ${cur_stream_file} ${cur_case_dir}");
		}
		else {
			push (@not_generated_list, $cur_case);
			next;	
		}
		push (@generated_list, $cur_case);
	}
	# &adjust_one_dir (\$output_name, $cur_dir);
	my $final_pkg_name = &output_test_patters_package($tmp_pkg_dir, $output_name);
	system("rm -rf $tmp_dir");
	system("rm -rf $output_name");
	print "${INFO} Complete to generate each test pattern's testdata \n\n";
	print "${INFO} The generated test patterns pakage for ip deliver has been placed to $final_pkg_name \n\n";
	
}

sub output_test_patters_package {
	my ($tmp_pkg_dir, $package_name) = @_;
	# check the tar format
	$tar_format =~ s/^\.// if defined $tar_format;
	if (!defined $tar_format || (defined $tar_format && $tar_format !~ /^tar$/ && $tar_format !~ /^tar\.gz$/)) {
		print "${ERROR} the tar formay should be \"tar\" or \"tar.gz\" but detect a not valid value.Exiting...\n\n";

	}
	
	system("mv $tmp_pkg_dir $package_name");
	chdir $package_name;
	if ($tar_format eq "tar") {
		system("tar cvf ${package_name}.tar * > /dev/null");
		system("mv ${package_name}.tar $cur_dir");
		chdir $cur_dir;
		return "${cur_dir}/${package_name}.tar";
	}
	elsif ($tar_format eq "tar.gz") {
		system("tar zcvf ${package_name}.tar.gtz * > /dev/null");
		system("mv ${package_name}.tar.gz $cur_dir");
		chdir $cur_dir;
		return "${cur_dir}/${package_name}.tar";
	}
}

sub prepare_out_dir {
	my $dir_name = shift;
	if (-e $dir_name) {
		system("rm -rf $dir_name/*");
	} else {
		system("mkdir $dir_name");
	}
}

sub adjust_one_dir {
	my ($dir_ref, $cur_path) = @_;
	my $dir = $$dir_ref;
	$dir =~ s/^\s*|\s*$//g;
	$dir =~ s%\$|/$%%;
	if ($dir =~ /^\.\/(\w+.*)$/) {
		$dir = "${cur_path}/${dir}";
	} elsif ($dir =~ /^\.\.\/\w+/) {
		$dir = "${cur_path}/${dir}";
	} elsif ($dir =~ /^\w+$/) {
		$dir = "${cur_path}/${dir}";
	}
	$$dir_ref = $dir;
}

sub obtain_case_list {
	my $file = shift;
	print "${INFO} Start to obtain the test case list from $file\n\n";
	if (defined $file && $file !~ /^\s*$/ && (-e $file)) {
		open(LOG,"<",$file) or die "Can not open $file for reading!\n";
		while() {
			my $line = $_;
			next if &is_not_valid($line);
			next if $line =~ /^\s*$/;
			chomp $line;
			&obtain_one_line_patterns($line,\@cases);
		}
		close(LOG);
	}
	else {
		print "${ERROR} Can not obtain the test case list. You must specify it use \"-case_list\" option.Exiting...";
		exit;
	}
	print "${tab}The obtained test case list form $file is cases = @cases \n\n" if $verbose;
	print "${INFO} Complete to obtain the test case list from $file\n\n";
}


sub print_array_by_len {
	my ($len,$ref) = @_;
	my $cur_len = 0;
	my $str = "";
	foreach my $case (@$ref) {
		if ($cur_len == 0) {
			my $item = "${tab}${tab}${case} ";
			$cur_len += length($case);
			$str .= $item;
		}
		elsif ($cur_len < $len) {
			my $item = "$case ";
			$cur_len += length($case);
			$str .= $item;
		}
		else {
			my $item = "$case \n";
			$cur_len = 0;
			$str .= $item;
		}
	}
	return $str;
}

sub is_not_valid {
	my $val = shift;
	if (!defined $val || (defined $val && $val =~ /^\s*$/)) {
		return 1;
	}
	return 0;
}

sub help_message {
	my $len = length($0);
	print "Usage : perl $0 OPTIONS \n\n";
	############# description for options 
	print "${tab}Description for OPTIONS:\n";
	print "${tab}" . "-"x50 . "\n";
	print "${tab}-package_name package_name	--specify the prepared test pattern package name.\n";
	print "${tab}-case_list list_file	--specify the test case list that will be generate testdata.\n";
	print "${tab}-tar_format format		--specify the output file format: .tar, .tar.gz .\n";
	print "${tab}-cfg_dir	cfg_dir		--specify the dir that config files locate in .\n";
	print "${tab}-stream_dir stream_dir	--specify the dir that the test streams locate in \n";
	print "${tab}-help			--print out this help info.\n";
	print "${tab}-debug			--print out some info for debug.\n";
	print "${tab}-verbose			--the same as \"-debug\",but have more detailed infomation\n";
	
	########### Examples
	print "${tab}Some examples : \n";
	print "${tab}" . "-"x50 . "\n";
	print "${tab}${tab} 1) perl $0 -case_list list_file -package_name test_data -tar_format .tar.gz \n";
	exit;
}

Perl学习笔记(4)——应用实例_第7张图片

你可能感兴趣的:(脚本语言,Perl)