mirror of
				https://github.com/xcat2/xcat-core.git
				synced 2025-10-30 02:42:41 +00:00 
			
		
		
		
	
		
			
				
	
	
		
			623 lines
		
	
	
		
			18 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
			
		
		
	
	
			623 lines
		
	
	
		
			18 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
| #!/usr/bin/env perl
 | |
| ###############################################################################
 | |
| # This script is used for rest-api automation test
 | |
| # Flags are used for test input:
 | |
| #     -m method. Should be GET, POST, PUT, DELETE
 | |
| #     -r resource
 | |
| #     -t token
 | |
| #     -h host
 | |
| #     -u user
 | |
| #     -p passwd
 | |
| #     -P port (BC)
 | |
| #     -d data
 | |
| #     -c cert
 | |
| #     -n hostname
 | |
| # Flags are used for check output:
 | |
| #     -o expected output
 | |
| #     -O logical operator
 | |
| #
 | |
| # Expected result format is '{ANY:{ANY:content}}'
 | |
| # These steps are used to explain how to scan result
 | |
| #     step 1. go through to see if content can be found
 | |
| #     step 2. compare content if found
 | |
| # options are used as followed:
 | |
| #    == returns 0 if found and equal, returns 1 if not found or found but not equal
 | |
| #    != returns 0 if found, returns 1 if not found
 | |
| #    =~ returns 0 if match, returns 1 if not match
 | |
| #    !=~ returns 0 if not match, returns 1 if match
 | |
| ################################################################################
 | |
| BEGIN
 | |
| {
 | |
|       $::XCATROOT = $ENV{'XCATROOT'} ? $ENV{'XCATROOT'} : '/opt/xcat';
 | |
| }
 | |
| use Getopt::Long qw{:config  bundling no_ignore_case};
 | |
| use Data::Dumper;
 | |
| use strict;
 | |
| my $help;
 | |
| my $method;
 | |
| my $token;
 | |
| my $resource;
 | |
| my $host;
 | |
| my $user;
 | |
| my $passwd;
 | |
| my $port;
 | |
| my $data;
 | |
| my $cert;
 | |
| my $hostname;
 | |
| my $output;
 | |
| my $loperator;
 | |
| my $debug;
 | |
| my $defaulthash;
 | |
| my $defaulthttpresult = 0;
 | |
| my $outputfile = "/tmp/testrestapiresult";
 | |
| 
 | |
| if (
 | |
|     !GetOptions("h|?"  => \$help,
 | |
|                 "m=s" => \$method,
 | |
|                 "t=s" => \$token,
 | |
|                 "r=s" => \$resource,
 | |
|                 "h=s" => \$host,
 | |
|                 "u=s" => \$user,
 | |
|                 "p=s" => \$passwd,
 | |
|                 "P=s" => \$port,
 | |
|                 "d=s" => \$data,
 | |
|                 "c=s" => \$cert,
 | |
|                 "n=s" => \$hostname,
 | |
|                 "o=s" => \$output,
 | |
|                 "O=s" => \$loperator,
 | |
|                 "debug" => \$debug,
 | |
|                 )
 | |
|   ) {
 | |
|     &usage;
 | |
|     exit 1;
 | |
| }
 | |
| 
 | |
| 
 | |
| ##############################################################
 | |
| # return help
 | |
| ##############################################################
 | |
| if ($help) {
 | |
|     &usage;
 | |
|     exit 0;
 | |
| }
 | |
| ##############################################################
 | |
| # flag check
 | |
| ##############################################################
 | |
| if  ($method ) {
 | |
|     unless( $resource ) {
 | |
|         print "-m must be used with -r \n";
 | |
|         &usage;
 | |
|         exit 0;
 | |
|     }
 | |
| }
 | |
| if  ($resource ) {
 | |
|     unless($method) {
 | |
|         print "-r must be used with -m \n";
 | |
|         &usage;
 | |
|         exit 0;
 | |
|     }
 | |
| }
 | |
