スポンサードリンク
カテゴリー:"Perl"

PerlのDBI/DBD::ODBCで 「String data, right truncated (SQL-01004)」 エラー

PerlでDBI(DBD::ODBC)経由でデータベースにアクセスしたところ、検索結果をフェッチするところで

DBD::ODBC::st fetchrow_array failed: [MySQL][ODBC 3.51 Driver][mysqld-3.23.49]String data, right truncated (SQL-01004)(DBD: st_fetch/SQLFetch (long truncated DBI attribute LongTruncOk not set and/or LongReadLen too small) err=-1) at C:\test\test.pl line 24.

というエラーが出て止まってしまいました。

メッセージによると、LongTruncOk が設定されていないか LongReadLen が小さすぎたかのどちらか(もしくは両方)とのことなので、対処法を調べてみました。

続きを読む »

PerlのDBIでLIKE検索にバインド変数を使おう

Perl の DBI で SQL を使いまわす場合、バインド変数を使うといろいろ楽ちんなんですが、LIKE 検索をする場合の書き方をいつも忘れてるのでメモメモです φ(..)。

で、何に迷うかって、 “%” をどこに使うか(書くか)なんですが、結論から言うとバインド変数に含めてやればいいんですね。

#!/usr/bin/perl
use strict;
use warnings;
use DBI;

my $dbh = DBI->connect('dbi:ODBC:hogehoge', 'username', 'password')
  || die "DB connect error:".$DBI::errstr;

my $sql = "select * from friends where friend like ?";
my $sth = $dbh->prepare($sql);
$sth->execute("mukai%");

# 以下略
 

とまぁ、こんな感じで。

ActivePerlのPPMが 「401 Authorization Required」 エラーでモジュールをインストールできなかったので

かなり前から使っている Windows の Webサーバー に ActivePerl を入れて使っているのですが、久しぶりにモジュールの新規インストールをしようとしたら、

ERROR: 401 Authorization Required

というエラーになってモジュールをインストールできなかったので、ちょっと調べてみました。

続きを読む »

Perl のファイルハンドラが開いているか確認しよう

Perl でファイルハンドラが開いているか(利用可能な状態かどうか)をチェックする方法を探してみました。

やりかたは幾つかあるようなんですが、fileno 関数を使うのが1番手っ取り早いようです。

使い方のサンプルは以下のようになります。

#!/usr/bin/perl

use strict;
use warnings;

open(FH, "<", "sample.txt");

if(fileno(FH)){
  print "Opened filehandle\n";
}else{
  print "Closed filehandle\n";
}

close(FH);
 

参考リンク
 ・ファイルハンドルが Perl で開いているかを確認する方法

Perlで強度の高いパスワードをランダムに作成するプログラムを書いてみた

娘に 「強度の高いパスワードを作ってよ」 と言われたので、ランダムにパスワードを作成するプログラムを Perl で書いてみました。

パスワード生成の仕様としては、アルファベットの大文字と小文字と数字と記号を含む、8文字のランダムな文字列を作成します。

#!/usr/bin/perl

use strict;
use warnings;

my @str1 = qw(a b c d e f g h i j k m n o p q r s t u v w x y z);
my @str2 = qw(A B C D E F G H J K L M N P Q R S T U V W X Y Z);
my @str3 = qw(1 2 3 4 5 6 7 8 9);
my @str4 = qw(+ - / = _);

my @pattern  = ();
my $historyP = "";
my $cnt  = 0;
while($cnt < 4){
  my $type = int(rand()*4);
  if($historyP =~ m/$type /){
    next;
  }else{
    $historyP .= $type." ";
    push(@pattern, $type);
    $cnt++;
  }
}

my $history1 = "";
my $history2 = "";
my $history3 = "";
my $history4 = "";

