週記くらい

  • Profile

Category Archives: PostgreSQL

LuaSQLでPostgreSQL接続(Linuxで再挑戦)

Posted on 2008/07/29 by smeghead

Linuxで再挑戦したら、接続できました。

眠いので、箇条書きで書いておきます。

  • LuaSQLのソースをダウンロードする。
  • 展開して、configファイルのコンパイル対象とPostgreSQLのヘッダファイルとライブラリのパスなどを、環境に合わせて指定する。
  • make && make install

普通に使うには、libpq.so.4 (4は環境依存だと思います)が見えている状態になってれば、使えるようになりました。(LD_LIBRARY_PATHとかで無理矢理見えるようにしてテストしましたが)

  • Apacheの実行ユーザから見えるようにするために、/usr/local/lib に libpq.so.4 のシンボリックリンクを貼る。

これで、Linuxで、LuaSQLからPostgreSQLに接続することができました。ということで、Win版のバイナリが公開されていないだけで、Linux上では、luasql/postgres.so もコンパイルできて使えました。

だけど、LuaSQLはシンプルすぎて、blobを扱うことができなそうなので、ファイルはディスクに保存することにしようとしてます。

Posted in lua, PostgreSQL | Leave a comment |

LuaSQLでPostgreSQLへODBC接続

Posted on 2008/07/28 by smeghead

結果は、惨敗だったのですが、記録しておきます。

Windowsで開発してるので、ライブラリの拡張子は、dllです。

luasql/postgres.dll

目的は、aipoのデータベースからユーザの情報を取ってこようとしたところから始まっています。

aipoのデータベースは、postgresqlなので、Luaから接続するには、LuaSQLのpostgresql用のバイナリをダウンロードしようとしました。しかし、http://luaforge.net/frs/?group_id=12 を見ると、LuaSQL 2.1.1 には、PostgreSQL用のバイナリがありません。物は試しということで、古いバイナリ(LuaSQL2.0.2)をダウンロードしてみましたが、requireした所で読み込みに失敗してしまいます。これは、元々ダウンロードしたファイル名にlua50が含まれてるから、Lua5.0用なのでしょう。なんで、Lua5.1では、PostgreSQL用のバイナリが無くなっちゃったんだろう?

luasql/odbc.dll

次に試したのは、ODBC接続です。Windows上で、システムDSNでデータベースへの接続を作成します。CGIから実行するので、システムDSNで作成する必要があります。(ユーザDSNで作成して嵌りました。)

require "luasql.odbc"
env = assert (luasql.odbc())
con = assert (env:connect('dbname', 'user', 'passwd'))
cur = assert (con:execute"select user_id from turbine_user")

動きました。

でも、↓のSQLだとだめでした。

cur = assert (con:execute"select user_id, last_name from turbine_user")

SQLをちょっと変更しただけなのに、odbc.dll内でエラーというかassertされてしまっているようです。どうも、select で文字列型のフィールドを指定すると、下のようなエラーが出るみたいです。

---------------------------
Microsoft Visual C++ Runtime Library
---------------------------
Assertion failed!
Program: c:\Kepler\1.1\bin\lua5.1.exe
File: src\ls_odbc.c
Line: 163
Expression: 0
For information on how your program can cause an assertion
failure, see the Visual C++ documentation on asserts
(Press Retry to debug the application - JIT must be enabled)
---------------------------
中止(A)   再試行(R)   無視(I)
---------------------------

src/ls_odbc.c を見てみても、結果のカラムの型判定で対応する型が無いというような場合にassert文が実行されるようです。Postgresのバージョンが新しすぎて、対応してない可能性もあるんですが、バグなのかどうかもわかりませんでした。Linuxなら大丈夫なのかな?Linuxで、luasql.postgres を使えるのが一番嬉しいんですが。

続く

Posted in lua, PostgreSQL | Leave a comment |

plpgsql 全角カナ 半角カナ 比較

Posted on 2007/09/27 by smeghead

postgresqlでsqlのユーザ関数を定義できることは知っていましたが、手を出したことはありませんでした。

http://www.postgresql.jp/document/pg721doc/programmer/plpgsql.html

半角カナと全角カナを区別せずに検索するという仕様があるとします。アプリ(javaとかphpとか)でDBからデータを全部取ってきてから判定するのはいろんな意味で無駄が多くなります。

postgresqlのsql関数を試すチャンスと思い試してみたのが以下です。

-- # 引数の文字列の半角カナを全角カナに変換する関数
-- drop function kana2full(varchar);
create function kana2full(varchar) returns varchar as
'
declare
  p1  alias for $1;
  str varchar;
  len int;
  i int;
  zenkakus varchar;
  hankakus varchar;
begin
  str := p1;
  str := replace(str, ''ガ'', ''ガ'');
  str := replace(str, ''ギ'', ''ギ'');
  str := replace(str, ''グ'', ''グ'');
  str := replace(str, ''ゲ'', ''ゲ'');
  str := replace(str, ''ゴ'', ''ゴ'');
str := replace(str, ''ザ'', ''ザ'');
str := replace(str, ''ジ'', ''ジ'');
str := replace(str, ''ズ'', ''ズ'');
str := replace(str, ''ゼ'', ''ゼ'');
str := replace(str, ''ゾ'', ''ゾ'');
str := replace(str, ''ダ'', ''ダ'');
str := replace(str, ''ヂ'', ''ヂ'');
str := replace(str, ''ヅ'', ''ヅ'');
str := replace(str, ''デ'', ''デ'');
str := replace(str, ''ド'', ''ド'');
str := replace(str, ''バ'', ''バ'');
str := replace(str, ''ビ'', ''ビ'');
str := replace(str, ''ブ'', ''ブ'');
str := replace(str, ''ベ'', ''ベ'');
str := replace(str, ''ボ'', ''ボ'');
str := replace(str, ''パ'', ''パ'');
str := replace(str, ''ピ'', ''ピ'');
str := replace(str, ''プ'', ''プ'');
str := replace(str, ''ペ'', ''ペ'');
str := replace(str, ''ポ'', ''ポ'');
str := replace(str, ''ヴ'', ''ヴ'');
zenkakus := ''アイウエオカキクケコサシスセソタチツテトナニヌネノハヒフヘホマミムメモヤユヨラリルレロワヲンァィゥェォッャュョ'';
hankakus := ''アイウエオカキクケコサシスセソタチツテトナニヌネノハヒフヘホマミムメモヤユヨラリルレロワヲンァィゥェォッャュョ'';
len := length(zenkakus);
for i in 0 .. len loop
str := replace(str, substr(hankakus, i, 1), substr(zenkakus, i, 1));
end loop;
return str;
end;
'
language 'plpgsql'
;
-- # 引数の文字列の全角カナを半角カナに変換する関数
-- drop function kana2half(varchar);
create function kana2half(varchar) returns varchar as
'
declare
  p1  alias for $1;
  str varchar;
  len int;
  i int;
  zenkakus varchar;
  hankakus varchar;
begin
  str := p1;
  str := replace(str, ''ガ'', ''ガ'');
  str := replace(str, ''ギ'', ''ギ'');
  str := replace(str, ''グ'', ''グ'');
  str := replace(str, ''ゲ'', ''ゲ'');
  str := replace(str, ''ゴ'', ''ゴ'');
str := replace(str, ''ザ'', ''ザ'');
str := replace(str, ''ジ'', ''ジ'');
str := replace(str, ''ズ'', ''ズ'');
str := replace(str, ''ゼ'', ''ゼ'');
str := replace(str, ''ゾ'', ''ゾ'');
str := replace(str, ''ダ'', ''ダ'');
str := replace(str, ''ヂ'', ''ヂ'');
str := replace(str, ''ヅ'', ''ヅ'');
str := replace(str, ''デ'', ''デ'');
str := replace(str, ''ド'', ''ド'');
str := replace(str, ''バ'', ''バ'');
str := replace(str, ''ビ'', ''ビ'');
str := replace(str, ''ブ'', ''ブ'');
str := replace(str, ''ベ'', ''ベ'');
str := replace(str, ''ボ'', ''ボ'');
str := replace(str, ''パ'', ''パ'');
str := replace(str, ''ピ'', ''ピ'');
str := replace(str, ''プ'', ''プ'');
str := replace(str, ''ペ'', ''ペ'');
str := replace(str, ''ポ'', ''ポ'');
str := replace(str, ''ヴ'', ''ヴ'');
zenkakus := ''アイウエオカキクケコサシスセソタチツテトナニヌネノハヒフヘホマミムメモヤユヨラリルレロワヲンァィゥェォッャュョ'';
hankakus := ''アイウエオカキクケコサシスセソタチツテトナニヌネノハヒフヘホマミムメモヤユヨラリルレロワヲンァィゥェォッャュョ'';
len := length(zenkakus);
for i in 0 .. len loop
str := replace(str, substr(zenkakus, i, 1), substr(hankakus, i, 1));
end loop;
return str;
end;
'
language 'plpgsql'
;
  • 追記:20080414 id:umitanuki さんからの指摘で、「ヴ」に対応しました。ありがとうございます。特殊なのは「ヴ」だけなのかな?「ッ」も抜けてましたので追加しました。
select * from boards where kana2full(name) = 'プログラマ';

みたいに使えると思います。

注意

実際のプロジェクトの仕様が半角カナと全角カナを区別しないようにする必要が無くなってしまったこともあり、全然テストしていません。m(_ _)m

バグを指摘いただければ、このエントリを修正します。

データベースのcharsetがutf-8の状態で簡単な確認をしましたが、他のcharsetではどうなんでしょう?

Posted in PostgreSQL | 1 Comment |

テーブル定義のexcelファイル出力(1)

Posted on 2007/09/17 by smeghead

テーブル定義って考えることが多くて大変だし、excel上だけで、作業するのも退屈なので、以前から実際のスキーマ情報からテーブル定義を自動生成したいとは思っていました。DBDesignerというソフトウェアで、実際のDBからテーブル定義をリバースエンジニアリングしてから、カラム名の日本語説明やら備考やらを書き込んで、HTMLリポートで出力ということも試してみたんですが、満足できませんでした。


