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 )