perl hash array

perl有一個to_json函數，作用是⌈將數據結構轉換為JSON字串⌋

資料庫撈資料

package sql_package;

use strict;
use DBI;
use ws;
 
my $host = "localhost";         # 主機地址
my $driver = "mysql";           # 資料庫類型 默認為localhost
my $database = "XXX";        	# 資料庫
# 驅動程式
my $dsn = "DBI:$driver:database=$database:$host";  
my $userid = "root";            
my $password = "www";        

sub getServTypeJsonObj{
	# 連接資料庫
	my $dbh = DBI->connect($dsn, $userid, $password ) or die $DBI::errstr;
	my $sql = qq{SELECT S_TYPE, S_TYPE_NAME FROM AA WHERE STATUS = 'Y' ORDER BY S_TYPE;};
	my $sth = $dbh->prepare($sql);
	$sth->execute();    # 執行SQL
	 
	my $ref;
	my @item;
	$ref = 	$sth->fetchall_arrayref({});
	$sth->finish;
	for(@$ref){
		my $s_type = ws::toUTF8($_->{'S_TYPE'});
		my $s_type_name = ws::toUTF8($_->{'S_TYPE_NAME'});
		push @item,{
			s_type => $s_type,
			s_type_name => $s_type_name
		};
	}
	 
	$dbh->disconnect();
	return @item;
} 

sub getQuestTypeJsonObj{
	my ($org_s_type) = @_;
	# 連接資料庫
	my $dbh = DBI->connect($dsn, $userid, $password ) or die $DBI::errstr;
	my $sql = qq{SELECT S_TYPE, Q_TYPE, Q_TYPE_NAME FROM BB WHERE STATUS = 'Y' AND S_TYPE = '$org_s_type';};
	my $sth = $dbh->prepare($sql);
	$sth->execute();    # 執行SQL

	my @item;
	my $ref;
	$ref = 	$sth->fetchall_arrayref({});
	$sth->finish;
	for(@$ref){
		my $s_type = ws::toUTF8($_->{'S_TYPE'});
		my $q_type = ws::toUTF8($_->{'Q_TYPE'});
		my $q_type_name = ws::toUTF8($_->{'Q_TYPE_NAME'});
		push @item,{
			s_type => $s_type,
			q_type => $q_type,
			q_type_name => $q_type_name
		};
	}

	$dbh->disconnect();
	return @item;
}

sub getQuestJsonObj{
	my ($org_s_type,$org_q_type) = @_;
	# 連接資料庫
	my $dbh = DBI->connect($dsn, $userid, $password ) or die $DBI::errstr;
	my $sql = qq{SELECT * FROM 
				(SELECT ID, S_TYPE, Q_TYPE, QUESTION, STATUS FROM CC WHERE STATUS = 'Y' AND S_TYPE = '$org_s_type' AND Q_TYPE = '$org_q_type' ORDER BY ID DESC) 
				WHERE ROWNUM <= 1;};
	my $sth = $dbh->prepare($sql);
	$sth->execute();    # 執行SQL
			
	my $ref;
	my @item;
	$ref = 	$sth->fetchall_arrayref({});
	$sth->finish;
	for(@$ref){
		my $id = ws::toUTF8($_->{'ID'});
		my $s_type = ws::toUTF8($_->{'S_TYPE'});
		my $q_type = ws::toUTF8($_->{'Q_TYPE'});
		my $quest = ws::toUTF8($_->{'QUESTION'});
		my $status = ws::toUTF8($_->{'STATUS'});
		push @item,{
			id => $id,
			s_type => $s_type,
			q_type => $q_type,
			quest => $quest,
			status => $status
		};
	}
	$dbh->disconnect();
	return @item;
}

package sql_package;

use strict;

use DBI;

use ws;

my $host = "localhost"; # 主機地址

my $driver = "mysql"; # 資料庫類型默認為localhost

my $database = "XXX"; # 資料庫

# 驅動程式

my $dsn = "DBI:$driver:database=$database:$host";

my $userid = "root";

my $password = "www";

sub getServTypeJsonObj{

# 連接資料庫

my $dbh = DBI->connect($dsn, $userid, $password ) or die $DBI::errstr;

my $sql = qq{SELECT S_TYPE, S_TYPE_NAME FROM AA WHERE STATUS = 'Y' ORDER BY S_TYPE;};

my $sth = $dbh->prepare($sql);

$sth->execute(); # 執行SQL

my $ref;

my @item;

$ref = $sth->fetchall_arrayref({});

$sth->finish;

for(@$ref){

my $s_type = ws::toUTF8($_->{'S_TYPE'});

my $s_type_name = ws::toUTF8($_->{'S_TYPE_NAME'});

push @item,{

s_type => $s_type,

s_type_name => $s_type_name

};

}

$dbh->disconnect();

return @item;

}

sub getQuestTypeJsonObj{

my ($org_s_type) = @_;

# 連接資料庫

my $dbh = DBI->connect($dsn, $userid, $password ) or die $DBI::errstr;

my $sql = qq{SELECT S_TYPE, Q_TYPE, Q_TYPE_NAME FROM BB WHERE STATUS = 'Y' AND S_TYPE = '$org_s_type';};

my $sth = $dbh->prepare($sql);

$sth->execute(); # 執行SQL

my @item;

my $ref;

$ref = $sth->fetchall_arrayref({});

$sth->finish;

for(@$ref){

my $s_type = ws::toUTF8($_->{'S_TYPE'});

my $q_type = ws::toUTF8($_->{'Q_TYPE'});

my $q_type_name = ws::toUTF8($_->{'Q_TYPE_NAME'});

push @item,{

s_type => $s_type,

q_type => $q_type,

q_type_name => $q_type_name

};

}

$dbh->disconnect();

return @item;

}

