perl 検索結果をsort関数で降順にしたい

http://www.japor.or.jp/search/

上記のサイトを10年以上前に作成されたプログラムです。
作成者が身体を崩したため私の方で更新作業をおこなっています。
現在、古い順に2000年より昇順で表示されるように作成をしているのですが、新しい順（降順）にする場合はどのようなプログラムを組めばいいのか、ネットで色々文献を調べましたが難しかったためご質問致しました。

配列を並び替えるためにsort関数を使用するまではわかってそれらしい配列にsortをかけてみたのですがうまくいきません。
念の為、htmlとcgiのプログラムを載せます。

下記プログラムのどこにsortをかければよろしいのでしょうか？
恐らく、下記のプログラム内と思い一部抜粋をいたしました。
ご教示頂ければ幸いです。

よろしくお願い致します。

perl
1#!/usr/local/bin/perl
2##!c:/perl/bin/perl
3#
4## ===========================================================================
5## データ表示部テンプレート
6## ===========================================================================
7# @param  : %str             対照データ
8# @return : $str
9# ---
10# @sub    : str_midasi     ( yoron_indexA_htm.tmp )
11#
12sub yoron_index_table_body1(){
13	my ($i,$keisai_midasi,%str) = @_;
14	my $str;
15	# 変数作成
16	my $kaisi = $str{'kikan_y'}."/".$str{'kikan_sm'}."/".$str{'kikan_sd'} if $str{'kikan_y'} ne '' || $str{'kikan_sm'} ne '' || $str{'kikan_sd'} ne '' ;
17	$str{'kikan_y'}++ if $str{'kikan_sm'} > $str{'kikan_lm'};
18	my $syuryo = $str{'kikan_y'}."/".$str{'kikan_lm'}."/".$str{'kikan_ld'} if $str{'kikan_lm'} ne '' || $str{'kikan_ld'} ne '' ;
19	$kaisi =~ s//+$//;
20	$syuryo =~ s//+$//;
21	my $kikan = $kaisi;
22	#print "$syuryo<br>";
23	$kikan .= "～ $syuryo" if $syuryo ne "";
24	$kikan = '&nbsp;' if $kikan eq '';
25	
26	$str{'sampling'} = '-' if $str{'sampling'} eq "";
27	$str{'syutai'} = '&nbsp;' if $str{'syutai'} eq "";
28	$str{'taosyou'} = '&nbsp;' if $str{'taisyou'} eq "";
29	$str{'houhou'} = '-' if $str{'houhou'} eq "";
30	$str{'sample'} = '&nbsp;' if $str{'sample'} eq "";
31	$str{'kaisyu'} = '&nbsp;' if $str{'kaisyu'} eq "";
32#$str = qq(<TABLE BORDER="1" CELLSPACING="1" CELLPADDING="1" WIDTH="700">\n);
33$str = qq(<TABLE BORDER="1" CELLSPACING="1" CELLPADDING="1" WIDTH="640">\n);
34$str .= qq(  <TR>\n);
35$str .= qq(    <TD ALIGN="center" WIDTH="180" ROWSPAN="2" COLSPAN="2" BGCOLOR="#C0FFC0"><FONT>$str{'syutai'}</FONT></TD>\n);
36#$str .= qq(    <TD ALIGN="center" WIDTH="200" ROWSPAN="2" COLSPAN="2" BGCOLOR="#C0FFC0"><FONT>$str{'syutai'}</FONT></TD>\n);
37$str .= qq(    <TD ALIGN="center" WIDTH="100" ROWSPAN="2" > $kikan </TD>\n);
38$str .= qq(    <TD ALIGN="center" WIDTH="100" ROWSPAN="2">$str{'taisyou'}</TD>\n);
39$str .= qq(    <TD ALIGN="center" WIDTH="100" BGCOLOR="#FFFFC0">$str{'houhou'}</TD>\n);
40$str .= qq(    <TD ALIGN="center" WIDTH="80" ROWSPAN="2">$str{'sample'}</TD>\n);
41$str .= qq(    <TD ALIGN="center" WIDTH="80" ROWSPAN="2">$str{'kaisyu'}</TD>\n);
42$str .= qq(  </TR>\n);
43$str .= qq(  <TR>\n);
44$str .= qq(    <TD ALIGN="center" WIDTH="100" BGCOLOR="#FFFFC0">$str{'sampling'}</TD>\n);
45$str .= qq(  </TR><TR><TD COLSPAN="7">\n);
46
47
48$str .= qq(<TABLE BORDER="0" CELLSPACING="3" CELLPADDING="3" WIDTH="640">\n);
49#$str .= qq(<TABLE BORDER="0" CELLSPACING="3" CELLPADDING="3" WIDTH="680">\n);
50#$str .= qq(<TR>\n);
51$str .= qq(	$keisai_midasi\n);
52#$str .= qq(</TR>\n);
53$str .= qq(</TABLE>\n);
54$str .= qq(\n);
55$str .= qq(</TR></TD>\n);
56
57$str .= qq(</TABLE>\n);
58#$str .= qq(<HR WIDTH="700" ALIGN="LEFT">\n);
59
60
61
62
63#$str .= qq(  <TABLE BORDER="1" CELLSPACING="1" CELLPADDING="1" WIDTH="700">\n);
64#$str .= &str_midasi;
65#$str .= qq(    <TR> \n);
66#$str .= qq(      <TD WIDTH="80" ALIGN="center" VALIGN="middle" rowspan="2">$kaisi&nbsp;</TD>\n);
67#$str .= qq(      <TD WIDTH="80" ALIGN="center" VALIGN="middle" rowspan="2">$syuryo&nbsp;</TD>\n);
68#$str .= qq(      <TD WIDTH="100" ALIGN="center" VALIGN="middle" BGCOLOR="#E0FFE0" rowspan="2">$str{'happyou'}&nbsp;</TD>\n);
69#$str .= qq(      <TD WIDTH="90" ALIGN="left" VALIGN="middle" BGCOLOR="#E0FFE0" rowspan="2">$str{'syutai'}&nbsp;</TD>\n);
70#$str .= qq(      <TD WIDTH="90" ALIGN="left" VALIGN="middle" rowspan="2">$str{'taisyou'}&nbsp;</TD>\n);
71#$str .= qq(      <TD WIDTH="90" ALIGN="center" VALIGN="middle" BGCOLOR="#FFFFC0">$str{'houhou'}&nbsp;</TD>\n);
72#$str .= qq(      <TD WIDTH="90" ALIGN="right" VALIGN="middle" rowspan="2">$str{'sample'}&nbsp;</TD>\n);
73#$str .= qq(      <TD WIDTH="80" ALIGN="right" VALIGN="middle" rowspan="2">$str{'kaisyu'}&nbsp;</TD>\n);
74#$str .= qq(    </TR>\n);
75#$str .= qq(    <TR>\n);
76#$str .= qq(      <TD WIDTH="90" ALIGN="center" VALIGN="middle" BGCOLOR="#FFFFC0">　 $str{'sampling'} &nbsp;</TD>\n);
77#$str .= qq(    </TR>\n);
78#$str .= qq(  </TABLE>\n);
79return $str;
80
81}
82## ===========================================================================
83## 見出し部分テンプレート（検索結果内）
84## ===========================================================================
85sub str_midasi{
86	my %str = @_;
87	my $midasi ;
88	my $key;
89	$midasi = "";
90
91	for ($i = 1;$i < 11;$i++){
92		$key = "midasi$i";
93		next if $str{$key} eq "";
94		$midasi .= $str{$key}."<br>\n";
95	}
96	$midasi =~ s/<BR>\n$/\n/i;
97	$str{'happyou'} = '&nbsp' if $str{'happyou'} eq '';
98	$midasi = qq{<TD WIDTH="540" BGCOLOR="#FFFFF0">$midasi</TD>\n};
99#	$midasi = qq{<TD WIDTH="580" BGCOLOR="#FFFFF0">$midasi</TD>\n};
100	#$midasi .= qq{</TR><TR>\n};
101    $keisai = qq{<TD ALIGN="center" BGCOLOR="#FFFFC0" NOWRAP WIDTH="100" COLSPAN="2">$str{'happyou'}</TD>\n}.$midasi;
102
103	return $keisai;
104}
105
106
107
108▼cgi
109
110## ----------------------------------------------------#
111## make_out_dat
112## データをフィルタにかけ、検索全件数の設定
113## 調査主体で5件 の 出力件数を出力用ハッシュに入れる
114## ----------------------------------------------------#
115## @param  : なし
116## @grobal : hash %{out -> {データ数}}
117## @grobal : $all_dat
118## @grobal : $next_num
119## @return : 1(なし）
120## ---
121## @sub    : check_cond      ( this_script )
122sub make_out_dat(){
123	my $flag;
124	my $i = 0;
125	my $j = 0;
126	my $chosa_no = "";
127	my $chosa_bk = "";
128	
129	# ページをチェックし、表示開始・衆力件数を設定
130	$in{'p'} =0 unless defined $in{'p'};
131	my $str_num = $in{'p'} * $hyouzi_num;
132	my $lst_num = $str_num + $hyouzi_num;
133	
134	# データをフィルタに書け、表示分のみをハッシュに入れる
135	$j = 0;
136	for (@$input ){
137		$j++;
138		# フィルター
139		$flag = &check_cond(%{$_}) if $in{'t'} eq "check";
140		next if $flag != 0;
141		$chosa_no = substr($_ -> {'chosa_no'},0,5);
142		if ($chosa_no ne $chosa_bk){
143			$i++;
144			$chosa_bk = $chosa_no;
145			$j = 0;
146		}
147		# 表示分のみハッシュへ
148		if ($i >$str_num && $i <= $lst_num){
149			$key1 = sprintf("%03d",$i);
150			$key2 = sprintf("%03d",$j);
151			%{$out -> {$key1."_".$key2}} = %{$_};
152		}
153			
154	}
155	# 全件数設定
156	$all_dat = $i;
157	$next_num = $all_dat - $hyouzi_num * ($in{'p'}+1) if $in{'p'} ne '';
158
159	# [次の20件、前の20件」ボタンの作成
160	$buttom1 = &last_buttom if $in{'p'} > 0;
161	$buttom2 = &next_buttom if $next_num > 0;
162	#$buttom = '<table><tr>'.$buttom.'</tr></table>';
163	# 件数表示部分の作成
164	if ($in{'t'} ne 'check' || $check_flag == 0){
165		$kensuu = "<B> 全体件数：$all_dat 件 </B>\n" ;
166		$javasc = qq{<A HREF="javascript:showsample();"><I>検索設定の\表\示</I></A><BR>\n};
167		$comment = '検索をする場合は以下をクリックして検索条件の設定画面を表示してください';
168		$zenken = "\全\件\を\表\示\し\て\い\ま\す。";
169	}else{
170		$kensuu = "<B>該当調査件数：$all_dat件</B>\n"  ;
171		$zenken = "\検\索\結\果\を\表\示\し\て\い\ま\す。";
172		$javasc = qq{<A HREF="./yoron.cgi"><I>全件\表\示</I></A><BR>\n};
173		$comment = '検索条件を変更する場合は、先の検索画面を表示して検索を実行してください。';
174	}
175	$a = $all_dat/$hyouzi_num;
176	$all_page_num = ($a == int($a) ? $a : int($a+1)) ;
177	$kensuu .= "(" .($in{'p'}+1)."／".$all_page_num." 頁)";
178	$i = 0;
179	$chosa_bk = "";
180	for $str (keys %$out){
181		$chosa_no = substr($out -> {$str} ->{'chosa_no'},0,5);
182		if($chosa_no ne $chosa_bk){
183			if ($chosa_bk ne ''){
184				$result_tmp  =~ s/</tr><tr>\n$//;
185				$result .= &yoron_index_table_body1($i,$result_tmp,%tmp); 
186				$result_tmp = "";
187			}
188			%tmp = %{$out -> {$str}};
189			$chosa_bk = $chosa_no;
190			$i = 0;
191		}
192		$result_tmp .= "<TR>".&str_midasi(%{$out -> {$str}})."</TR>";
193		$i++;
194		
195	}
196	$result .= &yoron_index_table_body1($i,$result_tmp,%tmp); 
197
198}

