treebase-guts

[Treebase-guts] SF.net SVN: treebase:[187] trunk/treebase-core/src/main/perl/lib/CIPRES/ TreeBase/DBIUtil.pm

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

Revision: 187
          http://treebase.svn.sourceforge.net/treebase/?rev=187&view=rev
Author:   rvos
Date:     2009-09-26 04:41:53 +0000 (Sat, 26 Sep 2009)

Log Message:
-----------
Debugging perly login methods

Modified Paths:
--------------
    trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/DBIUtil.pm

Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/DBIUtil.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/DBIUtil.pm	2009-09-26 04:04:53 UTC (rev 186)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/DBIUtil.pm	2009-09-26 04:41:53 UTC (rev 187)
@@ -16,7 +16,6 @@
     my $user = $opts{user} || $login_info_class->user;
     my $pass = $opts{pass} || $login_info_class->pass;
     my $dsn  = $opts{dsn} ? sprintf $opts{dsn}, $user, $pass : $login_info_class->dsn($user, $pass);
-
     my $h = DBI->connect($dsn);
     $h->{private_cipres_treebase_dbiutil_username} = $user if $h;
     return $h;


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Treebase-guts] SF.net SVN: treebase:[309] trunk/treebase-core/src/main/perl/lib/CIPRES/ TreeBase/DBIUtil.pm

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

Revision: 309
          http://treebase.svn.sourceforge.net/treebase/?rev=309&view=rev
Author:   rvos
Date:     2009-11-24 10:04:56 +0000 (Tue, 24 Nov 2009)

Log Message:
-----------
Added POD to DBIUtil

Modified Paths:
--------------
    trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/DBIUtil.pm

Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/DBIUtil.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/DBIUtil.pm	2009-11-24 04:34:45 UTC (rev 308)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/DBIUtil.pm	2009-11-24 10:04:56 UTC (rev 309)
@@ -1,36 +1,89 @@
-
 package CIPRES::TreeBase::DBIUtil;
 use base 'Exporter';
 use DBI;
 @EXPORT = qw(print_aoh quick_select);
 @EXPORT_OK = qw(get_colnames get_coltypes);
 
+=head1 CIPRES::TreeBase::DBIUtil
+
+Utility functions for database operations.
+
+=head1 SPECIAL VARIABLES
+
+=over
+
+=item @EXPORT
+
+Exports print_aoh and quick_select
+
+=item @EXPORT_OK
+
+Exports get_colnames and get_coltypes
+
+=back
+
+=head1 FUNCTIONS
+
+=over
+
+=item dbh()
+
+Creates and returns a database handle. Optional named arguments:
+ * user => database user name
+ * pass => database password
+ * dsn  => DBI-compliant dsn template string (with optional 
+           sprintf placeholders for user name and password)
+ * login_info_class => package name of a class that conforms 
+           to the interface of CIPRES::TreeBase::DBILogin
+
+=cut
+
 sub dbh {
     my ($class) = shift;
     my %opts = @_;
 
-    my ($login_info_class) = $opts{login_info_class} || 'CIPRES::TreeBase::DBILogin';
+    my ($login_info_class) = $opts{'login_info_class'} || 'CIPRES::TreeBase::DBILogin';
     my $login_info_file = $login_info_class;
     $login_info_file =~ s{::}{/}g;
     require "$login_info_file.pm";
-    my $user = $opts{user} || $login_info_class->user;
-    my $pass = $opts{pass} || $login_info_class->pass;
-    my $dsn  = $opts{dsn} ? sprintf $opts{dsn}, $user, $pass : $login_info_class->dsn($user, $pass);
+    my $user = $opts{'user'} || $login_info_class->user;
+    my $pass = $opts{'pass'} || $login_info_class->pass;
+    my $dsn  = $opts{'dsn'} ? sprintf $opts{'dsn'}, $user, $pass : $login_info_class->dsn($user, $pass);
     my $h = DBI->connect($dsn);
-    $h->{private_cipres_treebase_dbiutil_username} = $user if $h;
+    $h->{'private_cipres_treebase_dbiutil_username'} = $user if $h;
     return $h;
 }
 
+=item get_user()
+
+Returns the TreeBASE database user name.
+
+=cut
+
 sub get_user {
-    return $_[0]{private_cipres_treebase_dbiutil_username};
+    return $_[0]{'private_cipres_treebase_dbiutil_username'};
 }
 
