ラベル Perl の投稿を表示しています。 すべての投稿を表示
ラベル Perl の投稿を表示しています。 すべての投稿を表示

2020年6月18日木曜日

Windows上でPerlの統合環境(Visual Studio Code + Strawberry Perl)

WEB上の情報を参考に、Windows上でPerlの統合環境を作れないか調べてみると、以下の組み合わせが便利そうだったので、構築してみました。

1.Visual Studio Code
2.Strawberry Perl
3.Perl Debugger

まずは Visual Studio Code (https://code.visualstudio.com/)のダウンロードとインストール。
使いやすいように、表記を日本語にしておきます。

次に Strawberry Perl のインストールです。
WEB上には PowerShell を使ってインストール、って紹介もあったけど、うちの環境ではうまくインストールできなかったので、公式サイト(http://strawberryperl.com/)からダウンロードしてインストールしました。
インストールだけで PATH も変更されたようです。

Perl Debugger は、VS Code を起動して、「表示」「拡張機能」で検索窓に perl って入力したら「Perl Debugger」が出てくるので、それをインストールしました。

これで準備完了。

さっそく sample.pl を作成。
#! /usr/bin/perl
use strict;

print "Hellow Perl\n";

exit;
  

print 行にブレークポイントを貼って実行すると、見事にブレークしてくれました。(^_^)v

さて、よくある問題の日本語表示を試してみましょう。
  print "Perl開発環境出来上がり\n";
に変更して実行してみます。

PS E:\TestDir\Perl\sample> cd 'E:\TestDir\Perl\sample/'; ${env:PERLDB_OPTS}='RemotePort=localhost:55237'; & 'perl' '-d' 'E:\TestDir\Perl\sample/first.pl'
Perl髢狗匱迺ー蠅・・縺ァ縺阪≠縺後j

文字化けしますね orz

use utf8;
を追加して実行してみました。

PS E:\TestDir\Perl\sample> cd 'E:\TestDir\Perl\sample/'; ${env:PERLDB_OPTS}='RemotePort=localhost:55237'; & 'perl' '-d' 'E:\TestDir\Perl\sample/first.pl'
Wide character in print at E:\TestDir\Perl\sample/first.pl line 6.
Perl髢狗匱迺ー蠅・・縺ァ縺阪≠縺後j

有名な、Wide character エラーまで出力されるようになってしまいました。

use utf8; の代わりに
use open IO => qw/:encoding(UTF-8) :std/;

を加えてみましょうか・・・
PS E:\TestDir\Perl\sample> cd 'E:\TestDir\Perl\sample/'; ${env:PERLDB_OPTS}='RemotePort=localhost:55242'; & 'perl' '-d' 'E:\TestDir\Perl\sample/first.pl'
Perlテゥツ鳴凝ァツ卍コテァツ陳ーテ・ツ「ツε」ツ・ョテ」ツ・ァテ」ツ・催」ツ・づ」ツ・古」ツつ・

Wide character エラーはなくなりましたが、文字の化け方が変わりました。

こまったぞ。

ふと気づきまして。Visual Studio Code のコンソール出力には PS **** と出てます。
Power Shell なんですね。
んで、こいつが Shift-JIS ベースなのではないだろうかと思ったわけです。

#! /usr/bin/perl
use strict;
use utf8;
binmode STDOUT, ':encoding(cp932)';

print "Perl開発環境出来上がり\n";

exit;

結果
PS E:\TestDir\Perl\sample> cd 'E:\TestDir\Perl\sample/'; ${env:PERLDB_OPTS}='RemotePort=localhost:55287'; & 'perl' '-d' 'E:\TestDir\Perl\sample/first.pl'
Perl開発環境のできあがり

ちゃんと日本語表示されています。
めでたしめでたし。

Linuxサーバー用のプログラムを Windows 上で開発・デバッグしたいと思っているので、環境に応じて binmode 変えなきゃなりませんね。
さて、どーしようか・・・

つづきは、また今度。

2019年1月21日月曜日

Perl uri_unescape で文字化け

実は文字化けにはその後も苦しんでおりまして。
原因となる現象をようやく突き止めましたのでサンプルプログラムを公開しますね。

use Carp::Heavy;
use strict;
use URI::Escape;
use Encode;
use encoding 'utf-8';

my $a1 = '%E8%A9%A6%E9%A8%93';
my $b0 = '試験';
my $b1 = uri_escape_utf8($b0); #内容は '%E8%A9%A6%E9%A8%93'
print("$a1\n");
print("$b1\n");
print("1\n") if($a1 eq $b1);    #当然のごとく1が出力される

my $a2 = uri_unescape($a1);
my $b2 = uri_unescape($b1);
print("1\n") if($a2 eq $b2);    #なぜか 1 が表示されない
print("$b2\n"); #こちらは '試験'
print("$a2\n"); #文字化け
exit;


use encoding 'utf-8' を取ったり use utf8; にしたりすると他所に
大影響が出てしまうため変更できません。

これ。本当にハマりましたよ。
いったい何がどうなっているのかさっぱりわかりませんでした。

※実際には CGI 上のパラメータが文字化けしてました。

上記の謎の動作ですが
$a1= encode_utf8($a1);
を呼び出すことで期待通りの動きをすることがわかりました。

さて、本番環境に対応しようと・・・
my $cgi = new CGI();
my $a2 = $chi->param('a2');
文字化けです。
CGI の sub new で取得するuri_encode されたパラメータに対して事前に
encode_utf8を実行しなければならないのに、POSTリクエストだから標準
入力を変更する術が見つかりません。

じゃあ、ってことで呼び出し側を GET にしましたら、なんの変更も加えず
文字化けしなくなりましたよ。
Perlモジュールのバージョンの影響かと思い、さんざん調査すること3日
こういうのって、あっけなく解決するもんなんですねぇ
あー眠たい。

2018年12月30日日曜日

perl CGI HTML::Template で文字化け

Perl CGI での文字化け問題は何年も前に解決させたはずだったのですが(以前は Perl + Template の場合)
新しい CentOS (サーバに無料で入ってる Ver 6)の環境で、現在動作しているcgiを実行すると文字化けしてしまう現象に悩まされました。

ハマった手順を書いてみますね。

1)httpd.conf の変更
文字化けはこれでなおる!とネット上のあちこちに書いてあります。
# vi /etc/httpd/conf/httpd.conf

AddDefaultCharset off
または
#AddDefaultCharset off コメントアウト。


動作結果:NG
世界中でほとんど解決しているらしいのですが、うまくいきません。

2)php.ini の変更
# vi /etc/php.ini

