Big Sky

TheSchwartzも良いのですが、MySQLが必要だったりポーリングのタイムラグがあったりと、要件に合わない場合というのも出て来たりします。こんな時はどうするか、解決策の一つにメッセージバスがあります。
メッセージバスとして一般的に有名なのが、DBusです。Linux等では数多くのアプリケーションが採用しており、GNOMEもBonoboからの移行を表明、KDE4でも採用される様です。ちなみに私が愛用している軽量デスクトップROXは当初に採用しており、ちょっとしたpythonのコードでリッチなアプリケーション間通信が実現出来ています。他にも既に色々なプロジェクトでDBusが使われています。
さて今日はNet::DBusを使い、TheSchwartzと似たような事が出来ないかをWindows上でやってみようかと思います。
まず、DBusのWindows実装であるwinDBusをインストールします。winDBusはこちらで配布されておりバイナリもダウンロード出来ます。
ここでまず、DBusの動作を確認します。winDBusを展開したディレクトリの中のbinフォルダに移動し以下の様にしてデーモンを起動します。

C:¥winDBus¥> dbus-daemon.exe --config-file=C:/winDBus/dbus/bin/session.conf

winDBusを"C:¥Programme"に展開された場合には

C:¥Programme¥> dbus-daemon.exe --session

とするだけでも動作します。winDBusの場合、unixドメインソケットをサポートしていませんので、上記session.confに書かれている

<listen>tcp:host=localhost,port=12434</listen>

の値を環境変数「DBUS_SESSION_BUS_ADDRESS」に設定します。

set DBUS_SESSION_BUS_ADDRESS=tcp:host=localhost,port=12434

その上でdbus-daemon.exeと同じ位置にあるtest_names.exeを実行し

Successfully acquired name 'org.freedesktop.DBus.Test'
Successfully acquired name 'org.freedesktop.DBus.Test-2'
Successfully acquired name 'org.freedesktop.DBus.Test_2'

と表示されれば動作確認は終了です。
次にNet::DBusをインストールします。まずNet::DBusはビルドにpkg-configを使うので`pkg-config --cflags dbus-1`が扱えないVCではビルドに難があります。私の場合はMinGWを使用しました。
まず、winDBusに同梱されていなかったdbus-1.pcを作成します。winDBusをインストールしたディレクトリを指定して

prefix=C:/winDBus/dbus
exec_prefix=${prefix}
libdir=${exec_prefix}/lib
includedir=${prefix}/include

Name: D-Bus
Description: D-Bus Protocol Library
Version: 0.90
Libs: -LC:/winDBus/dbus/lib -ldbus-1
Cflags: -IC:/winDBus/dbus/include

という内容でdbus-1.pcを保存します。次に環境変数PKG_CONFIG_PATHにこのdbus-1.pcを保存したディレクトリを設定し、cpanからインストールします。おそらくこれでインストール出来るかと思いますが、出来なかった方はVCのコンパイラのパスを外し、MinGWのパスを設定して確認して見て下さい。
これでようやくperlからDBusを使える準備が揃いました。
さて、サーバのソース。DBusのセッションからバスを取得し、サービスをエクスポート、ワーカーの役目をするオブジェクトを作成します。ワーカーオブジェクトにはJobStartというメソッドを定義します。

#!/usr/bin/perl

use strict;
use warnings;
use threads;
use YAML;
use Net::DBus;
use Net::DBus::Service;
use Net::DBus::Reactor;

package MyWorker;
use base qw(Net::DBus::Object);
use Net::DBus::Exporter qw(net.kaoriya.mattn.DBusWorker);

sub new {
    my $class = shift;
    my $service = shift;
    my $self = $class->SUPER::new($service, "/MyWorker");
    bless $self, $class;
    
    return $self;
}

dbus_method("JobStart", [["dict", "string", "string"]], [["dict", "string", "int32"]]);
sub JobStart {
    my $self = shift;
    my $job = shift;
    my $thread = threads->new(sub {
        my $job = shift;
        printf "processing job%03d : %s\n", threads->tid, $job->{request};
        sleep 10;
        printf "done job%03d\n", threads->tid;
    }, $job);
    return { "id" => $thread->tid };
}