+=item max()
+
+Utility function, returns the highest numerical value in the argument list.
+
+=cut
+
 sub max {
     my $max = shift;
     $max = $max > $_ ? $max : $_ for @_;
     $max;
 }
 
+=item print_aoa()
+
+Utility function, prints an array of arrays provided as an array reference where the
+first row is a header row. Second argument is what is used to pad undefined values.
+Calls print_rows() internally.
+
+=cut
+
 sub print_aoa {
     my @aoa = @{shift()};
     return if @aoa == 0;
@@ -39,6 +92,15 @@
     print_rows(\@headers, \@aoa, $null);
 }
 
+=item print_aoh()
+
+Utility function, prints an array of hashes provided as an array reference
+containing hash references where the keys of the first hash are used as the
+header row. Second argument is what is used to pad undefined values.
+Calls print_rows() internally.
+
+=cut
+
 sub print_aoh {
     my $aoh = shift;
     return if @$aoh == 0;
@@ -48,31 +110,49 @@
     print_rows(\@headers, \@rows, $null);
 }
 
+=item print_rows()
+
+Internal function, called by print_aoa() and print_aoh().
+
+=cut
+
 sub print_rows {
     my ($headers, $rows, $null) = @_;
     my @width = map length, @$headers;
     for my $row (@$rows) {
-	@$row = map defined() ? $_ : $null, @$row;
-	s/ +$// for @$row;
-	s/^ +// for @$row;
-	s/([^[:print:]])/"\\x" . sprintf("%02x", ord($1))/ge for @$row;
-	$width[$_] = max($width[$_], length $row->[$_]) for 0 .. $#$row;
+		@$row = map defined() ? $_ : $null, @$row;
+		s/ +$// for @$row;
+		s/^ +// for @$row;
+		s/([^[:print:]])/"\\x" . sprintf("%02x", ord($1))/ge for @$row;
+		$width[$_] = max($width[$_], length $row->[$_]) for 0 .. $#$row;
     }
     printcols($headers, \@width, " | ");
     printhyphens(\@width, 3);
     printcols($_, \@width, " | ") for @$rows;
 }
 
+=item printcols()
+
+Internal function, called by print_rows()
+
+=cut
+
 sub printcols {
     my ($vals, $w, $fill) = @_;
     for my $i (0 .. $#$vals) {
-	my $v = $vals->[$i];
-	print $v, " " x ($w->[$i] - length $v);
-	print $fill unless $i == $#$vals;
+		my $v = $vals->[$i];
+		print $v, " " x ($w->[$i] - length $v);
+		print $fill unless $i == $#$vals;
     }
     print "\n";
 }
 
+=item printhyphens()
+
+Internal function, called by print_rows()
+
+=cut
+
 sub printhyphens {
     my ($w, $x) = @_;
     my $t = 0;
@@ -81,6 +161,16 @@
     print "-" x $t, "\n";
 }
 
+=item quick_select()
+
+Utility function, runs the provided query statement (second argument)
+on the provided database handle (first argument). Returns undef if 
+multiple records are returned by the query (because that is considered
+an error). Otherwise returns an array or the first value of the array
+depending on context (array or scalar, respectively).
+
+=cut
+
 sub quick_select {
     my $dbh = shift;
     my $q = shift;
@@ -91,6 +181,15 @@
     return wantarray ? @rec : $rec[0];
 }
 
+=item get_colnames()
+
+Given a database handle and a table name, returns the names
+of the columns in that table. Returns either a list or an
+array reference, depending on the context (array or scalar,
+respectively).
+
+=cut
+
 # Maybe use new $dbh->table_info method instead.
 sub get_colnames {
     my $dbh = shift();
@@ -104,6 +203,15 @@
     return wantarray() ? @$names : $names;
 }
 
+=item get_coltypes()
+
+Given a database handle and a table name, returns the
+datatype names of the columns in the table. Returns
+either a list or an array reference, depending on the
+context (array or scalar, respectively).
+
+=cut
+
 sub get_coltypes {
     my $dbh = shift();
     my $table = uc(shift());
@@ -117,4 +225,12 @@
     return wantarray() ? @$names : $names;
 }
 
+=back
+
+=head1 SEE ALSO
+
+L<CIPRES::TreeBase::DBILogin>, L<DBI>
+
+=cut
+
 1;


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.