;default_charset = "UTF-8"

default_charset = ""
に変更


動作結果:NG
そもそも php 使ってませんし。

ここでブラウザ側のレスポンスヘッダを確認してみますと utf-8 となっていました。
んー?なのに文字化け?理解できないぞ・・・

ちなみに、cgi のソースや HTML, CSS, JS, テンプレートファイルなど、すべてのファイルは UTF-8 で記述してます。(改行は LF)
なぜだろう、と、試験を実施することに。


3)簡単なHTMLを用意
[test.html]

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
    <head>
        <meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
        <title>テストページ</title>
    </head>
    <body>
        UTF-8で記述されたページ
    </body>
</html>


動作結果:なんと、うまく表示されます。

4)cgi だとダメなのかな?
[test.cgi]

#!/usr/bin/perl --
print "Content-Type: text/html; charset=utf-8\n\n";
print "<html><body><div>\n";
print 'クオート文字';
print '<br>';
print "ダブルクオート文字";
print '<br>';
print "<div></body></html>\n";
exit;

クオートとダブルクオートで分けたのは、 perl の動作で文字化けしているのかどうかを確認するためです。

動作結果:なんと、うまく表示されます。

5)HTML::Template が怪しい。
どうやら使用している HTML::Template が怪しいのではないかとあたりを付けて検索したら情報がありました。
HTML::Template 2.98 で UTF問題が解決してる!というのです。
移行先のサーバーの HTML::Template は Ver,2.97 です。
ちなみにうまくいっていた旧サーバーの HTML::Template は Ver,2.94 でした。

Ver 2.98 のソースはここにありました。
https://github.com/mpeters/html-template

CPAN からのインストールしかやったことないので、git からどうやってインストールするのかわからずw
ダウンロードした HTML/Template.pm, HTML/Template/FAQ.pm をそのまま perl5 のファイルに上書きw

