パッケージ化したサブルーチン
0001: package IBCommon;
0002: use 5.006_001;
0003: use strict;
0004: use IBPerl;
0005:
0006: our (@ISA, @EXPORT);
0007: use Exporter();
0008: @ISA = qw(Exporter);
0009: @EXPORT = qw(
0010: connectDB
0011: disconnectDB
0012: startTransaction
0013: commitTransaction
0014: checkSelect
0015: checkInsert
0016: checkInsertUpdate
0017: insertData
0018: updateData
0019: selectRows
0020: selectRowsLike
0021: selectOneLine
0022: deleteRows
0023: execProcedure
0024: );
0025:
0026: # subroutine ######################################################
0027: # DB 接続
0028: # 引数 $p_db : データベースハンドラへのポインタ
0029: # $dbpath : データベースへのパス(文字列)
0030: # $user : ユーザ名(文字列)
0031: # $password : パスワード(文字列)
0032: # $chaeset : CharacterSet(文字列)
0033: # 返値 データベースハンドラへのポインタ
0034: # エラー STDERRにメッセージを書いてexit(1)
0035: #
0036: sub connectDB
0037: {
0038: my($p_db, $dbpath, $user, $password, $charset)=@_;
0039: $$p_db=IBPerl::Connection->new(Path=>$dbpath,
0040: User=>$user,
0041: Password=>$password,
0042: Charset=>$charset,
0043: Dialect=>3);
0044: if ($$p_db->{Handle}<0){
0045: print(STDERR "connectDB: $$p_db->{Handle} $$p_db->{Error}\n");
0046: exit(1);
0047: }
0048: }
0049:
0050: # subroutine ######################################################
0051: # DB 切断
0052: # 引数 $p_db : データベースハンドラへのポインタ
0053: # 返値 データベースハンドラへのポインタ
0054: # エラー STDERRにメッセージを書いてexit(1)
0055: #
0056: sub disconnectDB
0057: {
0058: my($p_db)=@_;
0059: if ($$p_db->disconnect()<0){
0060: print(STDERR "disconnectDB: $$p_db->{Handle} $$p_db->{Error}\n");
0061: exit(1);
0062: }
0063: }
0064:
0065: # subroutine ######################################################
0066: # Transaction 開始
0067: # 引数 $p_db : データベースハンドラへのポインタ
0068: # $p_trans : トランザクションハンドラへのポインタ
0069: # 返値 トランザクションハンドラへのポインタ
0070: # エラー STDERRにメッセージを書いてexit(1)
0071: #
0072: sub startTransaction
0073: {
0074: my($p_db, $p_trans)=@_;
0075: $$p_trans=IBPerl::Transaction->new(Database=>$$p_db);
0076: if ($$p_trans->{Handle}<0){
0077: print(STDERR "startTransaction: $$p_trans->{Handle} $$p_db->{Error}\n");
0078: exit(1);
0079: }
0080: }
0081:
0082: # subroutine ######################################################
0083: # Transaction コミット
0084: # 引数 $p_trans : トランザクションハンドラへのポインタ
0085: # 返値 トランザクションハンドラへのポインタ
0086: # エラー STDERRにメッセージを書いてexit(1)
0087: #
0088: sub commitTransaction
0089: {
0090: my($p_trans)=@_;
0091: if ($$p_trans->commit()<0){
0092: print(STDERR "commitTransaction: $$p_trans->{Handle}\n");
0093: exit(1);
0094: }
0095: }
0096:
0097: # subroutine ######################################################
0098: # Transaction ロールバック
0099: # 引数 $p_trans : トランザクションハンドラへのポインタ
0100: # 返値 トランザクションハンドラへのポインタ
0101: # エラー STDERRにメッセージを書いてexit(1)
0102: #
0103: sub rollbackTransaction
0104: {
0105: my($p_trans)=@_;
0106: if ($$p_trans->rollback()<0){
0107: print(STDERR "rollbackTransaction: $$p_trans->{Handle}\n");
0108: exit(1);
0109: }
0110: }
0111:
0112: # subroutine ######################################################
0113: # 行の存在チェック
0114: # 引数 $p_trans : トランザクションハンドラへのポインタ
0115: # $p_tbl : テーブル名(文字列)へのポインタ
0116: # $p_khash : キー名=>キー値のハッシュへのポインタ
0117: # $p_option : SQL文のオプション(文字列)へのポインタ
0118: # $p_sql : SQL を返すポインタ
0119: # 返値 存在すれば 1
0120: # 存在しなければ 0
0121: #
0122: sub checkSelect
0123: {
0124: my($p_trans, $p_tbl, $p_khash, $p_option, $p_sql)=@_;
0125: my($sql)="SELECT * FROM $$p_tbl WHERE ";
0126: for (keys %$p_khash){
0127: $sql.="$_='" . $p_khash->{$_} . "' AND ";
0128: }
0129: $sql=~s/ AND $//;
0130: $sql.=" ".$$p_option if ($p_option);
0131: $$p_sql=$sql if ($p_sql);
0132: my($st)=IBPerl::Statement->new(Transaction=>$$p_trans, SQL=>$sql);
0133: my(%hash);
0134: $st->fetch(\%hash);
0135: return((%hash==0)?0:1);
0136: }
0137:
0138: # subroutine ######################################################
0139: # 行の追加
0140: # 行の存在をチェックし、存在しなければ新規に追加する
0141: # 引数 $p_trans : トランザクションハンドラへのポインタ
0142: # $p_tbl : テーブル名(文字列)へのポインタ
0143: # $p_khash : キー名=>キー値のハッシュへのポインタ
0144: # $p_vhash : カラム名=>値のハッシュへのポインタ
0145: # $p_option : SQL文のオプション(文字列)へのポインタ
0146: # $p_sql : SQL文 を返すポインタ
0147: # 返値 INSERT すれば 1
0148: # スキップすれば 0
0149: # エラー STDERRにメッセージを書いてexit(1)
0150: #
0151: sub checkInsert
0152: {
0153: my($p_trans, $p_tbl, $p_khash, $p_vhash, $p_option, $p_sql)=@_;
0154: my($sql)="SELECT * FROM $$p_tbl WHERE ";
0155: for (keys %$p_khash){
0156: $sql.="$_='" . $p_khash->{$_} . "' AND ";
0157: }
0158: $sql=~s/ AND $//;
0159: $sql.=$$p_option if ($p_option);
0160: $$p_sql=$sql if ($p_sql);
0161: my($st)=IBPerl::Statement->new(Transaction=>$$p_trans, SQL=>$sql);
0162: my(%hash);
0163: $st->fetch(\%hash);
0164: if (%hash){
0165: # 存在する
0166: return(0);
0167: }else{
0168: # 存在しない
0169: my($sql)="INSERT INTO $$p_tbl(";
0170: for (keys %$p_vhash){
0171: $sql.="$_,";
0172: }
0173: $sql=~s/,$//;
0174: $sql.=") VALUES(";
0175: for (values %$p_vhash){
0176: $sql.="'".$_."',";
0177: }
0178: $sql=~s/,$//;
0179: $sql.=")";
0180: $$p_sql.=" ".$sql if ($p_sql);
0181: my($st)=IBPerl::Statement->new(Transaction=>$$p_trans, SQL=>$sql);
0182: if ($st->{Handle}<0){
0183: print(STDERR "checkInsert new: $st->{Handle} $st->{Error}\n");
0184: exit(1);
0185: }
0186: $st->execute();
0187: if ($st->{Handle}<0){
0188: print(STDERR "checkInsert execute: $st->{Handle} $st->{Error}\n");
0189: exit(1);
0190: }
0191: return(1);
0192: }
0193: }
0194:
0195: # subroutine ######################################################
0196: # 行の追加または更新
0197: # 行の存在をチェックし、存在すれば更新する
0198: # 存在しなければ新規に追加する
0199: # 引数 $p_trans : トランザクションハンドラへのポインタ
0200: # $p_tbl : テーブル名(文字列)へのポインタ
0201: # $p_khash : キー名=>キー値のハッシュへのポインタ
0202: # $p_vhash : カラム名=>値のハッシュへのポインタ
0203: # $p_option : SQL文のオプション(文字列)へのポインタ
0204: # $p_sql : SQL文 を返すポインタ
0205: # 返値 INSERT ならば 1
0206: # UPDATE ならば 0
0207: # エラー STDERRにメッセージを書いてexit(1)
0208: #
0209: sub checkInsertUpdate
0210: {
0211: my($p_trans, $p_tbl, $p_khash, $p_vhash, $p_option, $p_sql)=@_;
0212: my($sql)="SELECT * FROM $$p_tbl WHERE ";
0213: for (keys %$p_khash){
0214: $sql.="$_='" . $p_khash->{$_} . "' AND ";
0215: }
0216: $sql=~s/ AND $//;
0217: $$p_sql=$sql if ($p_sql);
0218: my($st)=IBPerl::Statement->new(Transaction=>$$p_trans, SQL=>$sql);
0219: my(%hash);
0220: $st->fetch(\%hash);
0221: unless (%hash){
0222: # 存在しない
0223: my($sql)="INSERT INTO $$p_tbl(";
0224: for (keys %$p_vhash){
0225: $sql.="$_,";
0226: }
0227: $sql=~s/,$//;
0228: $sql.=") VALUES(";
0229: for (values %$p_vhash){
0230: $sql.="'".$_."',";
0231: }
0232: $sql=~s/,$//;
0233: $sql.=")";
0234: $$p_sql.=" ".$sql if ($p_sql);
0235: my($st)=IBPerl::Statement->new(Transaction=>$$p_trans, SQL=>$sql);
0236: if ($st->{Handle}<0){
0237: print(STDERR "checkInsertUpdate new: $st->{Handle} $st->{Error}\n");
0238: exit(1);
0239: }
0240: $st->execute();
0241: if ($st->{Handle}<0){
0242: print(STDERR "checkInsertUpdate execute: $st->{Handle} $st->{Error}\n");
0243: exit(1);
0244: }
0245: return(1);
0246: }else{
0247: # 存在する
0248: my($sql)="UPDATE $$p_tbl SET ";
0249: for (keys %$p_vhash){
0250: $sql.="$_='".$$p_vhash{$_}."',";
0251: }
0252: $sql=~s/,$//;
0253: $sql.=" WHERE ";
0254: for (keys %$p_khash){
0255: $sql.="$_='".$$p_khash{$_}."' AND ";
0256: }
0257: $sql=~s/ AND $//;
0258: $$p_sql.=" ".$sql if ($p_sql);
0259: my($st)=IBPerl::Statement->new(Transaction=>$$p_trans, SQL=>$sql);
0260: if ($st->{Handle}<0){
0261: print(STDERR "checkInsertUpdate new: $st->{Handle} $st->{Error}\n");
0262: exit(1);
0263: }
0264: $st->execute();
0265: if ($st->{Handle}<0){
0266: print(STDERR "checkInsertUpdate execute: $st->{Handle} $st->{Error}\n");
0267: exit(1);
0268: }
0269: return(0);
0270: }
0271: }
0272:
0273: # subroutine ######################################################
0274: # 行の追加
0275: # 引数 $p_trans : トランザクションハンドラへのポインタ
0276: # $p_tbl : テーブル名(文字列)へのポインタ
0277: # $p_vhash : カラム名=>値のハッシュへのポインタ
0278: # $p_sql : SQL文 を返すポインタ
0279: # 返値 SQL実行後のステートメントハンドラ
0280: # エラー STDERRにメッセージを書いてexit(1)
0281: #
0282: sub insertData
0283: {
0284: my($p_trans, $p_tbl, $p_vhash, $p_sql)=@_;
0285: my($sql)="INSERT INTO $$p_tbl(";
0286: for (keys %$p_vhash){
0287: $sql.="$_,";
0288: }
0289: $sql=~s/,$//;
0290: $sql.=") VALUES(";
0291: for (values %$p_vhash){
0292: $sql.="'".$_."',";
0293: }
0294: $sql=~s/,$//;
0295: $sql.=")";
0296: $$p_sql=$sql if ($p_sql);
0297: my($st)=IBPerl::Statement->new(Transaction=>$$p_trans, SQL=>$sql);
0298: if ($st->{'Handle'}<0){
0299: print(STDERR "insertData new: $st->{Handle} $st->{Error}\n");
0300: return 0;
0301: # exit(1);
0302: }
0303: $st->execute();
0304: if ($st->{'Handle'}<0){
0305: print(STDERR "insertData execute: $st->{Handle} $st->{Error}\n");
0306: return 0;
0307: # exit(1);
0308: }
0309: }
0310:
0311: # subroutine ######################################################
0312: # 行の更新
0313: # 引数 $p_trans : トランザクションハンドラへのポインタ
0314: # $p_tbl : テーブル名(文字列)へのポインタ
0315: # $p_khash : キー名=>キー値のハッシュへのポインタ
0316: # $p_vhash : カラム名=>値のハッシュへのポインタ
0317: # $p_option : SQL文のオプション(文字列)へのポインタ
0318: # $p_sql : SQL文 を返すポインタ
0319: # 返値 SQL実行後のステートメントハンドラ
0320: # エラー STDERRにメッセージを書いてexit(1)
0321: #
0322: sub updateData
0323: {
0324: my($p_trans, $p_tbl, $p_khash, $p_vhash, $p_sql)=@_;
0325: my($sql);
0326: $sql="UPDATE $$p_tbl SET ";
0327: for (keys %$p_vhash){
0328: $sql.="$_='".$$p_vhash{$_}."',";
0329: }
0330: $sql=~s/,$//;
0331: $sql.=" WHERE ";
0332: for (keys %$p_khash){
0333: $sql.="$_='".$$p_khash{$_}."' AND ";
0334: }
0335: $sql=~s/ AND $//;
0336: $$p_sql=$sql if ($p_sql);
0337: my($st)=IBPerl::Statement->new(Transaction=>$$p_trans, SQL=>$sql);
0338: if ($st->{Handle}<0){
0339: print(STDERR "updateData new: $st->{Handle} $st->{Error}\n");
0340: exit(1);
0341: }
0342: $st->execute();
0343: if ($st->{Handle}<0){
0344: print(STDERR "updateData execute: $st->{Handle} $st->{Error}\n");
0345: exit(1);
0346: }
0347: }
0348:
0349: # subroutine ######################################################
0350: # 行の検索
0351: # 引数 $p_trans : トランザクションハンドラへのポインタ
0352: # $p_tbl : テーブル名(文字列)へのポインタ
0353: # $p_khash : キー名=>キー値のハッシュへのポインタ
0354: # $p_option : SQL文のオプション(文字列)へのポインタ
0355: # $p_sql : SQL文 を返すポインタ
0356: # $dtfmt : 日付フォーマット(デフォルト %F)
0357: # $tmfmt : 時刻フォーマット(デフォルト %T)
0358: # 返値 生成したステートメントオブジェクト
0359: # エラー STDERRにメッセージを書いてexit(1)
0360: #
0361: sub selectRows{
0362: my($p_trans, $p_tbl, $p_khash, $p_option, $p_sql, $dtfmt, $tmfmt)=@_;
0363: my($sql)="SELECT * FROM $$p_tbl";
0364: if ($p_khash){
0365: $sql.=" WHERE ";
0366: for (keys %$p_khash){
0367: $sql.="$_='".$$p_khash{$_}."' AND ";
0368: }
0369: $sql=~s/AND $//;
0370: }
0371: $sql.=" ".$$p_option if ($p_option);
0372: $$p_sql=$sql if ($p_sql);
0373: my($dtformat)="%F";
0374: my($tmformat)="%T";
0375: $dtformat=$dtfmt if ($dtfmt);
0376: $tmformat=$tmfmt if ($tmfmt);
0377: my($tsformat)=$dtformat." ".$tmformat;
0378: my($st)=IBPerl::Statement->new(Transaction=>$$p_trans,
0379: SQL=>"$sql",
0380: TimeFormat=>$tmformat,
0381: DateFormat=>$dtformat,
0382: TimeStampFormat=>$tsformat);
0383: if ($st->{Handle}<0){
0384: print(STDERR "selectRowsbyKey new: $st->{Handle} $st->{Error}\n");
0385: exit(1);
0386: }
0387: return($st);
0388: }
0389:
0390: # subroutine ######################################################
0391: # 行の検索
0392: # 引数 $p_trans : トランザクションハンドラへのポインタ
0393: # $p_tbl : テーブル名(文字列)へのポインタ
0394: # $p_khash : キー名=>キー値のハッシュへのポインタ
0395: # $p_option : SQL文のオプション(文字列)へのポインタ
0396: # $p_sql : SQL文 を返すポインタ
0397: # $dtfmt : 日付フォーマット(デフォルト %F)
0398: # $tmfmt : 時刻フォーマット(デフォルト %T)
0399: # 返値 生成したステートメントオブジェクト
0400: # エラー STDERRにメッセージを書いてexit(1)
0401: #
0402: sub selectRowsLike{
0403: my($p_trans, $p_tbl, $p_khash, $p_option, $p_sql, $dtfmt, $tmfmt)=@_;
0404: my($sql)="SELECT * FROM $$p_tbl";
0405: if ($p_khash){
0406: $sql.=" WHERE ";
0407: for (keys %$p_khash){
0408: $sql.="$_ LIKE '".$$p_khash{$_}."' AND ";
0409: }
0410: $sql=~s/AND $//;
0411: }
0412: $sql.=" ".$$p_option if ($p_option);
0413: $$p_sql=$sql if ($p_sql);
0414: my($dtformat)="%F";
0415: my($tmformat)="%T";
0416: $dtformat=$dtfmt if ($dtfmt);
0417: $tmformat=$tmfmt if ($tmfmt);
0418: my($tsformat)=$dtformat." ".$tmformat;
0419: my($st)=IBPerl::Statement->new(Transaction=>$$p_trans,
0420: SQL=>"$sql",
0421: TimeFormat=>$tmformat,
0422: DateFormat=>$dtformat,
0423: TimeStampFormat=>$tsformat);
0424: if ($st->{Handle}<0){
0425: print(STDERR "selectRowsbyKey new: $st->{Handle} $st->{Error}\n");
0426: exit(1);
0427: }
0428: return($st);
0429: }
0430:
0431: # subroutine ######################################################
0432: # 1行のみfetchして返す
0433: # 引数 $p_trans : トランザクションハンドラへのポインタ
0434: # $p_tbl : テーブル名(文字列)へのポインタ
0435: # $p_khash : キー名=>キー値のハッシュへのポインタ
0436: # $p_sql : SQL文 を返すポインタ
0437: # $dtfmt : 日付フォーマット(デフォルト %F)
0438: # $tmfmt : 時刻フォーマット(デフォルト %T)
0439: # 返値 検索結果のハッシュ
0440: # エラー STDERRにメッセージを書いてexit(1)
0441: #
0442: sub selectOneLine{
0443: my($p_trans, $p_tbl, $p_khash, $p_option, $p_sql, $dtfmt, $tmfmt)=@_;
0444: my($sql)="SELECT * FROM $$p_tbl WHERE ";
0445: for (keys %$p_khash){
0446: $sql.="$_='".$$p_khash{$_}."' AND ";
0447: }
0448: $sql=~s/AND $//;
0449: $$p_sql=$sql if ($p_sql);
0450: my($dtformat)="%F";
0451: my($tmformat)="%T";
0452: $dtformat=$dtfmt if ($dtfmt);
0453: $tmformat=$tmfmt if ($tmfmt);
0454: my($tsformat)=$dtformat." ".$tmformat;
0455: my($st)=IBPerl::Statement->new(Transaction=>$$p_trans,
0456: SQL=>"$sql",
0457: TimeFormat=>$tmformat,
0458: DateFormat=>$dtformat,
0459: TimeStampFormat=>$tsformat);
0460: if ($st->{Handle}<0){
0461: print(STDERR "selectOneLine new: $st->{Handle} $st->{Error}\n");
0462: exit(1);
0463: }
0464: my(%hash);
0465: $st->fetch(\%hash);
0466: if ($st->{Handle}<0){
0467: print(STDERR "selectOneLine fetch: $st->{Handle} $st->{Error}\n");
0468: exit(1);
0469: }
0470: return(%hash);
0471: }
0472:
0473: # subroutine ######################################################
0474: # 行の削除
0475: # 引数 $p_trans : トランザクションハンドラへのポインタ
0476: # $p_tbl : テーブル名(文字列)へのポインタ
0477: # $p_khash : キー名=>キー値のハッシュへのポインタ
0478: # $p_sql : SQL文 を返すポインタ
0479: # 返値 生成したステートメントオブジェクト
0480: # エラー STDERRにメッセージを書いてexit(1)
0481: #
0482: sub deleteRows{
0483: my($p_trans, $p_tbl, $p_khash, $p_sql)=@_;
0484: my($sql)="DELETE FROM $$p_tbl";
0485: if ($p_khash){
0486: $sql.=" WHERE ";
0487: for (keys %$p_khash){
0488: $sql.="$_='".$$p_khash{$_}."' AND ";
0489: }
0490: }
0491: $sql=~s/AND $//;
0492: $$p_sql=$sql if ($p_sql);
0493: my($st)=IBPerl::Statement->new(Transaction=>$$p_trans, SQL=>"$sql");
0494: if ($st->{Handle}<0){
0495: print(STDERR "deleteRows new: $st->{Handle} $st->{Error}\n");
0496: exit(1);
0497: }
0498: $st->execute();
0499: if ($st->{Handle}<0){
0500: print(STDERR "deleteRows execute: $st->{Handle} $st->{Error}\n");
0501: exit(1);
0502: }
0503: return($st);
0504: }
0505:
0506: # subroutine ######################################################
0507: # Stored Procedure の実行
0508: # 引数 $p_trans : トランザクションハンドラへのポインタ
0509: # $p_proc : プロシージャ名(文字列)へのポインタ
0510: # $mode : 実行指示
0511: # 0 : EXECUTE した結果のステートメントハンドラを返す
0512: # 1 : fetch した1行のハッシュを返す
0513: # 2 : SELECT した結果のステートメントハンドラを返す
0514: # $p_params : パラメータの配列へのポインタ
0515: # $p_option : オプション文字列へのポインタ
0516: # $p_sql : SQL文 を返すポインタ
0517: # $dtfmt : 日付フォーマット(デフォルト %F)
0518: # $tmfmt : 時刻フォーマット(デフォルト %T)
0519: # 返値 生成したステートメントオブジェクト or 1行のハッシュ
0520: # エラー STDERRにメッセージを書いてexit(1)
0521: #
0522: sub execProcedure
0523: {
0524: my($p_trans, $p_proc, $mode, $p_params, $p_option, $p_sql, $dtfmt, $tmfmt)=@_;
0525: my($sql)=(($mode==2)?"SELECT * FROM":"EXECUTE PROCEDURE")." $$p_proc";
0526: $$p_sql=$sql if ($p_sql);
0527: if ($p_params){
0528: $sql.="(";
0529: for (@$p_params){
0530: $sql.="'" . $_ ."',";
0531: }
0532: $sql=~s/,$/\)/;
0533: }
0534: $sql.=" ".$$p_option if ($p_option);
0535: $$p_sql=$sql if ($p_sql);
0536: my($dtformat)="%F";
0537: my($tmformat)="%T";
0538: $dtformat=$dtfmt if ($dtfmt);
0539: $tmformat=$tmfmt if ($tmfmt);
0540: my($tsformat)=$dtformat." ".$tmformat;
0541: my($st)=IBPerl::Statement->new(Transaction=>$$p_trans,
0542: SQL=>"$sql",
0543: TimeFormat=>$tmformat,
0544: DateFormat=>$dtformat,
0545: TimeStampFormat=>$tsformat);
0546: $st->execute();
0547: if ($mode==1){
0548: my(%hash);
0549: $st->fetch(\%hash);
0550: return %hash;
0551: }else{
0552: return($st);
0553: }
0554: }
0555:
0556: return 1;
この HTML を検査する。( XHTML 1.0 Strict で書かれています )
Another HTML Lint Gateway ( Mirrored by htmllint.oosato.org )