Apache-SdnFw
view release on metacpan or search on metacpan
lib/Apache/SdnFw/lib/DB.pm view on Meta::CPAN
return %return;
} elsif ($t eq 'array') {
my @return;
while (my @row = $sth->fetchrow_array ) {
push @return, $row[0];
}
$sth->finish;
if (defined($s->{memd}) && $args{c}) {
$s->setkey($args{c},\@return,$args{cache_for});
}
return @return;
} elsif ($t eq 'hashhash') {
croak "undefined key field k in args" unless($args{k});
my %return;
while (my $hash = $sth->fetchrow_hashref ) {
foreach my $k (keys %{$hash}) {
$return{$hash->{$args{k}}}{$k} = $hash->{$k};
}
}
$sth->finish;
if (defined($s->{memd}) && $args{c}) {
$s->setkey($args{c},\%return,$args{cache_for});
}
return %return;
} elsif ($t eq 'scalar') {
my $return = ($sth->fetchrow_array)[0];
$sth->finish;
if (defined($s->{memd}) && $args{c}) {
$s->setkey($args{c},$return,$args{cache_for});
}
return $return;
} elsif ($t eq 'keyval') {
my %return;
while (my @row = $sth->fetchrow_array ) {
$return{$row[0]} = $row[1];
}
$sth->finish;
if (defined($s->{memd}) && $args{c}) {
$s->setkey($args{c},\%return,$args{cache_for});
}
return %return;
} elsif ($t eq 'arrayhash') {
my @return;
while (my $hash = $sth->fetchrow_hashref ) {
push @return, { %{$hash} };
}
$sth->finish;
if (defined($s->{memd}) && $args{c}) {
$s->setkey($args{c},\@return,$args{cache_for});
}
return @return;
} elsif ($t eq 'importfile') {
my $cols = $sth->{NAME};
croak "undefined file field f in args" unless($args{f});
croak "undefined table import name t in args" unless($args{t});
my %lookup;
my $n = length @{$cols};
for my $i ( 0 .. $n+1 ) {
$lookup{$cols->[$i]} = $i;
}
#croak "test".Data::Dumper->Dump([\%lookup]);
open F, ">$args{f}";
print F "COPY $args{t} (".(join ',', @{$cols}).") FROM STDIN;\n";
while (my @row = $sth->fetchrow_array) {
for my $i ( 0 .. $#row ) {
$row[$i] = '\N' if ($row[$i] eq '' || $row[$i] eq undef);
$row[$i] =~ s/\t//g;
$row[$i] =~ s/\r/\\r/g;
$row[$i] =~ s/\n/\\n/g;
}
if ($args{forceid}) {
my $sn = $lookup{$args{forceid}};
unless($row[$sn] =~ m/^\d+$/) {
#print "invalid $row[$sn]\n";
next;
}
}
if ($args{splitid}) {
my $sn = $lookup{$args{splitid}};
my $list = $row[$sn];
#print "Checking $list\n";
foreach my $value (split /,\s*/, $list) {
#print "value $value\n";
next unless($value);
($row[$sn] = $value) =~ s/\s//g;
print F (join "\t", @row)."\n";
}
} else {
print F (join "\t", @row)."\n";
}
}
print F "\\.\n";
$sth->finish;
close F;
} elsif ($t eq 'csv' || $t eq 'text') {
my $cols = $sth->{NAME};
#croak "<pre>".Data::Dumper->Dump([$cols])."</pre>";
croak "undefined file field f in args" unless($args{f});
#croak "undefined header field h in args" unless($args{h});
my %restrict;
if (defined($args{restrict_columns})) {
my $tmp;
for my $i ( 0 .. $#{$cols} ) {
unless (defined($args{restrict_columns}{$cols->[$i]})) {
push @{$tmp}, $cols->[$i];
} else {
$restrict{$i} = 1;
}
}
$cols = $tmp;
}
open F, ">$args{f}";
# add some common stuff so we have to do less further on in the code
$s->{r}{file_path} = $args{f};
$s->{r}{filename} = $args{filename} || 'exportfile.csv';
$s->{content_type} = 'text/plain' if ($t eq 'text');
$s->{content_type} = 'application/csv' if ($t eq 'csv');
print F '"'.(join '","', @{$cols}).'"'."\n";
while (my @row = $sth->fetchrow_array ) {
my @out;
for my $i ( 0 .. $#row ) {
if (defined($restrict{$i})) {
next;
}
$row[$i] =~ s/"/""/g;
push @out, $row[$i];
}
print F '"'.(join '","', @out).'"'."\n";
}
$sth->finish;
close F;
return;
} elsif ($t) {
croak "Unknown data return type t [$t]";
}
}
1;
( run in 1.664 second using v1.01-cache-2.11-cpan-fe3c2283af0 )