最近Postgresqlを使うことが多いんですが、postgresqlでは、DBのオブジェクトにCOMMENTを付加することができるので、それを利用して日本語名やら備考を設定していけば、実際のDBからテーブル定義書を出力できるようにできます。

仕様

汚い仕様ですが、例えばカラムに対してのコメントは、「カラム名;備考」というように、;で区切った前がカラム名で;以降が備考というように設定することにしました。pgadmin3というツールを使えばコメントを付加するのは簡単です。できたらMySQLとかも対応できたらいいけど、必要にならないとやらないかも。(MySQLにコメントを付加する機能があるかどうかも知りません。)

実装

リハビリの意味も含めてperlで書きました。

DbDefInfo.pmDBD:PgPP で各テーブル、カラム情報をコメント付きでとってきます。
WriteExcelDbDefInfo.pmSpreadsheet::WriteExcelで、excelファイルを出力します。
create_table_def.pl実行のエントリポイント

途中で疲れてきたので、SQLとか変数名とかバグとかPODがないとか不快なものがあると思います。見付けたら直していきます。恥を忍んで貼り付けます。

DbDefInfo.pm

2007/09/18 SQL文が間違っているので後で修正しました。

package DbDefInfo;
use strict;
use warnings;
our($VERSION, @ISA, @EXPORT, @EXPORT_OK);
require Exporter;
use Carp;
$VERSION = '0.0001';
@ISA = qw(Exporter);
@EXPORT = qw(get_table_def_infos);
@EXPORT_OK = qw();
 
use DBI;
my $column_info_query = <<EOD;
  SELECT DISTINCT
    PG_ATTRIBUTE.ATTNAME AS NAME,
    PG_TYPE.TYPNAME AS TYPE,
    PG_ATTRIBUTE.ATTTYPMOD - 4 AS SUBTYPE,
    PG_ATTRIBUTE.ATTNOTNULL AS NOTNULL,
    PG_ATTRDEF.ADSRC AS DEFAULT,
    PG_DESCRIPTION.DESCRIPTION AS DESCRIPTION,
    PG_ATTRIBUTE.ATTNUM AS NO,
    PG_ATTRIBUTE.ATTALIGN
  FROM
    PG_ATTRIBUTE
  INNER JOIN PG_CLASS ON 
    PG_CLASS.OID = PG_ATTRIBUTE.ATTRELID
  INNER JOIN PG_TYPE ON
    PG_ATTRIBUTE.ATTTYPID = PG_TYPE.OID
  LEFT JOIN PG_DESCRIPTION ON
    PG_CLASS.OID = PG_DESCRIPTION.OBJOID AND
    PG_ATTRIBUTE.ATTNUM = PG_DESCRIPTION.OBJSUBID
  LEFT JOIN PG_ATTRDEF ON 
      PG_ATTRIBUTE.ATTRELID = PG_ATTRDEF.ADRELID AND
      PG_ATTRIBUTE.ATTNUM = PG_ATTRDEF.ADNUM
  WHERE
    PG_CLASS.RELNAME='%s' AND
    PG_ATTRIBUTE.ATTNUM > 0
  ORDER BY
    PG_ATTRIBUTE.ATTNUM 
EOD
 
my $keys_info_query = <<EOD;
  SELECT
   C.RELNAME AS TABLENAME, 
   A.ATTNAME AS COLUMNNAME,
   FCLASS.RELNAME AS FTABLENAME,
   FATTR.ATTNAME AS FCOLUMNNAME
  FROM
    PG_CONSTRAINT N
  INNER JOIN  PG_CLASS C
   ON N.CONRELID = C.OID
  INNER JOIN PG_ATTRIBUTE A
   ON A.ATTRELID = C.OID
  LEFT JOIN 
   PG_CLASS AS FCLASS ON
    N.CONFRELID = FCLASS.OID
  LEFT JOIN PG_ATTRIBUTE FATTR
   ON FATTR.ATTRELID = C.OID AND
      FATTR.ATTNUM = ANY(N.CONFKEY)
  WHERE
    A.ATTNUM =ANY (N.CONKEY) AND
    C.RELNAME = '%s'
EOD
 
my $all_table_query = <<EOD;
  SELECT DISTINCT
    PG_CLASS.RELNAME,
    PG_DESCRIPTION.DESCRIPTION
  FROM
    PG_CLASS
  INNER JOIN 
    PG_TABLES ON
      PG_CLASS.RELNAME = PG_TABLES.TABLENAME
  LEFT JOIN
    PG_DESCRIPTION ON
      PG_CLASS.OID = PG_DESCRIPTION.OBJOID AND
      PG_DESCRIPTION.OBJSUBID = 0
  WHERE
    SCHEMANAME = '%s' AND PG_CLASS.RELKIND = 'r'
EOD
 
sub get_all_tables {
  my ($db, $schema_name) = @_;
  my $st = $db->prepare(sprintf $all_table_query, $schema_name);
  my $res = $st->execute;
  my @table_infos;
  while (my ($table_name, $table_comment) = $st->fetchrow) {
    push @table_infos, {table_name => $table_name, table_comment => $table_comment};
  }
  $st->finish;
  return @table_infos;
}
 
