PL/SQL に対応する

PL/SQL用に処理を変更しなければいけないのは、
・「--」〜は単一行コメント
・「'」〜「'」は文字列
・「"」〜「"」は識別子
などである。

SourceToHtml16.plx


use strict;
use Getopt::Std; # オプション解析用
#******************************************************************************
# C#, C++, Java, JavaScript, VB, Delphi, PL/SQL → HTML 変換処理
#******************************************************************************
# ヘッダ部
fileCopy(".\\Template\\header.txt");

# 言語種別の取得
my %langType;
my $langType;
getLangType();

# 演算子の取得
my $operators = "";
getOperators();

# 予約語の取得
my %keywords = ();
getKeywords();

# ソース部の変換
my $state = "その他";
my $kind = "";
my $line = "";
putLine() while ($line = getLine());

# フッタ部
fileCopy(".\\Template\\footer.txt");

#==============================================================================
# 言語種別の取得
#==============================================================================
sub getLangType
{
getopts('l:',\%langType);
$langType = lc($langType{'l'});

if (
($langType ne 'cs7')
&& ($langType ne 'vc7')
&& ($langType ne 'bcb')
&& ($langType ne 'java')
&& ($langType ne 'js')
&& ($langType ne 'vb7')
&& ($langType ne 'del')
&& ($langType ne 'psq')
)
{
$langType = 'xxx';
}
}
#==============================================================================
# 演算子の取得
#==============================================================================
sub getOperators
{
return if ($langType eq 'xxx');

open(F, ".\\$langType\\ope.txt") || die "open: $!";
$operators = <F>;
close(F);
}
#==============================================================================
# 予約語の取得
#==============================================================================
sub getKeywords
{
return if ($langType eq 'xxx');

open(F, ".\\$langType\\key.txt") || die "open: $!";
while (<F>)
{
chomp;

my $keyWord = $_;
if (
($langType eq 'vb7')
|| ($langType eq 'del')
|| ($langType eq 'psq')
)
{
$keyWord = lc($_);
}

$keywords{$keyWord} = $_;
};
close(F);
}
#==============================================================================
# テンプレートファイルのコピー
#==============================================================================
sub fileCopy
{
my ($fileName) = @_;

open(F, $fileName) || die "open: $!";
print while (<F>);
close(F);
}
#==============================================================================
# 1行ずつ読み込む
#==============================================================================
sub getLine
{
# 1行読み込む
$_ = <>;

# TABを空白に変換
my $pos;
my $num;
while(($pos = index($_, "\t")) >= 0) #TABがあるか
{
$num = 4 - ($pos % 4); #空白何文字分に置き換えればよいか
$_ = substr($_,0,$pos).(' ' x $num).substr($_,$pos+1); #空白に置き換え
}

# 行末の空白を削除
s/ +$//;

# 変換結果を返す
return $_;
}
#==============================================================================
# 1行ずつ書き込む
#==============================================================================
sub putLine
{
# 改行コードを取り除く
chomp($line);

while(length($line))
{
if ($state eq "その他")
{
if ($langType->isDirective ()) { $langType->stateDirective(); } # ディレクティブ
elsif ($langType->isComSingle ()) { $langType->stateComSingle(); } # 単一行コメント
elsif ($langType->isComMulti ()) { $langType->stateComMulti(); } # 複数行コメント
elsif ($langType->isComMulti2 ()) { $langType->stateComMulti2(); } # 複数行コメント その2
elsif ($langType->isStringLit ()) { $langType->stateStringLit(); } # 逐語的文字列
elsif ($langType->isString ()) { $langType->stateString(); } # 文字列
elsif ($langType->isChar ()) { $langType->stateChar(); } # 文字
elsif ($langType->isNumber ()) { $langType->stateNumber(); } # 数字
elsif ($langType->isIdent ()) { $langType->stateIdent(); } # 識別子・予約語
elsif ($langType->isSpace ()) { $langType->stateSpace(); } # 空白
elsif ($langType->isIdentEsc ()) { $langType->stateIdentEsc(); } # エスケープされた識別子
elsif ($langType->isDate ()) { $langType->stateDate(); } # 日付
else { $langType->stateOther(); } # 記号・演算子・その他
}
elsif ($state eq "複数行コメント") { $langType->stateComMulti(); }
elsif ($state eq "複数行コメント2") { $langType->stateComMulti2(); }
elsif ($state eq "逐語的文字列") { $langType->stateStringLit(); }
}

# 改行
main::putToken("\n", $state);
}
#==============================================================================
# トークンを書き込む
#==============================================================================
sub putToken
{
$_ = shift; #追加する文字列
my $kind_next = shift; #追加するトークンの種類

# トークンの種類が変わったら、書き込む
if ($kind ne $kind_next)
{
print "</SPAN>" unless (($kind eq "その他") || ($kind eq ""));

if ($kind_next eq "複数行コメント") { print "<SPAN CLASS=\"COM\">"; }
elsif ($kind_next eq "単一行コメント") { print "<SPAN CLASS=\"COM\">"; }
elsif ($kind_next eq "逐語的文字列") { print "<SPAN CLASS=\"STR\">"; }
elsif ($kind_next eq "文字列") { print "<SPAN CLASS=\"STR\">"; }
elsif ($kind_next eq "文字") { print "<SPAN CLASS=\"CHA\">"; }
elsif ($kind_next eq "識別子") { print "<SPAN CLASS=\"IDW\">"; }
elsif ($kind_next eq "数字") { print "<SPAN CLASS=\"NUM\">"; }
elsif ($kind_next eq "記号") { print "<SPAN CLASS=\"DLM\">"; }
elsif ($kind_next eq "演算子") { print "<SPAN CLASS=\"OPE\">"; }
elsif ($kind_next eq "予約語") { print "<SPAN CLASS=\"KEY\">"; }
elsif ($kind_next eq "ディレクティブ") { print "<SPAN CLASS=\"DIR\">"; }
elsif ($kind_next eq "日付") { print "<SPAN CLASS=\"STR\">"; }
elsif ($kind_next eq "エスケープされた識別子") { print "<SPAN CLASS=\"IDW\">"; }
}
$kind = $kind_next;

# <, >, &, |, (, ) を置換
s/&/&#x26;/g; # &
s/</&#x3C;/g; # <
s/>/&#x3E;/g; # >
s/\(/&#x28;/g; # ( はてな
s/\)/&#x29;/g; # ) はてな
s/\|/&#x7C;/g; # | はてな

print $_;
}
#******************************************************************************
# 全言語 共通処理
#******************************************************************************
{
package allLanguage;
#--------------------------------------------------------------------------
# 文字種を判定する
#--------------------------------------------------------------------------
sub isComSingle { return 0 ; } # 単一行コメント
sub isComMulti { return ($line =~ /^\/\*/) ; } # 複数行コメント
sub isComMulti2 { return 0 ; } # 複数行コメント その2
sub isStringLit { return 0 ; } # 逐語的文字列
sub isString { return ($line =~ /^"/) ; } # 文字列
sub isChar { return 0 ; } # 文字
sub isNumber { return ($line =~ /^\d/) ; } # 数字
sub isIdent { return ($line =~ /^\w/) ; } # 識別子・予約語
sub isDirective { return 0 ; } # ディレクティブ
sub isSpace { return ($line =~ /^s/) ; } # 空白
sub isDate { return 0 ; } # 日付
sub isIdentEsc { return 0 ; } # エスケープされた識別子
#--------------------------------------------------------------------------
# 単一行コメント
#--------------------------------------------------------------------------
sub stateComSingle
{
main::putToken($line, "単一行コメント");
$line = "";
}
#--------------------------------------------------------------------------
# 複数行コメント
#--------------------------------------------------------------------------
sub stateComMulti
{
if ($state eq "その他")
{
$line =~ /^\/\*/;
$state = "複数行コメント";
main::putToken($&, $state);
$line = $';
}

if ($line =~ /^.*\*\//) # 終了があるか?
{
main::putToken($&, $state);
$line = $';
$state = "その他";
}
else
{
main::putToken($line, $state);
$line = "";
}
}
#--------------------------------------------------------------------------
# 逐語的文字列
#--------------------------------------------------------------------------
sub stateStringLit {}
#--------------------------------------------------------------------------
# 文字列
#--------------------------------------------------------------------------
sub stateString
{
if ($line =~ /^"([^"\\]|\\.)*"/)
{
main::putToken($&, "文字列");
$line = $';
}
else
{
main::putToken($line, "文字列");
$line = "";
}
}
#--------------------------------------------------------------------------
# 文字
#--------------------------------------------------------------------------
sub stateChar {}
#--------------------------------------------------------------------------
# 数字
#--------------------------------------------------------------------------
sub stateNumber
{
if (
($line =~ /^[0-9]+(\.[0-9]+)?e[+-]?[0-9]+[A-Z]*/i) #99e99
|| ($line =~ /^[0-9]+\.[0-9]+[A-Z]*/i) #99.99
|| ($line =~ /^0X[0-9A-F]+[A-Z]*/i) #0x99
|| ($line =~ /^[0-9]+[A-Z]*/i) #99
)
{
main::putToken($&, "数字");
$line = $';
}
}
#--------------------------------------------------------------------------
# 識別子・予約語
#--------------------------------------------------------------------------
sub stateIdent
{
$line =~ /^\w+/;

my $keyword = $keywords{$&};
($keyword) ? ($state = "予約語") : ($state = "識別子");

main::putToken($&, $state);
$line = $';
$state = "その他";
}
#--------------------------------------------------------------------------
# ディレクティブ
#--------------------------------------------------------------------------
sub stateDirective {}
#--------------------------------------------------------------------------
# 空白
#--------------------------------------------------------------------------
sub stateSpace
{
$line =~ /^\s+/;
main::putToken($&, "その他");
$line = $';
}
#--------------------------------------------------------------------------
# エスケープされた識別子
#--------------------------------------------------------------------------
sub stateIdentEsc {}
#--------------------------------------------------------------------------
# 日付
#--------------------------------------------------------------------------
sub stateDate {}
#--------------------------------------------------------------------------
# 記号・演算子・その他
#--------------------------------------------------------------------------
sub stateOther
{
$line =~ /./;

if (length($&) == 2) #2byte文字
{
$state = "識別子";
}
else
{
(index($operators, $&) < 0) ? ($state = "記号") : ($state = "演算子");
}

main::putToken($&, $state);
$line = $';
$state = "その他";
}
}
#******************************************************************************
# C#, C++, Java, JavaScript 共通処理
#******************************************************************************
{
package CFamily;
use base qw(allLanguage);
#--------------------------------------------------------------------------
# 文字種を判定する
#--------------------------------------------------------------------------
sub isComSingle { return ($line =~ /^\/\//) ; } # 単一行コメント
sub isChar { return ($line =~ /^'/) ; } # 文字
sub isDirective { return ($line =~ /^#/) ; } # ディレクティブ
#--------------------------------------------------------------------------
# 文字
#--------------------------------------------------------------------------
sub stateChar
{
if ($line =~ /^'([^'\\]|\\.)*'/)
{
main::putToken($&, "文字");
$line = $';
}
else
{
main::putToken($line, "文字");
$line = "";
}
}
#--------------------------------------------------------------------------
# ディレクティブ
#--------------------------------------------------------------------------
sub stateDirective
{
$line =~ /^#[A-Za-z]+/;
main::putToken($&, "ディレクティブ");
$line = $';
}
}
#******************************************************************************
# C# 専用処理
#******************************************************************************
{
package cs7;
use base qw(CFamily);
#--------------------------------------------------------------------------
# 文字種を判定する
#--------------------------------------------------------------------------
sub isStringLit { return ($line =~ /^@"/) ; } # 逐語的文字列
#--------------------------------------------------------------------------
# 逐語的文字列
#--------------------------------------------------------------------------
sub stateStringLit
{
if ($state eq "その他")
{
$line =~ /^@"/;
$state = "逐語的文字列";
main::putToken($&, $state);
$line = $';
}

if ($line =~ /^(""|[^"])*"/) # 終了があるか?
{
main::putToken($&, $state);
$line = $';
$state = "その他";
}
else
{
main::putToken($line, $state);
$line = "";
}
}
}
#******************************************************************************
# VC++ 専用処理
#******************************************************************************
{
package vc7;
use base qw(CFamily);
}
#******************************************************************************
# C++Builder 専用処理
#******************************************************************************
{
package bcb;
use base qw(CFamily);
}
#******************************************************************************
# Java 専用処理
#******************************************************************************
{
package java;
use base qw(CFamily);
}
#******************************************************************************
# JavaScript 専用処理
#******************************************************************************
{
package js;
use base qw(CFamily);
}
#******************************************************************************
# 大文字・小文字を意識しない言語 専用処理
#******************************************************************************
{
package NoCase;
use base qw(allLanguage);
#--------------------------------------------------------------------------
# 識別子
#--------------------------------------------------------------------------
sub stateIdent
{
$line =~ /^\w+/;

my $keyword = $keywords{lc($&)};
($keyword) ? (main::putToken($keyword, "予約語")) : (main::putToken($&, "識別子"));

$line = $';
$state = "その他";
}
}
#******************************************************************************
# VB.NET 専用処理
#******************************************************************************
{
package vb7;
use base qw(NoCase);
#--------------------------------------------------------------------------
# 文字種を判定する
#--------------------------------------------------------------------------
sub isComSingle { return ($line =~ /^'/) ; } # 単一行コメント
sub isComMulti { return 0 ; } # 複数行コメント
sub isStringLit { return ($line =~ /^"/) ; } # 逐語的文字列
sub isString { return 0 ; } # 文字列
sub isNumber { return ($line =~ /^(\d|&h|&o)/i) ; } # 数字
sub isDate { return ($line =~ /^#[^'"]+#/) ; } # 日付
sub isIdentEsc { return ($line =~ /^\[/) ; } # エスケープされた識別子
#--------------------------------------------------------------------------
# 逐語的文字列
#--------------------------------------------------------------------------
sub stateStringLit
{
if ($line =~ /^"(""|[^"])*"/) # 終了があるか?
{
main::putToken($&, "逐語的文字列");
$line = $';
}
else
{
main::putToken($line, "逐語的文字列");
$line = "";
}
}
#--------------------------------------------------------------------------
# 数字
#--------------------------------------------------------------------------
sub stateNumber
{
if (
($line =~ /^[0-9]+(\.[0-9]+)?e[+-]?[0-9]+[A-Z]*/i) #99e99
|| ($line =~ /^[0-9]+\.[0-9]+[A-Z]*/i) #99.99
|| ($line =~ /^&H[0-9A-F]+[A-Z]*/i) #&h99
|| ($line =~ /^&O[0-9A-F]+[A-Z]*/i) #&o99
|| ($line =~ /^[0-9]+[A-Z]*/i) #99
)
{
main::putToken($&, "数字");
$line = $';
}
}
#--------------------------------------------------------------------------
# 日付
#--------------------------------------------------------------------------
sub stateDate
{
if ($line =~ /^#[^'"]+#/) # 終了があるか?
{
main::putToken($&, "日付");
$line = $';
}
}
#--------------------------------------------------------------------------
# エスケープされた識別子
#--------------------------------------------------------------------------
sub stateIdentEsc
{
if ($line =~ /^\[.+\]/) # 終了があるか?
{
main::putToken($&, "エスケープされた識別子");
$line = $';
}
else
{
main::putToken($&, "エスケープされた識別子");
$line = '';
}
}
}
#******************************************************************************
# Delphi 専用処理
#******************************************************************************
{
package del;
use base qw(NoCase);
#--------------------------------------------------------------------------
# 文字種を判定する
#--------------------------------------------------------------------------
sub isComSingle { return ($line =~ /^\/\//) ; } # 単一行コメント
sub isComMulti { return ($line =~ /^\(\*/) ; } # 複数行コメント
sub isComMulti2 { return ($line =~ /^\{/) ; } # 複数行コメント その2
sub isStringLit { return ($line =~ /^'/) ; } # 逐語的文字列
sub isString { return 0 ; } # 文字列
sub isChar { return ($line =~ /^#(\d|\$[a-f\d])/i) ; } # 文字
sub isNumber { return ($line =~ /^(\d|\$[a-f\d])/i) ; } # 数字
sub isDirective { return ($line =~ /^\{\$/) ; } # ディレクティブ
#--------------------------------------------------------------------------
# 複数行コメント
#--------------------------------------------------------------------------
sub stateComMulti
{
if ($state eq "その他")
{
$line =~ /^\(\*/;
$state = "複数行コメント";
main::putToken($&, $state);
$line = $';
}

if ($line =~ /^.*\*\)/) # 終了があるか?
{
main::putToken($&, $state);
$line = $';
$state = "その他";
}
else
{
main::putToken($line, $state);
$line = "";
}
}
#--------------------------------------------------------------------------
# 複数行コメント その2
#--------------------------------------------------------------------------
sub stateComMulti2
{
if ($state eq "その他")
{
$line =~ /^\{/;
$state = "複数行コメント2";
main::putToken($&, "複数行コメント");
$line = $';
}

if ($line =~ /^.*\}/) # 終了があるか?
{
main::putToken($&, "複数行コメント");
$line = $';
$state = "その他";
}
else
{
main::putToken($line, "複数行コメント");
$line = "";
}
}
#--------------------------------------------------------------------------
# 逐語的文字列
#--------------------------------------------------------------------------
sub stateStringLit
{
if ($line =~ /^'(''|[^'])*'/) # 終了があるか?
{
main::putToken($&, "逐語的文字列");
$line = $';
}
else
{
main::putToken($line, "逐語的文字列");
$line = "";
}
}
#--------------------------------------------------------------------------
# 文字
#--------------------------------------------------------------------------
sub stateChar
{
if (
($line =~ /^#\$[0-9A-F]+/i) # #$99
|| ($line =~ /^#[0-9]+/i) # #99
)
{
main::putToken($&, "文字");
$line = $';
}
}
#--------------------------------------------------------------------------
# 数字
#--------------------------------------------------------------------------
sub stateNumber
{
if (
($line =~ /^[0-9]+(\.[0-9]+)?e[+-]?[0-9]+/i) #99e99
|| ($line =~ /^[0-9]+\.[0-9]+/i) #99.99
|| ($line =~ /^\$[0-9A-F]+/i) #$99
|| ($line =~ /^[0-9]+/i) #99
)
{
main::putToken($&, "数字");
$line = $';
}
}
#--------------------------------------------------------------------------
# ディレクティブ
#--------------------------------------------------------------------------
sub stateDirective
{
$line =~ /^\{\$.*\}/;
main::putToken($&, "ディレクティブ");
$line = $';
}
}
#******************************************************************************
# PL/SQL 専用処理
#******************************************************************************
{
package psq;
use base qw(NoCase);
#--------------------------------------------------------------------------
# 文字種を判定する
#--------------------------------------------------------------------------
sub isComSingle { return ($line =~ /^\-\-/) ; } # 単一行コメント
sub isStringLit { return ($line =~ /^'/) ; } # 逐語的文字列
sub isString { return 0 ; } # 文字列
sub isIdentEsc { return ($line =~ /^"/) ; } # エスケープされた識別子
#--------------------------------------------------------------------------
# 逐語的文字列
#--------------------------------------------------------------------------
sub stateStringLit
{
if ($line =~ /^'(''|[^'])*'/) # 終了があるか?
{
main::putToken($&, "逐語的文字列");
$line = $';
}
else
{
main::putToken($line, "逐語的文字列");
$line = "";
}
}
#--------------------------------------------------------------------------
# 数字
#--------------------------------------------------------------------------
sub stateNumber
{
if (
($line =~ /^[0-9]+(\.[0-9]+)?e[+-]?[0-9]+/i) #99e99
|| ($line =~ /^[0-9]+\.[0-9]+/i) #99.99
|| ($line =~ /^[0-9]+/i) #99
)
{
main::putToken($&, "数字");
$line = $';
}
}
#--------------------------------------------------------------------------
# エスケープされた識別子
#--------------------------------------------------------------------------
sub stateIdentEsc
{
if ($line =~ /^"(""|[^"])*"/) # 終了があるか?
{
main::putToken($&, "エスケープされた識別子");
$line = $';
}
else
{
main::putToken($line, "エスケープされた識別子");
$line = "";
}
}
}
#******************************************************************************
# その他の言語用処理
#******************************************************************************
{
package xxx;
use base qw(allLanguage);
#--------------------------------------------------------------------------
# 文字種を判定する
#--------------------------------------------------------------------------
sub isComMulti { return 0 ; } # 複数行コメント
sub isString { return 0 ; } # 文字列
sub isNumber { return 0 ; } # 数字
sub isIdent { return 0 ; } # 識別子・予約語
#--------------------------------------------------------------------------
# その他
#--------------------------------------------------------------------------
sub stateOther
{
$line =~ /./;
main::putToken($&, "その他");
$line = $';
}
}

実行形式


C:\Perl5>jperl SourceToHtml16.plx -l psq input.sql > output.html