my $pass = "";
$cnt  = 0;
while(length($pass) < 8){
  my $type = "";
  if($cnt < 4){
    $type = shift(@pattern);
  }else{
    $type = int(rand()*4);    
  }
  
  if($type == 0){
    my ($idx, $word) = SelectWord(25, @str1);
    if($history1 =~ m/$idx /){
      next;
    }else{
      $history1 .= $idx." ";
      $pass     .= $word;
      $cnt++;
    }
    
  }elsif($type == 1){
    my ($idx, $word) = SelectWord(24, @str2);
    if($history2 =~ m/$idx /){
      next;
    }else{
      $history2 .= $idx." ";
      $pass     .= $word;
      $cnt++;
    }
    
  }elsif($type == 2){
    my ($idx, $word) = SelectWord(9, @str3);
    if($history3 =~ m/$idx /){
      next;
    }else{
      $history3 .= $idx." ";
      $pass     .= $word;
      $cnt++;
    }
    
  }elsif($type == 3){
    my ($idx, $word) = SelectWord(5, @str4);
    if($history4 =~ m/$idx /){
      next;
    }else{
      $history4 .= $idx." ";
      $pass     .= $word;
      $cnt++;
    }
    
  }else{
    print "out of index $type\n";
  }
}

print "$pass\n";
exit;


sub SelectWord{
  my $len   = shift@_;
  my @words = @_;
  
  my $idx  = int(rand()*$len);
  my $word = $words[$idx];
  
  return($idx, $word);
}
 

Enjoy!

PerlのDBIでバインド変数を使用したSQLがエラーになる場合の対処法

Wondows 上の ActivePerl から DBIモジュールを使って、ODBC 経由で DB に接続した場合、なぜかバインド変数を使用した SQL がエラーになることがあるんですよ。

例えば次のようなソースだと、execute するところでエラーになるんです。

#!/usr/bin/perl

use strict;
use warnings;

use DBI;

my $dbh = DBI->connect("dbi:ODBC:hoge","hoge","fuga");
my $sql = "select name from item where code=?";
my $sth = $dbh->prepare($sql);

open(FH, "<", "item_codes.txt");
while(<FH>){
  chomp;
  $sth->execute($_);
  while(my @data = $sth->fetchrow_array()){
    # いろいろ処理
  }
}
close(FH);
$dbh->disconnect();
 

続きを読む »

Perlで2つの日付の間の日数を計算しよう

仕事で2つの日付の間の日数を計算しなくちゃいけなくなりました。

いつもならすぐにサブルーチンなんか書き始めるのですが、今回はなんとなく 「Date::Calc モジュールで出来るかも」 と思いまして、調べてみたら、やっぱり出来るじゃないですか!

というわけでサンプルのソースは以下の通りになります。

#!/usr/bin/perl

use strict;
use warnings;

use Date::Calc qw(Delta_Days);

my $Dd = Delta_Days(2012,1,1,
                    2012,1,3);

print $Dd;
 

Delta_Days の第1引数から第3引数までが基準になる年月日で、第4引数から第6引数までが比較対象の年月日になります。

上記の例だと、2012年1月1日から2012年1月3日までの日数が変数 $Dd に格納されます。ちなみにこの場合の結果は2になります。

なお、実在しない日付を指定した場合はエラーになってそこで止まってしまうので、事前の日付存在チェックは必須となります。

参照リンク
 ・Date::Calc - search.cpan.org

Perlの関数を成功しなければ die するものに置き換えるプラグマモジュール 「autodie」

Perl という言語はえらく親切で、他の言語ではエラーで止まるような場合でも 「こうしたいんでしょ?」 みたいな感じに気を利かせてくれて、処理を続行してくれたりします。

もちろんそれが有りがたい場合もあるわけですが、そうじゃない場合だってあるじゃないですか。で、そういう時に autodie プラグマを使うと、ちょっとだけ幸せになれそうです。

機能としては、Perl の動作を

レキシカルスコープ内の関数を、成功しなければ die するものに置き換える

autodie - perldoc.jp より引用

というように変えてくれます。

続きを読む »

PerlでCSVのダブルクォテーションで囲まれた部分のカンマを削除しよう

CSV(カンマ区切りのテキスト)なデータを処理するときに、何が厄介かって "(ダブルクォート)で囲まれたフィールドの中に存在する ,(カンマ)だったりします。例えばこんな感じ(↓)のヤツです。

日本,"9,222.52",2012/11/21
アメリカ,"12,836.89",2012/11/22