sub get_keys_infos {
  my ($db, $table_name) = @_;
  my @keys;
  my $st_keys = $db->prepare(sprintf($keys_info_query, $table_name));
  my $res_columns = $st_keys->execute;
  while (my $row_hashref = $st_keys->fetchrow_hashref) {
    push @keys, $row_hashref;
  }
  $st_keys->finish;
  return @keys;
}
 
sub get_column_infos {
  my ($db, $table_name) = @_;
  my @columns;
  my $st_columns = $db->prepare(sprintf($column_info_query, $table_name));
  my $res_columns = $st_columns->execute;
  while (my $row_hashref = $st_columns->fetchrow_hashref) {
    push @columns, $row_hashref;
  }
  $st_columns->finish;
  return @columns;
}
 
sub get_table_def_infos {
  my $settings = shift;
  my $db = DBI->connect(
    "DBI:$settings->{type}:host=$settings->{host};dbname=$settings->{dbname}",
    $settings->{user},
    $settings->{passwd})
    or die "DBI connect failed : $DBI::errstr";
  my @rows;
  for my $table_info (get_all_tables($db, $settings->{schema_name})) {
    my @columns = get_column_infos($db, $table_info->{table_name});
    my @keys = get_keys_infos($db, $table_info->{table_name});
    push @rows, {
      table_info => $table_info,
      column_infos => \@columns,
      key_infos => \@keys
    };
  }
  $db->disconnect;
  return @rows;
}
1;

package DbDefInfo; use strict; use warnings; our($VERSION, @ISA, @EXPORT, @EXPORT_OK); require Exporter; use Carp; $VERSION = '0.0001'; @ISA = qw(Exporter); @EXPORT = qw(get_table_def_infos); @EXPORT_OK = qw(); use DBI; my $column_info_query = <<EOD; SELECT DISTINCT PG_ATTRIBUTE.ATTNAME AS NAME, PG_TYPE.TYPNAME AS TYPE, PG_ATTRIBUTE.ATTTYPMOD - 4 AS SUBTYPE, PG_ATTRIBUTE.ATTNOTNULL AS NOTNULL, PG_ATTRDEF.ADSRC AS DEFAULT, PG_DESCRIPTION.DESCRIPTION AS DESCRIPTION, PG_ATTRIBUTE.ATTNUM AS NO, PG_ATTRIBUTE.ATTALIGN FROM PG_ATTRIBUTE INNER JOIN PG_CLASS ON PG_CLASS.OID = PG_ATTRIBUTE.ATTRELID INNER JOIN PG_TYPE ON PG_ATTRIBUTE.ATTTYPID = PG_TYPE.OID LEFT JOIN PG_DESCRIPTION ON PG_CLASS.OID = PG_DESCRIPTION.OBJOID AND PG_ATTRIBUTE.ATTNUM = PG_DESCRIPTION.OBJSUBID LEFT JOIN PG_ATTRDEF ON PG_ATTRIBUTE.ATTRELID = PG_ATTRDEF.ADRELID AND PG_ATTRIBUTE.ATTNUM = PG_ATTRDEF.ADNUM WHERE PG_CLASS.RELNAME='%s' AND PG_ATTRIBUTE.ATTNUM > 0 ORDER BY PG_ATTRIBUTE.ATTNUM EOD my $keys_info_query = <<EOD; SELECT C.RELNAME AS TABLENAME, A.ATTNAME AS COLUMNNAME, FCLASS.RELNAME AS FTABLENAME, FATTR.ATTNAME AS FCOLUMNNAME FROM PG_CONSTRAINT N INNER JOIN PG_CLASS C ON N.CONRELID = C.OID INNER JOIN PG_ATTRIBUTE A ON A.ATTRELID = C.OID LEFT JOIN PG_CLASS AS FCLASS ON N.CONFRELID = FCLASS.OID LEFT JOIN PG_ATTRIBUTE FATTR ON FATTR.ATTRELID = C.OID AND FATTR.ATTNUM = ANY(N.CONFKEY) WHERE A.ATTNUM =ANY (N.CONKEY) AND C.RELNAME = '%s' EOD my $all_table_query = <<EOD; SELECT DISTINCT PG_CLASS.RELNAME, PG_DESCRIPTION.DESCRIPTION FROM PG_CLASS INNER JOIN PG_TABLES ON PG_CLASS.RELNAME = PG_TABLES.TABLENAME LEFT JOIN PG_DESCRIPTION ON PG_CLASS.OID = PG_DESCRIPTION.OBJOID AND PG_DESCRIPTION.OBJSUBID = 0 WHERE SCHEMANAME = '%s' AND PG_CLASS.RELKIND = 'r' EOD sub get_all_tables { my ($db, $schema_name) = @_; my $st = $db->prepare(sprintf $all_table_query, $schema_name); my $res = $st->execute; my @table_infos; while (my ($table_name, $table_comment) = $st->fetchrow) { push @table_infos, {table_name => $table_name, table_comment => $table_comment}; } $st->finish; return @table_infos; } sub get_keys_infos { my ($db, $table_name) = @_; my @keys; my $st_keys = $db->prepare(sprintf($keys_info_query, $table_name)); my $res_columns = $st_keys->execute; while (my $row_hashref = $st_keys->fetchrow_hashref) { push @keys, $row_hashref; } $st_keys->finish; return @keys; } sub get_column_infos { my ($db, $table_name) = @_; my @columns; my $st_columns = $db->prepare(sprintf($column_info_query, $table_name)); my $res_columns = $st_columns->execute; while (my $row_hashref = $st_columns->fetchrow_hashref) { push @columns, $row_hashref; } $st_columns->finish; return @columns; } sub get_table_def_infos { my $settings = shift; my $db = DBI->connect( "DBI:$settings->{type}:host=$settings->{host};dbname=$settings->{dbname}", $settings->{user}, $settings->{passwd}) or die "DBI connect failed : $DBI::errstr"; my @rows; for my $table_info (get_all_tables($db, $settings->{schema_name})) { my @columns = get_column_infos($db, $table_info->{table_name}); my @keys = get_keys_infos($db, $table_info->{table_name}); push @rows, { table_info => $table_info, column_infos => \@columns, key_infos => \@keys }; } $db->disconnect; return @rows; } 1;

