2009-06-30

Mac OS X Serverのblojsomでむりくり画像を入れる

macosx blojsom

僕が立てたPukiWikiは僕が別の部署に配属されたあいだに自然と使われなくなり、代わりに後から導入されたMac OS Xのblojsomがナレッジベースになっていました。まーブログかっこいいよね。しかしこれ画像アップロードできないようなので、そういう制限の中でできないはずのことをできるようにするのがハックだよね、とか思っている僕は（仕事しろ）、しょうがないから、以前作った

http://dot.dtpwiki.jp/

をですね、改造して、blojsomが受け付けるtableタグを吐き出す

http://dot.dtpwiki.jp/osxblog.cgi

を作って、画像が入らないはずのブログに画像が入り、これでより情報共有が進むもんだと思いましたが、

普通にimageタグ使えるわけなので、一部の人には有名な

The data: URI kitchen

にてdataスキームを作って画像が貼れるのでした。BASE64にチェックを付けると良い。

2008-10-12

InDesignでSocketクラスの上位クラスを作りHTTPでアクセス

InDesign JavaScript

VBS for Adobe InDesign＋更新履歴・メモ: Socketオブジェクトで遊ぶ。いや遊ばれる

で、InDesignのSocketオブジェクトを発見というか発掘され、InDesignからWebの情報を引っ張ると言うことをやっておられます。

正直InDesignだけでWebにアクセス出来るだなんて考えたこと無かったのですごいと思いました。

それで、サンプルプログラムを書き直したくなったんでちょっとやってみました。PerlのLWPモジュール風に簡単にHTTPのアクセスが出来ればいいよねーという感じで、ものすごく機能絞ったプロトタイプ的なものを作成。

(function(){
    
    function Lwp() {
        // コンストラクタ。ここでUser-Agent名や
        // timeout値など準備しておくといいよね
        this.userAgent = 'InDesign/5.0.3 '
        +'(Windows; U; Windows NT 6.0; ja;)';
    };
    Lwp.uri =function(uri) {
        var rex = new RegExp( 'http://([^:/]+)(?::(\d+))?(.+)' );
          // via http://pc11.2ch.net/test/read.cgi/php/1015692614/57
        var urlObj =[];
        if ( uri.match(rex) ) {
            urlObj.host = RegExp.$1;
            urlObj.port = RegExp.$2 ?RegExp.$2 :80;
            urlObj.path = RegExp.$3;
        }
        return urlObj;
    }
    Lwp.prototype.get = function (uri) {
        var conn = new Socket;
        var urlObj = Lwp.uri(uri);
        if (conn.open ( urlObj.host + ':' + urlObj.port, 'UTF-8' ) ) {
            conn.write ('GET ' + urlObj.path + " HTTP/1.0\n"
            + 'Host: ' + urlObj.host + "\n"
            + 'User-Agent: ' + this.userAgent + "\n"
            + "\n");
    　　    var reply = conn.read(999999);
　　        conn.close();
            return reply.substring(reply.indexOf("\n\n") + 2 );
        }
    }
    
    // main
    
    var lwp = new Lwp;
    var contents = lwp.get('http://www.yahoo.co.jp/');
    
    var txf = app.activeDocument.textFrames[0];
    txf.contents = contents;
    
})();

それならブログのほうはどうだ？　これはUTF-8だぞ。ところが302エラー。せうぞーさんのところもYUJIさんのところも302エラー。どうもサーバーとドメインの関係で、取得できないっぽい。

Socketでのアクセスなので、一般のブラウザ的なアクセスをさせるには、ちゃんとしたユーザエージェントとして振る舞うよう作らなくては駄目。そのためには、ちゃんとリクエストヘッダに必要な情報を入れるとか（Hostをみて名前ベースバーチャルホストを実現しています）、レスポンスヘッダを読んで適当な処理をさせたりする（転送はちゃんとやらないと駄目とか）ことが重要だとおもいます。

と言うわけで、自分ところのblog（blog.dtpwiki.jpをcocolog.nifty.comのIPに割り当て、cocologの名前ベースバーチャルホストで表示）は、元ソースでは表示できなかったわけですが、上記ソースで取得できています。

上記ソースのように、クラスとして、httpのユーザエージェントを作ると、作りやすいと思います。

2008-09-21

CodeReposにSubversionでコミットする

CodeRepos Subversion

CodeReposのコミット権いただいたあと、SVKがドータら良く分からず、CPANのビルド通らず、めんどくせーなんて思っていて、放置していましたが、otsuneさんから、svnでやってみたら、ていうアドバイスをいただいたので、やってみたら、なんのことはない、普通にネット越しにリポジトリ指定してSubversion使うのと同じでした。