package main;

my $bus = Net::DBus->session();
my $service = $bus->export_service("net.kaoriya.mattn.DBusWorker");
my $object = MyWorker->new($service);
Net::DBus::Reactor->main->run();

DBusは非同期通信も提供していますが、リクエストを連続で送った際サーバがビジー状態だとクライアントが側が応答を待ってロックします。
そこで上記ソースではスレッドを起こし、重たい処理をさせる様になっています。スレッド内では"threads->tid"で言わばジョブ番号の役割をするスレッドIDを使ってユニークな処理が出来るかと思います。
さらにクライアントのコード。

#/usr/bin/perl

use strict;
use warnings;

use Net::DBus;
use Net::DBus::Reactor;
use Net::DBus::Callback;
use Net::DBus::Annotation qw(:call);

my $request = shift @ARGV || 'request at '.time();
my $bus = Net::DBus->session();
my $service = $bus->get_service("net.kaoriya.mattn.DBusWorker");
my $object = $service->get_object("/MyWorker");
my $res = $object->JobStart({ request => $request });
printf "job was accepted as job%03d\n", $res->{id};

DBusセッションからもらったMyWorkerオブジェクトのJobStartメソッドにリクエスト文字列を指定して送信します。
まずクライアントの実行結果は

C:¥winDBus¥test¥> perl client.pl
job was accepted as job001
C:¥winDBus¥test¥> perl client.pl
job was accepted as job002
C:¥winDBus¥test¥> perl client.pl
job was accepted as job003

クライアントではjob001を実行した後、10秒待ってjob002、job003を投入しました。そしてサーバの実行結果

processing job001 : request at 1214560175
done job001
processing job002 : request at 1214560192
processing job003 : request at 1214560195
done job002
done job003

おぉ！非同期ですね！
DBusでは、引数の構成および戻り値の構成をdbus_methodにて指定でき、文字列(string)や数値(int32等)、配列(array)、タプル(tuple)、構造体(struct)を引き渡したり、戻り値として返したり出来ます。
さらに、Net::DBusに同梱されている"example-client-async.pl"の様に非同期送信結果を受け取り、完了イベントで結果を受け取るという事も出来ます。

#/usr/bin/perl

use warnings;
use strict;

use Net::DBus;
use Net::DBus::Reactor;
use Net::DBus::Callback;
use Net::DBus::Annotation qw(:call);

my $bus = Net::DBus->session();

my $service = $bus->get_service("org.designfu.SampleService");
my $object = $service->get_object("/SomeObject");

print "Doing async call\n";
my $reply = $object->HelloWorld(dbus_call_async, "Hello from example-client.pl!");

my $r = Net::DBus::Reactor->main;

sub all_done {
    my $reply = shift;
    my $list = $reply->get_result;
    print "[", join(", ", map { "'$_'" } @{$list}), "]\n";

    $r->shutdown;
}

print "Setting notify\n";
$reply->set_notify(\&all_done);

sub tick {
    print "Tick-tock\n";
}


print "Adding timer\n";
$r->add_timeout(500, Net::DBus::Callback->new(method => \&tick));

print "Entering main loop\n";
$r->run;

今回はWebで扱いやすい様に、非同期で結果を待機する処理ではなくサーバ側でスレッドを実行していますが、デスクトップクライアントを作る際にはdbus_call_asyncを使う事になるかと思います。

TheSchwartzも面白いですが、DBusも面白いですね。
perlの他にも、C(GLib)はもちろんpythonやJava等でも実装されています(参照)。
皆さんも試してみては如何でしょうか。

最近TheSchwartが賑わってる様ですね。

TheSchwartzで仕事をあとにまわす - bits and bytes