続く

Posted in perl, PostgreSQL | Leave a comment |

テーブル定義のexcelファイル出力(2)

Posted on 2007/09/17 by smeghead

id:smeghead:20070917:def の続き

WriteExcelDbDefInfo.pm

泥臭さ満載です;;

package WriteExcelDbDefInfo;
use strict;
use warnings;
our($VERSION, @ISA, @EXPORT, @EXPORT_OK);
require Exporter;
use Carp;
use Data::Dumper;
$VERSION = '0.0001';
@ISA = qw(Exporter);
@EXPORT = qw(write_db_def_info);
@EXPORT_OK = qw();
use Spreadsheet::WriteExcel;
 
sub utf16 {
  my $string = shift;
  use Encode qw(from_to);
  Encode::from_to($string, "utf8", "utf16");
  return $string;
}
 
sub set_width {
  my ($worksheet, $data) = @_;
  my $col = 0;
  for my $width (@$data) {
    $worksheet->set_column($col, $col++, $width);
  }
}
 
sub print_table_header {
  my ($workbook, $worksheet, $table_name, $table_comment) = @_;
  my $format_header = $workbook->addformat();
  $format_header->set_properties(merge => 1, border => 1, bold => 1,
    valign => 'top', align => 'center',
    bg_color => 32, color => 9);
  my $format = $workbook->addformat();
  $format->set_properties(merge => 1, border => 1, valign => 'top', align => 'left');
  my $comment;
  my $index = index($table_comment, ';');
  ($table_comment, $comment) = (substr($table_comment, 0, $index),
    substr($table_comment, $index + 1))
  if $index > -1;
  $worksheet->merge_range('A1:B1', utf16('テーブル名'), $format_header, 1);
  $worksheet->merge_range('C1:E1', utf16($table_name), $format, 1);
  $worksheet->merge_range('F1:H1', utf16($table_comment), $format, 1);
  $worksheet->merge_range('A2:H2', utf16($comment), $format, 1);
  $worksheet->set_row(1, 30);
}
 
sub print_data {
  my ($workbook, $worksheet, $row, $data, $format_hash) = @_;
  my $col = 0;
  my $format_left = $workbook->addformat(%$format_hash);
  my $format = $workbook->addformat(%$format_hash);
  $format->set_properties(bottom => 1, top => 1,
    valign => 'top', align => 'center',
    bg_color => 32, color => 9);
  my $i = 0;
  for my $d (@$data) {
    $worksheet->write_unicode($row, $col++, utf16($d), $format);
    $i++;
  }
}
 
sub print_header {
  my ($workbook, $worksheet, $table) = @_;
  my $table_name = $table->{table_info}->{table_name} || '';
  my $table_comment = $table->{table_info}->{table_comment} || '';
  my $col_width = [4.75, 24.88, 14.5, 10, 7, 7, 15, 57.63];
  my $column_header_data1 = ['No.', '項目名', '(項目名)', '属性', '桁数', 'not null', 'default', '備考'];
  set_width($worksheet, $col_width);
  print_table_header($workbook, $worksheet, $table_name, $table_comment);
  print_data($workbook, $worksheet, 2, $column_header_data1, {bold => 1, border => 1});
}
 
sub print_column_info {
  my ($workbook, $worksheet, $row, $column, $is_last) = @_;
  my ($description, $comment);
  $description = $column->{description} || '';
  my $index = index($description, ';');
  ($description, $comment) = (substr($description, 0, $index),
    substr($description, $index + 1))
  if $index > -1;
  my $format = $workbook->addformat();
  $format->set_properties(bottom => $is_last ? 1 : 4, top => 4, right => 1, left => 1);
  $format->set_align('vjustify');
  my $subtype = ($column->{subtype} > -5) ? $column->{subtype} : '';
  if ($column->{type} eq 'numeric') {
    $subtype = int($subtype / 65536) . ", " . ($subtype % 65536);
  }
  $worksheet->write($row, 0, $column->{no} || '', $format);
  $worksheet->write_unicode($row, 1, utf16($description || ''), $format);
  $worksheet->write($row, 2, $column->{name}, $format);
  $worksheet->write($row, 3, $column->{type} || '', $format);
  $worksheet->write($row, 4, $subtype, $format);
  $worksheet->write_unicode($row, 5, utf16($column->{notnull} ? "○" : ""), $format);
  $worksheet->write_unicode($row, 6, utf16($column->{default} || ''), $format);
  $worksheet->write_unicode($row, 7, utf16($comment || ''), $format);
}
 