| 
 | |
| 
 | |
| ##############################################################
 | |
| # ONLY check result,exit immediately
 | |
| ##############################################################
 | |
| if ($output and !defined($method)) {
 | |
|     my $res = check_result($output,$loperator,$outputfile);
 | |
|     log_debug(2, "check result runs with $output and $loperator, result is $res\n" );
 | |
|     exit $res;
 | |
| }
 | |
| 
 | |
| ##############################################################
 | |
| # Give default values for optional vars.
 | |
| ###############################################################
 | |
| my $rootdir = "$::XCATROOT/share/xcat/tools/autotest";
 | |
| my $resultdir = "$rootdir/result";
 | |
| my $logfile = "$rootdir/result/restapitest.log";
 | |
| #/opt/xcat/share/xcat/tools/autotest/result/restapitest.log
 | |
| my $confile = "$rootdir/default.conf";
 | |
| 
 | |
| 
 | |
| # read configuration file
 | |
| if (!open (CONF, "<$confile")) {
 | |
|         log_debug(1,"can't open configuration file $confile");
 | |
|         exit 1;
 | |
| }
 | |
| my %confhash;
 | |
| while (<CONF>){
 | |
|     if (/restapi-(\w+)=(\S+)/) {
 | |
|        $confhash{$1}=$2;
 | |
|     }
 | |
| }
 | |
| 
 | |
| # get token
 | |
| my $defaultserver = $confhash{DefaultServer};
 | |
| my $defaultuser = $confhash{DefaultUser1};
 | |
| my $DefaultPasswd = $confhash{DefaultPasswd1};
 | |
| my $gettoken = `curl -X POST -k 'https://$defaultserver/xcatws/tokens?userName=$defaultuser&password=$DefaultPasswd' -H Content-Type:application/json --data '{"userName":"$defaultuser","password":"$DefaultPasswd"}' 2>/dev/null`;
 | |
| my $reshash = parse_json($gettoken);
 | |
| my $token1 = $$reshash{token}{id};
 | |
| 
 | |
| # get hostname
 | |
| unless ($hostname) {
 | |
|    $hostname = `hostname`;
 | |
|     chomp($hostname);
 | |
| }
 | |
| unless ($defaultserver) {
 | |
|     $host = "127.0.0.1";
 | |
| } else {
 | |
|     $host = $defaultserver;
 | |
| }
 | |
| 
 | |
| # keey default test result for save
 | |
| my $res = run_restapi($method, $resource, $data, "", $port, "$host", "$defaultuser", "$DefaultPasswd");
 | |
| $defaulthash = parse_json($res);
 | |
| $defaulthttpresult = check_errcode();
 | |
| 
 | |
| # debug and log info
 | |
| log_debug(3, "get token $token1. \n" );
 | |
| log_debug(3, "get first default user $confhash{DefaultUser1} \n" );
 | |
| log_debug(3, "get first default user's passwd is $confhash{DefaultPasswd1} \n" );
 | |
| log_debug(3, "get second default user $confhash{DefaultUser2} \n" );
 | |
| log_debug(3, "get second default user's passwd is $confhash{DefaultPasswd2} \n" );
 | |
| log_debug(3, "get path of ca $confhash{Cert} \n" );
 | |
| log_debug(3, "get server $defaultserver from configuration file and it is $host\n" );
 | |
| log_debug(3, "get hostname $hostname.\n");
 | |
| log_debug(3, "default result is $res. \n" );
 | |
| log_debug(3, "default resulthash is: \n" );
 | |
| log_debug(3,$defaulthash);
 | |
| log_debug(3, "default errcode is $defaulthttpresult \n" );
 | |
| log_debug(3,"**************begin to run more restapi test, stop when post***************");
 | |
| 
 | |
| 
 | |
| ####################################################
 | |
| # Begin to run test cases
 | |
