code_perl/Maasha/Biopieces.pm

   1 package Maasha::Biopieces;
   2
   3
   4 # Copyright (C) 2007-2009 Martin A. Hansen.
   5
   6 # This program is free software; you can redistribute it and/or
   7 # modify it under the terms of the GNU General Public License
   8 # as published by the Free Software Foundation; either version 2
   9 # of the License, or (at your option) any later version.
  10
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program; if not, write to the Free Software
  18 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  19
  20 # http://www.gnu.org/copyleft/gpl.html
  21
  22
  23 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  24
  25
  26 # Routines for manipulation, parsing and emitting of human/machine readable biopieces records.
  27
  28
  29 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  30
  31
  32 use vars qw( @ISA @EXPORT_OK );
  33
  34 require Exporter;
  35
  36 @ISA = qw( Exporter );
  37
  38 @EXPORT_OK = qw(
  39     read_stream
  40     write_stream
  41     get_record
  42     put_record
  43 );
  44
  45
  46 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SIGNAL HANDLER <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  47
  48
  49 $SIG{ '__DIE__' } = \&sig_handler;
  50 $SIG{ 'INT' }     = \&sig_handler;
  51 $SIG{ 'TERM' }    = \&sig_handler;
  52
  53
  54 sub log_biopiece
  55 {
  56     # Martin A. Hansen, January 2008.
  57
  58     # Log messages to logfile.
  59
  60     # Returns nothing.
  61
  62     my ( $time_stamp, $user, $script, $fh_global, $fh_local );
  63
  64     $time_stamp = Maasha::Common::time_stamp();
  65     $user       = Maasha::Common::get_user();
  66     $script     = Maasha::Common::get_scriptname();
  67
  68     $fh_global  = Maasha::Common::append_open( "$ENV{ 'BP_LOG' }/biopieces.log" );
  69     $fh_local   = Maasha::Common::append_open( "$ENV{ 'HOME' }/.biopieces.log" );
  70
  71     print $fh_global "$time_stamp\t$user\t$script ", join( " ", @ARGV ), "\n";
  72     print $fh_local  "$time_stamp\t$user\t$script ", join( " ", @ARGV ), "\n";
  73
  74     $fh_global->autoflush( 1 );
  75     $fh_local->autoflush( 1 );
  76
  77     close $fh_global;
  78     close $fh_local;
  79 }
  80
  81
  82 sub read_stream
  83 {
  84     # Martin A. Hansen, July 2007.
  85
  86     # Opens a stream to STDIN or a file,
  87
  88     my ( $path,   # path - OPTIONAL
  89        ) = @_;
  90
  91     # Returns filehandle.
  92
  93     my ( $fh );
  94
  95     if ( not -t STDIN ) {
  96         $fh = Maasha::Common::read_stdin();
  97     } elsif ( not $path ) {
  98 #        Maasha::Common::error( qq(no data stream) );
  99     } else {
 100         $fh = Maasha::Common::read_open( $path );
 101     }
 102
 103 #    $fh->autoflush(1) if $fh;  # Disable file buffer for debugging.
 104
 105     return $fh;
 106 }
 107
 108
 109 sub write_stream
 110 {
 111     # Martin A. Hansen, August 2007.
 112
 113     # Opens a stream to STDOUT or a file.
 114
 115     my ( $path,   # path          - OPTIONAL
 116          $gzip,   # compress data - OPTIONAL
 117        ) = @_;
 118
 119     # Returns filehandle.
 120
 121     my ( $fh );
 122
 123     if ( $path ) {
 124         $fh = Maasha::Common::write_open( $path, $gzip );
 125     } else {
 126         $fh = Maasha::Common::write_stdout();
 127     }
 128
 129     return $fh;
 130 }
 131
 132
 133 sub get_record
 134 {
 135     # Martin A. Hansen, July 2007.
 136
 137     # Reads one record at a time and converts that record
 138     # to a Perl data structure (a hash) which is returned.
 139
 140     my ( $fh,   # handle to stream
 141        ) = @_;
 142
 143     # Returns a hash.
 144
 145     my ( $block, @lines, $line, $key, $value, %record );
 146
 147     local $/ = "\n---\n";
 148
 149     $block = <$fh>;
 150
 151     chomp $block;
 152
 153     return if not defined $block;
 154
 155     @lines = split "\n", $block;
 156
 157     foreach $line ( @lines )
 158     {
 159         ( $key, $value ) = split ": ", $line, 2;
 160
 161         $record{ $key } = $value;
 162     }
 163
 164     return wantarray ? %record : \%record;
 165 }
 166
 167
 168 sub put_record
 169 {
 170     # Martin A. Hansen, July 2007.
 171
 172     # Given a Perl datastructure (a hash ref) emits this to STDOUT or a filehandle.
 173
 174     my ( $data,   # data structure
 175          $fh,     # file handle - OPTIONAL
 176        ) = @_;
 177
 178     # Returns nothing.
 179
 180     if ( scalar keys %{ $data } )
 181     {
 182         if ( $fh )
 183         {
 184             map { print $fh "$_: $data->{ $_ }\n" } keys %{ $data };
 185             print $fh "---\n";
 186         }
 187         else
 188         {
 189             map { print "$_: $data->{ $_ }\n" } keys %{ $data };
 190             print "---\n";
 191         }
 192     }
 193
 194     undef $data;
 195 }
 196
 197
 198 sub getopt_files
 199 {
 200     # Martin A. Hansen, November 2007.
 201
 202     # Extracts files from an explicit GetOpt::Long argument
 203     # allowing for the use of glob. E.g.
 204     # --data_in=test.fna
 205     # --data_in=test.fna,test2.fna
 206     # --data_in=*.fna
 207     # --data_in=test.fna,/dir/*.fna
 208
 209     my ( $option,   # option from GetOpt::Long
 210        ) = @_;
 211
 212     # Returns a list.
 213
 214     my ( $elem, @files );
 215
 216     foreach $elem ( split ",", $option )
 217     {
 218         if ( -f $elem ) {
 219             push @files, $elem;
 220         } elsif ( $elem =~ /\*/ ) {
 221             push @files, glob( $elem );
 222         }
 223     }
 224
 225     return wantarray ? @files : \@files;
 226 }
 227
 228
 229 sub sig_handler
 230 {
 231     # Martin A. Hansen, April 2008.
 232
 233     # Removes temporary directory and exits gracefully.
 234     # This subroutine is meant to be run always as the last
 235     # thing even if a script is dies or is interrupted
 236     # or killed.
 237
 238     my ( $sig,   # signal from the %SIG
 239        ) = @_;
 240
 241     # print STDERR "signal->$sig<-\n";
 242
 243     chomp $sig;
 244
 245     sleep 1;
 246
 247     if ( -d $BP_TMP )
 248     {
 249         if ( $sig =~ /MAASHA_ERROR/ ) {
 250             print STDERR "\nProgram '$script' had an error"                     . "  -  Please wait for temporary data to be removed\n";
 251         } elsif ( $sig eq "INT" ) {
 252             print STDERR "\nProgram '$script' interrupted (ctrl-c was pressed)" . "  -  Please wait for temporary data to be removed\n";
 253         } elsif ( $sig eq "TERM" ) {
 254             print STDERR "\nProgram '$script' terminated (someone used kill?)"  . "  -  Please wait for temporary data to be removed\n";
 255         } else {
 256             print STDERR "\nProgram '$script' died->$sig"                       . "  -  Please wait for temporary data to be removed\n";
 257         }
 258
 259         clean_tmp();
 260     }
 261
 262     exit( 0 );
 263 }
 264
 265
 266 sub clean_tmp
 267 {
 268     # Martin A. Hansen, July 2008.
 269
 270     # Cleans out any unused temporary files and directories in BP_TMP.
 271
 272     # Returns nothing.
 273
 274     my ( $tmpdir, @dirs, $curr_pid, $dir, $user, $sid, $pid );
 275
 276     $tmpdir = $ENV{ 'BP_TMP' } || Maasha::Common::error( 'No BP_TMP variable in environment.' );
 277
 278     $curr_pid = Maasha::Common::get_processid();
 279
 280     @dirs = Maasha::Common::ls_dirs( $tmpdir );
 281
 282     foreach $dir ( @dirs )
 283     {
 284         if ( $dir =~ /^$tmpdir\/(.+)_(\d+)_(\d+)_bp_tmp$/ )
 285         {
 286             $user = $1;
 287             $sid  = $2;
 288             $pid  = $3;
 289
 290 #            next if $user eq "maasha"; # DEBUG
 291
 292             if ( $user eq Maasha::Common::get_user() )
 293             {
 294                 if ( not Maasha::Common::process_running( $pid ) )
 295                 {
 296                     # print STDERR "Removing stale dir: $dir\n";
 297                     Maasha::Common::dir_remove( $dir );
 298                 }
 299                 elsif ( $pid == $curr_pid )
 300                 {
 301                     # print STDERR "Removing current dir: $dir\n";
 302                     Maasha::Common::dir_remove( $dir );
 303                 }
 304             }
 305         }
 306     }
 307 }
 308
 309
 310 END
 311 {
 312     clean_tmp();
 313 }
 314
 315
 316 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 317
 318
 319 1;
 320
 321 __END__