PNGをファイルに保存するPerlスクリプト(psql使用)

psqlを実行した結果のバイナリ表現をバイナリに変更して適当にファイルを作って書き込む、というものです。
なにがすごいって、CPANから何も入れなくてもいい(なんか違う)。

PostgreSQL 9.0以降と8.x以前とではバイナリ表現が違います。これは9.0+用です。

#!/usr/bin/perl

$psql = "psql";

my $sql = '';
my %popts = ('-d','','-h','','-p','');
my %lopts = ('-od', './', '-of','%04d.png');

#
# sub: prints the usage to STDERR
#
sub usage {
  print STDERR << "_EOL_USAGE_";
Usage: $0 [options] command
options:
  --help
  -d 
  -h 
  -p 
  -od  ("./")
  -of  ("%04d.png")
_EOL_USAGE_
}

# analyzes arguments
my @st = ();
foreach my $arg ( @ARGV ) {
  if( !@st ) {
    if( $arg =~ /^-/ ) {
      if( $arg eq '--help' ) {
        &usage;
        exit 0;
      }
      foreach $key ( keys(%popts) ) {
        if( $key eq $arg ) {
          $st[0] = 'popts';
          $st[1] = $key;
        }
      }
      if( !@st ) {
        foreach $key ( keys(%lopts) ) {
          if( $key eq $arg ) {
            $st[0] = 'lopts';
            $st[1] = $key;
          }
        }
      }
      if( !@st ) {
        print STDERR "Unknown option: $arg\nSpecify --help to see help.\n";
        exit 1;
      }
    }
    else {
      $sql = $arg;
    }
  }
  else {
    if( $st[0] eq 'popts' ) {
      $popts{$st[1]} = $arg;
    }
    elsif( $st[0] eq 'lopts' ) {
      $lopts{$st[1]} = $arg;
    }
    @st = ();
  }
}
# checks whether last option is set properly.
if( @st ) {
  print STDERR "unspecified option value for ${st[1]}\nSpecify --help to see help.\n";
  exit 1;

}

# will die if command is not specified
if( $sql eq '' ) {
  print STDERR "No SQL command.\n";
  exit 1;
}

# options specified by user
@cmd = ("\"$psql\"");
foreach $key ( keys(%popts) ) {
  if( $popts{$key} ne '' ) {
    push(@cmd, "\"$key\" \"${popts{$key}}\"");
  }
}

# enforced psql options
push(@cmd, "-t -A"); # tupples only, no align

# sql
push(@cmd, "-c \"$sql\"");

# command string
$cmd = join(' ',@cmd);

# local options
my $od = $lopts{'-od'};
my $of = $lopts{'-of'};
if( !($od =~ /\/$/) ) {
  $od = $od . '/';
}

my $cnt = 1;

# reads all and outputs.
open(P,"$cmd|");
while(
 ) {
  chomp;
  if( $_ =~ /^\\x/ ) {
    my $hex = $_;
    $hex =~ s/^.*\\x(.*)$/\1/;
    $hex =~ s/([0-9A-Fa-f][0-9A-Fa-f])/pack("H2", $1 )/eg;
    my $file = $od.sprintf($of,$cnt);
    open(W,">$file") || die $file;
    print W $hex;
    close(W);
    print STDERR "$file\n";
    $cnt++;
  }
}
close(P);

使い方はラスタカラムだけを出すようにSELECTを書いて渡せばOK。

./foo.perl -od ./data "SELECT rast FROM foo"

こんなかんじにすると、./data の下に 0001.png, 0002.png ... と出てきます。

あと、拡張子を .perl にしているのは、かつて個人的に .pl を Prolog ファイルに割り当ててた頃の名残ですので気にしないでください。