fixed color palette in KISS

[biopieces.git] / code_perl / Maasha / Biopieces.pm

diff --git a/code_perl/Maasha/Biopieces.pm b/code_perl/Maasha/Biopieces.pm
index 867f71b011aaf90326ed38ace14927007623d933..1865cca4bb377780bb54460ef9ae0ec57cbf593e 100644 (file)
--- a/code_perl/Maasha/Biopieces.pm
+++ b/code_perl/Maasha/Biopieces.pm
@@ -306,7 +306,6 @@ sub parse_options
     # ---- Adding the mandatory arguments to the arg_list ----
 
     push @{ $arg_list }, (
-    
         { long => 'help',       short => '?', type => 'flag',  mandatory => 'no', default => undef, allowed => undef, disallowed => undef },
         { long => 'stream_in',  short => 'I', type => 'file!', mandatory => 'no', default => undef, allowed => undef, disallowed => undef },
         { long => 'stream_out', short => 'O', type => 'file',  mandatory => 'no', default => undef, allowed => undef, disallowed => undef },
@@ -398,23 +397,27 @@ sub check_print_usage
 
     # Returns nothing.
 
-    my ( $script, $wiki );
+    my ( %options, $help, $script, $wiki );
+
+    %options = %{ $options };
+    $help    = $options{ 'help' };
+    delete $options{ 'help' };
 
     $script = Maasha::Common::get_scriptname();
 
     if ( $script ne 'print_wiki' )
     {
-        if ( exists $options->{ 'help' } or -t STDIN )
+        if ( $help or -t STDIN )
         {
-            if ( not ( exists $options->{ 'stream_in' } or $options->{ 'data_in' } ) )
+            if ( not ( exists $options{ 'stream_in' } or $options{ 'data_in' } ) )
             {
-                if ( scalar keys %{ $options } <= 1 ) 
+                if ( scalar keys %options == 0 ) 
                 {
                     $wiki = $ENV{ 'BP_DIR' } . "/bp_usage/$script.wiki";
                
-                    if ( exists $options->{ 'help' } ) {
+                    if ( $help ) {
                         `print_wiki --data_in=$wiki --help`;
-                    } elsif ( $script =~ /^(list_biopieces|list_genomes|biostat)$/ ) {
+                    } elsif ( $script =~ /^(list_biopieces|list_genomes|list_mysql_databases|biostat)$/ ) {
                         return;
                     } else {
                         `print_wiki --data_in=$wiki`;
@@ -688,35 +691,36 @@ sub check_disallowed
 }
 
 
-sub getopt_files
-{
-    # Martin A. Hansen, November 2007.
-
-    # Extracts files from an explicit GetOpt::Long argument
-    # allowing for the use of glob. E.g.
-    # --data_in=test.fna
-    # --data_in=test.fna,test2.fna
-    # --data_in=*.fna
-    # --data_in=test.fna,/dir/*.fna
-
-    my ( $option,   # option from GetOpt::Long
-       ) = @_;
-
-    # Returns a list.
-
-    my ( $elem, @files );
-
-    foreach $elem ( split ",", $option )
-    {
-        if ( -f $elem ) {
-            push @files, $elem;
-        } elsif ( $elem =~ /\*/ ) {
-            push @files, glob( $elem );
-        }
-    }
-
-    return wantarray ? @files : \@files;
-}
+# marked for deletion - obsolete?
+#sub getopt_files
+#{
+#    # Martin A. Hansen, November 2007.
+#
+#    # Extracts files from an explicit GetOpt::Long argument
+#    # allowing for the use of glob. E.g.
+#    # --data_in=test.fna
+#    # --data_in=test.fna,test2.fna
+#    # --data_in=*.fna
+#    # --data_in=test.fna,/dir/*.fna
+#
+#    my ( $option,   # option from GetOpt::Long
+#       ) = @_;
+#
+#    # Returns a list.
+#
+#    my ( $elem, @files );
+#
+#    foreach $elem ( split ",", $option )
+#    {
+#        if ( -f $elem ) {
+#            push @files, $elem;
+#        } elsif ( $elem =~ /\*/ ) {
+#            push @files, glob( $elem );
+#        }
+#    }
+#
+#    return wantarray ? @files : \@files;
+#}
 
 
 sub sig_handler
@@ -847,6 +851,36 @@ sub get_tmpdir
 }
 
 
+sub biopiecesrc
+{
+    # Martin A. Hansen, July 2009.
+
+    # Read Biopiece configuration info from .biopiecesrc.
+    # and returns the value of a given key.
+
+    my ( $key,   # configuration key
+       ) = @_;
+
+    # Returns a string.
+
+    my ( $file, $fh, $record );
+
+    $file = "$ENV{ 'HOME' }/.biopiecesrc";
+
+    return undef if not -f $file;
+
+    $fh     = Maasha::Filesys::file_read_open( $file );
+    $record = get_record( $fh );
+    close $fh;
+
+    if ( exists $record->{ $key } ) {
+        return $record->{ $key };
+    } else {
+        return undef;
+    }
+}
+
+
 END
 {
     clean_tmp();