だったら、そのカンマを取り除いてしまえ! というわけで、プログラムを書いてみました。

#!/usr/bin/perl

use strict;
use warnings;

my $qw  = '"'; # 引用符を定義
my $dlm = ","; # 区切り文字を定義

open(RH, "<", "from.csv");
open(WH, ">", "to.csv");
while(<RH>){
  print WH RemoveDelimiterInQuotes($_, $qw, $dlm);
}
close(WH);
close(RH);

exit;

sub RemoveDelimiterInQuotes {
  my $str = shift; # 対象文字列
  my $qw  = shift; # 引用符
  my $dlm = shift; # 区切り文字
  
  my @substrs = ( $str =~ /$qw[^$qw]*$qw/g);
  
  for my $substr (@substrs){
    my $target = $substr;
    $substr =~ s/$dlm//g;
   
    $str =~ s/\Q$target\E/$substr/;
  }
  
  return $str;
}
 

from.csv を読み込んでダブルクォートに囲まれた部分のカンマを削除して、to.csv に書き出します。これでバッチリだね!

と、ここまで出来てから、な~んとなくもう一度 Web で検索してみたところ、標準モジュールの Text::ParseWords を使えばもっと簡単に出来たことが判明。あちゃ~。

perlでcsvファイルを読む(ダブルコーテーション内カンマを無視したい) | PerlのQ&A【OKWave】

折角なので Text::ParseWords を使って書き直したのがこちらになります。

#!/usr/bin/perl

use strict;
use warnings;

use Text::ParseWords;

my $dlm = ","; # 区切り文字を定義

open(RH, "<", "from.csv");
open(WH, ">", "to.csv");
while(<RH>){
  chomp;
  my @parsed = parse_line($dlm, 1, $_);
  
  for(my $i=0; $i<=$#parsed; $i++){
    $parsed[$i] =~ s/$dlm//g;
  }
  
  print WH join($dlm, @parsed)."\n";
}
close(WH);
close(RH);

exit;
 

今回は処理内容を同じにするために、あえて to.csv として書き出していますが、parse_line を通した時点でデータはフィールドごとに分かれていますので、そのまま目的の処理をしてしまうのが正しい使い方でしょうね。

参考リンク
 ・Comma-Separated Values - Wikipedia

Date::Calc とりあえずこれだけは

Date::Calc は Perl に標準で付いてきて、日付関係の計算をあれこれしてくれる非常に便利なモジュールなんですが・・・、よく使う割にはいつも使い方を忘れるので、その “よく使うところ” をまとめてみました。

use Date::Calc qw(:all);

# 現在の日付を取得(年月日)
($year, $month, $day) = Today();

# 現在の日付と時刻を取得(年月日時分秒)
($year, $month, $day, $hour, $min, $sec) = Today_and_Now();

# 指定した日付の曜日を数字で取得(戻り値:月曜日が1で日曜日が7)
$DoW = Day_of_Week($year,$month,$day);

# 日付の足し算引き算(第4引数は加減算する日数)
($Dyear, $Dmonth, $Dday) = Add_Delta_Days($year, $month, $day, $Dd);
($Dyear, $Dmonth, $Dday) = Add_Delta_Days($year, $month, $day, -1); # 1日前の日付
($Dyear, $Dmonth, $Dday) = Add_Delta_Days($year, $month, $day, 2);  # 2日後の日付

# 指定した月の最終日を取得
$lastday = Days_in_Month($year, $month);

# 指定した日付が実在するかを確認(戻り値:真なら1、偽なら0)
$check = check_date($year, $month, $day);
 

参照リンク
 ・Date::Calc - search.cpan.org

スポンサードリンク

プロフィール


  • 書いてる人:夢界 陸

    名古屋在住のおっさん。
    プログラミングやガジェットの話など、 日々の興味を徒然と綴っています。



    Twitterやってます @mukairiku



    運営サイト
    www.mukairiku.net

アクセスランキング


ブログ内検索

Licenses

  • Creative Commons License

OTHER

  • このブログのはてなブックマーク数

    ブログパーツ
Blog powered by TypePad

スポンサードリンク