sub print_keys_header {
  my ($workbook, $worksheet, $row) = @_;
  my $column_header_data = ['key', 'カラム'];
  print_data($workbook, $worksheet, $row, $column_header_data, {bold => 1, border => 1});
}
 
sub print_key_info {
  my ($workbook, $worksheet, $row, $key, $is_last) = @_;
  my $format = $workbook->addformat();
  $format->set_properties(bottom => $is_last ? 1 : 4, top => 4, right => 1, left => 1);
  $format->set_align('vjustify');
  if ($key->{ftablename}) {
    my $description = "$key->{columnname} -> $key->{ftablename}.$key->{fcolumnname}";
    $worksheet->write($row, 0, 'fk', $format);
    $worksheet->write_unicode($row, 1, utf16($description), $format);
  } else {
    $worksheet->write($row, 0, 'pk', $format);
    $worksheet->write_unicode($row, 1, utf16($key->{columnname}), $format);
  }
}
 
sub write_db_def_info {
  my ($tables_ref, $settings) = @_;
  my $workbook = Spreadsheet::WriteExcel->new($settings->{output});
  for my $table (@$tables_ref) {
    my $worksheet = $workbook->addworksheet($table->{table_info}->{table_name});
    $worksheet->set_landscape();
    $worksheet->fit_to_pages(1, 1);
    print_header($workbook, $worksheet, $table);
    my $columns_ref = $table->{column_infos};
    my $rownum = 3;
    my $i = 0;
    for my $column (@$columns_ref) {
      print_column_info($workbook, $worksheet, $rownum++, $column, scalar(@$columns_ref) - 1 == $i);
      $i++;
    }
    print_keys_header($workbook, $worksheet, $i + 3 + 1);
    my $keys_ref = $table->{key_infos};
    $rownum = 3 + 2 + $i;
    $i = 0;
    for my $key (@$keys_ref) {
      print_key_info($workbook, $worksheet, $rownum++, $key, scalar(@$keys_ref) - 1 == $i);
    }
  }
}
1;

