Hi.
I think that DBD::AnyData and its base AnyData are
very powerful and interesting modules.
But I have a question about it :
Why should I make a new module for my specific format?
(for just 2 methods)
So I've made two simple modules :
- AnyData::Format::FlexRec
- AnyData::Format::FlexRAM
I hope these modules will make your life more easy.
[FlexRec]
package AnyData::Format::FlexRec;
use strict;
use AnyData::Format::Base;
use vars qw( @ISA $VERSION);
@ISA = qw( AnyData::Format::Base );
$VERSION = '0.01';
sub new {
my ($class, $flg) = @_;
$flg ||= {};
foreach my $sKey
qw(col_names func_read_fields func_write_fields) {
warn "Set $sKey" unless((defined $flg->{$sKey}));
}
my $self = AnyData::Format::Base->new($flg);
return bless $self, $class;
}
sub read_fields { return $_[0]->{func_read_fields} (@_)}
sub write_fields { return $_[0]->{func_write_fields}(@_)}
1;
[FlexRAM]
package AnyData::Format::FlexRAM;
use strict;
use AnyData::Format::Base;
use vars qw( @ISA $VERSION);
@ISA = qw( AnyData::Format::Base );
$VERSION = '0.01';
sub new {
my ($class, $flg) = @_;
$flg ||= {};
foreach my $sKey
qw(func_get_data func_export) {
warn "Set $sKey" unless((defined $flg->{$sKey}));
}
$flg->{export_on_close} = 1;
$flg->{slurp_mode} = 1;
my $self = AnyData::Format::Base->new($flg);
return bless $self, $class;
}
sub storage_type { 'RAM'; }
sub import {return undef;} #must be strange
sub get_data {return $_[0]->{func_get_data}(@_) }
sub export() {return $_[0]->{func_export} (@_) }
1;
--------------------
2. Example For FlexRec:
2.1 Script
use strict;
use DBI;
#1. Format Definition
my $RecSep = ($^O eq 'MSWin32')? pack('c2', 0x0D, 0x0A): "\n";
sub funcRead($$) {
my ($self, $sRec) = @_;
my ($sCol1, $sCol2, $sCol3, $sCol4, $sCol2_3);
if($sRec =~ /^(.{10})(.*)\t(.*)$/) {
($sCol1, $sCol2_3, $sCol4) = ($1, $2, $3);
$sCol1 =~ s/\s+$//;
($sCol2, $sCol3) = split /,/, $sCol2_3;
}
return ($sCol1, $sCol2, $sCol3, $sCol4);
}
sub funcWrite($@) {
my ($self, @aFlds) =@_;
return (sprintf("%-10s%s,%s\t%s", @aFlds) . $RecSep);
}
#2. Manipulation
my $hDb = DBI->connect('dbi:AnyData:', undef, undef,
{RaiseError=>1, AutoCommit=>1,});
$hDb->func( 'testfmt', 'FlexRec', 'testdat.txt',
{ col_names => 'name,country,city,point',
func_read_fields => \&funcRead,
func_write_fields=> \&funcWrite,
},
'ad_catalog' );
$hDb->do('DELETE FROM testfmt WHERE point = 0');
$hDb->do(q/UPDATE testfmt SET
name = 'Updated' WHERE name like '%Upd%' /);
my $hSt = $hDb->prepare(
q/INSERT INTO testfmt VALUES(?, ?, ?, ?)/);
$hSt->execute('TestDatK', 'Korea','Seoul', 38);
$hSt->execute('TestDatJ', 'Japan','Kyoto', 40);
$hSt = $hDb->prepare(
'SELECT * FROM testfmt ORDER BY point DESC');
$hSt->execute;
while(my $raD = $hSt->fetchrow_arrayref()) {
print join(':', @$raD), "\n";
}
$hSt->finish;
$hDb->disconnect;
(*)When you use FlexRAM you should modify AnyData.pm (645) like
below:
if ('XML HTMLtable Excel Vertical FlexRAM' =~ /$target_format/) {
2.2 Result
(1) testdat.txt(Original)
Hippo2000 Japan,Kyoto 23
WillDel Japan,Tokyo 0
WillUpd US,LA 35
(2)Console
C:\256\5>perl -w test1.pl
TestDatJ:Japan:Kyoto:40
TestDatK:Korea:Seoul:38
Updated:US:LA:35
Hippo2000:Japan:Kyoto:23
(3)textdat.txt(Result)
Hippo2000 Japan,Kyoto 23
Updated US,LA 35
TestDatK Korea,Seoul 38
TestDatJ Japan,Kyoto 40
---------
3.Example for FlexRAM
3.1 Script
use strict;
use DBI;
#1. Format Definition
my $RecSep = ($^O eq 'MSWin32')? pack('c2', 0x0D, 0x0A): "\n";
sub funcGet {
my($self, $sData, $raColNames) = @_;
my (@aData, @aCol);
my $iRow = 0;
foreach my $sRow (split /\n/ ,$sData) {
my $iCol = (defined $raColNames)? 0: -1;
while($sRow ne '') {
my $sWk = substr($sRow, 0, 10);
$sWk =~ s/\s+$//;
if($iCol<0) {
$aCol[$iRow] = $sWk;
}
else {
$aData[$iCol][$iRow] = $sWk;
}
++$iCol;
$sRow = (length($sRow) > 10)? substr($sRow, 10) : '';
}
++$iRow;
}
$self->{col_names} = \@aCol unless defined $raColNames;
return \@aData, $self->{col_names};
}
sub funcExport {
my($self, $storage) = @_;
my $raCol = $storage->{col_names};
my $raTbl = $storage->{records};
my $fh = $storage->{fh};
my @aRow;
foreach my $sCol (@$raCol) {
push @aRow, sprintf('%-10s', $sCol);
}
my $iRow = 0;
foreach my $raRow (@$raTbl) {
my $iCol = 0;
foreach my $sCell (@$raRow) {
$aRow[$iCol] .= sprintf('%-10s', $sCell);
++$iCol;
}
++$iRow;
}
foreach my $sRow (@aRow) {
print $fh $sRow, $RecSep;
}
}
#2. Manipulation
my $hDb = DBI->connect('dbi:AnyData:', undef, undef,
{RaiseError=>1, AutoCommit=>1,});
$hDb->func( 'testfmt', 'FlexRAM', 'testv.txt',
{ func_get_data => \&funcGet,
func_export => \&funcExport,},
'ad_import' );
$hDb->do('DELETE FROM testfmt WHERE point = 32');
my $hSt = $hDb->prepare(
q/INSERT INTO testfmt VALUES(?, ?, ?, ?)/);
$hSt->execute('TestDatK', 'Korea','Seoul', 38);
$hSt->execute('TestDatJ', 'Japan','Kyoto', 40);
$hSt = $hDb->prepare(
'SELECT * FROM testfmt ORDER BY point DESC');
$hSt->execute;
while(my $raD = $hSt->fetchrow_arrayref()) {
print join(':', @$raD), "\n";
}
$hSt->finish;
$hDb->func( 'testfmt', 'FlexRAM', 'testv2.txt',
{ func_get_data => \&funcGet,
func_export => \&funcExport,},
'ad_export' );
$hDb->disconnect;
3.2 Result
(1) testv.txt
name Hippo2000 WillDel
country Japan Japan
city Kyoto Tokyo
point 28 32
(2) console
C:\256\5>perl -w test2.pl
TestDatJ:Japan:Kyoto:40
TestDatK:Korea:Seoul:38
Hippo2000:Japan:Kyoto:28
(3)testv2.txt
name Hippo2000 TestDatK TestDatJ
country Japan Korea Japan
city Kyoto Seoul Kyoto
point 28 38 40
==============================================
Kawai, Takanori(Hippo2000)
Mail: [EMAIL PROTECTED] [EMAIL PROTECTED]
http://member.nifty.ne.jp/hippo2000
==============================================