| ####################################################
 | |
| my @users = ($confhash{DefaultUser1},$confhash{DefaultUser2}, $user);
 | |
| my @passwds = ($confhash{DefaultPasswd1},$confhash{DefaultPasswd2}, $passwd);
 | |
| my @tokens = ("", $token1, $token);
 | |
| my @certs = ("", $confhash{Cert}, $cert);
 | |
| my $i = 0;
 | |
| unless ($method eq "POST") { # Should not post sevral times
 | |
|     for my $u (@users) {
 | |
|         next unless($u);
 | |
|         my $p = $passwds[$i];
 | |
|         $i++;
 | |
|         for my $t (@tokens) {
 | |
|             for my $c (@certs){
 | |
|                 #if ($method eq "POST" and ($resource =~ /^\/nodes\/(\w+)$/)) {
 | |
|                 #     `/opt/xcat/bin/rmdef $1`;
 | |
|                 #     log_debug(2,"restapi test rmdef $1\n");
 | |
|                 #}
 | |
|                 my $res = run_restapi($method, $resource, $data, $c, $port, $host, $u, $p, $t);
 | |
|                 if($res){
 | |
|                     my $reshash = parse_json($res);
 | |
|                     log_debug(2,"parse curl result and got:\n");
 | |
|                     log_debug(2,$reshash);
 | |
|                     if (%$reshash != %$defaulthash) {
 | |
|                         log_debug(3, "restapi test cases run different result with $method, $resource, $data, $c, $port, $host, $u, $p, $t\n" );
 | |
|                         exit 1;
 | |
|                     }
 | |
|                 }
 | |
|                 my $errcode = check_errcode();
 | |
|                 log_debug(2,"get curl error code: $errcode\n");
 | |
|                 if ($errcode != $defaulthttpresult) {
 | |
|                     log_debug(3, "restapi test cases run different error code with $method, $resource, $data, $c, $port, $host, $u, $p, $t\n" );
 | |
|                     exit 1;
 | |
|                 }
 | |
|             }
 | |
|         }
 | |
|     }
 | |
| }
 | |
| ##############################################################
 | |
| # check result
 | |
| ##############################################################
 | |
| if ($output) {
 | |
|     my $res = check_result($output,$loperator,$res);
 | |
|     log_debug(2, "check result runs with $output and $loperator, result is $res\n" );
 | |
|     exit $res;
 | |
| }
 | |
| 
 | |
| exit  $defaulthttpresult;
 | |
| 
 | |
| ################################################
 | |
| # begin subroutine
 | |
| ################################################
 | |
| 
 | |
| ##########
 | |
| # usage  #
 | |
| ##########
 | |
| sub usage
 | |
| {
 | |
|     print "Usage:testrestapi - Run xcat test cases.\n";
 | |
|     print "  testrestapi [-?|-h]\n";
 | |
|     print "  testrestapi [-m method] [-r resource] [-t tocken]\n";
 | |
|     print "  [-h host] [-P port][-u user] [-p passwd]\n";
 | |
|     print "  [-d data] [-c cert] [-n hostname]\n";
 | |
|     print "  [-o expect_output] [-O logical_operator] \n";
 | |
|     print "  [--debug]\n";
 | |
|     print "\n";
 | |
|     return;
 | |
| }
 | |
| 
 | |
| 
 | |
| #######################
 | |
| # print debug infor   #
 | |
| # 1 for only log      #
 | |
| # 2 for only debug    #
 | |
| # 3 for log and debug #
 | |
| #######################
 | |
| sub log_debug
 | |
