Perl 入門講座

目次内 検索


従来は、JavaScript で「目次内検索」を実装してきましたが、
[1] 複数ヒットの表\示ができない。
[2] 色変え等の強調案内ができない。
[3] マウスクリックで案内が消えやすい。
という不備があり、Perlでサーバサイドで処理するのがよいように思われます。

Perl で「目次ファイル」の全行を一つづつ検索語をマッチさせ、
ヒットすれば「色変換」で置換し、
一行づつhtmlとして再表示させます。
my $index_file = "../index_Perl.html"; print "Content-type: text/html\n\n"; # ファイルの全行を取得し一行づつ処理して再表示する---------------------------- my $fh = IO::File -> new($index_file) or print "Can't open $index_file: $!\n"; while ( defined ( my $line = $fh -> getline )) { if ($line =~/$words/) { my $words_colored ="<font color=red><b> $words </b></font>"; $line =~ s/$words/$words_colored/g; } print "$line\r\n"; } close $fh;
従来のJavaScript
<script> <!-- Hide from old browsers var TRange = null; var dupeRange = null; var TestRange = null; var win = null; var nom = navigator.appName.toLowerCase(); var agt = navigator.userAgent.toLowerCase(); var is_major = parseInt(navigator.appVersion); var is_minor = parseFloat(navigator.appVersion); var is_ie = (agt.indexOf("msie") != -1); var is_ie4up = (is_ie && (is_major >= 4)); var is_not_moz = (agt.indexOf('netscape')!=-1) var is_nav = (nom.indexOf('netscape')!=-1); var is_nav4 = (is_nav && (is_major == 4)); var is_mac = (agt.indexOf("mac")!=-1); var is_gecko = (agt.indexOf('gecko') != -1); var is_opera = (agt.indexOf("opera") != -1); var is_rev=0 if (is_gecko) { temp = agt.split("rv:") is_rev = parseFloat(temp[1]) } var frametosearch = self; function search(whichform, whichframe) { if (is_ie4up && is_mac) return; if (is_gecko && (is_rev <1)) return; if (is_opera) return; if(whichform.findthis.value!=null && whichform.findthis.value!='') { str = whichform.findthis.value; win = whichframe; var frameval=false; if(win!=self) { frameval=true; // this will enable Nav7 to search child frame win = parent.frames[whichframe]; } } else return; // i.e., no search string was entered var strFound; if(is_nav4 && (is_minor < 5)) { strFound=win.find(str); // case insensitive, forward search by default } if (is_gecko && (is_rev >= 1)) { if(frameval!=false) win.focus(); // force search in specified child frame strFound=win.find(str, false, false, true, false, frameval, false); if (is_not_moz) whichform.findthis.focus(); } if (is_ie4up) { if (TRange!=null) { TestRange=win.document.body.createTextRange(); if (dupeRange.inRange(TestRange)) { TRange.collapse(false); strFound=TRange.findText(str); if (strFound) { win.document.body.scrollTop = win.document.body.scrollTop + TRange.offsetTop; TRange.select(); } } else { TRange=win.document.body.createTextRange(); TRange.collapse(false); strFound=TRange.findText(str); if (strFound) { win.document.body.scrollTop = TRange.offsetTop; TRange.select(); } } } if (TRange==null || strFound==0) { TRange=win.document.body.createTextRange(); dupeRange = TRange.duplicate(); strFound=TRange.findText(str); if (strFound) { win.document.body.scrollTop = TRange.offsetTop; TRange.select(); } } } if (!strFound) alert ("String '"+str+"' not found!") } // --> </script>
PerlIndexSearch.cgi
#!/usr/bin/perl use strict; use CGI; use IO::File; use File::Basename; # 基本データ取得 my $query = new CGI; my $mode = $query->param('mode'); my $words = $query->param('words'); $mode = &Escape($mode); $words = &Escape($words); my $index_file = "../index_Perl.html"; print "Content-type: text/html\n\n"; # ファイルの全行を取得し検索する---------------------------------- my $fh = IO::File -> new($index_file) or print "Can't open $index_file: $!\n"; while ( defined ( my $line = $fh -> getline )) { if ($line =~/$words/) { my $words_colored ="<font color=red><b> $words </b></font>"; $line =~ s/$words/$words_colored/g; } # <a HREF="./study/jissen/script2010.html $line =~ s/<a HREF=\"/<a HREF=\"./i; print "$line\r\n"; } close $fh; exit(0); #//////////////////////////////////// # 入力文字列エスケープ sub Escape { my ($str, $flag)= @_; if ($flag eq "") { # タグ変換 $str=~ s/\n//g; $str=~ s/\r//g; $str=~ s/\x0D\x0A$//g; $str=~ s/\x0A$//g; $str =~ s/\t/ /g; $str =~ s/</&lt;/g; $str =~ s/>/&gt;/g; $str =~ s/&/&amp;/g; $str =~ s/\"/&quot;/g; $str =~ s/&nbsp/&amp;&nbsp;/g; $str =~ s/&quot/&amp;quot;/g; } else { # URL をリンクに変換 if ($str=~ m/(http:\/\/[^ ]+)/) { my $url_org = "$1"; my $url_new = '<a href="' . "$url_org" . '">' . "$url_org" . '</a>'; $str=~ s/$url_org/$url_new/gs; } } return $str; }


The first written on Nov 28, 2014 The second written on Dec 2, 2014




更新日 Tuesday, 02-Dec-2014 15:37:00 JST

573