package WriteExcelDbDefInfo; use strict; use warnings; our($VERSION, @ISA, @EXPORT, @EXPORT_OK); require Exporter; use Carp; use Data::Dumper; $VERSION = '0.0001'; @ISA = qw(Exporter); @EXPORT = qw(write_db_def_info); @EXPORT_OK = qw(); use Spreadsheet::WriteExcel; sub utf16 { my $string = shift; use Encode qw(from_to); Encode::from_to($string, "utf8", "utf16"); return $string; } sub set_width { my ($worksheet, $data) = @_; my $col = 0; for my $width (@$data) { $worksheet->set_column($col, $col++, $width); } } sub print_table_header { my ($workbook, $worksheet, $table_name, $table_comment) = @_; my $format_header = $workbook->addformat(); $format_header->set_properties(merge => 1, border => 1, bold => 1, valign => 'top', align => 'center', bg_color => 32, color => 9); my $format = $workbook->addformat(); $format->set_properties(merge => 1, border => 1, valign => 'top', align => 'left'); my $comment; my $index = index($table_comment, ';'); ($table_comment, $comment) = (substr($table_comment, 0, $index), substr($table_comment, $index + 1)) if $index > -1; $worksheet->merge_range('A1:B1', utf16('テーブル名'), $format_header, 1); $worksheet->merge_range('C1:E1', utf16($table_name), $format, 1); $worksheet->merge_range('F1:H1', utf16($table_comment), $format, 1); $worksheet->merge_range('A2:H2', utf16($comment), $format, 1); $worksheet->set_row(1, 30); } sub print_data { my ($workbook, $worksheet, $row, $data, $format_hash) = @_; my $col = 0; my $format_left = $workbook->addformat(%$format_hash); my $format = $workbook->addformat(%$format_hash); $format->set_properties(bottom => 1, top => 1, valign => 'top', align => 'center', bg_color => 32, color => 9); my $i = 0; for my $d (@$data) { $worksheet->write_unicode($row, $col++, utf16($d), $format); $i++; } } sub print_header { my ($workbook, $worksheet, $table) = @_; my $table_name = $table->{table_info}->{table_name} || ''; my $table_comment = $table->{table_info}->{table_comment} || ''; my $col_width = [4.75, 24.88, 14.5, 10, 7, 7, 15, 57.63]; my $column_header_data1 = ['No.', '項目名', '(項目名)', '属性', '桁数', 'not null', 'default', '備考']; set_width($worksheet, $col_width); print_table_header($workbook, $worksheet, $table_name, $table_comment); print_data($workbook, $worksheet, 2, $column_header_data1, {bold => 1, border => 1}); } sub print_column_info { my ($workbook, $worksheet, $row, $column, $is_last) = @_; my ($description, $comment); $description = $column->{description} || ''; my $index = index($description, ';'); ($description, $comment) = (substr($description, 0, $index), substr($description, $index + 1)) if $index > -1; my $format = $workbook->addformat(); $format->set_properties(bottom => $is_last ? 1 : 4, top => 4, right => 1, left => 1); $format->set_align('vjustify'); my $subtype = ($column->{subtype} > -5) ? $column->{subtype} : ''; if ($column->{type} eq 'numeric') { $subtype = int($subtype / 65536) . ", " . ($subtype % 65536); } $worksheet->write($row, 0, $column->{no} || '', $format); $worksheet->write_unicode($row, 1, utf16($description || ''), $format); $worksheet->write($row, 2, $column->{name}, $format); $worksheet->write($row, 3, $column->{type} || '', $format); $worksheet->write($row, 4, $subtype, $format); $worksheet->write_unicode($row, 5, utf16($column->{notnull} ? "○" : ""), $format); $worksheet->write_unicode($row, 6, utf16($column->{default} || ''), $format); $worksheet->write_unicode($row, 7, utf16($comment || ''), $format); } sub print_keys_header { my ($workbook, $worksheet, $row) = @_; my $column_header_data = ['key', 'カラム']; print_data($workbook, $worksheet, $row, $column_header_data, {bold => 1, border => 1}); } sub print_key_info { my ($workbook, $worksheet, $row, $key, $is_last) = @_; my $format = $workbook->addformat(); $format->set_properties(bottom => $is_last ? 1 : 4, top => 4, right => 1, left => 1); $format->set_align('vjustify'); if ($key->{ftablename}) { my $description = "$key->{columnname} -> $key->{ftablename}.$key->{fcolumnname}"; $worksheet->write($row, 0, 'fk', $format); $worksheet->write_unicode($row, 1, utf16($description), $format); } else { $worksheet->write($row, 0, 'pk', $format); $worksheet->write_unicode($row, 1, utf16($key->{columnname}), $format); } } sub write_db_def_info { my ($tables_ref, $settings) = @_; my $workbook = Spreadsheet::WriteExcel->new($settings->{output}); for my $table (@$tables_ref) { my $worksheet = $workbook->addworksheet($table->{table_info}->{table_name}); $worksheet->set_landscape(); $worksheet->fit_to_pages(1, 1); print_header($workbook, $worksheet, $table); my $columns_ref = $table->{column_infos}; my $rownum = 3; my $i = 0; for my $column (@$columns_ref) { print_column_info($workbook, $worksheet, $rownum++, $column, scalar(@$columns_ref) - 1 == $i); $i++; } print_keys_header($workbook, $worksheet, $i + 3 + 1); my $keys_ref = $table->{key_infos}; $rownum = 3 + 2 + $i; $i = 0; for my $key (@$keys_ref) { print_key_info($workbook, $worksheet, $rownum++, $key, scalar(@$keys_ref) - 1 == $i); } } } 1;

続く

Posted in perl, PostgreSQL | Leave a comment |
Next Page »

Pages

  • Profile

Archives

  • November 2019
  • September 2019
  • May 2019
  • September 2018
  • August 2018
  • March 2018
  • May 2015
  • February 2015
  • January 2015
  • December 2014
  • November 2014
  • October 2014
  • September 2014
  • April 2014
  • November 2013
  • October 2013
  • July 2013
  • April 2013
  • March 2013
  • February 2013
  • January 2013
  • December 2012
  • November 2012
  • October 2012
  • September 2012
  • August 2012
  • July 2012
  • June 2012
  • May 2012
  • April 2012
  • March 2012
  • February 2012
  • January 2012
  • December 2011
  • November 2011
  • October 2011
  • September 2011
  • August 2011
  • July 2011
  • June 2011
  • May 2011
  • April 2011
  • March 2011
  • February 2011
  • January 2011
  • December 2010
  • November 2010
  • October 2010
  • September 2010
  • August 2010
  • July 2010
  • June 2010
  • May 2010
  • April 2010
  • March 2010
  • February 2010
  • January 2010
  • December 2009
  • November 2009
  • October 2009
  • August 2009
  • July 2009
  • June 2009
  • May 2009
  • April 2009
  • March 2009
  • January 2009
  • December 2008
  • November 2008
  • October 2008
  • September 2008
  • August 2008
  • July 2008
  • June 2008
  • May 2008
  • April 2008
  • March 2008
  • February 2008
  • January 2008
  • December 2007
  • November 2007
  • October 2007
  • September 2007
  • August 2007
  • July 2007
  • June 2007
  • May 2007
  • April 2007
  • March 2007
  • February 2007
  • January 2007
  • December 2006
  • July 2006

