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 Getopt::Long qw( :config bundling );
  33 use Data::Dumper;
  34 use Maasha::Match;
  35 use Maasha::Common;
  36 use Maasha::Filesys;
  37 use vars qw( @ISA @EXPORT_OK );
  38
  39 require Exporter;
  40
  41 @ISA = qw( Exporter );
  42
  43 @EXPORT_OK = qw(
  44     read_stream
  45     write_stream
  46     get_record
  47     put_record
  48 );
  49
  50
  51 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SIGNAL HANDLER <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  52
  53
  54 $SIG{ '__DIE__' } = \&sig_handler;
  55 $SIG{ 'INT' }     = \&sig_handler;
  56 $SIG{ 'TERM' }    = \&sig_handler;
  57
  58
  59 sub log_biopiece
  60 {
  61     # Martin A. Hansen, January 2008.
  62
  63     # Log messages to logfile.
  64
  65     # Returns nothing.
  66
  67     my ( $time_stamp, $user, $script, $fh_global, $fh_local );
  68
  69     $time_stamp = Maasha::Common::time_stamp();
  70     $user       = Maasha::Common::get_user();
  71     $script     = Maasha::Common::get_scriptname();
  72
  73     $fh_global  = Maasha::Filesys::file_append_open( "$ENV{ 'BP_LOG' }/biopieces.log" );
  74     $fh_local   = Maasha::Filesys::file_append_open( "$ENV{ 'HOME' }/.biopieces.log" );
  75
  76     print $fh_global "$time_stamp\t$user\t$script ", join( " ", @ARGV ), "\n";
  77     print $fh_local  "$time_stamp\t$user\t$script ", join( " ", @ARGV ), "\n";
  78
  79     $fh_global->autoflush( 1 );
  80     $fh_local->autoflush( 1 );
  81
  82     close $fh_global;
  83     close $fh_local;
  84 }
  85
  86
  87 sub read_stream
  88 {
  89     # Martin A. Hansen, July 2007.
  90
  91     # Opens a stream to STDIN or a file,
  92
  93     my ( $file,   # file - OPTIONAL
  94        ) = @_;
  95
  96     # Returns filehandle.
  97
  98     my ( $fh );
  99
 100     if ( not -t STDIN ) {
 101         $fh = Maasha::Filesys::stdin_read();
 102     } elsif ( not $file ) {
 103         # Maasha::Common::error( qq(no data stream) );
 104     } else {
 105         $fh = Maasha::Filesys::file_read_open( $file );
 106     }
 107
 108     return $fh;
 109 }
 110
 111
 112 sub write_stream
 113 {
 114     # Martin A. Hansen, August 2007.
 115
 116     # Opens a stream to STDOUT or a file.
 117
 118     my ( $path,   # path          - OPTIONAL
 119          $gzip,   # compress data - OPTIONAL
 120        ) = @_;
 121
 122     # Returns filehandle.
 123
 124     my ( $fh );
 125
 126     if ( $path ) {
 127         $fh = Maasha::Filesys::file_write_open( $path, $gzip );
 128     } else {
 129         $fh = Maasha::Filesys::stdout_write();
 130     }
 131
 132     return $fh;
 133 }
 134
 135
 136 sub close_stream
 137 {
 138     # Martin A. Hansen, May 2009.
 139
 140     # Close stream if open.
 141
 142     my ( $fh,   # filehandle
 143        ) = @_;
 144
 145     # Returns nothing.
 146
 147     close $fh if defined $fh;
 148 }
 149
 150
 151 sub get_record
 152 {
 153     # Martin A. Hansen, July 2007.
 154
 155     # Reads one record at a time and converts that record
 156     # to a Perl data structure (a hash) which is returned.
 157
 158     my ( $fh,   # handle to stream
 159        ) = @_;
 160
 161     # Returns a hash.
 162
 163     my ( $block, @lines, $line, $key, $value, %record );
 164
 165     return if not defined $fh;
 166
 167     local $/ = "\n---\n";
 168
 169     $block = <$fh>;
 170
 171     return if not defined $block;
 172
 173     chomp $block;
 174
 175     @lines = split "\n", $block;
 176
 177     foreach $line ( @lines )
 178     {
 179         ( $key, $value ) = split ": ", $line, 2;
 180
 181         $record{ $key } = $value;
 182     }
 183
 184     return wantarray ? %record : \%record;
 185 }
 186
 187
 188 sub put_record
 189 {
 190     # Martin A. Hansen, July 2007.
 191
 192     # Given a Perl datastructure (a hash ref) emits this to STDOUT or a filehandle.
 193
 194     my ( $data,   # data structure
 195          $fh,     # file handle - OPTIONAL
 196        ) = @_;
 197
 198     # Returns nothing.
 199
 200     if ( scalar keys %{ $data } )
 201     {
 202         if ( $fh )
 203         {
 204             map { print $fh "$_: $data->{ $_ }\n" } keys %{ $data };
 205             print $fh "---\n";
 206         }
 207         else
 208         {
 209             map { print "$_: $data->{ $_ }\n" } keys %{ $data };
 210             print "---\n";
 211         }
 212     }
 213
 214     undef $data;
 215 }
 216
 217
 218 sub parse_options
 219 {
 220     # Martin A. Hansen, May 2009
 221
 222     #
 223
 224     my ( $arg_list,   # data structure with argument description
 225        ) = @_;
 226
 227     # Returns hashref.
 228
 229     my ( $arg, @list, $options );
 230
 231     # ---- Adding the mandatory arguments to the arg_list ----
 232
 233     push @{ $arg_list }, (
 234
 235         { long => 'help',       short => '?', type => 'flag',  mandatory => 'no',  default => undef, allowed => undef, disallowed => undef },
 236         { long => 'stream_in',  short => 'I', type => 'file!', mandatory => 'no',  default => undef, allowed => undef, disallowed => undef },
 237         { long => 'stream_out', short => 'O', type => 'file',  mandatory => 'no',  default => undef, allowed => undef, disallowed => undef },
 238         { long => 'verbose',    short => 'v', type => 'flag',  mandatory => 'no',  default => undef, allowed => undef, disallowed => undef },
 239     );
 240
 241     check_duplicates_args( $arg_list );
 242
 243     # ---- Compiling options list ----
 244
 245     foreach $arg ( @{ $arg_list } )
 246     {
 247         if ( $arg->{ 'type' } eq 'flag' ) {
 248             push @list, "$arg->{ 'long' }|$arg->{ 'short' }";
 249         } else {
 250             push @list, "$arg->{ 'long' }|$arg->{ 'short' }=s";
 251         }
 252     }
 253
 254     # ---- Parsing options from @ARGV ----
 255
 256     $options = {};
 257
 258     Getopt::Long::GetOptions( $options, @list );
 259
 260     # print Dumper( $options );
 261
 262     check_print_usage( $options );
 263
 264     # ---- Expanding and checking options ----
 265
 266     foreach $arg ( @{ $arg_list } )
 267     {
 268         check_mandatory(  $arg, $options );
 269         set_default(      $arg, $options );
 270         check_uint(       $arg, $options );
 271         check_int(        $arg, $options );
 272         set_list(         $arg, $options );
 273         check_dir(        $arg, $options );
 274         check_file(       $arg, $options );
 275         set_files(        $arg, $options );
 276         check_files(      $arg, $options );
 277         check_allowed(    $arg, $options );
 278         check_disallowed( $arg, $options );
 279     }
 280
 281     # print Dumper( $options );
 282
 283     # return wantarray ? $options : %{ $options }; # WTF! Someone changed the behaviour of wantarray???
 284
 285     return $options;
 286 }
 287
 288
 289 sub check_duplicates_args
 290 {
 291     # Martin A. Hansen, May 2009
 292
 293     # Check if there are duplicate long or short arguments,
 294     # and raise an error if so.
 295
 296     my ( $arg_list,   # List of argument hashrefs,
 297        ) = @_;
 298
 299     # Returns nothing.
 300
 301     my ( $arg, %check_hash );
 302
 303     foreach $arg ( @{ $arg_list } )
 304     {
 305         Maasha::Common::error( qq(Duplicate long argument: $arg->{ 'long' }) )   if exists $check_hash{ $arg->{ 'long' } };
 306         Maasha::Common::error( qq(Duplicate short argument: $arg->{ 'short' }) ) if exists $check_hash{ $arg->{ 'short' } };
 307
 308         $check_hash{ $arg->{ 'long' } } = 1;
 309         $check_hash{ $arg->{ 'short' } } = 1;
 310     }
 311 }
 312
 313
 314 sub check_print_usage
 315 {
 316     # Martin A. Hansen, May 2009.
 317
 318     # Check if we need to print usage and print usage
 319     # and exit if that is the case.
 320
 321     my ( $options,   # option hash
 322        ) = @_;
 323
 324     # Returns nothing.
 325
 326     my ( $script, $wiki );
 327
 328     $script = Maasha::Common::get_scriptname();
 329
 330     if ( $script ne 'print_wiki' )
 331     {
 332         # if ( exists $options{ 'help' } or not ( exists $options{ 'stream_in' } or exists $options{ 'data_in' } or not -t STDIN ) )
 333         if ( exists $options->{ 'help' } or ( scalar keys %{ $options } == 0 or exists $options->{ 'data_in' } or not -t STDIN ) )
 334         {
 335             $wiki = $ENV{ 'BP_DIR' } . "/bp_usage/$script.wiki";
 336
 337             if ( exists $options->{ 'help' } ) {
 338                 `print_wiki --data_in=$wiki --help`;
 339             } elsif ( $script =~ /^(list_biopieces|list_genomes)$/ ) {
 340                 return;
 341             } else {
 342                 `print_wiki --data_in=$wiki`;
 343             }
 344
 345             exit;
 346         }
 347     }
 348 }
 349
 350
 351 sub check_mandatory
 352 {
 353     # Martin A. Hansen, May 2009.
 354
 355     # Check if mandatory arguments are set and raises an error if not.
 356
 357     my ( $arg,       # hashref
 358          $options,   # options hash
 359        ) = @_;
 360
 361     # Returns nothing.
 362
 363     if ( $arg->{ 'mandatory' } eq 'yes' and not defined $options->{ $arg->{ 'long' } } ) {
 364         Maasha::Common::error( qq(Argument --$arg->{ 'long' } is mandatory) );
 365     }
 366 }
 367
 368
 369 sub set_default
 370 {
 371     # Martin A. Hansen, May 2009.
 372
 373     # Set default values in option hash.
 374
 375     my ( $arg,      # hashref
 376          $options,  # options hash
 377        ) = @_;
 378
 379     # Returns nothing.
 380
 381     if ( not defined $options->{ $arg->{ 'long' } } ) {
 382         $options->{ $arg->{ 'long' } } = $arg->{ 'default' }
 383     }
 384 }
 385
 386
 387 sub check_uint
 388 {
 389     # Martin A. Hansen, May 2009.
 390
 391     # Check if value to argument is an unsigned integer and
 392     # raises an error if not.
 393
 394     my ( $arg,      # hashref
 395          $options,  # options hash
 396        ) = @_;
 397
 398     # Returns nothing.
 399
 400     if ( $arg->{ 'type' } eq 'uint' and defined $options->{ $arg->{ 'long' } } )
 401     {
 402         if ( $options->{ $arg->{ 'long' } } !~ /^\d+$/ ) {
 403             Maasha::Common::error( qq(Argument --$arg->{ 'long' } must be an unsigned integer - not $options->{ $arg->{ 'long' } }) );
 404         }
 405     }
 406 }
 407
 408
 409 sub check_int
 410 {
 411     # Martin A. Hansen, May 2009.
 412
 413     # Check if value to argument is an integer and
 414     # raises an error if not.
 415
 416     my ( $arg,      # hashref
 417          $options,  # options hash
 418        ) = @_;
 419
 420     # Returns nothing.
 421
 422     if ( $arg->{ 'type' } eq 'int' and defined $options{ $arg->{ 'long' } } )
 423     {
 424         if ( $options->{ $arg->{ 'long' } } !~ /^-?\d+$/ ) {
 425             Maasha::Common::error( qq(Argument --$arg->{ 'long' } must be an integer - not $options->{ $arg->{ 'long' } }) );
 426         }
 427     }
 428 }
 429
 430
 431 sub set_list
 432 {
 433     # Martin A. Hansen, May 2009.
 434
 435     # Splits an argument of type 'list' into a list that is put
 436     # in the options hash.
 437
 438     my ( $arg,      # hashref
 439          $options,  # options hash
 440        ) = @_;
 441
 442     # Returns nothing.
 443
 444     if ( $arg->{ 'type' } eq 'list' and defined $options->{ $arg->{ 'long' } } ) {
 445         $options->{ $arg->{ 'long' } } = [ split /,/, $options->{ $arg->{ 'long' } } ];
 446     }
 447 }
 448
 449
 450 sub check_dir
 451 {
 452     # Martin A. Hansen, May 2009.
 453
 454     # Check if an argument of type 'dir!' truly is a directory and
 455     # raises an error if not.
 456
 457     my ( $arg,      # hashref
 458          $options,  # options hash
 459        ) = @_;
 460
 461     # Returns nothing.
 462
 463     if ( $arg->{ 'type' } eq 'dir!' and defined $options->{ $arg->{ 'long' } } )
 464     {
 465         if ( not -d $options->{ $arg->{ 'long' } } ) {
 466             Maasha::Common::error( qq(No such directory: "$options->{ $arg->{ 'long' } }") );
 467         }
 468     }
 469 }
 470
 471
 472 sub check_file
 473 {
 474     # Martin A. Hansen, May 2009.
 475
 476     # Check if an argument of type 'file!' truly is a file and
 477     # raises an error if not.
 478
 479     my ( $arg,      # hashref
 480          $options,  # options hash
 481        ) = @_;
 482
 483     # Returns nothing.
 484
 485     if ( $arg->{ 'type' } eq 'file!' and defined $options->{ $arg->{ 'long' } } )
 486     {
 487         if ( not -f $options->{ $arg->{ 'long' } } ) {
 488             Maasha::Common::error( qq(No such file: "$options->{ $arg->{ 'long' } }") );
 489         }
 490     }
 491 }
 492
 493
 494 sub set_files
 495 {
 496     # Martin A. Hansen, May 2009.
 497
 498     # Split the argument to 'files' into a list that is put on the options hash.
 499
 500     my ( $arg,      # hashref
 501          $options,  # options hash
 502        ) = @_;
 503
 504     # Returns nothing.
 505
 506     if ( $arg->{ 'type' } eq 'files' and defined $options->{ $arg->{ 'long' } } ) {
 507         $options->{ $arg->{ 'long' } } = [ split /,/, $options->{ $arg->{ 'long' } } ];
 508     }
 509 }
 510
 511
 512 sub check_files
 513 {
 514     # Martin A. Hansen, May 2009.
 515
 516     # Split the argument to 'files!' and check if each file do exists before adding
 517     # the file list to the options hash.
 518
 519     my ( $arg,      # hashref
 520          $options,  # options hash
 521        ) = @_;
 522
 523     # Returns nothing.
 524
 525     my ( $elem, @files );
 526
 527     if ( $arg->{ 'type' } eq 'files!' and defined $options->{ $arg->{ 'long' } } )
 528     {
 529         foreach $elem ( split /,/, $options->{ $arg->{ 'long' } } )
 530         {
 531             if ( -f $elem ) {
 532                 push @files, $elem;
 533             } elsif ( $elem =~ /\*/ ) {
 534                 push @files, glob( $elem );
 535             }
 536         }
 537
 538         if ( scalar @files == 0 ) {
 539             Maasha::Common::error( qq(Argument to --$arg->{ 'long' } must be a valid file or fileglob expression - not $options->{ $arg->{ 'long' } }) );
 540         }
 541
 542         $options->{ $arg->{ 'long' } } = [ @files ];
 543     }
 544 }
 545
 546
 547 sub check_allowed
 548 {
 549     # Martin A. Hansen, May 2009.
 550
 551     # Check if all values to all arguement are allowed and raise an
 552     # error if not.
 553
 554     my ( $arg,      # hashref
 555          $options,  # options hash
 556        ) = @_;
 557
 558     # Returns nothing.
 559
 560     my ( $elem );
 561
 562     if ( defined $arg->{ 'allowed' } and defined $options->{ $arg->{ 'long' } } )
 563     {
 564         map { $val_hash{ $_ } = 1 } split /,/, $arg->{ 'allowed' };
 565
 566         if ( $arg->{ 'type' } =~ /^(list|files|files!)$/ )
 567         {
 568             foreach $elem ( @{ $options->{ $arg->{ 'long' } } } )
 569             {
 570                 if ( not exists $val_hash{ $elem } ) {
 571                     Maasha::Common::error( qq(Argument to --$arg->{ 'long' } $elem is not allowed) );
 572                 }
 573             }
 574         }
 575         else
 576         {
 577             if ( not exists $val_hash{ $options->{ $arg->{ 'long' } } } ) {
 578                 Maasha::Common::error( qq(Argument to --$arg->{ 'long' } $options->{ $arg->{ 'long' } } is not allowed) );
 579             }
 580         }
 581     }
 582 }
 583
 584
 585 sub check_disallowed
 586 {
 587     # Martin A. Hansen, May 2009.
 588
 589     # Check if any values to all arguemnts are disallowed and raise an error if so.
 590
 591     my ( $arg,      # hashref
 592          $options,  # options hash
 593        ) = @_;
 594
 595     # Returns nothing.
 596
 597     my ( $val, %val_hash );
 598
 599     if ( defined $arg->{ 'disallowed' } and defined $options->{ $arg->{ 'long' } } )
 600     {
 601         foreach $val ( split /,/, $arg->{ 'disallowed' } )
 602         {
 603             if ( $options->{ $arg->{ 'long' } } eq $val ) {
 604                 Maasha::Common::error( qq(Argument to --$arg->{ 'long' } $val is disallowed) );
 605             }
 606         }
 607     }
 608 }
 609
 610
 611 sub getopt_files
 612 {
 613     # Martin A. Hansen, November 2007.
 614
 615     # Extracts files from an explicit GetOpt::Long argument
 616     # allowing for the use of glob. E.g.
 617     # --data_in=test.fna
 618     # --data_in=test.fna,test2.fna
 619     # --data_in=*.fna
 620     # --data_in=test.fna,/dir/*.fna
 621
 622     my ( $option,   # option from GetOpt::Long
 623        ) = @_;
 624
 625     # Returns a list.
 626
 627     my ( $elem, @files );
 628
 629     foreach $elem ( split ",", $option )
 630     {
 631         if ( -f $elem ) {
 632             push @files, $elem;
 633         } elsif ( $elem =~ /\*/ ) {
 634             push @files, glob( $elem );
 635         }
 636     }
 637
 638     return wantarray ? @files : \@files;
 639 }
 640
 641
 642 sub sig_handler
 643 {
 644     # Martin A. Hansen, April 2008.
 645
 646     # Removes temporary directory and exits gracefully.
 647     # This subroutine is meant to be run always as the last
 648     # thing even if a script is dies or is interrupted
 649     # or killed.
 650
 651     my ( $sig,   # signal from the %SIG
 652        ) = @_;
 653
 654     # print STDERR "signal->$sig<-\n";
 655
 656     my $script = Maasha::Common::get_scriptname();
 657
 658     chomp $sig;
 659
 660     sleep 1;
 661
 662 #    if ( -d $BP_TMP )
 663     {
 664         if ( $sig =~ /MAASHA_ERROR/ ) {
 665             print STDERR "\nProgram '$script' had an error"                     . "  -  Please wait for temporary data to be removed\n";
 666         } elsif ( $sig eq "INT" ) {
 667             print STDERR "\nProgram '$script' interrupted (ctrl-c was pressed)" . "  -  Please wait for temporary data to be removed\n";
 668         } elsif ( $sig eq "TERM" ) {
 669             print STDERR "\nProgram '$script' terminated (someone used kill?)"  . "  -  Please wait for temporary data to be removed\n";
 670         } else {
 671             print STDERR "\nProgram '$script' died->$sig"                       . "  -  Please wait for temporary data to be removed\n";
 672         }
 673
 674         clean_tmp();
 675     }
 676
 677     exit( 0 );
 678 }
 679
 680
 681 sub clean_tmp
 682 {
 683     # Martin A. Hansen, July 2008.
 684
 685     # Cleans out any unused temporary files and directories in BP_TMP.
 686
 687     # Returns nothing.
 688
 689     my ( $tmpdir, @dirs, $curr_pid, $dir, $user, $sid, $pid );
 690
 691     $tmpdir = $ENV{ 'BP_TMP' } || Maasha::Common::error( 'No BP_TMP variable in environment.' );
 692
 693     $curr_pid = Maasha::Common::get_processid();
 694
 695     @dirs = Maasha::Filesys::ls_dirs( $tmpdir );
 696
 697     foreach $dir ( @dirs )
 698     {
 699         if ( $dir =~ /^$tmpdir\/(.+)_(\d+)_(\d+)_bp_tmp$/ )
 700         {
 701             $user = $1;
 702             $sid  = $2;
 703             $pid  = $3;
 704
 705 #            next if $user eq "maasha"; # DEBUG
 706
 707             if ( $user eq Maasha::Common::get_user() )
 708             {
 709                 if ( not Maasha::Common::process_running( $pid ) )
 710                 {
 711                     # print STDERR "Removing stale dir: $dir\n";
 712                     Maasha::Filesys::dir_remove( $dir );
 713                 }
 714                 elsif ( $pid == $curr_pid )
 715                 {
 716                     # print STDERR "Removing current dir: $dir\n";
 717                     Maasha::Filesys::dir_remove( $dir );
 718                 }
 719             }
 720         }
 721     }
 722 }
 723
 724
 725 sub run_time
 726 {
 727     # Martin A. Hansen, May 2009.
 728
 729     # Returns a precision timestamp for calculating
 730     # run time.
 731
 732     return Maasha::Common::get_time_hires();
 733 }
 734
 735
 736 sub run_time_print
 737 {
 738     # Martin A. Hansen, May 2009
 739
 740     # Print the run time to STDERR for the current script if
 741     # the verbose switch is set in the option hash.
 742
 743     my ( $t0,       # run time begin
 744          $t1,       # run time end
 745          $options,  # options hash
 746        ) = @_;
 747
 748     # Returns nothing
 749
 750     my $script = Maasha::Common::get_scriptname();
 751
 752     print STDERR "Program: $script" . ( " " x ( 25 - length( $script ) ) ) . sprintf( "Run time: %.4f\n", ( $t1 - $t0 ) ) if $options->{ 'verbose' };
 753
 754 }
 755
 756
 757 sub get_tmpdir
 758 {
 759     # Martin A. Hansen, April 2008.
 760
 761     # Create a temporary directory based on
 762     # $ENV{ 'BP_TMP' } and sessionid.
 763
 764     # this thing is a really bad solution and needs to be removed.
 765
 766     # Returns a path.
 767
 768     my ( $user, $sid, $pid, $path );
 769
 770     Maasha::Common::error( qq(no BP_TMP set in %ENV) ) if not -d $ENV{ 'BP_TMP' };
 771
 772     $user = Maasha::Common::get_user();
 773     $sid  = Maasha::Common::get_sessionid();
 774     $pid  = Maasha::Common::get_processid();
 775
 776     $path = "$ENV{ 'BP_TMP' }/" . join( "_", $user, $sid, $pid, "bp_tmp" );
 777
 778     Maasha::Filesys::dir_create( $path );
 779
 780     return $path;
 781 }
 782
 783
 784 END
 785 {
 786     clean_tmp();
 787 }
 788
 789
 790 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 791
 792
 793 1;
 794
 795 __END__