Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

poj's scratchpad

by poj (Priest)
on Jun 12, 2013 at 17:16 UTC ( #1038520=scratchpad: print w/ replies, xml ) Need Help??

Here is the code for both reading from CSV or DB, just hash out the appropriate lines.

I got a slight speed improvement using split on the input lines rather than the proper way using Text::CSV but that assumes than none of the fields have commas in and quotes around.

#!perl use strict; use DBD::Oracle; use XML::Writer; use Data::Dump 'pp'; my $DEBUG = 0; # connect to database my $dbh = dbh(); # query database and create XML # for each rltp_id in turn for my $rltp_id (10,20){ ## CHOOSE DATA SOURCE HERE my $href_data = query_database($dbh,$rltp_id); #my $href_data = read_CSV('testdata.csv',$rltp_id); pp $href_data if $DEBUG; create_XML($href_data); } $dbh->disconnect; sub read_CSV { my ($infile,$rltp_id) = @_; my %data = (); $data{'TIME_BEGIN'} = localtime; my $t0 = time(); my $count = 0; open my $fh,'<',$infile or die "Could not open $infile : $!"; while (<$fh>){ my @f = split ',',$_; next unless $f[0] == $rltp_id; $data{'RLTP_ID'} = $f[0]; $data{'RLTP_NAME'} = $f[1]; $data{'PRODUCT'}{$f[2]}{'PROD_NAME'} = $f[3]; $data{'CUST'}{$f[4]}{'CUST_NAME'} = $f[5]; $data{'ACCOUNT'}{$f[6]}{'ACC_NAME'} = $f[7]; $data{'ACCOUNT'}{$f[6]}{'ACC_BALANCE'} = $f[8]; $data{'ACCTYPE'}{$f[6]}{'type'}{$f[11]} = 1; $data{'ACCTYPE'}{$f[6]}{'code'}{$f[12]} = 1; $data{'TXNTYPE'}{$f[9]}{$f[13]} = 1; $data{'TRANS'}{$f[2]}{$f[4]}{$f[6]}{$f[9]} = $f[10]; ++$count; } $data{'TIME_FINISH'} = localtime; my $dur = time() - $t0; print "$count records read from $infile for $rltp_id in $dur seconds +\n"; return \%data; } sub query_database { my ($dbh,$rltp_id) = @_; my %data = (); $data{'TIME_BEGIN'} = localtime; my $t0 = time(); # RLTP_MNGR my $sql = 'SELECT rltp_name FROM A_RLTP_MNGR WHERE rltp_id=?'; my $sth = $dbh->prepare($sql); $sth->execute($rltp_id); $data{'RLTP_ID'} = $rltp_id; $data{'RLTP_NAME'} = $sth->fetchrow_array; # PRODUCT $sql = 'SELECT prod_id,prod_name FROM A_PRODUCT WHERE rltp_id=?'; $sth = $dbh->prepare($sql); $sth->execute($rltp_id); $data{'PRODUCT'} = $sth->fetchall_hashref(1); # CUSTOMER $sql = 'SELECT cust_id,cust_name FROM A_CUST WHERE rltp_id=?'; $sth = $dbh->prepare($sql); $sth->execute($rltp_id); $data{'CUST'} = $sth->fetchall_hashref(1); # ACCOUNT $sql = 'SELECT acc_id,acc_name,acc_balance FROM A_ACCOUNT WHERE rltp_id=?'; $sth = $dbh->prepare($sql); $sth->execute($rltp_id); $data{'ACCOUNT'} = $sth->fetchall_hashref(1); # ACCTYPE my %ACCTYPE=(); $sql = 'SELECT acc_id,acc_type,acc_code FROM A_ACCTYPE WHERE rltp_id=? GROUP BY acc_id,acc_type,acc_code'; $sth = $dbh->prepare($sql); $sth->execute($rltp_id); while (my @f = $sth->fetchrow_array){ $data{'ACCTYPE'}{$f[0]}{'type'}{$f[1]}=1; $data{'ACCTYPE'}{$f[0]}{'code'}{$f[2]}=1; } # TRANS my %TRANS=(); $sql = 'SELECT prod_id,cust_id,acc_id,txn_id,txn_amt FROM A_TRANSACTION WHERE rltp_id=?'; $sth = $dbh->prepare($sql); $sth->execute($rltp_id); while (my @f = $sth->fetchrow_array){ $data{'TRANS'}{$f[0]}{$f[1]}{$f[2]}{$f[3]} = $f[4]; } # TXNTYPE my %TXNTYPE=(); $sql = 'SELECT txn_id,txn_code FROM A_TXNTYPE WHERE rltp_id=? GROUP BY txn_id,txn_code'; $sth = $dbh->prepare($sql); $sth->execute($rltp_id); while (my @f = $sth->fetchrow_array){ $data{'TXNTYPE'}{$f[0]}{$f[1]} = 1; } $data{'TIME_FINISH'} = localtime; my $dur = time() - $t0; print "data extracted for $rltp_id in $dur seconds\n"; return \%data; } # CREATE XML sub create_XML { my ($hr) = @_; my $t0 = time(); my $rltp_id = $hr->{'RLTP_ID'}; my $outfile = 'output_'.$rltp_id.'.xml'; my $output = IO::File->new(">$outfile"); my $w = XML::Writer->new( OUTPUT => $output, DATA_MODE => 1, DATA_INDENT => 2 ); $w->startTag('transactiondetails'); $w->dataElement('rltp_id' => $rltp_id); $w->dataElement('rltp_name' => $hr->{'RLTP_NAME'}); for my $prod (sort keys %{$hr->{'TRANS'}}){ $w->startTag('product'); $w->dataElement('product_id' => $prod); $w->dataElement('product_name' => $hr->{'PRODUCT'}{$prod}{'PROD_NA +ME'}); for my $cust (sort keys %{$hr->{'TRANS'}{$prod}}){ $w->startTag('customer'); $w->dataElement('cust_id' => $cust); $w->dataElement('cust_name' => $hr->{'CUST'}{$cust}{'CUST_NAME'} +); for my $acc (sort keys %{$hr->{'TRANS'}{$prod}{$cust}}){ $w->startTag('account'); $w->dataElement('acc_id' => $acc); $w->dataElement('acc_name' => $hr->{'ACCOUNT'}{$acc}{'ACC_N +AME'}); $w->dataElement('acc_balance' => $hr->{'ACCOUNT'}{$acc}{'ACC_B +ALANCE'}); if (defined $hr->{ACCTYPE}{$acc}{'type'}){ for my $type (sort keys %{$hr->{'ACCTYPE'}{$acc}{'type'}}){ $w->dataElement('acc_type' => $type); } } else { $w->dataElement('acc_type' => ''); } if (defined $hr->{'ACCTYPE'}{$acc}{'code'}){ for my $code (sort keys %{$hr->{'ACCTYPE'}{$acc}{'code'}}){ $w->dataElement('acc_code' => $code); } } else { $w->dataElement('acc_code' => ''); } for my $txn (sort keys %{$hr->{'TRANS'}{$prod}{$cust}{$acc}}){ $w->startTag('transaction'); $w->startTag('txntrack'); $w->dataElement('txn_id' => $txn); $w->dataElement('txn_amt' => $hr->{'TRANS'}{$prod}{$cust}{$a +cc}{$txn}); if (defined $hr->{'TXNTYPE'}{$txn}){ for my $code (sort keys %{$hr->{'TXNTYPE'}{$txn}}){ $w->dataElement('txn_code',$code); } } else { $w->dataElement('txn_code' => ''); } $w->endTag('txntrack'); $w->endTag('transaction'); } $w->endTag('account'); } $w->endTag('customer'); } $w->endTag('product'); } $w->endTag('transactiondetails'); $w->end(); $output->close(); my $dur = time() - $t0; print "XML created as $outfile in $dur seconds\n"; } # connect sub dbh { my $host = "localhost"; my $sid = 'xe'; my $user = 'user'; my $pwd = 'password'; my $dsn = "dbi:Oracle:host=$host;sid=$sid"; my $dbh = DBI->connect($dsn, $user, $pwd, { AutoCommit => 0, }) or die "$!"; #$dbh->{'LongReadLen'} = 10_000; return $dbh }
================================================
THIS IS MY FIRST ATTEMPT
=================================================

The code neads some tidying up but it should give you a start. I have to include a <root> tag to have mutiple <transactiondetails> tags in the one file, or do you want separate files for each rltp_id ?

#!perl use strict; use Text::CSV_XS; use XML::Writer; use Data::Dump 'pp'; my $t0 = time(); my %RLTP=(); my %PROD=(); my %CUST=(); my %ACC=() ; my %DATA=(); my %BAL=(); my $count_in = 0; my $infile = 'testdata.csv'; my $outfile = 'output.xml'; #my $csv = Text::CSV_XS->new ( { binary => 1 } ) # should set binary +attribute. # or die "Cannot use CSV: ".Text::CSV_XS->error_diag ( +); open my $fh,'<',$infile or die "Could not open $infile : $! "; #my $header = $csv->getline(IN); #while (my $row = $csv->getline($fh)) { while (my $row = <$fh>){ my @f = split ',',$row;#@$row; # print "@f\n"; # ID => NAME $RLTP{$f[0]} = $f[1]; $PROD{$f[2]} = $f[3]; $CUST{$f[4]} = $f[5]; $ACC{$f[6]}{'name'} = $f[7]; $ACC{$f[6]}{'balance'} = $f[8]; $ACC{$f[6]}{'type'} = $f[11]; $ACC{$f[6]}{'acc_code'}{$f[12]} = 1; # RLPT_ID,PROD_ID,CUST_ID,ACC_ID,TXN_ID, # leading zeros added to preserve numerical sort order my $pk = join '~',map { sprintf "%08d",$_ }@f[0,2,4,6,9]; $DATA{$pk}{'txn_amt'} = $f[10]; $DATA{$pk}{'txn_code'}{$f[13]}=1; ++$count_in; } #pp %DATA; my $dur = time() - $t0; print "$count_in records read from $infile in $dur seconds Press return to create XML \n"; <STDIN>; # create XML use XML::Writer; use IO::File; my $output = IO::File->new(">$outfile"); my $w = XML::Writer->new( OUTPUT => $output, DATA_MODE => 1, DATA_INDENT=>2 ); $w->startTag('root'); my @prev=(); for my $pk (sort keys %DATA){ # leading zeros removed my @f = map{ s/0+//;$_ } split '~',$pk; if ($prev[0] && ($prev[0] ne $f[0])){ $w->endTag('account'); $w->endTag('customer'); $w->endTag('product'); $w->endTag('transactiondetails'); splice @prev,-4; } elsif ($prev[1] && ($prev[1] ne $f[1])){ $w->endTag('account'); $w->endTag('customer'); $w->endTag('product'); splice @prev,-3; } elsif ($prev[2] && ($prev[2] ne $f[2])){ $w->endTag('account'); $w->endTag('customer'); splice @prev,-2; } elsif($prev[3] && ($prev[3] ne $f[3])){ $w->endTag('account'); splice @prev,-1; }; if ($f[0] ne $prev[0]){ $w->startTag('transactiondetails'); _tag('rltp',$f[0],$RLTP{$f[0]}); } if ($f[1] ne $prev[1]){ $w->startTag('product'); _tag('prod',$f[1],$PROD{$f[1]}); } if ($f[2] ne $prev[2]){ $w->startTag('customer'); _tag('cust',$f[2],$CUST{$f[2]}); } if ($f[3] ne $prev[3]){ $w->startTag('account'); $w->dataElement('acc_id' => $f[3]); $w->dataElement('acc_name' => $ACC{$f[3]}{'name'}); $w->dataElement('acc_balance' => $ACC{$f[3]}{'balance'}); $w->dataElement('acc_type' => $ACC{$f[3]}{'type'}); for my $code (sort keys %{$ACC{$f[3]}{'acc_code'}}){ $w->dataElement('acc_code',$code); } } $w->startTag('transaction'); $w->startTag('txntrack'); $w->dataElement('txn_id' => $f[4]); $w->dataElement('txn_amt' => $DATA{$pk}{'txn_amt'}); for my $code (sort keys %{$DATA{$pk}{'txn_code'}}){ $w->dataElement('txn_code',$code); } $w->endTag('txntrack'); $w->endTag('transaction'); @prev = @f; } $w->endTag('account'); $w->endTag('customer'); $w->endTag('product'); $w->endTag('transactiondetails'); $w->endTag('root'); $w->end(); $output->close(); $dur = time() - $t0; print "XML created as $outfile in $dur seconds\n"; sub _tag { my ($tag,$id,$name) = @_; $w->startTag($tag.'_id'); $w->characters($id); $w->endTag($tag.'_id'); $w->startTag($tag.'_name'); $w->characters($name); $w->endTag($tag.'_name'); } __DATA__ RLTP_ID,RLTP_NAME,PROD_ID,PROD_NAME,CUST_ID,CUST_NAME,ACC_ID,ACC_NAME, +ACC_BALANCE,TXN_ID,TXN_AMT,ACC_TYPE,ACC_CODE,TXN_CODE 10,Phil,1,Personal,2,Fixed,3,Savings,3000,4,500,X,YY,11 10,Phil,1,Personal,2,Fixed,3,Savings,3000,4,500,X,YY,12 10,Phil,1,Personal,2,Fixed,3,Savings,3000,4,500,X,ZZ,11 10,Phil,1,Personal,2,Fixed,3,Savings,3000,4,500,X,ZZ,12 10,Phil,1,Personal,2,Fixed,7,Savings,3000,8,500,X,AA,11 10,Phil,1,Personal,2,Fixed,7,Savings,3000,8,500,X,AA,12 10,Phil,1,Personal,2,Fixed,7,Savings,3000,8,500,X,AA,13 10,Phil,1,Personal,2,Fixed,7,Savings,3000,8,500,X,BB,11 10,Phil,1,Personal,2,Fixed,7,Savings,3000,8,500,X,BB,12 10,Phil,1,Personal,2,Fixed,7,Savings,3000,8,500,X,BB,13
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (4)
As of 2015-07-28 04:23 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (252 votes), past polls