Categories

  • android (35)
  • apache (1)
  • bison (1)
  • BTS (18)
  • c# (23)
  • cgi (1)
  • chrome (9)
  • chromeextention (18)
  • clclcl (9)
  • clojure (13)
  • cloudbug1 (2)
  • css (4)
  • cygwin (7)
  • C言語 (21)
  • dart (1)
  • docker (1)
  • dotnet (11)
    • vb.net (2)
  • e-hash.jp (1)
  • eclipse (2)
  • emacs (10)
  • excel (1)
  • flex (1)
  • framework (11)
  • free (94)
  • gae (4)
  • gcc (4)
  • gimmehash.in (1)
  • glipper (3)
  • golang (7)
  • howm (1)
  • html (3)
  • ikushipe (1)
  • java (47)
  • JavaScript (29)
  • linux (17)
  • lisp (92)
  • lua (34)
  • luatinycgi (2)
  • mba (1)
  • Meadow (4)
  • memo (1)
  • music (5)
  • mysql (2)
  • neta (5)
  • node (2)
  • O/Rマッピングツール (4)
  • obj-c (6)
  • OOP (6)
  • oracle (1)
  • perl (49)
  • php (38)
    • CakePHP2 (2)
  • PostgreSQL (8)
  • PowerShell (1)
  • putty (1)
  • python (14)
  • redmine (2)
  • ruby (7)
  • s3 (1)
  • sakura (5)
  • screen (1)
  • Selenium (1)
  • SF (1)
  • SKK (4)
  • slime (6)
  • sql (8)
  • sqlite3 (4)
  • starbug1 (179)
  • tthttpd (3)
  • twitter (8)
  • ubuntu (14)
  • Uncategorized (4)
  • unix (14)
  • unkode-mania (5)
  • vba (3)
  • vim (24)
  • w3m (1)
  • Windows (18)
  • wordpress (1)
  • zsh (6)
  • 愚痴 (1)

WordPress

  • Log in
  • WordPress

Subscribe

  • Entries (RSS)
  • Comments (RSS)

Pages

  • Profile

Archives

  • November 2019
  • September 2019
  • May 2019
  • September 2018
  • August 2018
  • March 2018
  • May 2015
  • February 2015
  • January 2015
  • December 2014
  • November 2014
  • October 2014
  • September 2014
  • April 2014
  • November 2013
  • October 2013
  • July 2013
  • April 2013
  • March 2013
  • February 2013
  • January 2013
  • December 2012
  • November 2012
  • October 2012
  • September 2012
  • August 2012
  • July 2012
  • June 2012
  • May 2012
  • April 2012
  • March 2012
  • February 2012
  • January 2012
  • December 2011
  • November 2011
  • October 2011
  • September 2011
  • August 2011
  • July 2011
  • June 2011
  • May 2011
  • April 2011
  • March 2011
  • February 2011
  • January 2011
  • December 2010
  • November 2010
  • October 2010
  • September 2010
  • August 2010
  • July 2010
  • June 2010
  • May 2010
  • April 2010
  • March 2010
  • February 2010
  • January 2010
  • December 2009
  • November 2009
  • October 2009
  • August 2009
  • July 2009
  • June 2009
  • May 2009
  • April 2009
  • March 2009
  • January 2009
  • December 2008
  • November 2008
  • October 2008
  • September 2008
  • August 2008
  • July 2008
  • June 2008
  • May 2008
  • April 2008
  • March 2008
  • February 2008
  • January 2008
  • December 2007
  • November 2007
  • October 2007
  • September 2007
  • August 2007
  • July 2007
  • June 2007
  • May 2007
  • April 2007
  • March 2007
  • February 2007
  • January 2007
  • December 2006
  • July 2006

Categories

  • android (35)
  • apache (1)
  • bison (1)
  • BTS (18)
  • c# (23)
  • cgi (1)
  • chrome (9)
  • chromeextention (18)
  • clclcl (9)
  • clojure (13)
  • cloudbug1 (2)
  • css (4)
  • cygwin (7)
  • C言語 (21)
  • dart (1)
  • docker (1)
  • dotnet (11)
    • vb.net (2)
  • e-hash.jp (1)
  • eclipse (2)
  • emacs (10)
  • excel (1)
  • flex (1)
  • framework (11)
  • free (94)
  • gae (4)
  • gcc (4)
  • gimmehash.in (1)
  • glipper (3)
  • golang (7)
  • howm (1)
  • html (3)
  • ikushipe (1)
  • java (47)
  • JavaScript (29)
  • linux (17)
  • lisp (92)
  • lua (34)
  • luatinycgi (2)
  • mba (1)
  • Meadow (4)
  • memo (1)
  • music (5)
  • mysql (2)
  • neta (5)
  • node (2)
  • O/Rマッピングツール (4)
  • obj-c (6)
  • OOP (6)
  • oracle (1)
  • perl (49)
  • php (38)
    • CakePHP2 (2)
  • PostgreSQL (8)
  • PowerShell (1)
  • putty (1)
  • python (14)
  • redmine (2)
  • ruby (7)
  • s3 (1)
  • sakura (5)
  • screen (1)
  • Selenium (1)
  • SF (1)
  • SKK (4)
  • slime (6)
  • sql (8)
  • sqlite3 (4)
  • starbug1 (179)
  • tthttpd (3)
  • twitter (8)
  • ubuntu (14)
  • Uncategorized (4)
  • unix (14)
  • unkode-mania (5)
  • vba (3)
  • vim (24)
  • w3m (1)
  • Windows (18)
  • wordpress (1)
  • zsh (6)
  • 愚痴 (1)

WordPress

  • Log in
  • WordPress

CyberChimps WordPress Themes

© 週記くらい@やーづ

With Google+ plugin by Geoff Janes