あらかじめ、Yappoさんにコミット権を設定してもらっておきます。

まずは、作ってあるスクリプトなどをディレクトリに入れておきます。

そして、そのディレクトリの1つ上のディレクトリで、こんなの打ちます。

$ svn import fit_text/ http://svn.coderepos.org/share/platform/indesign/fit_text/ -m "initial import." --username CL
追加しています              fit_text/trunk
追加しています              fit_text/trunk/fit_text.jsx

リビジョン 19664 をコミットしました。
$

と出てきます。初回パスワード入力がいるかも。

今のは、リポジトリにインポートする行為でした。なので、これから開発するには、一度、わざわざ作業用コピーをチェックアウトする必要があります。

$ mkdir work
$ cd work/
$ svn checkout http://svn.coderepos.org/share/platform/indesign/fit_text/
A    fit_text/trunk
A    fit_text/trunk/fit_text.jsx
リビジョン 19664 をチェックアウトしました。
$

と出てきます。あとは、チェックアウトしたディレクトリの中で開発します。インポートしたときのディレクトリはもういりません。

コミットするときは、

$ cd work/fit_text/
$ svn commit -m "rewite script."

とかすると、コミットします。

他の人と共同開発するときは、作業開始時にsvn updateしなきゃいけないですけれども、いままで会社でSubversion使っているのは僕１人だったから、忘れないようにしよう。

2008-06-17

HTML::Parserに入力するテキスト、最後に改行付けないと最終行処理されないよ

perl

RSS 1.0のdescription要素とcontent:encoded要素の使い分けがずいぶん前にさんざん言われたときがあったんですけれども、とにかく、description要素はプレーンテキストが望ましいと言うことで、それを利用して、僕が作るシステムではRSSをメッセージングとして利用しているんだけれども、状況に応じて、description要素とcontent:encoded要素のどちらを拾うか選択しています。

そんで、RSS 1.0のdescription要素に仕込む、HTMLタグ取っ払ったテキスト作ろうとして、

Filename: reject_html.pl

#!/usr/bin/perl
use strict;
use warnings;
use HTML::Parser;

my $html_text = "やったー携帯小説できたよー（＾o＾）ﾉ<br>
<br>
　───アタシの名前はアイ。心に傷を負った女子高生。モテカワスリムで恋愛体質の愛されガール♪<br>
アタシがつるんでる友達は援助交際をやってるミキ、学校にナイショで<br>
キャバクラで働いてるユウカ。訳あって不良グループの一員になってるアキナ。<br>
　友達がいてもやっぱり学校はタイクツ。今日もミキとちょっとしたことで口喧嘩になった。<br>
女のコ同士だとこんなこともあるからストレスが溜まるよね☆そんな時アタシは一人で繁華街を歩くことにしている。<br>
がんばった自分へのご褒美ってやつ？自分らしさの演出とも言うかな！<br>
　｢あームカツク｣・・。そんなことをつぶやきながらしつこいキャッチを軽くあしらう。<br>
｢カノジョー、ちょっと話聞いてくれない？｣どいつもこいつも同じようなセリフしか言わない。<br>
キャッチの男はカッコイイけどなんか薄っぺらくてキライだ。もっと等身大のアタシを見て欲しい。<br>
　｢すいません・・。｣・・・またか、とセレブなアタシは思った。シカトするつもりだったけど、<br>
チラっとキャッチの男の顔を見た。<br>
「・・！！」<br>
　・・・チガウ・・・今までの男とはなにかが決定的に違う。スピリチュアルな感覚がアタシのカラダを<br>
駆け巡った・・。「・・（カッコイイ・・！！・・これって運命・・？）」<br>
男はホストだった。連れていかれてレイプされた。「キャーやめて！」ドラッグをきめた。<br>
「ガッシ！ボカッ！」アタシは死んだ。
スイーツ（笑）";
 print _reject_tags( $html_text );
# RSS用HTMLタグ除去
# HTMLタグを除去する
sub _reject_tags {
  my $html = shift;
  my $text = q();
  my $parser = HTML::Parser->new(
    api_version => 3,
    text_h      => [ sub { $text .= shift; }, "dtext" ]
  );
  $parser->parse( $html );
  return $text;
}

実行例：

$ perl reject_html.pl 
やったー携帯小説できたよー（＾o＾）ﾉ