なければ勝手に作ってくれるのかなと思ってSYNOPSISのコードを実行してみたけどやっぱり自動でできたりはしなそうだったので調べたらCatalyst and TheSchwartz: Reliable JobQueue in a great framework - Voxにschema.sqlを使うといいと書いてありました。このスキーマをmysqlで実行すればTheSchwartzのキューを管理するためのテーブルが出来上がります。

http://labs.gmo.jp/blog/ku/2008/06/theschwartz.html

Twitter / ku: TheSchwartzおもしろかった sqliteで動...

TheSchwartzおもしろかった sqliteで動くようにしたいけどsqliteようのschemeかきかたわかんない

http://twitter.com/ku/statuses/843135311

って事でSQLiteでも動く様に出来ないか調べてみました。
schema.sqlは、MySQL用のスキーマで

CREATE TABLE funcmap (
        funcid         INT UNSIGNED PRIMARY KEY NOT NULL AUTO_INCREMENT,
        funcname       VARCHAR(255) NOT NULL,
        UNIQUE(funcname)
);

CREATE TABLE job (
        jobid           BIGINT UNSIGNED PRIMARY KEY NOT NULL AUTO_INCREMENT,
        funcid          INT UNSIGNED NOT NULL,
        arg             MEDIUMBLOB,
        uniqkey         VARCHAR(255) NULL,
        insert_time     INTEGER UNSIGNED,
        run_after       INTEGER UNSIGNED NOT NULL,
        grabbed_until   INTEGER UNSIGNED NOT NULL,
        priority        SMALLINT UNSIGNED,
        coalesce        VARCHAR(255),
        INDEX (funcid, run_after),
        UNIQUE(funcid, uniqkey),
        INDEX (funcid, coalesce)
);

CREATE TABLE note (
        jobid           BIGINT UNSIGNED NOT NULL,
        notekey         VARCHAR(255),
        PRIMARY KEY (jobid, notekey),
        value           MEDIUMBLOB
);

CREATE TABLE error (
        error_time      INTEGER UNSIGNED NOT NULL,
        jobid           BIGINT UNSIGNED NOT NULL,
        message         VARCHAR(255) NOT NULL,
        funcid          INT UNSIGNED NOT NULL DEFAULT 0,
        INDEX (funcid, error_time),
        INDEX (error_time),
        INDEX (jobid)
);

CREATE TABLE exitstatus (
        jobid           BIGINT UNSIGNED PRIMARY KEY NOT NULL,
        funcid          INT UNSIGNED NOT NULL DEFAULT 0,
        status          SMALLINT UNSIGNED,
        completion_time INTEGER UNSIGNED,
        delete_after    INTEGER UNSIGNED,
        INDEX (funcid),
        INDEX (delete_after)
);

というSQLなので、これをSQLite用に書き換えます。

cl.pocari.org - SQLite で auto-increment なフィールドを作成する方法

つまり，SQLite で auto-increment なフィールドを作りたければ，INTEGER PRIMARY KEY を指定してあげればいいらしい．

http://cl.pocari.org/2006-02-12-1.html

こちらの記事でも書かれている通り、SQLiteではINTEGER PRIMARY KEYを指定すればok。
※ちなみにUNSIGNEDとかNOT NULLとか付けると動かないです。

で書き換えたSQLは以下の通り

CREATE TABLE funcmap (
        funcid         INTEGER PRIMARY KEY,
        funcname       VARCHAR(255) NOT NULL,
        UNIQUE(funcname)
);

CREATE TABLE job (
        jobid           INTEGER PRIMARY KEY,
        funcid          INTEGER NOT NULL,
        arg             MEDIUMBLOB,
        uniqkey         VARCHAR(255) NULL,
        insert_time     INTEGER UNSIGNED,
        run_after       INTEGER UNSIGNED NOT NULL,
        grabbed_until   INTEGER UNSIGNED NOT NULL,
        priority        SMALLINT UNSIGNED,
        coalesce        VARCHAR(255),
        UNIQUE(funcid, uniqkey)
);
CREATE INDEX job_idx_1 ON job (funcid, run_after);
CREATE INDEX job_idx_2 ON job (funcid, coalesce);