sub getQuestJsonObj{

my ($org_s_type,$org_q_type) = @_;

# 連接資料庫

my $dbh = DBI->connect($dsn, $userid, $password ) or die $DBI::errstr;

my $sql = qq{SELECT * FROM

(SELECT ID, S_TYPE, Q_TYPE, QUESTION, STATUS FROM CC WHERE STATUS = 'Y' AND S_TYPE = '$org_s_type' AND Q_TYPE = '$org_q_type' ORDER BY ID DESC)

WHERE ROWNUM <= 1;};

my $sth = $dbh->prepare($sql);

$sth->execute(); # 執行SQL

my $ref;

my @item;

$ref = $sth->fetchall_arrayref({});

$sth->finish;

for(@$ref){

my $id = ws::toUTF8($_->{'ID'});

my $s_type = ws::toUTF8($_->{'S_TYPE'});

my $q_type = ws::toUTF8($_->{'Q_TYPE'});

my $quest = ws::toUTF8($_->{'QUESTION'});

my $status = ws::toUTF8($_->{'STATUS'});

push @item,{

id => $id,

s_type => $s_type,

q_type => $q_type,

quest => $quest,

status => $status

};

}

$dbh->disconnect();

return @item;

}

資料組成json

#!/usr/bin/perl -w

use JSON;
use sql_package;

my (@s,@q,@item);
my ($result_json_str);


@s = &sql_package::getServTypeJsonObj();
@item = &genJson(\@s);#取得陣列@s的參照

$result_json_str = to_json(\@item); #取得陣列@item的參照

#-------------sub begin--------------
sub genJson{
	 my($s) = @_; #是預設傳入的參數，若傳入的引數有n個，可以直接使用清單的方式指定。
	 my @info_json;

	 #第一層
	 foreach (@{$s}){
		my ($s_type,$s_type_name,$url,$counter,@list);
		$s_type = $_->{'s_type'};
		$s_type_name = $_->{'s_type_name'};
		$url = 'aaa';

		$counter = 0;
		@q = &sql_package::getQuestTypeJsonObj($s_type);
		foreach (@q){
			my ($q_s_type,$q_type,$q_type_name,$q_counter);
			my @q_title;
			$q_serv_type = $q[$counter]{s_type};
			$q_type = $q[$counter]{q_type};
			$q_type_name = $q[$counter]{q_type_name};
			
			$q_counter = 0;
			@q_title = &sql_package::getQuestJsonObj($q_s_type,$q_type);
			foreach (@q_title){
				my ($content,$title);

				$content = $q_title[$q_counter]{id};
				$title = $q_title[$q_counter]{quest};

				push @list,{
					name=>$q_type_name,
					title=>$title, 
					content=>$content,
					open=>&getBoolean()
				};
			}
			$counter++;
		}

		push @info_json,{
				type=>$s_type_name,
				link=>$url, 
				open=>&getBoolean(),
				list=>\@list
			};

	 }#第一層end
	 
	 return @info_json;
}

sub getBoolean{
	my($value) = @_ ;
	if( $value eq 'Y'){
		return \1; #true
	}
	return \0; #false
}

#!/usr/bin/perl -w

use JSON;

use sql_package;

my (@s,@q,@item);

my ($result_json_str);

@s = &sql_package::getServTypeJsonObj();

@item = &genJson(\@s);#取得陣列@s的參照

$result_json_str = to_json(\@item); #取得陣列@item的參照

#-------------sub begin--------------

sub genJson{

my($s) = @_; #是預設傳入的參數，若傳入的引數有n個，可以直接使用清單的方式指定。

my @info_json;

#第一層

foreach (@{$s}){

my ($s_type,$s_type_name,$url,$counter,@list);

$s_type = $_->{'s_type'};

$s_type_name = $_->{'s_type_name'};

$url = 'aaa';

$counter = 0;

@q = &sql_package::getQuestTypeJsonObj($s_type);

foreach (@q){

my ($q_s_type,$q_type,$q_type_name,$q_counter);

my @q_title;

$q_serv_type = $q[$counter]{s_type};

$q_type = $q[$counter]{q_type};

$q_type_name = $q[$counter]{q_type_name};

$q_counter = 0;

@q_title = &sql_package::getQuestJsonObj($q_s_type,$q_type);

foreach (@q_title){

my ($content,$title);

$content = $q_title[$q_counter]{id};

$title = $q_title[$q_counter]{quest};

push @list,{

name=>$q_type_name,

title=>$title,

content=>$content,

open=>&getBoolean()

};

}

$counter++;

}

push @info_json,{

type=>$s_type_name,

link=>$url,

open=>&getBoolean(),

list=>\@list

};

}#第一層end

return @info_json;

}

sub getBoolean{

my($value) = @_ ;

if( $value eq 'Y'){

return \1; #true

}

return \0; #false

}

Wen's murmur

perl hash array

相關

2024 年 7 月
一	二	三	四	五	六	日
« 4 月
1	2	3	4	5	6	7
8	9	10	11	12	13	14
15	16	17	18	19	20	21
22	23	24	25	26	27	28
29	30	31

Share this:

相關