文字化けする cgi を動作させてみました。

動作結果:NG
ここまで、大量に時間を食ったにもかかわらず、うまくいかないとは・・・

6)binmode => 'utf8' を記述
既存 cgi の new HTML::Template 構文で、binmode => 'utf8' を追加する、との記述があったので
試してみました。

動作結果:NG
この記述は、上記リンクをたどる際に対応したパッチを当てたソースの場合に有効だったもので、動かないことは予想できていました。

7)utf8 => 1 を記述
HTML/Template のドキュメントを読み、new 構文の utf8 オプションがあることを発見。(旧サーバにはないオプションでした。)

既存 cgi の new HTML::Template 構文で、utf8 => 1 オプションを追加して実行してみました。

my $tmpl = HTML::Template->new(die_on_bad_params => 0, filename => $file, utf8 => 1);

動作結果:おお!!!!ようやく文字化けせずに表示されました!

しかしながら、問題があります。
既存プログラムの cgi ファイルは山のようにあります。
その全部にフラグを追加するのは困難ですよ。
デグレードなんか発生させちゃった日にゃ目も当てられません。
なんとかならないかな・・・

8)HTML::Template を編集。
perl5 の HTML/Template.pm を開いてみると、次のような部分なありました。

my %OPTIONS;
BEGIN {
    %OPTIONS = (
        debug                       => 0,
        ;
        utf8                        => 0,
        ;

ええい、こいつを1にしてしまえ!

        utf8                        => 1,

と変更した後で、既存の cgi に戻して動作

動作結果:OK

文字化けが解消されました!!!

モジュールの挙動が変わるなんて、ほんと困りものです。

2018年7月25日水曜日

Perl CGI でバイナリファイルのアップロードに失敗する

use CGI;
my $cgi = new CGI();
my $fh = $cgi->upload(file);
my $temp = $cgi->tmpFileName($fh);
File::Copy::move($temp, $target_filename);

これでうまくいくはずなんですよね。
png ファイルをアップロードしても表示されない・・・
なかなかはまってしまいました。
コピーされたファイルのサイズが大きくなってるんです。

ファイルの中身をバイナリダンプしてみると、EF BF BD というバイト列が多数。
つまりバイト単位に変換できてないので無効な情報とされているわけ。

ネット上を検索していろいろ試しました。
binmode(STDIN);
とか
binmode(STDIN, ':raw');
とか
コピーを実装したりとか。

で、何時間も試行錯誤して、ふとスクリプトの上部を見てみると
use Encode;
use encoding 'utf-8';

ここで入力がすべてUTF-8 とみなされてしまい、バイナリ値が FF BF BD に変換されてしまっていたわけです。
この2行、削除したらまんまと動いてくれました。

2018年1月31日水曜日

Perl CGI でWEBサーバから高速に最新値を取得する

node.js あたりを使って非同期に動作させていればこんな苦労はないのでしょうがw

運用してるWEBサーバで、クライアント側の更新が必要かどうかだけを問い合わせたい時があります。

めったに変更されない値が変更されたかどうか、とか、

表示している内容が最新なのかどうか、とか。

jquery.timers.js を使って、everyTime, stopTime メソッドを呼び出せば定期的にサーバーに問い合せすることができます。

今回必要だったのが、データベース上のシーケンシャルなIDの更新状態です

ブラウザ上には一覧が表示されてるのですが、サーバー上では不定期にIDが追加されますので、現在表示している内容が最新かどうかを問い合わせたいわけです。

select count(*) from table where id>last_id; 

SQLを発行すれば、最新の件数がすぐに取得できます。

でもね、id ってときどきしか増えないのに、できるだけ早く検知するには everyTimeのインターバルを短くしなきゃならないわけで、無駄だなーと思うわけです。

しかも CGI 側では DBI::connect, disconnect, 戻り値のjsonだのXMLの出力を実施するんで、大量に利用者がいるとサーバーの負荷たるや、半端ない状態に陥ることまちがいなしです。

最新の値だけをファイルに書き込んでおいてそれを読みだすという方法も考えました。

それも open~close のオーバーヘッド考えるとわざわざ最新IDをファイルに保存するのは余計な処理と思ってしまいます。



そこで!


ファイルのタイムスタンプを利用してID管理できるんじゃなかろうか、という発想のもと作成したクラスが、これ。

package FastSerialHolder;
#============================================
# 2018/01/26 
#============================================
# 最新のIDを管理するクラス
# ファイルのタイムスタンプを使ってデータを保持させる
# ファイルの内容はアプリケーションごとに任意に書き込み
# atime<<32+mtime で63bitの値を管理する。
# ただし、atime はマウントにより使用していない場合もあるので注意
#============================================
our $FshBasePath = '任意のフォルダ';

#
#   コンストラクタ
#
sub new
{
    my ($self, $name, $group, $def_value) = @_;
    my $path = $FastSerialHolder::FshBasePath;
    #再帰的なディレクトリ作成はCGIでエラーになるので個別に作る
    #グループを階層化したい場合には、あらかじめディレクトリを作っておく
    if(! -d $path)
    {
        mkdir($path);
    }
    if(defined($group))
    {
        $path .= '/';
        $path .= $group;
        if(! -d $path)
        {
            mkdir($path);
        }
    }
    $def_value = 0 if(!defined($def_value));
    $def_value = 0 if($def_value !~ /^\d+$/);
    my $filename = $path . '/' . $name . '.fsh';
    my $object = bless {
  path => $path,
  name => $name,
  filename => $filename,
  current => $def_value,
  defualt => $def_value,
  handle => undef
 }, $self;
    if(! -e $filename)
    {
 $object->SetSerial($def_value);
    }
    return $object;
}

#
# 最新IDを取得する
#
sub GetSerial
{
    my ($self) = @_;
    if(! -e $self->{filename})
    {
        $self->{current} = $self->{default};
        return $self->{current};
    }
    my @st = stat($self->{filename}); # atime=$st[8], mtime=$st[9]
    my $hi = $st[8] << 32;
    my $lo = $st[9] & 0xFFFFFFFF;
    my $serial = ($hi + $lo) >> 1;
    return $serial;
}

sub SetSerial
{
    my ($self, $serial) = @_;
    if($serial < 0)
    {
        $serial = $self->{defualt};
    }
    if(! -e $self->{filename})
    {
        #ファイル作成
        if(open(my $fh, ">", $self->{filename}))
        {
            close($fh);
        }
    }
    my $rc = false;
    my $val = ($serial << 1);
    my $lo = ($val & 0xFFFFFFFF);
    my $hi = ($val >> 32);
    $rc = (0 < utime($hi, $lo, $self->{filename}));
    if($rc)
    {
        $self->{current} = $serial;
    }
    return $rc;
}
 

コメントなくてすみませんw

ようするに、ファイルシステムの更新時間とアクセス時間を変更して数値として取り扱うわけです。

実際には派生クラスを使って特定のグループごとにフォルダを分けて使うようにしてますが

使い方としては、最新値を取り出す場合は

my $idManager = new FastSerialHolder(名前,グループ名,初期値);
my $current = $idManager->GetSerial();
データベースが更新されたタイミングで

my $idManager = new FastSerialHolder(名前,グループ名,初期値);
$idManager->SetSerial(最新値);
とするだけです。



CGIでは、まず最新値があるかどうかの比較だけを行っておき、「あるよ」って返事が来たらデータベースにアクセスさせる別のCGIを呼び出すようにすればいいわけです。

実装して動かしてみると、とってもサクサクで快適です!

【備考というか補足というか】
実際に動かしたのは、CentOS 6.4 64bit です。

値を1ビットシフトしてるのは、ファイルシステムが秒の記録を2秒単位にしてた(昔の)記憶に頼ったもので、正しいかどうかは不明ですw

mkdir じゃなくて mkpath 使えと言われそうですが、初回生成時に STDOUTにprintするので、使わないようにしてます

stat で返される、atime と mtime が実際にファイルシステム上で何ビットなのか調べたけどわからなかったので(笑)、32bit だと思い込んで書いてます。

ファイルアクセスを高速化するために atime を無効にマウントされてる場合は 31bit しか扱えません。注意してください。(未検証)

0バイトでもクラスタ使っちゃうのかも・・・(そうなのかな?


画期的な方法だと思い込んでますが、きっと既出か、あるいはよくない実装って怒られるのか、どちらなのかもしれません。