From: <rv...@us...> - 2009-11-02 23:05:30
|
Revision: 235 http://treebase.svn.sourceforge.net/treebase/?rev=235&view=rev Author: rvos Date: 2009-11-02 23:05:22 +0000 (Mon, 02 Nov 2009) Log Message: ----------- Added special case for STUDY_NEXUSFILE table dumper Modified Paths: -------------- trunk/treebase-core/src/main/perl/dump/sqldump trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm Modified: trunk/treebase-core/src/main/perl/dump/sqldump =================================================================== --- trunk/treebase-core/src/main/perl/dump/sqldump 2009-11-02 16:08:27 UTC (rev 234) +++ trunk/treebase-core/src/main/perl/dump/sqldump 2009-11-02 23:05:22 UTC (rev 235) @@ -18,6 +18,7 @@ my $nrecs; # max number of recs per table my $where = ""; # WHERE clause to select dumped records my $maxlen = 5 * 1024 * 1024; # Maximum field length: 5 MB by default +my $dir = 'STUDY_NEXUSFILE'; # Location to write dumped nexus files # get command line options, see Getopt::Long GetOptions( @@ -28,6 +29,7 @@ 'user=s' => \$ENV{'TREEBASE_DB_USER'}, 'pass=s' => \$ENV{'TREEBASE_DB_PASS'}, 'dsn=s' => \$ENV{'TREEBASE_DB_DSN'}, + 'dir=s' => \$dir, 'table=s' => \@tables, 'zip' => \$zip, 'maxlen=i' => \$maxlen, @@ -83,7 +85,8 @@ my $dumper = CIPRES::TreeBase::RecDumper->new( 'FIELDS' => \@names, 'TYPES' => \@types, - 'TABLE' => $table + 'TABLE' => $table, + 'DIR' => $dir, ) or die "Couldn't instantiate CIPRES::TreeBase::RecDumper"; # give dumper the output handle to write to, i.e. either STDOUT, 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 16:08:27 UTC (rev 234) +++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-11-02 23:05:22 UTC (rev 235) @@ -8,12 +8,15 @@ 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 $X = my @fieldnames = map uc, @$fn; + my $dir = $arg{'DIR'}; + mkdir $dir if not -d $dir; my $self = { 'F' => \@fieldnames, 'X' => $X, 'N' => $tn, - 'T' => $ct + 'T' => $ct, + 'D' => $dir, }; bless $self => $class; $self->_initialize(); @@ -48,8 +51,29 @@ and croak("rec: too few items (expected $self->{X})"); @_ = $self->quote_data(@_); - - my $values = join ", ", @_; + my @values; + if ( $self->{'N'} ne 'STUDY_NEXUSFILE' ) { + @values = @_; + } + else { + 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')"; + } + } + } + my $values = join ", ", @values; my $insert = $self->{'PREFIX'} . $values . $self->{'SUFFIX'}; return print {$self->{'OUT'}} $insert if $self->{'OUT'}; return $insert; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |