Menu
▾
▴
treebase-guts
|
From: <rv...@us...> - 2009-06-11 04:02:40
|
Revision: 21
http://treebase.svn.sourceforge.net/treebase/?rev=21&view=rev
Author: rvos
Date: 2009-06-11 04:02:05 +0000 (Thu, 11 Jun 2009)
Log Message:
-----------
Formatted source, added closing semicolon to terminate SQL INSERT statements
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-06-11 02:10:55 UTC (rev 20)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-06-11 04:02:05 UTC (rev 21)
@@ -5,12 +5,16 @@
sub new {
my $class = shift;
my %arg = @_;
- my $fn = $arg{FIELDS} or croak("$class->new: FIELDS required");
- my $ct = $arg{TYPES} or croak("$class->new: TYPES required");
- my $tn = uc $arg{TABLE} or croak("$class->new: TABLE required");
- my $X = my @fieldnames = map uc, @$fn;
-
- my $self = { F => \@fieldnames, X => $X, N => $tn, T => $ct };
+ my $fn = $arg{'FIELDS'} or croak("$class->new: FIELDS required");
+ my $ct = $arg{'TYPES'} or croak("$class->new: TYPES required");
+ my $tn = uc $arg{'TABLE'} or croak("$class->new: TABLE required");
+ my $X = my @fieldnames = map uc, @$fn;
+ my $self = {
+ 'F' => \@fieldnames,
+ 'X' => $X,
+ 'N' => $tn,
+ 'T' => $ct
+ };
bless $self => $class;
$self->_initialize();
return $self;
@@ -18,53 +22,54 @@
sub set_output {
my ($self, $fh) = @_;
- $self->{OUT} = $fh;
+ $self->{'OUT'} = $fh;
}
sub _initialize {
my $self = shift;
my $fieldlist = join ", ", @{$self->{F}};
# Need to escape certain field names here
- $self->{PREFIX} = qq{INSERT INTO $self->{N} ($fieldlist) VALUES (};
- $self->{SUFFIX} = qq{)\n};
+ $self->{'PREFIX'} = qq{INSERT INTO $self->{N} ($fieldlist) VALUES (};
+ $self->{'SUFFIX'} = qq{);\n}; # XXX added closing semicolon
return;
}
# Format data into an insert statement and return (or write) the result
sub rec {
- my $self = shift;
- @_ > @{$self->{F}}
- and croak("rec: too many items (expected $self->{X})");
- @_ < @{$self->{F}}
- and croak("rec: too few items (expected $self->{X})");
-
- @_ = $self->quote_data(@_);
-
- my $values = join ", ", @_;
- my $insert = $self->{PREFIX} . $values . $self->{SUFFIX};
- return print {$self->{OUT}} $insert if $self->{OUT};
- return $insert;
+ my $self = shift;
+ @_ > @{$self->{F}}
+ and croak("rec: too many items (expected $self->{X})");
+ @_ < @{$self->{F}}
+ and croak("rec: too few items (expected $self->{X})");
+
+ @_ = $self->quote_data(@_);
+
+ my $values = join ", ", @_;
+ my $insert = $self->{'PREFIX'} . $values . $self->{'SUFFIX'};
+ return print {$self->{'OUT'}} $insert if $self->{'OUT'};
+ return $insert;
}
# XXX UNFINISHED !!!!
sub quote_data {
my $self = shift;
my @d = @_;
- for my $i (0 .. $#{$self->{F}}) {
- my $t = $self->{T}[$i];
- local *_ = \$d[$i];
- $_ = "NULL", next unless defined;
-
- if ($t eq "CHAR" || $t eq "VARCHAR") {
- s/'/''/g;
- $_ = "'$_'";
- } elsif ($t =~ /^(BIG|SMALL|)INT$/ || $t eq "INTEGER"
- || $t eq "DOUBLE") {
- # do nothing
- } else {
- croak("Unknown field type '$t'; aborting");
+ for my $i (0 .. $#{$self->{F}}) {
+ my $t = $self->{T}[$i];
+ local *_ = \$d[$i];
+ $_ = "NULL", next unless defined;
+
+ if ($t eq "CHAR" || $t eq "VARCHAR") {
+ s/'/''/g;
+ $_ = "'$_'";
+ }
+ elsif ($t =~ /^(BIG|SMALL|)INT$/ || $t eq 'INTEGER' || $t eq 'DOUBLE') {
+ # do nothing
+ }
+ else {
+ croak("Unknown field type '$t'; aborting");
+ }
}
- }
return @d;
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rv...@us...> - 2009-06-11 08:37:54
|
Revision: 42
http://treebase.svn.sourceforge.net/treebase/?rev=42&view=rev
Author: rvos
Date: 2009-06-11 08:37:48 +0000 (Thu, 11 Jun 2009)
Log Message:
-----------
Added pg upper case escaping
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-06-11 08:21:24 UTC (rev 41)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-06-11 08:37:48 UTC (rev 42)
@@ -12,7 +12,7 @@
my $self = {
'F' => \@fieldnames,
'X' => $X,
- 'N' => $tn,
+ 'N' => '"'.$tn.'"',
'T' => $ct
};
bless $self => $class;
@@ -27,7 +27,7 @@
sub _initialize {
my $self = shift;
- my $fieldlist = join ", ", @{$self->{F}};
+ my $fieldlist = join ", ", map { "\"$_\"" } @{$self->{F}};
# Need to escape certain field names here
$self->{'PREFIX'} = qq{INSERT INTO $self->{N} ($fieldlist) VALUES (};
$self->{'SUFFIX'} = qq{);\n}; # XXX added closing semicolon
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rv...@us...> - 2009-06-12 06:14:27
|
Revision: 47
http://treebase.svn.sourceforge.net/treebase/?rev=47&view=rev
Author: rvos
Date: 2009-06-12 06:14:21 +0000 (Fri, 12 Jun 2009)
Log Message:
-----------
Added CLOB handling
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-06-12 05:19:59 UTC (rev 46)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-06-12 06:14:21 UTC (rev 47)
@@ -65,7 +65,7 @@
local *_ = \$d[$i];
$_ = "NULL", next unless defined;
- if ($t eq "CHAR" || $t eq "VARCHAR") {
+ if ($t eq "CHAR" || $t eq "VARCHAR" || $t eq 'CLOB') {
s/'/''/g;
$_ = "'$_'";
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rv...@us...> - 2009-06-12 07:04:00
|
Revision: 48
http://treebase.svn.sourceforge.net/treebase/?rev=48&view=rev
Author: rvos
Date: 2009-06-12 07:02:15 +0000 (Fri, 12 Jun 2009)
Log Message:
-----------
Added TIMESTMP handler
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-06-12 06:14:21 UTC (rev 47)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-06-12 07:02:15 UTC (rev 48)
@@ -72,6 +72,13 @@
elsif ($t =~ /^(BIG|SMALL|)INT$/ || $t eq 'INTEGER' || $t eq 'DOUBLE') {
# do nothing
}
+ elsif ($t eq 'TIMESTMP'){
+ if ( m|(\d+)/(\d+)/(\d+)\s+(\d+{2}):(\d+{2}):(\d+{2})| ) {
+ my ( $day, $month, $year, $hour, $minute, $second ) =
+ ( $1, $2, $3, $4, $5, $6 );
+ $_ = "${year}-${month}-${day} ${hour}:${minute}:${second}";
+ }
+ }
else {
croak("Unknown field type '$t'; aborting");
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rv...@us...> - 2009-06-12 07:09:25
|
Revision: 50
http://treebase.svn.sourceforge.net/treebase/?rev=50&view=rev
Author: rvos
Date: 2009-06-12 07:08:24 +0000 (Fri, 12 Jun 2009)
Log Message:
-----------
Fixed typo in regex
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-06-12 07:04:33 UTC (rev 49)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-06-12 07:08:24 UTC (rev 50)
@@ -73,7 +73,7 @@
# do nothing
}
elsif ($t eq 'TIMESTMP'){
- if ( m|(\d+)/(\d+)/(\d+)\s+(\d+{2}):(\d+{2}):(\d+{2})| ) {
+ if ( m|(\d{1,2})/(\d{1,2})/(\d{4})\s+(\d{2}):(\d{2}):(\d{2})| ) {
my ( $day, $month, $year, $hour, $minute, $second ) =
( $1, $2, $3, $4, $5, $6 );
$_ = "${year}-${month}-${day} ${hour}:${minute}:${second}";
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <mjd...@us...> - 2009-06-11 18:05:45
|
Revision: 43
http://treebase.svn.sourceforge.net/treebase/?rev=43&view=rev
Author: mjdominus
Date: 2009-06-11 18:04:40 +0000 (Thu, 11 Jun 2009)
Log Message:
-----------
clean up messy quotation marks, remove unused comment
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-06-11 08:37:48 UTC (rev 42)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-06-11 18:04:40 UTC (rev 43)
@@ -1,7 +1,7 @@
package CIPRES::TreeBase::RecDumper;
use Carp 'croak';
-# LOB fields should be removed from fieldlist and handled separately
+# XXX LOB fields should be removed from fieldlist and handled separately
sub new {
my $class = shift;
my %arg = @_;
@@ -12,7 +12,7 @@
my $self = {
'F' => \@fieldnames,
'X' => $X,
- 'N' => '"'.$tn.'"',
+ 'N' => $tn,
'T' => $ct
};
bless $self => $class;
@@ -27,9 +27,8 @@
sub _initialize {
my $self = shift;
- my $fieldlist = join ", ", map { "\"$_\"" } @{$self->{F}};
- # Need to escape certain field names here
- $self->{'PREFIX'} = qq{INSERT INTO $self->{N} ($fieldlist) VALUES (};
+ my $fieldlist = join ", ", map qq{"$_"}, @{$self->{F}};
+ $self->{'PREFIX'} = qq{INSERT INTO "$self->{N}" ($fieldlist) VALUES (};
$self->{'SUFFIX'} = qq{);\n}; # XXX added closing semicolon
return;
}
@@ -52,7 +51,7 @@
# Format metadata into a create statement and return (or write) the result
sub dump_create {
- my $create = 'CREATE TABLE ' . $self->{'N'} . ";\n";
+ my $create = qq{CREATE TABLE "$self->{'N'}";\n};
return print {$self->{'OUT'}} $create if $self->{'OUT'};
return $create;
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rv...@us...> - 2009-06-15 23:24:16
|
Revision: 51
http://treebase.svn.sourceforge.net/treebase/?rev=51&view=rev
Author: rvos
Date: 2009-06-15 23:24:14 +0000 (Mon, 15 Jun 2009)
Log Message:
-----------
Added DATE handler
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-06-12 07:08:24 UTC (rev 50)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-06-15 23:24:14 UTC (rev 51)
@@ -79,6 +79,13 @@
$_ = "${year}-${month}-${day} ${hour}:${minute}:${second}";
}
}
+ elsif ($t eq 'DATE'){
+ if ( m|(\d{1,2})/(\d{1,2})/(\d{4})| ) {
+ my ( $day, $month, $year ) =
+ ( $1, $2, $3 );
+ $_ = "${year}-${month}-${day}";
+ }
+ }
else {
croak("Unknown field type '$t'; aborting");
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rv...@us...> - 2009-06-15 23:32:05
|
Revision: 52
http://treebase.svn.sourceforge.net/treebase/?rev=52&view=rev
Author: rvos
Date: 2009-06-15 23:31:27 +0000 (Mon, 15 Jun 2009)
Log Message:
-----------
Added single quotes around date and timestamp reformatted strings
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-06-15 23:24:14 UTC (rev 51)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-06-15 23:31:27 UTC (rev 52)
@@ -76,14 +76,14 @@
if ( m|(\d{1,2})/(\d{1,2})/(\d{4})\s+(\d{2}):(\d{2}):(\d{2})| ) {
my ( $day, $month, $year, $hour, $minute, $second ) =
( $1, $2, $3, $4, $5, $6 );
- $_ = "${year}-${month}-${day} ${hour}:${minute}:${second}";
+ $_ = "'${year}-${month}-${day} ${hour}:${minute}:${second}'";
}
}
elsif ($t eq 'DATE'){
if ( m|(\d{1,2})/(\d{1,2})/(\d{4})| ) {
my ( $day, $month, $year ) =
( $1, $2, $3 );
- $_ = "${year}-${month}-${day}";
+ $_ = "'${year}-${month}-${day}'";
}
}
else {
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <mjd...@us...> - 2009-06-15 23:38:56
|
Revision: 53
http://treebase.svn.sourceforge.net/treebase/?rev=53&view=rev
Author: mjdominus
Date: 2009-06-15 23:38:04 +0000 (Mon, 15 Jun 2009)
Log Message:
-----------
Added handler for ISO 8601 dates
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-06-15 23:31:27 UTC (rev 52)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-06-15 23:38:04 UTC (rev 53)
@@ -80,11 +80,16 @@
}
}
elsif ($t eq 'DATE'){
+ my ( $day, $month, $year );
if ( m|(\d{1,2})/(\d{1,2})/(\d{4})| ) {
- my ( $day, $month, $year ) =
- ( $1, $2, $3 );
- $_ = "'${year}-${month}-${day}'";
+ ( $day, $month, $year ) =
+ ( $1, $2, $3 );
}
+ if ( m|(\d{4})-(\d{1,2})-(\d{1,2})| ) {
+ ( $year, $month, $day ) =
+ ( $1, $2, $3 );
+ }
+ $_ = "'${year}-${month}-${day}'";
}
else {
croak("Unknown field type '$t'; aborting");
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rv...@us...> - 2009-06-16 00:10:45
|
Revision: 54
http://treebase.svn.sourceforge.net/treebase/?rev=54&view=rev
Author: rvos
Date: 2009-06-16 00:10:30 +0000 (Tue, 16 Jun 2009)
Log Message:
-----------
Some code formatting.
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-06-15 23:38:04 UTC (rev 53)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-06-16 00:10:30 UTC (rev 54)
@@ -80,16 +80,14 @@
}
}
elsif ($t eq 'DATE'){
- my ( $day, $month, $year );
+ my ( $day, $month, $year );
if ( m|(\d{1,2})/(\d{1,2})/(\d{4})| ) {
- ( $day, $month, $year ) =
- ( $1, $2, $3 );
+ ( $day, $month, $year ) = ( $1, $2, $3 );
}
- if ( m|(\d{4})-(\d{1,2})-(\d{1,2})| ) {
- ( $year, $month, $day ) =
- ( $1, $2, $3 );
- }
- $_ = "'${year}-${month}-${day}'";
+ if ( m|(\d{4})-(\d{1,2})-(\d{1,2})| ) {
+ ( $year, $month, $day ) = ( $1, $2, $3 );
+ }
+ $_ = "'${year}-${month}-${day}'";
}
else {
croak("Unknown field type '$t'; aborting");
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <mjd...@us...> - 2009-11-04 00:20:55
|
Revision: 236
http://treebase.svn.sourceforge.net/treebase/?rev=236&view=rev
Author: mjdominus
Date: 2009-11-04 00:19:56 +0000 (Wed, 04 Nov 2009)
Log Message:
-----------
Added special case handling for STUDY_NEXUSFILE lob fields
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-11-02 23:05:22 UTC (rev 235)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-11-04 00:19:56 UTC (rev 236)
@@ -1,5 +1,7 @@
package CIPRES::TreeBase::RecDumper;
use Carp 'croak';
+use File::Temp qw(tempfile);
+use strict;
# XXX LOB fields should be removed from fieldlist and handled separately
sub new {
@@ -49,29 +51,26 @@
and croak("rec: too many items (expected $self->{X})");
@_ < @{$self->{F}}
and croak("rec: too few items (expected $self->{X})");
-
- @_ = $self->quote_data(@_);
my @values;
if ( $self->{'N'} ne 'STUDY_NEXUSFILE' ) {
- @values = @_;
+ @values = $self->quote_data(@_);
}
else {
+ my ( %record, $dir, $path );
+ eval {
my @fields = @{$self->{F}};
- my ( $dir, $path ) = ( $self->{'D'} );
- for my $i ( 0 .. $#fields ) {
- if ( uc $fields[$i] eq 'ID' ) {
- $path = "$dir/".$_[$i];
- }
- if ( uc $fields[$i] ne 'NEXUS' ) {
- push @values, $_[$i];
- }
- else {
- open my $nexfh, '>', $path or croak $!;
- print $nexfh $_[$i];
- close $nexfh;
- push @values, "lo_import('$path')";
- }
- }
+ %record = map { $fields[$_] => $_[$_] } ( 0 .. $#fields );
+# $dir = $self->{'D'} . '/' . $record{STUDY_ID};
+# mkdir $dir if not -d $dir;
+# $path = $dir . '/' . $record{FILENAME};
+ my ( $fh, $filename ) = tempfile( DIR => $self->{'D'} );
+ @values = ( $self->quote_data($record{STUDY_ID}), "lo_import('$filename')", $self->quote_data($record{FILENAME}) );
+# open my $nexfh, '>', $path or croak $!;
+ print $fh substr( $record{NEXUS}, 1, length($record{NEXUS}) - 2 );
+ close $fh;
+ system('gzip','-9',$filename);
+ };
+ warn 'dir: ', $dir, ' path: ', $path, ' file: ', $record{FILENAME}, ' id: ', $record{STUDY_ID}, ' msg: ', $@ if $@;
}
my $values = join ", ", @values;
my $insert = $self->{'PREFIX'} . $values . $self->{'SUFFIX'};
@@ -81,6 +80,7 @@
# Format metadata into a create statement and return (or write) the result
sub dump_create {
+ my $self = shift;
my $create = qq{CREATE TABLE "$self->{'N'}";\n};
return print {$self->{'OUT'}} $create if $self->{'OUT'};
return $create;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rv...@us...> - 2009-11-24 10:29:13
|
Revision: 312
http://treebase.svn.sourceforge.net/treebase/?rev=312&view=rev
Author: rvos
Date: 2009-11-24 10:29:04 +0000 (Tue, 24 Nov 2009)
Log Message:
-----------
Added POD to recdumper
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-11-24 10:12:09 UTC (rev 311)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-11-24 10:29:04 UTC (rev 312)
@@ -3,6 +3,24 @@
use File::Temp qw(tempfile);
use strict;
+=head1 CIPRES::TreeBase::RecDumper
+
+Writes the contents of a database table as CREATE and INSERT statements.
+Used by the C<sqldump> script.
+
+=head1 METHODS
+
+=over
+
+=item new()
+
+Record dumper constructor. Required named arguments:
+ * TABLE => name of table to dump
+ * FIELDS => columns to dump from the focal table
+ * TYPES => datatype names for FIELDS to dump
+
+=cut
+
# XXX LOB fields should be removed from fieldlist and handled separately
sub new {
my $class = shift;
@@ -25,11 +43,6 @@
return $self;
}
-sub set_output {
- my ($self, $fh) = @_;
- $self->{'OUT'} = $fh;
-}
-
sub _initialize {
my $self = shift;
my $fieldlist = join ", ", map qq{"$_"}, @{$self->{F}};
@@ -38,13 +51,36 @@
return;
}
+=item set_output()
+
+Set the invocant record dumper to write to the provided handle.
+
+=cut
+
+sub set_output {
+ my ($self, $fh) = @_;
+ $self->{'OUT'} = $fh;
+}
+
+=item print()
+
+Prints argument list. If set_output() has been called previously,
+this method prints to the handle provided there.
+
+=cut
+
# Print some text literally
sub print {
my $self = shift;
return print {$self->{'OUT'}} @_;
}
-# Format data into an insert statement and return (or write) the result
+=item rec()
+
+Format data into an insert statement and return (or write) the result
+
+=cut
+
sub rec {
my $self = shift;
@_ > @{$self->{F}}
@@ -58,19 +94,19 @@
else {
my ( %record, $dir, $path );
eval {
- my @fields = @{$self->{F}};
- %record = map { $fields[$_] => $_[$_] } ( 0 .. $#fields );
-# $dir = $self->{'D'} . '/' . $record{STUDY_ID};
-# mkdir $dir if not -d $dir;
-# $path = $dir . '/' . $record{FILENAME};
- my ( $fh, $filename ) = tempfile( DIR => $self->{'D'} );
- @values = ( $self->quote_data($record{STUDY_ID}), "lo_import('$filename')", $self->quote_data($record{FILENAME}) );
-# open my $nexfh, '>', $path or croak $!;
- print $fh substr( $record{NEXUS}, 1, length($record{NEXUS}) - 2 );
- close $fh;
- system('gzip','-9',$filename);
+ my @fields = @{$self->{F}};
+ %record = map { $fields[$_] => $_[$_] } ( 0 .. $#fields );
+ # $dir = $self->{'D'} . '/' . $record{STUDY_ID};
+ # mkdir $dir if not -d $dir;
+ # $path = $dir . '/' . $record{FILENAME};
+ my ( $fh, $filename ) = tempfile( DIR => $self->{'D'} );
+ @values = ( $self->quote_data($record{'STUDY_ID'}), "lo_import('$filename')", $self->quote_data($record{FILENAME}) );
+ # open my $nexfh, '>', $path or croak $!;
+ print $fh substr( $record{'NEXUS'}, 1, length($record{'NEXUS'}) - 2 );
+ close $fh;
+ system('gzip','-9',$filename);
};
- warn 'dir: ', $dir, ' path: ', $path, ' file: ', $record{FILENAME}, ' id: ', $record{STUDY_ID}, ' msg: ', $@ if $@;
+ warn 'dir: ', $dir, ' path: ', $path, ' file: ', $record{'FILENAME'}, ' id: ', $record{'STUDY_ID'}, ' msg: ', $@ if $@;
}
my $values = join ", ", @values;
my $insert = $self->{'PREFIX'} . $values . $self->{'SUFFIX'};
@@ -78,7 +114,12 @@
return $insert;
}
-# Format metadata into a create statement and return (or write) the result
+=item dump_create()
+
+Format metadata into a create statement and return (or write) the result
+
+=cut
+
sub dump_create {
my $self = shift;
my $create = qq{CREATE TABLE "$self->{'N'}";\n};
@@ -86,11 +127,19 @@
return $create;
}
+=item quote_data()
+
+For a provided list of record fields, looks up internally what the
+data types are and applies the correct quoting (e.g. numbers
+unquoted, strings quoted).
+
+=cut
+
sub quote_data {
my $self = shift;
my @d = @_;
- for my $i (0 .. $#{$self->{F}}) {
- my $t = $self->{T}[$i];
+ for my $i (0 .. $#{$self->{'F'}}) {
+ my $t = $self->{'T'}[$i];
local *_ = \$d[$i];
$_ = "NULL", next unless defined;
@@ -126,4 +175,12 @@
return @d;
}
+=back
+
+=head1 SEE ALSO
+
+sqldump
+
+=cut
+
1;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X