| {
 | |
|     my $flag = shift;
 | |
|     my $msg = shift;
 | |
|     if ($flag & 0x2) {
 | |
|         if($debug){
 | |
|             if(ref($msg) eq 'HASH') {
 | |
|                 print Dumper($msg);
 | |
|             } elsif( ref($msg) eq 'ARRAY') {
 | |
|                 print Dumper($msg);
 | |
|             } else {
 | |
|                 print "$msg";
 | |
|             }
 | |
|         }
 | |
|     }
 | |
|     if ($flag & 0x1) {
 | |
|         open (LOG, ">>$logfile")
 | |
|            or  return 1;
 | |
|         my $date = `date`;
 | |
|         print LOG "$date\: $msg\n";
 | |
|     }
 | |
| }
 | |
| #########################
 | |
| # run rest-api command  #
 | |
| #########################
 | |
| sub run_restapi
 | |
| {
 | |
|     my ($m,$r,$d,$c,$p,$h,$u,$a,$t) = @_;
 | |
|     my $cmd = "curl";
 | |
|     $cmd .= " -X $m";
 | |
|     unless ($c) {
 | |
|         $cmd .= " -k ";
 | |
|     }else {
 | |
|         $cmd .= " --cacert $c";
 | |
|     }
 | |
|     if($t){
 | |
|         $cmd .= " -H X-Auth-Token:$t ";
 | |
|     }
 | |
|     if($t or $c){
 | |
|         $cmd .= " 'https://$hostname";
 | |
|     } else {
 | |
|         $cmd .= " 'https://$h";
 | |
|     }
 | |
|     if ($p) {
 | |
|         $cmd .= ":$p";
 | |
|     }
 | |
|     $cmd .= "/xcatws";
 | |
|     $cmd .= "$r?";
 | |
|     unless($t){
 | |
|         $cmd .= "userName=$u&password=$a'";
 | |
|     }else {
 | |
|         $cmd .= "'";
 | |
|     }
 | |
|     if($d) {
 | |
|         $cmd .= " -H Content-Type:application/json --data '$d'";
 | |
|     }
 | |
|     $cmd .= " -D /tmp/err.log";
 | |
|     log_debug(1,"Begin to run restapi test with $cmd");
 | |
|     my $res = `$cmd 2>/dev/null`;
 | |
|     log_debug(2,"run curl: $cmd\n");
 | |
|     log_debug(2,"result is $res\n");
 | |
|     if (!open (RESULT, ">$outputfile")) {
 | |
|         log_debug(1,"wirte outputfile error");
 | |
|     }
 | |
|     print RESULT $res;
 | |
|     close RESULT;
 | |
|     return $res;
 | |
| }
 | |
| 
 | |
| ############################
 | |
| # transfer json into hash  #
 | |
| ############################
 | |
| sub parse_json
 | |
| {
 | |
|     my $input = shift;
 | |
|     my %hash;
 | |
|     if ($input =~ /:/) {
 | |
|         # for those who look like:
 | |
|         # {"networks":[{"mgtifname":"eth1","mask":"255.255.255.0"},{"mgtifname":"eth1","mask":"255.255.255.0"}]}
 | |
|         if ($input =~ /^\[(.*)\]$/s) {
 | |
|             my $content = $1;
 | |
|             log_debug(2, "[:] content is $content \n" );
 | |
|             parse_json($content);
 | |
|         }
 | |
|         # for those who look like:
 | |
|         # {"Vc68m4hsp01":{"parent":"Server-9119-590-SN02C5F9E","pprofile":"Vc68m4hsp01"},"p5ih_c75vios":{"parent":"P5IH-SN02012EB-A","mgt":"hmc","id":"2"},"p5ih_lpar04":{"parent":"P5IH-SN02013EB-A","pprofile":"p5ih_lpar04"}}
 | |
|         elsif($input =~ /^"(\S+?)\":{\S+},/){
 | |
|             $input =~ s/},/}%/;
 | |
|             my @contents = split /%/, $input;
 | |
|             my @reval;
 | |
|             # record result
 | |
|             foreach my $t (@contents) {
 | |
|                log_debug(2, ":{}, content is $t \n" );
 | |
|                my $re = parse_json($t);
 | |
|                push @reval, $re;
 | |
|             }
 | |
|             # merge hash
 | |
|             foreach my $t (@reval) {
 | |
|                 if(ref($t) =~ "HASH") {
 | |
|                     foreach my $k (keys %$t){
 | |
|                         $hash{$k} = $$t{$k};
 | |
|                     }
 | |
|                 }
 | |
|             }
 | |
|             return \%hash;
 | |
|         }
 | |