CREATE TABLE note (
        jobid           INTEGER NOT NULL,
        notekey         VARCHAR(255),
        value           BLOB
);

CREATE TABLE error (
        error_time      INTEGER UNSIGNED NOT NULL,
        jobid           INTEGER NOT NULL,
        message         VARCHAR(255) NOT NULL,
        funcid          INTEGER NOT NULL DEFAULT 0
);
CREATE INDEX error_idx_1 ON error (funcid, error_time);
CREATE INDEX error_idx_2 ON error (error_time);
CREATE INDEX error_idx_3 ON error (jobid);

CREATE TABLE exitstatus (
        jobid           INTEGER PRIMARY KEY,
        funcid          INTEGER NOT NULL DEFAULT 0,
        status          SMALLINT UNSIGNED,
        completion_time INTEGER UNSIGNED,
        delete_after    INTEGER UNSIGNED
);
CREATE INDEX exitstatus_idx_1 ON exitstatus (funcid);
CREATE INDEX exitstatus_idx_2 ON exitstatus (delete_after);

あとはコレを

# sqlite3 the_schwartz < theschwartz_schema.sql

としてDBファイルを作る。
さてサーバのコードはDSNを"dbi:SQLite:the_schwartz"にするだけ。

#!/usr/bin/env perl
package MyWorker;
use strict;
use utf8;
use warnings;
use base qw( TheSchwartz::Worker );
use Data::Dumper;

binmode STDERR, ":encoding(cp932)" if $^O eq "MSWin32";

sub work {
    my ($class, $job) = @_;
    warn "お仕事ですよ！ @{[ Dumper($job->arg) ]}\n";
    $job->completed();
}

package main;
use strict;
use warnings;
use TheSchwartz;

my $client = TheSchwartz->new(
    databases => [ +{ dsn => 'dbi:SQLite:the_schwartz' } ]
);
$client->can_do('MyWorker');
$client->work();

さらにクライアントのコード

#!/usr/bin/env perl
use strict;
use warnings;
use TheSchwartz;

my $client = TheSchwartz->new(
    databases => [ +{ dsn => 'dbi:SQLite:the_schwartz' } ]
);
$client->insert('MyWorker' => +{ hoge => "fuga" });

実行すると

お仕事ですよ！ $VAR1 = {
          'hoge' => 'fuga'
        };

という風にサーバ側で表示されます。 ちなみに、DBD::SQLiteのバグで

closing dbh with active statement handles at .../Data/ObjectDriver/Driver/DBI.pm line 566.

という表示が出る様ならばココにある"issue-17603.tar.gz"のパッチを当てるといいです。どうやらこのバグ、デグレっぽいですね。

ま、結局SQLiteでやっちゃったら同一マシンだし負荷分散にはならない(UIロックを避けるという意味では有用)んですけどね。

グダグダの文章ですみません。

perl-monger.orgってはてなグループじゃダメなの？ - DTP+印刷営業メモ

なんとなくだが近所の人がperl-monger.orgな話をしていてさっきページを見ていたんだけど、これってはてなグループ（なんとか部みたいな）のじゃダメなのかなぁ、と思った。

...snip...

っていうかWikiに色々なコンテンツを追加していくてのはダメなんだろうかと普通に思ったんだけど。

Wikiでもログイン制にしてしまえば同じような事は出来るし、弄れば同じ風貌に出来なくもないと思う。ただWikiだと筆者に掛かる責任ぽい物だとか、評価だとか、「perl-mongers」っていう組織感だとかが表現し辛いんじゃないかなぁ。
例えば「Journal of miyagawa」がWikiだったら少し感じが変ってくる様な気がする。(私だけかもしれない)

記事を原稿用紙に書くのかフリースケッチに描くのか...そんな程度の違いなのかもしれないけど、私は今の形がCoolだと思う。

答えになってないなぁ。

追記
組織感ってのは、例えばsubtechみたいなもんかな。