　───アタシの名前はアイ。心に傷を負った女子高生。モテカワスリムで恋愛体質の愛されガール♪
アタシがつるんでる友達は援助交際をやってるミキ、学校にナイショで
キャバクラで働いてるユウカ。訳あって不良グループの一員になってるアキナ。
　友達がいてもやっぱり学校はタイクツ。今日もミキとちょっとしたことで口喧嘩になった。
女のコ同士だとこんなこともあるからストレスが溜まるよね☆そんな時アタシは一人で繁華街を歩くことにしている。
がんばった自分へのご褒美ってやつ？自分らしさの演出とも言うかな！
　｢あームカツク｣・・。そんなことをつぶやきながらしつこいキャッチを軽くあしらう。
｢カノジョー、ちょっと話聞いてくれない？｣どいつもこいつも同じようなセリフしか言わない。
キャッチの男はカッコイイけどなんか薄っぺらくてキライだ。もっと等身大のアタシを見て欲しい。
　｢すいません・・。｣・・・またか、とセレブなアタシは思った。シカトするつもりだったけど、
チラっとキャッチの男の顔を見た。
「・・！！」
　・・・チガウ・・・今までの男とはなにかが決定的に違う。スピリチュアルな感覚がアタシのカラダを
駆け巡った・・。「・・（カッコイイ・・！！・・これって運命・・？）」
男はホストだった。連れていかれてレイプされた。「キャーやめて！」ドラッグをきめた。
「ガッシ！ボカッ！」アタシは死んだ。$

オチで落ちません。
最後の行が処理されない。どうやら、最後に改行が必要みたいだね。

つうわけで、わかりやすく対処。入力に"\n"付けよう。出力はchompせずともいいみたい。

# RSS用HTMLタグ除去
# HTMLタグを除去する
sub _reject_tags {
  my $html = shift . "\n"; # HTML::Paserに最終行処理させるため改行付ける
  my $text = q();
  my $parser = HTML::Parser->new(
    api_version => 3,
    text_h      => [ sub { $text .= shift; }, "dtext" ]
  );
  $parser->parse( $html );
  return $text;
}

当たり障りがないタグ（とか）でくくるのもありかもね。

2008-05-15

XREAの共用SSLアクセスでCGI::Application::Plugin::Authenticationの認証遷移を機能させる

Perl

CGI::Application::Plugin::Authenticationというとても長い名前のモジュールですが、これは、CGI::Appicationで認証を実現するモジュールです。これなんですが、現在実行されているスクリプトのURLを絶対パスで取得する部分があります。$query->self_url ていうやつ。通常はそんなに問題はないんですけれども、またまたXREAの共用SSLサーバを通すと、認証が終わったあとの遷移がちゃんと動きません。よって、やっぱりパッチします。パッチっていっても、元のモジュールから該当部引っ張ってきて、$query->self_urlを、$query->url(-relative=>1, -query=>1)に書き換えているだけだぞ。

#!/usr/bin/perl
package MyWebApp;
use base 'CGI::Application';
use strict;
use warnings;
use utf8;
use CGI::Application::Plugin::Authentication;
cgi_application_plugin_authentication_fixup();


#以下略


