[Treebase-guts] SF.net SVN: treebase:[235] trunk/treebase-core/src/main/perl

[<rv...@us...>]

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.