|         elsif( $input =~ /^{\S+},{\S+}/ and !($input =~ /]/)){
 | |
|             $input =~ s/},{/}%{/;
 | |
|             my @contents = split /%/, $input;
 | |
|             my @reval;
 | |
|             # record result
 | |
|              foreach my $t (@contents) {
 | |
|                log_debug(2, "{},{}, content is $t \n" );
 | |
|                my $re = parse_json($t);
 | |
|                push @reval, $re;
 | |
|             }
 | |
|             # merge hash
 | |
|             foreach my $t (@reval) {
 | |
|                 if(ref($t) =~ "HASH") {
 | |
|                     foreach my $k (keys %$t){
 | |
|                         $hash{$k} = $$t{$k};
 | |
|                     }
 | |
|                 }
 | |
|             }
 | |
|             return \%hash;
 | |
|         }
 | |
| 
 | |
|         # for those who look like
 | |
|         # {"clustersite":{"domain":"cluster.com","master":"192.168.1.15"}}
 | |
|         elsif ($input =~ /^\s*{(.*)}\s*$/s) {
 | |
|             my $content = $1;
 | |
|             log_debug(2, "{} content is $content \n" );
 | |
|             parse_json($content);
 | |
|         }
 | |
|         elsif( $input =~ /],\"\S+\":/){
 | |
|             $input =~ s/],\"(\S+)\":/]%\"$1\":/;
 | |
|             my @contents = split /%/, $input;
 | |
|             my @reval;
 | |
|             # record result
 | |
|              foreach my $t (@contents) {
 | |
|                log_debug(2, "],:, content is $t \n" );
 | |
|                my $re = parse_json($t);
 | |
|                push @reval, $re;
 | |
|             }
 | |
|             # merge hash
 | |
|             foreach my $t (@reval) {
 | |
|                 if(ref($t) =~ "HASH") {
 | |
|                     foreach my $k (keys %$t){
 | |
|                         $hash{$k} = $$t{$k};
 | |
|                     }
 | |
|                 }
 | |
|             }
 | |
|             return \%hash;
 | |
|         }
 | |
|         # for those who look like
 | |
|         # "domain":"cluster.com","master":"192.168.1.15"
 | |
|         elsif ($input =~ /,/ and !($input =~ /}/)) {
 | |
|             my @contents = split /,/, $input;
 | |
|             my @reval;
 | |
|             # record result
 | |
|             foreach my $t (@contents) {
 | |
|                log_debug(2, ", content is $t \n");
 | |
|                my $re = parse_json($t);
 | |
|                push @reval, $re;
 | |
|             }
 | |
|             # merge hash
 | |
|             foreach my $t (@reval) {
 | |
|                 if(ref($t) =~ "HASH") {
 | |
|                     foreach my $k (keys %$t){
 | |
|                         $hash{$k} = $$t{$k};
 | |
|                     }
 | |
|                 }
 | |
|             }
 | |
|             return \%hash;
 | |
| 
 | |
|         }
 | |
|         # for those who look like:
 | |
|         # "clustersite":{"domain":"cluster.com","master":"192.168.1.15"}
 | |
|         # "domain":"cluster.com"
 | |