このサーバではJSON::Syck::Load(YAML::Syck::LoadJSON)が動かなかった(おそらくXSコンパイルされてない)のでJSON::PPを使ってますが、使える人はJSON::Syck::Loadを使うという事で
hatenastar_mobile

# Blosxom Plugin: hatenastar mobile
# Author(s): mattn
# Version: Fri, 06 Jun 2008

package hatenastar_mobile;

use strict;
use warnings;
use vars qw($stars);
use LWP::UserAgent;
use URI::Escape;
use HTTP::Request;
use JSON::PP;

$stars = '';

my $permalink_flavour = 'htm';
my @mobile_ua = qw(UP\.Browser KDDI PDXGW DoCoMo J-PHONE L-mode Vodafone SoftBank);

sub start {
    return 1 if map { $ENV{'HTTP_USER_AGENT'} =~ /$_/ } @mobile_ua;
}

sub story {
    my($pkg, $path, $fn, $story_ref, $title_ref, $body_ref) = @_;
    return 0 if $ENV{'PATH_INFO'} !~ /\.$permalink_flavour$/;

    eval {
        my $uri = 'http://s.hatena.ne.jp/entries.json?uri=' . URI::Escape::uri_escape("$blosxom::url$path/$fn.$permalink_flavour");
        my $ua = LWP::UserAgent->new;
        my $req = HTTP::Request->new(GET => $uri);
        my $res = $ua->request($req);
        $res->is_success or return 0;
        my $json = decode_json( $res->content );
        my @sts = @{$json->{entries}->[0]->{stars}};
        for my $st (@sts) {
            $stars .= '<img src="http://s.hatena.ne.jp/images/star.gif" title="' . $st->{name} . '" />'
        }
    };
    1;
}

パーマリンクとなるflavour名をpermalink_flavourに指定し、flavourに"$hatenastar_mobile::stars"を入れると表示されます。

Perlハブサイトコアメンバーに訊きたい質問 - [51]注目！パソコンの使い方-はてなダイアリー

Perl日本人ユーザーハブサイト(Perl-users.jp - 日本のPerlユーザのためのハブサイト) が立ち上がり、他言語でもユーザーハブサイトができ、挙句の果てにはRailユーザーハブサイトまでできた模様。

これまでいくつものPerlユーザーハブサイトをコピペしてPerlを使ってきた立場から今回のサイトが末永く続くように運営に関わろうとする篤い志の方へその志の大きさを客観的に示してもらえるよう質問を用意しました。プロフィールページがあったら少しはサイトも長く続くかと考えています。

質問の順番も重要でしょうから、追加・改変はご自由に、コピペして100の質問のようにご利用ください。

http://d.hatena.ne.jp/Akira51/20080523/1211500311

• rubyは好きですか？
• pythonは好きですか？
• perl命と言いながらjava-jaに参加してませんか？
• 織田祐二は好きですか？
• 今日のパンツは何色ですか？

追記
ゆーすけべーさんのほうで、最終引数をパスではなくオプションハッシュにする対応を入れて頂きました。 これにより以下のパッチを当てなくても動的にメソッドパスを設定出来る様になりました。ゆーすけべーさんにはサンプルも変更に対応して頂き、さらにはパッケージに含んで頂いたようです。
yusukebe++
修正されたソースは

http://coderepos.org/share/browser/lang/perl/WebService-Simple/trunk/example/lingr.pl

より参照下さい。以下、パッチも一応残しておきますが当たりませんのでお気をつけ下さい。サンプルは入れ替えておきました。

便利だなぁ。

ゆーすけべー日記: POX over HTTP のウェブAPIにアクセスするためのモジュール「WebService::Simple」を作ってみた

俗に言う「POX over HTTP」のウェブAPIにアクセスするためのシンプルな(？)Perlモジュール「WebService::Simple」なるものを作ってみました。

ゆーすけべー日記: WebService::Simple でキャッシュできるようにしたよ

dannさんから「WebService::Simpleで（取得したコンテンツを）キャッシュしたいよ！」と言われて、俺もその機能欲しかったので追加しました。

