PERL[CGI]でPHPのSESSIONを利用してみます

はじめに

PERLで作ったダウンローダーって行数少なくソフト的にはファイルサイズに上限がないなど、個人的に便利なので社内のちょっとしたシステムでよく使います。

一方でメイン画面は他言語でPERLを使う機会は減っていて、ほかの言語で書いたプログラムとセッション情報を共有するには工夫が必要なこともあります。

今回は、メイン画面をPHPでログイン処理するようなシステムがあり、そのセッション情報をPERLから利用する機会があったのでそのメモです。

簡単に機能説明

・PHP

ログイン情報をセッションで保持する

（{ id }を含む連想配列をloginという名前で保持する）

・PERL（CGI）

ログイン情報をPHPのセッションから取得する

（取得できればファイルをダウンロードさせる）

リクエストパラメータでファイルを特定する

（id=5 みたいなパラメータでMySQLを検索）

依存ライブラリ（CPAN）

ライブラリ使ってみます。下の三つを配置してCGIスクリプトから参照。CPANの環境からだと「PHP::Session」を入れたら全部落ちてくるような気もします。

・CGIやDBIなど一般的なライブラリ

XSERVERなどレンサバで最初から使えるものは割愛します。

・UNIVERSAL::require

https://metacpan.org/pod/UNIVERSAL::require

・PHP::Session

https://metacpan.org/pod/PHP::Session

・PHP::Session::Serializer::PHP

https://metacpan.org/pod/PHP::Session::Serializer::PHP

CGIのサンプル

エラー処理は省略。（例えば、PHP::Session->new が失敗すると異常終了します）

#!/usr/bin/perl
use strict;
use warnings;
use lib 'modules';#依存ライブラリを配置したディレクトリ

use CGI qw(:standard);
use PHP::Session;
#セッションファイルの場所はphpinfo()等で確認して、
my $session = PHP::Session->new(cookie('PHPSESSID'), { save_path => '/＊＊＊/php/session' });
if ($session && $session->get('login') && $session->get('login')->{'id'}) {
    use DBI;
    use Encode qw/encode_utf8/;
    use URI::Escape;

    my %form = ( "id" => "" );
    my $query = $ENV{'QUERY_STRING'};
    $query =~ tr/+/ /;
    $query =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg;
    foreach (split(/&/, $query)) {
        my ($k, $v) = split(/=/,$_);
        $v =~ tr/+/ /;
        $v =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        $form{$k} = $v;
    }

    if ($form{"id"}) {
        my $dsn = "dbi:mysql:database=＊＊＊;host=＊＊＊;port=＊＊＊";
        my $user = "＊＊＊";
        my $pass ="＊＊＊";
        my $dbh = DBI->connect($dsn, $user, $pass, {
            AutoCommit => 1,
            PrintError => 0,
            RaiseError => 1,
            ShowErrorStatement => 1,
            AutoInactiveDestroy => 1
        })|| die $DBI::errstr;
        my $sth = $dbh->prepare("SELECT name `ファイル名`,path `ファイルパス` FROM ＊＊＊);

        $sth->execute();
        if (my @row = $sth->fetchrow) {
            my $name = URI::Escape::uri_escape($row[0]);
            open IN,"$row[1]" || die "E3001：400 Bad Request.";
            print "Content-type: application/octet-stream\n";
            print "Content-Disposition: attachment; filename=\"$row[0]\"; filename*=UTF-8''$name\n\n";
            print ;
            close IN;
        } else {
            die "E3002：400 Bad Request.";
        }
        $sth->finish;
        $dbh->disconnect;
    } else {
        die "E3003：400 Bad Request.";
    }
} else {
    die "E3004：401 Unauthorized.";
}



1;

まとめ

PERLは好きな言語です。

ab39