|         elsif ($input =~ /\"(\S+?)\":(.+)/s) {
 | |
|             my $key = $1;
 | |
|             my $value = $2;
 | |
|             if ($value =~ /{/) {
 | |
|                 # "clustersite":{"domain":"cluster.com","master":"192.168.1.15"}
 | |
|                 log_debug(2, "{ content is $value \n" );
 | |
|                 $hash{$key} =  parse_json($value, $key);
 | |
|                 return \%hash;
 | |
|             } else {
 | |
|                 # "domain":"cluster.com"
 | |
|                 $value =~ /\"(\S+)\"/;
 | |
|                 $hash{$key} = $1;
 | |
|                 return \%hash;
 | |
|             }
 | |
|         }
 | |
|     }
 | |
|     # for those who look like
 | |
|     # ["10.1.255.250","192.168.200.16","192.168.200.19","192.168.200.22"]
 | |
|     else {
 | |
|         if ($input =~ /^\[(.*)\]/s) {
 | |
|             my $content = $1;
 | |
|             log_debug(2, "[] content is $content \n");
 | |
|             my @all = split /,/, $content;
 | |
|             foreach my $n (@all) {
 | |
|                 $n =~ /\"(.*)\"/;
 | |
|                 $hash{$1} = "restapiarray";
 | |
|             }
 | |
|             return \%hash;
 | |
|         }
 | |
|     }
 | |
| }
 | |
| 
 | |
| ############################
 | |
| # check curl running code  #
 | |
| ############################
 | |
| sub check_errcode
 | |
| {
 | |
|     if(!open (ERRLOG, "</tmp/err.log")) {
 | |
|         log_debug(1,"can't open err.log in tmp");
 | |
|         return 1;
 | |
|     }
 | |
|     my $num;
 | |
|     while (<ERRLOG>){
 | |
|         if (/HTTP\/\w*\.*\w* (\w+) (\w+)/) {
 | |
|            $num = $1;
 | |
|            last;
 | |
|         }
 | |
|     }
 | |
|     close ERRLOG;
 | |
|     log_debug(2,"can't get errorcode\n") unless($num);
 | |
|     return $num;
 | |
| }
 | |
| 
 | |
| ############################
 | |
| # check curl return result #
 | |
| ############################
 | |
| sub check_result
 | |
