Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Re^3: Generate A DDL From Access

by remiah (Hermit)
on Mar 04, 2012 at 01:54 UTC ( #957722=note: print w/replies, xml ) Need Help??


in reply to Re^2: Generate A DDL From Access
in thread Generate A DDL From Access

I am not sure about collate. If you find one, please tell me. Here is my code. Method "describe" calls collumn_info() and statistics_info().

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;

And my quistion: I want to make a package which treats MS access dialect (they treat '*' for '%' and no limit, offset keyword). Package which can do like this.

my $db=connect(\%dbinfo) or die $!; my $sql ="select * from test1 where fld1 like 'monk%' offset 10 limit +10"; foreach my $r ( $db->fetch($sql) ){ print "$r->{fld1}\n"; } $db->disconnect;
I want to make a package which can easily switch MS Access and other database like SQLite. I am interested in DBIX::Class but I am not sure it is the way to go... If you have some advice for me, I am glad. Any comments, advice, welcome.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://957722]
help
Chatterbox?
[erix]: This sad, embarrassing wreck of a man

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (7)
As of 2018-07-17 21:48 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    It has been suggested to rename Perl 6 in order to boost its marketing potential. Which name would you prefer?















    Results (378 votes). Check out past polls.

    Notices?