KojiDoi

2018/06/11 13:21

質問文の中にコードを含めるときは、その前後を```で挟んでください。 https://teratail.com/questions/123033 この質問の中で、LouiS0616さんが図で分かりやすく説明されているので参考にしてください。これにより、コード部分が視覚的に区別しやすくなり、インデントも再現され、なにより、回答者が自分の環境でコードを実行しようとするときにコピペが大変簡単になります。

pyoo001213

2018/06/11 13:25

ご丁寧にありがとうございました。不慣れなもので大変申し訳ございません。

行動規範の内容に同意します

回答1件

実際にcgiを動かしてみる気力はないので、以下は質問文中のコードをざっと見た限りでの考察です。

まず、sortをどこで実行するかですが、

 for $str (keys %$out){

からのループでデータを順番に取り出してhtmlテーブルを作っているようですので、sortをかけるならここでしょうね。まず日付によってデータの「大小」を決める「評価関数」というものを作り（たとえばby_date()とでもしておきますか）、これを使って次のような感じでソートします。

 for $str (keys sort by_date %$out){

のようになります。

評価関数とは、sort対象となる配列のの中の任意の二つの要素を比較して大小を判定するものです。perlでは次のようなお約束があります。
0. 関数内では、比較対象の二つの要素を$a, $bとして参照する。
0. $aの方が「大きい」なら-1、同じなら0、$bの方が「大きい」なら1と、1,0,-1の3種類の値のうちのどれかを返り値とする。

大体次のような感じになるでしょう。

sub by_date(){
  #date: "2017/5/30"

  my($ya, $ma, $da) = split("/", $a->{'date'});
  my($yb, $mb, $db) = split("/", $b->{'date'});
  
  return( $ya <=> $yb or $ma <=> $mb or $da <=> $db);
}

ここでは'date'というキーを仮定しましたが、この辺は元のスクリプトのハッシュの構成に適切に合わせて調整してください。

投稿2018/06/12 19:03

KojiDoi

総合スコア13671