シリコンバレー在住エンジニアの、Perl、PHP、AJAX、Drupal、Java の小枝集です。( 7,833,028 since 2005.02.20 )
Perl で、アップロードしたファイルを処理する
Perl の場合は、CGI として動作させる場合は、必ず
Perl の場合は、CGI として動作させる場合は、必ず
print qq|Content-type: text/html\n\n|;という行が必要な以外は、PHP とほとんど同じである。 アップロードには、いつも使っているおなじみの CGI モジュールを使う。
use CGI;そうすると、以下のようにアクセスできる。
our $CGI = new CGI;
...
my $xml = $CGI->param('file');
$xml はファイルポインタが入っている。通常は open(IN, "..."); などするときの IN にあたるものである。以下は、コード。アップロードする側の HTML ファイルは PHP でアップロードファイルを処理するで紹介したのと同じ。
#!/usr/bin/perl
use strict;
use CGI;
our $CGI = new CGI;
print qq|Content-type: text/html\n\n|;
init();
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);
}
1;print qq|Content-type: text/html\n\n|;という行が必要な以外は、PHP とほとんど同じである。 アップロードには、いつも使っているおなじみの CGI モジュールを使う。
use CGI;そうすると、以下のようにアクセスできる。
our $CGI = new CGI;
...
my $xml = $CGI->param('file');
$xml はファイルポインタが入っている。通常は open(IN, "..."); などするときの IN にあたるものである。以下は、コード。アップロードする側の HTML ファイルは PHP でアップロードファイルを処理するで紹介したのと同じ。
#!/usr/bin/perl
use strict;
use CGI;
our $CGI = new CGI;
print qq|Content-type: text/html\n\n|;
init();
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);
}
1;
Perl で、HTML 文書中にあるリンクを置換する
以下は、HTML 文書中にあるリンクを任意の文字列に置換するスクリプトであるが、他のタグでもいろいろと応用が利くと思われる。
以下は、HTML 文書中にあるリンクを任意の文字列に置換するスクリプトであるが、他のタグでもいろいろと応用が利くと思われる。
#!/usr/bin/perl
use LWP::UserAgent;
use HTTP::Status;
use HTTP::Response;
our $URL = 'https://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) { # 無限ループに陥るのを防ぐ
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;#!/usr/bin/perl
use LWP::UserAgent;
use HTTP::Status;
use HTTP::Response;
our $URL = 'https://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) { # 無限ループに陥るのを防ぐ
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;
Perl で、#!/usr/bin/perl -w とは？
起動時のオプション -w スイッチは、警告を出すようにする。なので、スクリプト開発フェーズではスクリプトの先頭に以下のように書くこと。
起動時のオプション -w スイッチは、警告を出すようにする。なので、スクリプト開発フェーズではスクリプトの先頭に以下のように書くこと。
#!/usr/bin/perl -w
# Your own logic from here#!/usr/bin/perl -w
# Your own logic from here