package MSAccess;

#from database to pg, cp932->utf8
#pg to database utf8->cp932
#
#connect, disconnect, fetch, exec_sql, commit, describe
#
use strict;
use warnings;
use utf8;
use DBI;
use Encode qw(decode encode);

my %default = (    dbpath=>'C:/test.mdb', 
                username=>'admin', 
                password=>'', 
                );

sub connect {
    my $thing=shift;
    my $class = ref($thing) || $thing;
    my $args=shift;        #dbpath,username,password
    
    my ($self,$dbh,$dsn);
    
    $self={};
    foreach my $k (keys %default) { #default
        $self->{$k}=$default{$k} if (! exists($self->{$k}) );
    }
    foreach my $k (keys %$args) { #args
        $self->{$k}=$args->{$k} ;
    }
    
    #connect
    $dsn="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=$self->{dbpath}
+;";
    $dbh= DBI->connect("dbi:ADO:$dsn"
                        ,$self->{username}
                        ,$self->{password}
                        ,$self->{attr}
    );    

    if(!$dbh){
        print "connect error:" . decode("cp932",$DBI::errstr);
        exit;
    }
    
    $self->{dbh}=$dbh;

    return bless($self,$class);
}

sub fetch{
    my $self = shift;
    my $dbh = $self->{dbh};
    my $sql = shift;
    my @params = @_;
    
#    print "debug:sql=$sql\n";
#    print "debug:$_\n" foreach(@params);

    my ($sth,$ret,@ret);

    $sql=encode('cp932',$sql);
    for(my $idx=0; $idx<@params; $idx++){ 
        $params[$idx]=encode('cp932',$params[$idx]);
    }
    
    $sth=$dbh->prepare($sql);
        
    $ret=$sth->execute(@params);
    if(!$ret){
        print "execute error:" . decode("cp932",$DBI::errstr);
        $dbh->disconnect;
        exit;
    };

    while(my $href= $sth->fetchrow_hashref){
        $href->{$_}=decode("cp932",$href->{$_}) for keys %$href;
        push (@ret, $href);
    }
    
    $sth->finish;
    
    return @ret;
}    

sub commit {
    my $self = shift;
    my $dbh = $self->{dbh};

    #comit
    $dbh->commit;
}

sub exec_sql{
    my $self = shift;
    my $dbh = $self->{dbh};
    my $sql = shift;
    my @params = @_;

    #print "debug:exec_sql,sql=$sql\n";
    #print "debug:exec_sql,$_\n" foreach(@params);

    my ($sth, $ret);

    $sql=encode('cp932',$sql);
    for(my $idx=0; $idx<@params; $idx++){
        $params[$idx]=encode('cp932',$params[$idx]);
    }

    $sth=$dbh->prepare($sql);

    $ret=$sth->execute(@params);

    if(!$ret){
        print "execute error:" . decode("cp932",$DBI::errstr);
        $dbh->disconnect;
        exit;
    };

    $sth->finish;
}

sub disconnect {
    my $self = shift;
    my $dbh = $self->{dbh};
    
    $dbh->disconnect;

    if(!$dbh){
        print "disconnect error:" . decode("cp932",$DBI::errstr);
        exit;
    }
}

#like oracle describe
sub describe{
    my $self = shift;
    my $dbh = $self->{dbh};
    my $table=shift;
    
    my($ret,$sth_t,$sth_c,$sth_idx,$rt,$rc,$ridx);
    my($remark,%inds);

    #( $catalog, $schema, $table, $type ) 
    $table=undef if $table=~/^\s*$/;
    $sth_t= $dbh->table_info(undef,undef,$table, 'TABLE');
    while( $rt=$sth_t->fetchrow_hashref ){
        $remark=defined($rt->{REMARKS})?$rt->{REMARKS}:'';
        $ret.= "\n\n";
        $ret.= "###Table: $rt->{TABLE_NAME},$remark\n";

        #( $catalog, $schema, $table, $column );
        $sth_c= $dbh->column_info(undef,undef,$rt->{TABLE_NAME},undef)
+;
        while( $rc=$sth_c->fetchrow_hashref ){
            $remark=defined($rc->{REMARKS})?$rc->{REMARKS}:'';
            $ret.=sprintf("%15s,%10s,%5s,%30s\n",$rc->{COLUMN_NAME},$r
+c->{TYPE_NAME},$rc->{COLUMN_SIZE},$remark );
        }
        
        #( $catalog, $schema, $table, $unique_only, $quick );
        $ret.= "###Indeces:\n";
        $sth_idx = $dbh->statistics_info(undef,undef,$rt->{TABLE_NAME}
+, 0,0);
        %inds=(); #NON_UNIQUE:0=unique,1=non unique
        while( my $ridx=$sth_idx->fetchrow_hashref ){
            if (! defined($ridx->{INDEX_NAME}) ){
                next;
            }
            if (! exists( $inds{ $ridx->{INDEX_NAME}} ) ){
                $inds{ $ridx->{INDEX_NAME} } = 
                    {type=> $ridx->{TYPE}, is_unique=> ($ridx->{NON_UN
+IQUE}==0 ? 'unique': 'non unique') };    
                $inds{ $ridx->{INDEX_NAME} }->{columns}=
                    $ridx->{ORDINAL_POSITION} . ":" .$ridx->{COLUMN_NA
+ME};
            } else {
                $inds{ $ridx->{INDEX_NAME} }->{columns} .=
                    "," . $ridx->{ORDINAL_POSITION} . ":" .$ridx->{COL
+UMN_NAME};
            }
        }
        foreach my $k (keys %inds){
            my %h =%{$inds{$k}};
            $ret.= "  $k( $h{type},$h{is_unique})\n";
            $ret.= "    columns=$h{columns}\n";
        }
    }
    
    #cp932 -> utf8
    return decode("cp932",$ret);
}

1;
[download]