まず元になる画像を用意する。画像形式は JPEG、PNG、そしてアニメ GIF どれでもよい。それを favicon.ico という名前で Favicon を 作成、サーバにアップロードする。favicon.ico という名前は決めうちである。基本的には Favionを表示させたいページの ... タグの中に下記のタグを追加する。従って Movable Type でも、テンプレート中の ... の間に、下記のタグを追記すればよい。
<link rel="shortcut icon" href="favicon までのパス/favicon.ico" />
Favicon は以下のサイトで作成できる。
PHP で、以下の仕様を満たすカウンタを作成してみる (このサイトで使っています)。
連続カウント防止機能は、
if(($ip_check == 1 && $ip != $_SERVER['REMOTE_ADDR']) ...
の部分でチェックしている。$ip には、「直前にアクセスしてきた IP アドレス」が入っている。同じ IP アドレスからアクセスし続ける限りはカウントされない。通常はこれでわりと正確なカウンタとなり得ると思うが、ファイアウォールの内側にいる同一マシンなどで、ファイアウォールのアドレスがアクセスのたびに変わる場合はこの限りではない。また、ケータイからのアクセスなどの場合も毎回アクセス元の IP アドレスがある一定の範囲内で変わるので連続カウント防止にはならないことに注意。
カウンタの数字をカンマ区切りにしているのは以下の 1行である。
$total = number_format($total); // カンマ区切りにする
以下は PHP の全ソース。
<?php
// count.php
// (c) 2006 twinkle.cc
// http://perltips.twinkle.cc/
// updated by yas 2006/01/03
// updated by yas 2003/05/07
// updated by yas 2003/03/05
// オリジナル: http://works.xrea.jp/
// ※このスクリプトと同じディレクトリに「count.dat」という名前のファイルを作成し、置いておくこと。
if(!$file) { $file='count.dat'; }
// 設定 ここから ────────────────────────────
$HOME = 'count.datがあるディレクトリのパス'; // ディレクトリ
$data = "$HOME/$file"; // カウント記録ファイル
$ip_check = 1; // 連続カウント防止（yes=1 no=0)
// 設定 ここまで ────────────────────────────
$count = file($data); // ファイルを配列に
// データ内の文字列を分解してそれぞれの変数に代入
list($total, $ip)=explode('<>', $count[0]);
// カウントアップ処理
if(($ip_check == 1 && $ip != $_SERVER['REMOTE_ADDR'])
|| $ip_check == 0) {
<pre>$total++;
$new_data = implode('<>', array($total, $_SERVER['REMOTE_ADDR']));
$fp = fopen($data, 'w'); // 書きモードでオープン
flock($fp, LOCK_EX); // ファイルロック
fputs($fp, $new_data); // 書き込み
flock($fp, LOCK_UN); // ロック解除
fclose($fp); // ファイルを閉じる
}
$total = number_format($total); // カンマ区切りにする
print $total; // カウンタを表示
?>
このソースを自身の PHP のカウンタを表示したいページを同じディレクトリに置き、同じディレクトリに count.dat という名前のファイルを置く (私のところは「chmod 644 count.dat」で動いているがお使いの環境によってはパーミッションに注意)。
最後に、カウンタを表示したい場所に以下のように書けばよい。
<?php
include('count.php');
?>
Perl で、
open(SEND, '/usr/sbin/sendmail') || die;
などとせずにモジュールを使ってメールを送信するには、以下のようにする。
使用するモジュール
use Net::SMTP;
use MIME::Entity;
#!/usr/bin/perl
use Net::SMTP;
use MIME::Entity;
# Settings
our $SENDER = '送信元のメールアドレス';
our $RECIPIENT = '送信先のメールアドレス';
our $SUBJECT = 'タイトル';
our $ATTACHED_FILE_1 = '/home/youraccount/添付ファイル名その1.jpg';
our $ATTACHED_FILE_2 = '/home/youraccount/添付ファイル名その2.jpg';
# Create object
my $smtp=Net::SMTP->new('localhost',
HELLO=>'yourmailsever.yourdomain.com');
# Built headers
$smtp->mail($SENDER); # Sender
$smtp->to ($RECIPIENT); # Receiver
# Built Data (Create data by MIME::Entity)
$smtp->data();
my $mime = MIME::Entity->build(
From => $SENDER , # Sender (data)
To => $RECIPIENT, # Receiver (data)
Subject => $SUBJECT , # Subject
Data => ['']); # body
# Attached file
$mime->attach(
Path => $ATTACHED_FILE_1,
Type => 'image/jpeg',
Encoding => 'Base64'
);
# Attached file
$mime->attach(
Path => $ATTACHED_FILE_2,
Type => 'image/jpeg',
Encoding => 'Base64'
);
# Attached file (Text)
# $mime->attach(
# Path => $ATTACHED_FILE,
# Type => 'text/plain',
# Encoding => '-SUGGEST'
#);
$smtp->datasend($mime->stringify); # transfer strings
# Data termination and send mail
$smtp->dataend();
#Quit SMTP connection
$smtp->quit;
# for debug
print "Sender : $SENDER\n";
print "Recipient : $RECIPIENT\n";
print "Attached : $ATTACHED_FILE\n";
1;
Perl で、Google の PageRank を表示するには以下のモジュールを使う。
ここではクライアント／サーバ間の通信、画面表示に AJAX を使っている。
ここで、ブラウザ側 (JavaScript) で XML を受け取るには、以下の部分が重要である。
var xml = xmlHttp.responseXML;
var pagerank = xml.documentElement
.getElementsByTagName('PageRank')[0]
.childNodes[0]
.nodeValue;
以下はサーバ側コード、XML のフォーマット、クライアント側 JavaScript である。
使用するモジュール
use WWW::Google::PageRank;
サーバ側の CGI (Perl) コード
#!/usr/bin/perl
# created by yas 2006/01/08
use lib 'WWW::Google::PageRank モジュールまでのパス: …/lib/perl5/site_perl';
use strict;
use utf8;
use WWW::Google::PageRank;
use CGI;
our $XML_HEADER = "Content-type: text/xml\n\n" # XML を送るときは絶対にこれが必要!!! MUST!!!
. "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"; # XML Header
my $CGI = new CGI;
my $proxy = new WWW::Google::PageRank;
my $pagerank = $proxy->get($CGI->param('url'));
my $xml = "$XML_HEADER"
. qq|<xml><PageRank>$pagerank</PageRank></xml>\n|;
print $xml;
1;
サーバがクライアントに送る XML の例 (～で囲まれた「1」の部分が PageRank であるのでサーバがブラウザから受け取った URL によって毎回変わる)
Content-type: text/xml
<?xml version="1.0" encoding="UTF-8"?>
1
クライアント (ブラウザ) 側のコード
//<![CDATA[
var BASE_URL = '/perltips';
var CGI_FILE = '/pagerank.cgi';
// 特に IE に対応するために、XMLHttpRequest オブジェクトをブラウザによって作成
function createXmlHttp() {
<pre>try {
return new ActiveXObject ('Msxml2.XMLHTTP');
} catch(e) {
try {
return new ActiveXObject ('Microsoft.XMLHTTP');
} catch(e1) {
try {
return new XMLHttpRequest();
} catch(e2) {
return null;
}
}
}
}
// メイン部分。HTML <input type="button" onClick="getPageRank"> タグの
// onClick で関連付けられている。ボタンが押されると呼び出される。
function getPageRank() {
if ((xmlhttp = createXmlHttp()) == null) {
window.alert('XMLHTTP Initialization Failed.');
} else {
xmlhttp.abort(); // 連続して HTTP 通信する場合は必ず呼び出す。
}
post('url=' + document.getElementById('url').value); // submit から url を取得
}
function repaint(xml) {
var pagerank = '';
if(xml) {
// IE の場合はより厳密にチェックが必要、Firefox は xml だけでよい
if(xml.documentElement) {
pagerank = xml.documentElement
.getElementsByTagName('PageRank')[0]
.childNodes[0]
.nodeValue;
}
}
// このスクリプトが呼ばれる HTML には、<div id="PageRank"></div> があるとする。
document.getElementById('PageRank').innerHTML = 'PageRank: ' + pagerank;
}
// post メソッドは、例えば getPath メソッドから呼ばれる
function post(data) {
var xmlHttp = createXmlHttp();
xmlHttp.onreadystatechange = function() {
if (xmlHttp.readyState == 4) {
var xml = xmlHttp.responseXML;
repaint(xml);
}
}
xmlHttp.open('POST', BASE_URL + CGI_FILE, true);
xmlHttp.setRequestHeader('Content-Type', 'application/x-www-form-urlencoded');
xmlHttp.send(data);
}
//]]>
gmap_excel.html のファイルの内容
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<link rel="stylesheet" href="styles-site.css" type="text/css" />
</head>
<body>
<form enctype="multipart/form-data" action="gmap_excel.cgi" method="post">
<input type="hidden" name="MAX_FILE_SIZE" value="2000000" />
<table width="600">
<tr><td>Names file:</td><td><input type="file" name="file" />
<input type="submit" value="Upload" /></td></tr>
</table>
</form>
</body>
gmap_excel.cgi のファイルの内容
#!/usr/bin/perl
use lib "path_to_your_perl_lib/lib/perl5/site_perl";
use strict;
use Geo::Google;
use CGI;
our $XML_HEADER = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"; # XML ヘッダ
our $HOME_DIR = 'your_home_dir';
our $LOCK_DIR = 'path_to_lock_dir/lock'; # do chmod 777 path_to_lock_dir/lock
our $LOCK_FILE = 'lock';
our $XML_FILE = 'path_to_your_output_xml/gmap_excel.xml'; # 出力用 XML ファイル名
our $col_index = 0; # Excel シートの現在の列（カラム）インデックス
our $row_index = 0; # Excel シートの現在の行インデックス
our @data = (); # 出力用データ
our @current_data = (); # 現在のデータ
# オブジェクト初期化
our $CGI = new CGI;
our $GEO = new Geo::Google;
# HTML 出力
print qq|Content-type: text/html\n\n|;
print qq||;
print qq||;
print qq||;
init();
print qq|
|;
# 個々のデータのハンドラ
sub dataHandler {
my ($expat, $text) = @_;
# $row_index = 0 と 1 は、Excel で データのヘッダのため必要なし
if($text !~ /^\s+$/ && $row_index > 1) { # 空白行でなければ
$current_data[$col_index] = $text;
}
}
# 要素の開始
sub startElement {
my ($expat, $tag, %attr) = @_;
if($tag eq 'Row') { # <Row>で始まるとき
$col_index = 0; # カラムを初期化
$row_index++; # 行を進める
@current_data = (); # 現在の行データを初期化
}
if($tag eq 'Data') { # <Data>で始まるとき
$col_index++; # 列を進める
}
}
# 要素の終了
sub endElement {
my ($expat, $tag) = @_;
my ($xml, $html);
my ($lng, $lat, $name, $link, $category1, $category2);
my ($street, $city, $state, $phone, $comment1, $comment2);
# </Row> のとき
if($tag eq 'Row') {
push(@data, { # データに現在の行データを代入
'category1' => $current_data[1],
'category2' => $current_data[2],
'name' => $current_data[3],
'address' => $current_data[4],
'phone' => $current_data[5],
'link' => $current_data[6],
'comment1' => $current_data[7],
'comment2' => $current_data[8]
});
}
# </Workbook> のとき
if($tag eq 'Workbook') {
$row_index = -1; # 行数を初期化 ($row_index = 0 はヘッダのため -1 からスタート)
foreach my $row (@data) {
$row_index++;
if($row->{address}) {
$lng = ''; $lat = '';
my ($degree) = getDegrees($row->{address});
if($degree) {
$lng = $degree->longitude;
$lat = $degree->latitude;
}
}
$name = $row->{name};
$link = $row->{link}
=~ /http:\/\/[!#-9A-~]+\.+[a-z0-9]/ ? $row->{link} : '';
$category1 = $row->{category1};
$category2 = $row->{category2};
($street, $city, $state) = split(',', $row->{address});
$street = $street;
$city = $city;
$state = $state;
$phone = $row->{phone};
$comment1 = $row->{comment1} eq '-' ? '' : $row->{comment1};
$comment2 = $row->{comment2};
# lng と lat が検索できたら (データが入っているということだから)
if($lng && $lat) {
$xml .= "\t<marker\n"
. "\t\tlng = \"$lng\" lat = \"$lat\"\n"
. "\t\tname = \"" . $name . "\"\n"
. "\t\tlink = \"" . $link . "\"\n"
. "\t\tcategory1 = \"" . $category1 . "\"\n"
. "\t\tcategory2 = \"" . $category2 . "\"\n"
. "\t\taddress1 = \"$street\"\n"
. "\t\taddress2 = \"$city, $state\"\n"
. "\t\tphone = \"$phone\"\n"
. "\t\tcomment1 = \"$comment1\"\n"
. "\t\tcomment2 = \"$comment2\"\n"
. "\t/>\n\n";
} elsif($row_index) {
$html .= '<tr><td>'
. "$row_index / $name / $street, $city, $state"
. '</td></tr>';
}
}
$xml = $XML_HEADER
. "<markers>\n"
. $xml
. "</markers>\n";
if($html) { # エラーがあれば
$html = '<table>'
. '<tr><td>＊＊＊＊＊ 以下、緯度経度が検索不能でした。</td></tr>'
. $html
. '</table>';
} else { # エラーがなければ
print '<br />done.';
}
# ファイルのオープン
&file_lock; # ファイルロック
open(XML, ">$HOME_DIR$XML_FILE")
or die('Cannot open an XML file: ' . "$HOME_DIR$XML_FILE");
print XML $xml; # 書き込み
close(XML); # ファイルを閉じる
&file_unlock; # ロック解除
print $html;
}
}
sub getDegrees { # 住所から緯度経度を検索
return $GEO->location( address => shift); # shift = address / リファレンスを返す
}
sub init() {
# XMLパーサー作成 ('UTF-8')
my $xml_parser = new XML::Parser( ProtocolEncoding => 'UTF-8',
Handlers=>{ Start=>\&startElement,
End =>\&endElement,
Char =>\&dataHandler });
# ファイルのオープンはいらない。input タグで指定した name 属性がそのままファイルハンドルになる
my $xml = $CGI->param('file');
# XMLパース処理
$xml_parser->parse($xml) or die "XML error: $xml_parser";
# ファイルクローズ
close($xml);
}
sub file_lock {
my $wait = 5;
while (!symlink('.',"$HOME_DIR$LOCK_DIR/.$LOCK_FILE")) {
if (--$wait <= 0) {
# &error( '現在他の方が使用中です。',
# 'しばらくしてから再度ご利用ください。');
}
sleep (1);
}
}
sub file_unlock {
unlink ("$HOME_DIR$LOCK_DIR/.$LOCK_FILE");
}
1;
gmap_excel.xml 出力例
<?xml version="1.0" encoding="UTF-8"?>
<marker
lng = "-122.125690" lat = "37.413570"
name = "Tofu House"
link = ""
category1 = "Restaurant"
category2 = "Korean"
address1 = "4127 El Camino Real"
address2 = " Palo Alto, CA 94306"
phone = "650-424-8805"
comment1 = ""
comment2 = "Santa Clara の Tofu House と同じ店。"
/>
...
LWP (libwww-perl という形で配布されている) を使う。LWP::Agent モジュールは、ウェブクライアント、ウェブオートメーション (ソフトウェアやプログラムが自動的にサイトにアクセスして情報を取ってくること) といったものの基本である。もうはるか彼方、何年も前からある技術なのに基本は変わっていないのがポイント。以下のスクリプトは、$URL で指定されているサイトにアクセスして、成功すればその HTML のコードをコンソールに表示、失敗したときはエラーコードを出力する例。CGI として機能させたときは、ブラウザには HTML コードでなく $URL でアクセスしたページを表示する。つまりプロキシとして動作するということ。
シンプルなバージョン
#!/usr/bin/perl
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Response;
our $URL = 'http://perltips.twinkle.cc/'; # アクセスする URL
my $proxy = new LWP::UserAgent;
my $req = HTTP::Request->new('GET' => $URL); # HTTP リクエストを作成
my $res = $proxy->request($req); # $res に HTTP レスポンスが返ってくる
print $res->content; # HTML を表示
1;
ちょっと長いバージョン
#!/usr/bin/perl
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Response;
our $URL = 'http://perltips.twinkle.cc/'; # アクセスする URL
my $proxy = new LWP::UserAgent;
$proxy->agent('your own created browser name here'); # 任意
$proxy->timeout(60); # 任意
my $req = HTTP::Request->new('GET' => $URL);
my $res = $proxy->request($req);
my $content = $res->content;
print "Content-Type: text/html\n\n"; # HTML ヘッダ (CGI として動作できる)
if($res->is_success) {
print $content;
} else {
print 'HTTP エラーコード: ' . $res->code;
}
1;
米国に限られるが、Perl には Geo::Google というモジュールがある。このモジュールを利用すると Google Maps からルートを検索できる。以下は、サンフランシスコダウンタウンのユニオンスクウェアにあるヒルトンからPIER 39までのルート検索の結果を XML で出力する例。
使用するモジュール
use Encode;
use Geo::Google;
#!/usr/bin/perl
use Encode;
use Geo::Google;
# 変数の初期化
our $GEO = new Geo::Google;
our $XML_HEADER = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
our $output = ''; # xml 出力
our ($dist);
$dist->{from} = qq|333 Ofarrell St, San Francisco, CA|; # From の住所 (米国のみ)
$dist->{to } = qq|39 PIER 39, San Francisco, CA|; # To の住所 (米国のみ)
$output = getPath($dist);
$output = $XML_HEADER
. "<markers>\n"
. $output
. "</markers>\n";
print "Content-type: text/xml\n\n"; # XML を送るときは絶対にこれが必要!!! MUST!!!
print $output;
exit;
sub getPath {
my ($dist) = shift;
my $output;
my $path = $GEO->path(getDegrees($dist->{from}), getDegrees($dist->{to}));
my @segments = $path->segments();
foreach my $s (@segments) {
my $description = $s->text();
$description =~ s/</&lt;/g;
$description =~ s/>/&gt;/g;
$output .= "\t<route\n"
. "\t\tdescription=\"" . $description . "\"\n"
. "\t/>\n";
my @points = $s->points;
foreach my $p (@points) {
$output .= "\t<path lng=\"" . $p->longitude . "\" lat=\"" . $p->latitude . "\" />\n";
}
}
return $output;
}
sub getDegrees { # 住所から緯度経度を検索
return $GEO->location( address => Encode::encode_utf8(shift));
# shift = address / リファレンスを返す
}
1;
Content-type: text/xml
<?xml version="1.0" encoding="UTF-8"?>
<route
description="Head <b>east</b> from <b>Ofarrell St</b>"
/>
<route
description="Turn <b>left</b> at <b>Grant Ave</b>"
/>
<path lng="-122.40966" lat="37.78621" />
<path lng="-122.40932" lat="37.78628" />
<path lng="-122.40894" lat="37.78632" />
<path lng="-122.40803" lat="37.78644" />
<path lng="-122.40639" lat="37.78663" />
<path lng="-122.40529" lat="37.78676" />
<path lng="-122.40485" lat="37.78683" />
<path lng="-122.40485" lat="37.78683" />
<route
description="Turn <b>left</b> at <b>Sutter St</b>"
/>
<path lng="-122.40504" lat="37.78774" />
<path lng="-122.40513" lat="37.78819" />
<path lng="-122.40524" lat="37.78870" />
<path lng="-122.40530" lat="37.78913" />
<path lng="-122.40533" lat="37.78931" />
<path lng="-122.40539" lat="37.78964" />
<path lng="-122.40539" lat="37.78964" />
Procmail を利用すればサーバに送られてきたメールが標準入力から Perl スクリプトに渡すことができる。ここでは Procmail の詳細は割愛するが、以下は標準入力に入っているメールを処理する関数。
使用するクラス
use MIME::Parser;
use MIME::Base64;
use Mail::Address;
use MIME::Parser;
use MIME::Base64;
use Mail::Address;
use Unicode::Japanese;
my ($mail) = &parse;
print "From: " . $mail->{sender} . "\n";
print "To: " . $mail->{recipient} . "\n";
print "Subject: " . $mail->{subject} . "\n";
sub parse {
my ($mail);
# Parser Setting
my $parser = new MIME::Parser;
$parser->output_to_core(1); # Keeps body analyzed internally
$parser->tmp_recycling (1); # Recycles the temporary stuff
my $entity = $parser->parse(\*STDIN) or die "Parse Error in __FILE__\n";
# Headers
$mail->{sender } = $entity->head->get('from' );
$mail->{subject } = $entity->head->get('subject');
$mail->{recipient} = $entity->head->get('to' );
$mail->{recipient} =~ s/\n//g;
# From
@addrs = Mail::Address->parse($mail->{sender});
foreach $addr (@addrs) {
$mail->{sender} = $addr->address if $addr->address; # USE CAUTION, for the multiple address
}
# Subject
my $subject = $mail->{subject};
$lws = '(?:(?:\x0D\x0A|\x0D|\x0A)?[ \t])+';
$ew_regex = '=\?ISO-2022-JP\?B\?([A-Za-z0-9+/]+=*)\?=';
$subject =~ s/\n//g;
$subject =~ s/($ew_regex)$lws(?=$ew_regex)/$1/gio;
$subject =~ s/$lws/ /go;
$subject =~ s/$ew_regex/decode_base64($1)/egio;
$subject = Unicode::Japanese->new($subject, 'auto')->sjis_imode;
$mail->{subject} = $subject;
# Get MIME
($mail->{body}, $mail->{filename}, $mail->{mimetype}, $mail->{object}) = &getEntities($entity);
$mail->{body } = Unicode::Japanese->new($mail->{body}, 'auto')->sjis_imode;
$mail->{body } =~ s/[ \n\r]+$//g; # Delete the white spaces in the end of the line
$mail->{subject} =~ s/[ \n\r]+$//g; # Delete the white spaces in the end of the line
return $mail;
}
sub getEntities {
my $entity = shift;
my $body, $filename, $mimetype, $object;
# BODY
my @parts = $entity->parts;
if (@parts) { # multipart...
my $i;
foreach $i (0 .. $#parts) { # dump each part...
&getEntities($parts[$i]);
}
} else { # single part...
# Get MIME type, and display accordingly...
my ($type, $subtype) = split('/', $entity->head->mime_type);
my $bodyhandle = $entity->bodyhandle;
if ($type =~ /^(text|message)$/) { # text
$body .= $bodyhandle->as_string;
} else { # binary
$filename= $entity->head->recommended_filename;
$mimetype = $entity->head->mime_type;
$object = $bodyhandle->as_string;
binmode($object);
# if we want to store it as BASE64, you can continue the processs here
}
}
return ($body, $filename, $mimetype, $object);
}
1;
HTTP::Date クラスを使うと RSS で配信されたエントリーの日付 (dc:date) を変換してくれる。この場合、RSS のソースによって米国から日本のニュースにアクセスした場合などは、時差 (タイムゾーン) を考慮する必要があるため注意する。
使用するクラス
use HTTP::Date;
#!/usr/bin/perl
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Date;
# 初期化
my $html;
my $timezone = 'JST';
my $url = 'http://www.yoursite.com/index.rdf';
my $rss = new XML::RSS;
my $proxy = new LWP::UserAgent; # UseAgent の作成
my $req = new HTTP::Request(GET=>$url);
my $res = $proxy->request($req); # $url にアクセスする
my $xml = $res->content; # コンテンツ (この場合は RSS/XML) を取得
# RSS を解析
eval {
$rss->parse($xml);
};
if($@) {
# $rss->parse が失敗したとき
}
# @{$rss->{items}} に、RSS のすべてのエントリー (item) が入る
foreach my $item ( @{$rss->{items}} ) {
my $date = HTTP::Date::str2time($item->{dc}->{date}, $timezone);
$html .= qq|<a href=$item->{link}>$item->{title}</a><br>\n|; # タイトルをリンクつきで出力
$html .= qq|$description<br>| if $item->{description}; # 概要 (description) を出力
$html .= qq|[<a href=$item->{link}>続きを読む</a>]<hr size=1>\n|;
}
print $html;
1;
以下は、HTML 文書中にあるリンクを任意の文字列に置換するスクリプトであるが、他のタグでもいろいろと応用が利くと思われる。
#!/usr/bin/perl
use LWP::UserAgent;
use HTTP::Status;
use HTTP::Response;
our $URL = 'http://perltips.twinkle.cc/'; # アクセスする URL
my $proxy = new LWP::UserAgent;
$proxy->agent('your own created browser name here');
$proxy->timeout(60);
my $response = $proxy->request(HTTP::Request->new('GET' => $URL));
my $content = $response->content;
my %tags = (
'img' => 'src',
'a' => 'href',
'link' => 'href',
'td' => 'background',
'form' => 'action'
);
my $data = $content;
skip_others: while($data =~ s/<([^>]*)>// && $i++ < 10000) { # 無限ループに陥るのを防ぐ
<pre>my $in_brackets = $1;
foreach $key (keys %tags) {
if($in_brackets =~ /^\s*$key\s+/i) {
if($in_brackets =~ /\s+$tags{$key}\s*=\s*["']([^"']*)["']/i
|| $in_brackets =~ /\s+$tags{$key}\s*=\s*([^\s]+)/i ) {
my $link = $1;
$link =~ s/[\n\r]//g;
$link =~ s/\./\\./g;
$link =~ s/\?/\\?/g;
$content =~
s/\s*=\s*["']*$link["']*/=<<<ここに置換文字列を書く>>>/
if $link !~ m/mailto:/i
&& $link !~ m/javascript/i;
next skip_others;
}
}
}
}
1;