| {
 | |
|     my $data = shift;
 | |
|     my $opterator = shift;
 | |
|     my $output = shift;
 | |
|     if ( !open (OUTPUT, "<$output")) {
 | |
|         log_debug(1,"can't read output file");
 | |
|         return 1;
 | |
|     }
 | |
|     my $res;
 | |
|     while (<OUTPUT>) {
 | |
|         $res .= $_;
 | |
|     }
 | |
|     close OUTPUT;
 | |
| 
 | |
|     log_debug(2, "\nbegin to parse json for expected value: \n");
 | |
|     my $expects = transf_hash(parse_json($data)); # one entry
 | |
|     log_debug(2, "\nbegin to parse json for actual result: \n");
 | |
|     my $actuals = transf_hash(parse_json($res)); # serval entries
 | |
| 
 | |
|     log_debug(2,"expected result is:\n");
 | |
|     log_debug(2,$expects);
 | |
|     log_debug(2,"testcase run result is \n");
 | |
|     log_debug(2,$actuals);
 | |
| 
 | |
|     my $flag = 0;
 | |
|     my %flaghash;
 | |
|     my $expect = $$expects[0]; # $expect = ANY:ANY:x86_64
 | |
| 
 | |
|     my @expectvalue = split /:/, $expect; #@expectvalue = ANY, ANY, x86_64
 | |
|     $flag = 0;
 | |
|     foreach my $expval (@expectvalue) { # $expval = ANY
 | |
|         foreach my $actual (@$actuals) { # $actual = nodetype:arch:x86_64
 | |
|             if($flaghash{$actual} eq "none"){
 | |
|                next;
 | |
|             }
 | |
|             my @actualvalue = split /:/, $actual; # @actualvalue = nodetype, arch, x86_64
 | |
|             log_debug(2,"begin to compare $expval and $actualvalue[$flag]");
 | |
| 
 | |
|             if(($expval eq "restapiarray" ) and ($actualvalue[$flag] eq "restapiarray")){
 | |
|       next;
 | |
|      }
 | |
| 
 | |
|             if(($expval eq $actualvalue[$flag]) or ($expval eq "ANY")) { #ANY =~ nodetype
 | |
|                 $flaghash{$actual} = "eq";
 | |
|             } elsif (($actualvalue[$flag] =~ $expval) or ($expval eq "ANY")) {
 | |
|                 $flaghash{$actual} = "match";
 | |
|             } else {
 | |
|                 $flaghash{$actual} = "none";
 | |
|             }
 | |
|            log_debug(2,", compare result is $flaghash{$actual}\n");
 | |
|         }
 | |
|         $flag++;
 | |
|     }
 | |
|     log_debug(2,"search result is \n");
 | |
|     log_debug(2,\%flaghash);
 | |
| 
 | |
|     if ($opterator eq "!="){
 | |
|         foreach my $val (keys %flaghash) {
 | |
|             if ($flaghash{$val} eq "eq") {
 | |
|                log_debug(2,"compare result: failed\n");
 | |
|                return 1; # fail
 | |
|             }
 | |
|        }
 | |
|        log_debug(2,"compare result: succeed\n");
 | |
|        return 0; #succeed
 | |
|     }
 | |
|     if ($opterator eq "=="){
 | |
|         foreach my $val (keys %flaghash) {
 | |
|             if ($flaghash{$val} eq "eq") {
 | |
|                 log_debug(2,"compare result: succeed\n");
 | |
|                 return 0; # succeed
 | |
|             }
 | |
|        }
 | |
|        log_debug(2,"compare result: failed\n");
 | |
|        return 1; #fail
 | |
|     }
 | |
| 
 | |
|     if ($opterator eq "=~"){
 | |
|         foreach my $val (keys %flaghash) {
 | |
|             if ($flaghash{$val} eq "match") {
 | |
|                 log_debug(2,"compare result: succeed\n");
 | |
|                 return 0; # succeed
 | |
|             }
 | |
|        }
 | |
|        log_debug(2,"compare result: failed\n");
 | |
|        return 1; #fail
 | |
|     }
 | |
|     if ($opterator eq "!=~"){
 | |
|         foreach my $val (keys %flaghash) {
 | |
|             if ($flaghash{$val} eq "match") {
 | |
|                 log_debug(2,"compare result: failed\n");
 | |
|                 return 1; # fail
 | |
|             }
 | |
|        }
 | |
|        log_debug(2,"compare result: succeed\n");
 | |
|        return 0; #succeed
 | |
|     }
 | |
| 
 | |
| }
 | |
| 
 | |
| ####################################
 | |
| # help to transfer hash into array #
 | |
| ####################################
 | |
| sub find_key
 | |
| {
 | |
|     my $input = shift;
 | |
|     my $en = shift;
 | |
|     my $ou = shift;
 | |
|     if( ref($input) =~ "HASH") {
 | |
|         foreach my $val (keys %$input) {
 | |
|            my $tmp = $$en; # keey head
 | |
|             $$en .= "$val:";
 | |
|             my $t1 = find_key($$input{$val}, $en, $ou);
 | |
|             if ($$en eq ""){
 | |
|                 $$en = $tmp; #restore head
 | |
|             }
 | |
|         }
 | |
|     } else {
 | |
|         $$en .= $input;
 | |
|         push @$ou, $$en;
 | |
|         $$en = "";  # clear entry;
 | |
|     }
 | |
| }
 | |
| 
 | |
| ############################
 | |
| # transfer hash into array #
 | |
| ############################
 | |
| sub transf_hash
 | |
| {
 | |
|     my $input = shift;
 | |
|     my $entry;
 | |
|     my @array;
 | |
|     find_key($input, \$entry, \@array);
 | |
|     return \@array;
 | |
| }
 | |
| 
 | |
| 
 |