$title

=head スクリプト名 favorites_rn3_ff.cgi - Firefoxブックマーク更新チェック付検索 =head 概要 Firefoxブックマークをパターンマッチ検索して、ハイパーリンクしたタイトルをリストアップするとともに、更新状況をチェックして HTML 一覧表を出力する。 =cut require LWP::UserAgent; use LWP::Simple; require 'cgi-lib.pl'; use Unicode::Japanese; $s = Unicode::Japanese->new(); # bookmarks.htmlのパスの設定(ユーザー設定が必要と思われる) $bookmarks = $ENV{'USERDIR'}."\\Application Data\\Mozilla\\Firefox\\Profiles\\default.e2c\\bookmarks.html"; # 環境変数の取得 $cgidir = $ENV{'CGIDIR'}; # フォームからのデータ入力 &ReadParse(*in); # 検索パターン pattern が入力された場合、更新日付付きブックマーク検索 if($in{'pattern'}){ $pattern = $in{'pattern'}; $title = "更新日付付きブックマーク検索パターン： $pattern"; # 検索フォルダ watchfolder が入力された場合、 #「お気に入り」指定フォルダの更新チェック }elsif($in{'watchfolder'}){ $pattern = "."; $title = "ブックマーク $in{'watchfolder'}フォルダの更新チェック結果"; # デバッグ用 }else{ # ブックマークのWATCHフォルダすべてを検索する $pattern = "."; $title = "ブックマークWATCHフォルダの更新チェック結果"; } $ua = LWP::UserAgent->new(); # CGI 先頭部分の出力 print < $title

$title

\n"; $LMDATE{$url} = $lm;# 更新日時データの更新 # 応答がエラーの場合の処理は、 }else{ # エラーメッセージと前回更新日時、URL にリンクしたタイトルを出力 print "$errorcode{$url}\n"; $LMDATE{$url} = $errorcode{$url};# 更新日時データの更新 } # メモ作成用の memol_edit.cgi へのリンクを出力 print "\n"; } # 表 HTML 等の CGI 出力完了 print "

更新日時	前回更新日時	タイトル	HEADER # 検索パターンにマッチする「お気に入り」のHTTP応答ヘッダから # 更新日時、エラーコードを取得する open(IN, "<$bookmarks"); while(){ $_ = $s->set($_,'utf8')->sjis; if($in{'watchfolder'} eq 'WATCH' && $_ =~ /^ {4} WATCH<\/H3>$/){ $insw = 1;$spc = " {8}"; } if($insw == 1 && $in{'watchfolder'} eq 'WATCH' && $_ =~ /^ {4}<\/DL>/){ last; } if($in{'watchfolder'} eq 'WATCH/RSS' && $_ =~ /^ {8} RSS<\/H3>$/){ $insw = 1;$spc = " {12}"; } if($insw == 1 && $in{'watchfolder'} eq 'WATCH/RSS' && $_ =~ /^ {8}<\/DL>/){ $insw = 0;last; } if($insw == 1 && $_ =~ /$pattern/o && $_ =~ /^$spc (.*?)<\/A>$/i){ $url = $1;# ブックマーク URL を取得 # ブックマークタイトルを取得 $urltitle{$url} = $2; # HTTPヘッダ応答の要求 $ans = $ua->request(HTTP::Request->new("HEAD", $url)); # HTTPヘッダ要求が成功すれば、 if($ans->is_success){ # 更新ヘッダがあればその値を、なければ0を、 # URL をキーに格納する $lmdate{$url} = $ans->last_modified \|\| 0; # HTTPヘッダ要求が失敗すれば、 }else{ # 更新日付データとして、0をURL をキーに格納する $lmdate{$url} = 0; # エラーコードとエラーメッセージを URL をキーに格納する $errorcode{$url} = "Error code [" . $ans->code . "]: " . $ans->message . "!"; } } } close(IN); # 更新日付の新しい順に更新チェック結果を HTML 表にまとめて CGI 出力する dbmopen %LMDATE, 'lmdate', 0666; @lmdates = sort {$lmdate{$b} <=> $lmdate{$a} or $urltitle{$a} cmp $urltitle{$b}} keys(%lmdate); foreach $url (@lmdates){ # print $lmdate{$url},"\n"; $urlencoding = &juri_encode($url);# memol_edit.cgi 用 print "
"; ($lm, $favorite) = ($lmdate{$url},$urltitle{$url}); $favencoding = &juri_encode($favorite);# memol_edit.cgi 用 # URL が RSS ファイルであれば、RSS リーダー rss2html.cgi にリンク if($url =~ /(rss\|rdf\|xml)/i){ $link = "$cgidir/rss2html.cgi?rss=$urlencoding"; $target = "submain";# 出力先は submain フレーム # その他の URL は単にその URL にリンク }else{ $link = $url; $target = "main";# 出力先は main フレーム } # HTTPヘッダ要求への応答がエラーでなければ、 unless($errorcode{$url}){ # CGI による多くの応答の場合のように更新ヘッダがなければ、 unless($lm){ # HTML のサイズを測定して、以前の長さと比較する dbmopen %HTMLLENGTH, 'htmllength', 0666; $htmllen = length(get($url)); if($HTMLLENGTH{$url}){ $diff = abs($htmllen - $HTMLLENGTH{$url}); # 以前の長さと10バイトを越える差があれば、 if($diff > 10){ $lm = time;# 更新日時に現在時間を置く } } $HTMLLENGTH{$url} = $htmllen;# 新しいサイズを記録する dbmclose %HTMLLENGTH; } # 更新日時が以前の記録と異なれば、 if($LMDATE{$url} != $lm){ print "";# フォントを赤に # そうでなければ、 }else{ print "";# フォントを緑に } # $lm が真ならば（0 でなければ）日時に変換して、 # そうでなければ、未更新とファイルサイズの差を出力し、 # さらに前回更新日時データが(0以外の)数値であれば前回更新日時を、 # そうでなければ、文字列(エラー出力)をそのまま出力し、 # 0であれば、「応答なし」を出力、さらにリンクしたタイトルを出力 print $lm ? &jdate($lm) : "未更新(Δ $diff byte)","	",$LMDATE{$url} ? ($LMDATE{$url} =~ /^\d+$/ ? &jdate($LMDATE{$url}) : $LMDATE{$url}) : "応答なし","	$favorite	",$LMDATE{$url} ne $errorcode{$url} ? ($LMDATE{$url} =~ /^\d+$/ ? &jdate($LMDATE{$url}) : $LMDATE{$url}) : "同一エラー","	$favorite	メモ作成

\n"; dbmclose(%LMDATE); # time 関数の出力からローカルの現在日時を得る sub jdate{ my($lmtime) = @_; my($sec,$min,$hour,$mday,$mon,$year,$wday) = (localtime($lmtime))[0..6]; $year += 1900; $mon += 1; my $thisday = ("日","月","火","水","木","金","土")[$wday]; return sprintf "%4d-%1.2d-%1.2d(%s) %1.2d:%1.2d:%1.2d", $year, $mon, $mday, $thisday, $hour, $min, $sec; } # Jperl 用 URL エンコーディング sub juri_encode{ my($str) = @_; $str =~ s/([^a-z0-9\-_.!*'~ ])/length($1) == 2 ? sprintf "%%%1s%1s%%%1s%1s", split("",unpack("H4", $1)) : sprintf "%%%02X", ord($1)/egi; $str =~ tr/ /+/; return $str; }