# CGI::Application::Plugin::AuthenticationをXREAの共通SSLに対応させるパッチ
sub cgi_application_plugin_authentication_fixup {
  package CGI::Application::Plugin::Authentication;
  no warnings 'redefine';
*login_box = sub  {
    my $self        = shift;
    my $query       = $self->_cgiapp->query;
    my $credentials = $self->credentials;
    my $runmode     = $self->_cgiapp->get_current_runmode;
#    my $destination = $query->param('destination') || $query->self_url;
    my $destination = $query->param('destination') || './'
                     .$query->url(-relative=>1, -query=>1);
#    my $action      = $query->url( -absolute => 1 );
    my $action      = './'.$query->url(-relative=>1);
    my $username    = $credentials->[0];
    my $password    = $credentials->[1];
    my $login_form  = $self->_config->{LOGIN_FORM} || {};
    my %options = (
        TITLE                   => 'Sign In',
        USERNAME_LABEL          => 'User Name',
        PASSWORD_LABEL          => 'Password',
        SUBMIT_LABEL            => 'Sign In',
        COMMENT                 => 'Please enter your username and '
                                  .'password in the fields below.',
        REMEMBERUSER_OPTION     => 1,
        REMEMBERUSER_LABEL      => 'Remember User Name',
        REMEMBERUSER_COOKIENAME => 'CAPAUTHTOKEN',
        REGISTER_URL            => '',
        REGISTER_LABEL          => 'Register Now!',
        FORGOTPASSWORD_URL      => '',
        FORGOTPASSWORD_LABEL    => 'Forgot Password?',
        INVALIDPASSWORD_MESSAGE => 'Invalid username or password'
                                  .'<br />(login attempt %d)',
        INCLUDE_STYLESHEET      => 1,
        %$login_form,
    );

    my $messages = '';
    if ( my $attempts = $self->login_attempts ) {
        $messages .= '<li class="warning">'
                  . sprintf($options{INVALIDPASSWORD_MESSAGE}, $attempts) . '</li>';
    } elsif ($options{COMMENT}) {
        $messages .= "<li>$options{COMMENT}</li>";
    }

    my $tabindex = 3;
    my ($rememberuser, $username_value, $register,
        $forgotpassword, $javascript, $style) = ('','','','','','');
    if ($options{FOCUS_FORM_ONLOAD}) {
        $javascript .= "document.loginform.${username}.focus();\n";
    }
    if ($options{REMEMBERUSER_OPTION}) {
        $rememberuser = qq[<input id="authen_rememberuserfield" ]
                       .qq[tabindex="$tabindex" type="checkbox" ]
                       .qq[name="authen_rememberuser" value="1" />]
                       .qq[$options{REMEMBERUSER_LABEL}<br />];
        $tabindex++;
        my $query = $self->_cgiapp->query;
        $username_value = $query->param($username)
                       || $query->cookie($options{REMEMBERUSER_COOKIENAME})
                       || '';
        $javascript .= "document.loginform.${username}.select();\n" if $username_value;
    }
    my $submit_tabindex = $tabindex++;
    if ($options{REGISTER_URL}) {
        $register = qq[<a href="$options{REGISTER_URL}" ]
                   .qq[id="authen_registerlink" tabindex="$tabindex">]
                   .qq[$options{REGISTER_LABEL}</a>];
        $tabindex++;
    }
    if ($options{FORGOTPASSWORD_URL}) {
        $forgotpassword = qq[<a href="$options{FORGOTPASSWORD_URL}" ]
                         .qq[id="authen_forgotpasswordlink" tabindex="$tabindex">]
                         .qq[$options{FORGOTPASSWORD_LABEL}</a>];
        $tabindex++;
    }
    if ($options{INCLUDE_STYLESHEET}) {
        my $login_styles = $self->login_styles;
        $style = <<EOS;
<style type="text/css">
<!--/* <![CDATA[ */
$login_styles
/* ]]> */-->
</style>
EOS
    }
    if ($javascript) {
        $javascript = qq[<script type="text/javascript" ]
                     .qq[language="JavaScript">$javascript</script>];
    }

    my $html .= <<END;
$style
<form name="loginform" method="post" action="${action}">
  <div class="login">
    <div class="login_header">
      $options{TITLE}
    </div>
    <div class="login_content">
      <ul class="message">
${messages}
      </ul>
      <fieldset>
        <label for="${username}">$options{USERNAME_LABEL}</label>
        <input id="authen_loginfield" tabindex="1" type="text"
          name="${username}" size="20" value="$username_value" /><br />
        <label for="${password}">$options{PASSWORD_LABEL}</label>
        <input id="authen_passwordfield" tabindex="2" type="password"
          name="${password}" size="20" /><br />
        ${rememberuser}
      </fieldset>
    </div>
    <div class="login_footer">
      <div class="buttons">
        <input id="authen_loginbutton" tabindex="${submit_tabindex}"
          type="submit" name="authen_loginbutton" value="$options{SUBMIT_LABEL}"
          class="button" />
        ${register}
        ${forgotpassword}
      </div>
    </div>
  </div>
  <input type="hidden" name="destination" value="${destination}" />
  <input type="hidden" name="rm" value="${runmode}" />
</form>
$javascript
END

    return $html;
};

    return 1;
}

デフォルトの認証ダイアログがイヤなら、このパッチ内で書き換えてしまう手もあるね。

このエントリを書くにあたって、

404 Blog Not Found:perl - パッチなしでパッチする

を参考にしました。

2008-05-14

XREAの共用SSLアクセスでCGI::Sessionの-ip_matchを機能させる

Perl

XREAの共用SSLサーバを使ってPerlのCGIを使うとして、これってプロキシになっていて、スクリプト側からすると、非SSL通信になっていますので、$ENV{'REMOTE_ADDR'}は、XREAのサーバのIPアドレスになってしまいます。

CGI::Sessionの-ip_matchに影響が出るので、パッチします。

前提条件として、使っているXREAのCGI::Sessionのバージョンが3.95である事を確認。sshで入って、/usr/bin/less /usr/local/lib/perl5/site_perl/5.8.4/CGI/Session.pm でどうぞ。

バージョン上がるとpatchあてずdieします。4.0系になるとパッチを書き換えないといけないので注意。

#!/usr/bin/perl
use strict;
use warnings;
use CGI::Session qw(-ip_match);
cgi_session_fixup();