flickrとか簡単に扱えてしかもキャッシュ機能もある。1セッション当たりにサーバへのアクセス数が多いサービスでは重宝するんじゃないかな。で、試そうかと思ったんですが、ベースURLが固定なRESTサービス(methodパラメータとか無い物)って案外無い。どっちかっていうと、URLにメソッドを含んでいる物が多い。そうした場合、メソッド単位でURLを変えなきゃいけない。って事でちょっとだけ改造してみました。
この変更は別の方法で取り込まれました。

Index: lib/WebService/Simple.pm
===================================================================
--- lib/WebService/Simple.pm    (revision 8637)
+++ lib/WebService/Simple.pm    (working copy)
@@ -3,9 +3,9 @@
 use warnings;
 use strict;
 use Carp;
+use URI;
 use URI::Escape;
 use LWP::UserAgent;
-use URI::Escape;
 use WebService::Simple::Response;
 
 our $VERSION = '0.02';
@@ -21,8 +21,8 @@
 }
 
 sub get {
-    my ($self, $request_param) = @_;
-    my $url = $self->_make_url($request_param);
+    my ($self, $request_param, $path) = @_;
+    my $url = $self->_make_url($request_param, $path);
     my $response = $self->_fetch_url($url);
     return $response;
 }
@@ -44,14 +44,21 @@
     return $response;
 }
 sub _make_url{
-    my ($self, $request_param) = @_;
+    my ($self, $request_param, $path) = @_;
     my $base_url = $self->{base_url};
     my $url = $base_url =~ /\?$/ ? $base_url : $base_url . "?";
     my @params;
     push(@params, $self->_hashref_to_str($self->{param}));
     push(@params, $self->_hashref_to_str($request_param));
-    my $str = join("&",@params);
-    return $url . $str;
+    $url .= join("&",@params);
+    if ($path) {
+        # append additional path.
+        my $u = URI->new( $url );
+        $path =~ s!^/!! if $u->path =~ /\/$/;
+        $u->path( $u->path . $path );
+        $url = $u->as_string;
+    }
+    return $url;
 }
 
 sub _hashref_to_str {

やっているのは「get」メソッドのパラメータにoptionalな「path」パラメータを足しただけです。このpathパラメータはbase_urlに指定のパスを付け足します。例えば

http://example.com/rest?test=1

とういベースURLに対して

$api->get( {
        value => 123,
    }, '/api/foo/bar' );

とすれば

http://example.com/rest/api/foo/bar?test=1&value=123

というアクセスになる様な修正です。
ただ、引数の一番最後で良いのかどうかで悩んでcommitはしていません。

今日はこの改造後のWebService::Simpleを使ってLingrに発言するスクリプトを作ってみました。(こんなにスマートになるよ！という意味で)
このサンプルは上記codereposにある物のコピーです。

use strict;
use warnings;
use WebService::Simple;

my $api_key  = "your_api_key";
my $room_id  = "hO4SmQWTdJ4"; # http://www.lingr.com/room/hO4SmQWTdJ4
my $nickname = "lingr.pl";
my $message  = $ARGV[0] || "Hello, World.";

my $lingr = WebService::Simple->new(
    base_url => 'http://www.lingr.com/',
    param    => { api_key => $api_key, format => 'xml' }
);

# create session, get session
my $response;
$response = $lingr->get( {}, { path => '/api/session/create' } );
my $session = $response->parse_xml->{session};

# enter the room, get ticket
$response = $lingr->get(
    {
        session  => $session,
        id       => $room_id,
        nickname => $nickname,
    },
    { path => '/api/room/enter' }
);
my $ticket = $response->parse_xml->{ticket};

# say 'Hello, World'
$response = $lingr->get(
    {
        session => $session,
        ticket  => $ticket,
        message => $message,
    },
    { path => '/api/room/say' }
);
my $status = $response->parse_xml->{status};

# destroy session
$lingr->get( { session => $session, }, { path => '/api/session/destroy' } );

base_urlが変る事で毎回WebService::Simpleを作らなくても良くなり、スッキリした感じです。
ゆーすけべーさんには、案だけ採用して貰いたい。(私の下手なコードは使わないで下さいという意味)

以前、miyagawa氏作のXML::Atom::ServerをベースとしてXSをなるべく使わない「XML::Atom::Server::Lite」というのを作ってCodeReposに放置していたのですが、そろそろ放置しすぎな感もあったので発作的にエントリ。
「XML::Atom::Server::Lite」は「XML::Atom::Server」と構造をほぼ同じにしてあり、中で使用しているXML::Atomを自前のXSを使わないクラスで置き換えてしまおうというモジュールです。
LibXMLが使えないサーバには、もしかしたら有用かもしれません。サーバ用途だけならばLWPも使いませんし、簡単に低コストでAtom::Serverが実現出来ると思います。
「Digest::SHA」も「Digest::SHA::PurePerl」で置き換えています。
今日はこの「XML::Atom::Server::Lite」を使ってblosxomのAtom::Serverを作ってみました。
ソースは以下の通り。

#!/usr/bin/perl

package Blosxom::AtomPP;
use strict;
use base qw( XML::Atom::Server::Lite );
use File::Find;
use File::stat;

if (-e "/path/to/blosxom/config/file/config.cgi") {
    package blosxom;
    require '/path/to/blosxom/config/file/config.cgi';
}

my %Passwords = (
    yourname => 'yourpassword',
);
my $postsWanted = 10;

sub password_for_user {
    my $server = shift;
    my($username) = @_;
    $Passwords{$username};
}

sub getFilenameFromPostId {
  my $postid = shift @_;
  unless ( $postid =~ /$blosxom::datadir/ ) {
    if ( $postid =~ m!^/! ) {
      #Post ID now has a preceeding /
      $postid = $blosxom::datadir . $postid;
    } else {
      $postid = "$blosxom::datadir/$postid";
    }
  }
  return $postid;
}

sub getRandomFilename {
  my $time = time;
  $time .= int( rand(10) );
  $time .= int( rand(10) );
  return $time;
}

sub decode_html {
    my $str = shift @_;
    $str =~ s/&#([0-9]+);/chr($1)/ge;
    $str =~ s/&#[xX]([0-9A-Fa-f]+);/chr(hex $1)/ge;
    $str =~ s!\x0D|\x0A!<br />\n!g;
    $str =~ s/\&gt;/>/g;
    $str =~ s/\&lt;/</g;
    $str =~ s/\&quot;/"/g;
    $str =~ s/\&amp;/\&/g;
    return $str;
}

sub getPost {
    my $filename  = shift @_;
    my $start     = shift @_ || $blosxom::datadir;
    my $extension = shift @_ || $blosxom::file_extension;

    if ( -e $filename ) {
        open POST, "$filename";
        my @post = <POST>;
        close POST;
        my %struct;
        $struct{'postid'}      = $filename;
        $struct{'dateCreated'} = File::stat::stat($filename)->mtime;
        my $title              = shift @post;
        $title                 =~ s!\x0D|\x0A!!g;
        $struct{'title'}       = $title;
        foreach (@post) {
            my $line = $_;
            if ( !$struct{'subject'} && $line =~ /^meta-tags: (.*)$/ ) {
                $line = $1;
                $line =~ s!\x0D|\x0A!!g;
                my @subjects = split(/\s*,\s*/, $line);
                $struct{'subject'} = \@subjects;
            } else {
                $struct{'description'} .= $line;
            }
        }
        my @cats;
        $filename =~ s/$start(\/.*)\/.*$extension$/$1/ or $filename = "/";
        push @cats, $filename;
        $struct{'categories'} = \@cats;
        return \%struct;
    }
    else {
        return 0;
    }
}

sub newPost {
    my $struct    = shift @_;
    my $start     = shift @_ || $blosxom::datadir;
    my $extension = shift @_ || $blosxom::file_extension;

    my $filename;

    if ( defined( $struct->{'postid'} ) ) {