#メインルーチンここにかけ

exit;


# CGI::SessionをXREAの共通SSLに対応させるパッチ
sub cgi_session_fixup {
  # このpatchは、XREAにインストール済みのCGI::Session 3.95のみ対応
  die 'CGI::Session ga 3.95 yori new!'
    if CGI::Session->VERSION > 3.95;
  package CGI::Session;
  no warnings 'redefine';
  
  *__remote_addr = sub {
    # XREA SSLアクセス対策
    # XREAのhttps://ss1.xrea.com 経由でアクセスすると、
    # 内部的には XREAの内部サーバからアクセスされていることに
    # なるので、CGI::Session の -ip_matchの動きに影響が出ます。
    # XREAの内部サーバ経由時には、環境変数HTTP_X_FORWARDED_FOR
    # を入れることにします。
    if($ENV{'REMOTE_ADDR'} =~ /^192\.168\./ ||
       $ENV{'REMOTE_ADDR'} =~ /^219\.101\.229\./) {
      return $ENV{HTTP_X_FORWARDED_FOR};
    } else {
      return $ENV{REMOTE_ADDR};
    }
  };
  *_ip_matches = sub {
      return ( $_[0]->{_DATA}->{_SESSION_REMOTE_ADDR} eq __remote_addr() );
  };
  # _init_new_session() - initializes a new session
  *_init_new_session = sub {
      my $self = shift;
      
      my $currtime = time();
      $self->{_DATA} = {
          _SESSION_ID => $self->generate_id($self->{_OPTIONS}),
          _SESSION_CTIME => $currtime,
          _SESSION_ATIME => $currtime,
          _SESSION_ETIME => undef,
          _SESSION_REMOTE_ADDR => __remote_addr() || undef,
          _SESSION_EXPIRE_LIST => { },            
      };
      
      # to Chris Dolan's request:
          # I'm not sure if this information should be serialized (placed under _DATA),
          # but I don't see any desperate need for it. So let it be part of the object
          $self->{_IS_NEW} = 1;
      
      $self->{_STATUS} = MODIFIED;
      
      return 1;
  };
return 1;
}

このエントリを書くにあたって、

http://sb.xrea.com/showthread.php?&threadid=6646
http://sb.xrea.com/showthread.php?t=8531
404 Blog Not Found:perl - パッチなしでパッチする

を参考にしたよ。

2008-05-08

DTP従事者がついうっかりやってしまうCMYK-JPEGのままアップされた画像で、ちゃんとブラウザで表示できるサムネイル画像を作る

Perl

ええと、

Illustrator DTP PC よろず掲示版

をWindowsのOperaで見ると、添付画像のサムネイルがまっくろくろ助なわけです。Opera、CMYKのJPEGイメージに対応してないのですね……

イメージを名前をつけて保存して、Windows 画像とFAXビューアで見たら表示できるんですけれども、それでは、サムネイルの意味ないです。

というわけで、サムネイルを作るときに使われる定番のImageMagickの使い方で、何とかする方法。
$img->Set(colorspace => 'RGB');ていう書き方で、CMYKのイメージでもRGBにしちゃいましょう！

今回のは、

Image::Magick を使って大量画像のサムネイル画像を一括自動生成 - drk7jp

を参考にしつつ、Windows XPのExplorer風のサムネイルを生成することを目標にしたよ。

Filename: image2cmykjpeg_thumbnail.pl

#!/usr/bin/perl
use strict;
use warnings;
use File::Basename;
use Image::Magick;
 
_thumbnail('eroero.jpg');
exit;
 
sub _thumbnail {
  my $RESIZE_X = 85;
  my $RESIZE_Y = 85;
  my $filepath = shift;
  # 画像縮小 
  my $img = Image::Magick->new;
  $img->Read($filepath);
  $img->Set(colorspace => 'RGB');
  $img->Set(quality => 90);
  my ( $x, $y ) = $img->Get( 'width', 'height' );
  if ( $x > $y * $RESIZE_X / $RESIZE_Y ) {
    $img->Thumbnail(
      width  => $RESIZE_X,
      height => $y / $x * $RESIZE_Y,
    );
  }
  else {
    $img->Thumbnail(
      width  => $x / $y * $RESIZE_X,
      height => $RESIZE_Y,
    );
  }
  $img->Border( width=>2, height=>2, fill=>'white', );
  binmode(STDOUT);
  my ( $base, $dir, $suffix ) = fileparse( $filepath, qr/\.[^.]*/ );
  my $newpath = "$dir${base}_s.jpg";
  $img->Write("jpeg:$newpath");
  return $newpath;
}