[Bioperl-guts-l] bioperl-live/Bio/Root Err.pm, 1.21, 1.22 IOManager.pm, 1.20, 1.21 Object.pm, 1.32, 1.33 Utilities.pm, 1.31, 1.32 Vector.pm, 1.17, 1.18 Xref.pm, 1.15, 1.16

Mauricio Herrera Cuadra mauricio at dev.open-bio.org
Sun Sep 24 11:36:34 EDT 2006


Update of /home/repository/bioperl/bioperl-live/Bio/Root
In directory dev.open-bio.org:/tmp/cvs-serv15026/Bio/Root

Modified Files:
	Err.pm IOManager.pm Object.pm Utilities.pm Vector.pm Xref.pm 
Log Message:
Updating URLs


Index: Utilities.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Root/Utilities.pm,v
retrieving revision 1.31
retrieving revision 1.32
diff -C2 -d -r1.31 -r1.32
*** Utilities.pm	4 Jul 2006 22:23:20 -0000	1.31
--- Utilities.pm	24 Sep 2006 15:36:32 -0000	1.32
***************
*** 24,28 ****
  #
  # Copyright (c) 1996-2000 Steve Chervitz. All Rights Reserved.
! #          This module is free software; you can redistribute it and/or 
  #          modify it under the same terms as Perl itself.
  #
--- 24,28 ----
  #
  # Copyright (c) 1996-2000 Steve Chervitz. All Rights Reserved.
! #          This module is free software; you can redistribute it and/or
  #          modify it under the same terms as Perl itself.
  #
***************
*** 56,66 ****
  $ID        = 'Bio::Root::Utilities';
  
! # $GNU_PATH points to the directory containing the gzip and gunzip 
! # executables. It may be required for executing gzip/gunzip 
  # in some situations (e.g., when $ENV{PATH} doesn't contain this dir.
  # Customize $GNU_PATH for your site if the compress() or
  # uncompress() functions are generating exceptions.
! $GNU_PATH  = ''; 
! #$GNU_PATH  = '/tools/gnu/bin/'; 
  
  $DEFAULT_NEWLINE = "\012";  # \n  (used if get_newline() fails for some reason)
--- 56,66 ----
  $ID        = 'Bio::Root::Utilities';
  
! # $GNU_PATH points to the directory containing the gzip and gunzip
! # executables. It may be required for executing gzip/gunzip
  # in some situations (e.g., when $ENV{PATH} doesn't contain this dir.
  # Customize $GNU_PATH for your site if the compress() or
  # uncompress() functions are generating exceptions.
! $GNU_PATH  = '';
! #$GNU_PATH  = '/tools/gnu/bin/';
  
  $DEFAULT_NEWLINE = "\012";  # \n  (used if get_newline() fails for some reason)
***************
*** 125,130 ****
    Bio::Root::Global.pm       - Manages global variables/constants
  
!   http://bio.perl.org/Projects/modules.html  - Online module documentation
!   http://bio.perl.org/                       - Bioperl Project Homepage 
  
    FileHandle.pm (included in the Perl distribution or CPAN).
--- 125,129 ----
    Bio::Root::Global.pm       - Manages global variables/constants
  
!   http://bio.perl.org/                       - Bioperl Project Homepage
  
    FileHandle.pm (included in the Perl distribution or CPAN).
***************
*** 132,136 ****
  =head1 FEEDBACK
  
! =head2 Mailing Lists 
  
  User feedback is an integral part of the evolution of this and other Bioperl modules.
--- 131,135 ----
  =head1 FEEDBACK
  
! =head2 Mailing Lists
  
  User feedback is an integral part of the evolution of this and other Bioperl modules.
***************
*** 147,153 ****
  web:
  
!   http://bugzilla.open-bio.org/           
  
! =head1 AUTHOR 
  
  Steve Chervitz E<lt>sac at bioperl.orgE<gt>
--- 146,152 ----
  web:
  
!   http://bugzilla.open-bio.org/
  
! =head1 AUTHOR
  
  Steve Chervitz E<lt>sac at bioperl.orgE<gt>
***************
*** 168,172 ****
  
  Copyright (c) 1997-98 Steve Chervitz. All Rights Reserved.
! This module is free software; you can redistribute it and/or 
  modify it under the same terms as Perl itself.
  
--- 167,171 ----
  
  Copyright (c) 1997-98 Steve Chervitz. All Rights Reserved.
! This module is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
***************
*** 199,203 ****
  
   Title     : date_format
!  Usage     : $Util->date_format( [FMT], [DATE]) 
   Purpose   : -- Get a string containing the formated date or time
             :    taken when this routine is invoked.
--- 198,202 ----
  
   Title     : date_format
!  Usage     : $Util->date_format( [FMT], [DATE])
   Purpose   : -- Get a string containing the formated date or time
             :    taken when this routine is invoked.
***************
*** 212,217 ****
   Returns   : String (unless 'list' is provided as argument, see below)
             :
!            :   'yyyy-mm-dd'  = 1996-05-03    # default format. 
!            :   'yyyy-dd-mm'  = 1996-03-05   
             :   'yyyy-mmm-dd' = 1996-May-03
             :   'd-m-y'       = 3-May-1996
--- 211,216 ----
   Returns   : String (unless 'list' is provided as argument, see below)
             :
!            :   'yyyy-mm-dd'  = 1996-05-03    # default format.
!            :   'yyyy-dd-mm'  = 1996-03-05
             :   'yyyy-mmm-dd' = 1996-May-03
             :   'd-m-y'       = 3-May-1996
***************
*** 228,233 ****
   Argument  : (all are optional)
             : FMT  = yyyy-mm-dd | yyyy-dd-mm | yyyy-mmm-dd |
!            :        mdy | ymd | md | d-m-y | hms | hm 
!            :        ('hms' may be appended to any of these to 
  	   :        add a time stamp)
             :
--- 227,232 ----
   Argument  : (all are optional)
             : FMT  = yyyy-mm-dd | yyyy-dd-mm | yyyy-mmm-dd |
!            :        mdy | ymd | md | d-m-y | hms | hm
!            :        ('hms' may be appended to any of these to
  	   :        add a time stamp)
             :
***************
*** 235,241 ****
             :        Acceptable input formats:
             :           12/1/97 (for 1 December 1997)
!            :           1997-12-01 
             :           1997-Dec-01
!  Throws    : 
   Comments  : Relies on the $BASE_YEAR constant exported by Bio:Root::Global.pm.
             :
--- 234,240 ----
             :        Acceptable input formats:
             :           12/1/97 (for 1 December 1997)
!            :           1997-12-01
             :           1997-Dec-01
!  Throws    :
   Comments  : Relies on the $BASE_YEAR constant exported by Bio:Root::Global.pm.
             :
***************
*** 243,247 ****
             : always use: $date = `date`;
             :
!            : For more features, use Date::Manip.pm, (which I should 
             : probably switch to...)
  
--- 242,246 ----
             : always use: $date = `date`;
             :
!            : For more features, use Date::Manip.pm, (which I should
             : probably switch to...)
  
***************
*** 267,271 ****
      if(defined($date) && ($date =~ /[\D-]+/)) {
  	if( $date =~ /\//) {
! 	    ($mon,$mday,$year) = split(/\//, $date); 
  	} elsif($date =~ /(\d{4})-(\d{1,2})-(\d{1,2})/) {
  	    ($year,$mon,$mday) = ($1, $2, $3);
--- 266,270 ----
      if(defined($date) && ($date =~ /[\D-]+/)) {
  	if( $date =~ /\//) {
! 	    ($mon,$mday,$year) = split(/\//, $date);
  	} elsif($date =~ /(\d{4})-(\d{1,2})-(\d{1,2})/) {
  	    ($year,$mon,$mday) = ($1, $2, $3);
***************
*** 286,290 ****
      $day_txt   = $DAYS[$wday] if defined $wday;
      $month_num = $mon+1;
!     $fullYear = $BASE_YEAR+$year; 
  
  #    print "sec: $sec, min: $min, hour: $hour, month: $mon, m-day: $mday, year: $year\nwday: $wday, yday: $yday, dst: $isdst";<STDIN>;
--- 285,289 ----
      $day_txt   = $DAYS[$wday] if defined $wday;
      $month_num = $mon+1;
!     $fullYear = $BASE_YEAR+$year;
  
  #    print "sec: $sec, min: $min, hour: $hour, month: $mon, m-day: $mday, year: $year\nwday: $wday, yday: $yday, dst: $isdst";<STDIN>;
***************
*** 317,321 ****
  	print STDERR "\n*** Unrecognized date format request: $option\n";
      }
!     
      if( $option =~ /hms/i) {
  	$date .= " $hour:$min:$sec" if $date;
--- 316,320 ----
  	print STDERR "\n*** Unrecognized date format request: $option\n";
      }
! 
      if( $option =~ /hms/i) {
  	$date .= " $hour:$min:$sec" if $date;
***************
*** 349,353 ****
      for(0..$#MONTHS) {
  	return $_+1 if $str =~ /$MONTHS[$_]/i;
!     } 
      $self->throw("Invalid month name: $str");
  }
--- 348,352 ----
      for(0..$#MONTHS) {
  	return $_+1 if $str =~ /$MONTHS[$_]/i;
!     }
      $self->throw("Invalid month name: $str");
  }
***************
*** 382,386 ****
             :            If the supplied filename ends with '.gz' or '.Z',
             :            that extension will be removed before attempting to compress.
!            : tmp = boolean, 
             :    If true, (or if user is not the owner of the file)
             :         the file is compressed to a tmp file
--- 381,385 ----
             :            If the supplied filename ends with '.gz' or '.Z',
             :            that extension will be removed before attempting to compress.
!            : tmp = boolean,
             :    If true, (or if user is not the owner of the file)
             :         the file is compressed to a tmp file
***************
*** 406,411 ****
  #------------
      my $self = shift;
!     my $fileName = shift;  
!     my $tmp = shift || 0;  
  
      if($fileName =~ /(\.gz|\.Z)$/) { $fileName =~ s/$1$//; };
--- 405,410 ----
  #------------
      my $self = shift;
!     my $fileName = shift;
!     my $tmp = shift || 0;
  
      if($fileName =~ /(\.gz|\.Z)$/) { $fileName =~ s/$1$//; };
***************
*** 423,427 ****
  	$compressed .= '.gz';
  	@args = ($GNU_PATH."gzip -f < $fileName > $compressed");
! 	not $tmp and 
  	    $self->warn("Not owner of file $fileName\nCompressing to tmp file $compressed.");
  	$tmp = 1;
--- 422,426 ----
  	$compressed .= '.gz';
  	@args = ($GNU_PATH."gzip -f < $fileName > $compressed");
! 	not $tmp and
  	    $self->warn("Not owner of file $fileName\nCompressing to tmp file $compressed.");
  	$tmp = 1;
***************
*** 438,443 ****
  	} else {
  	    @args = ('/usr/bin/compress', '-f', $fileName);
! 	}	    
! 	system(@args) == 0 or 
  	    $self->throw("Failed to gzip/compress file $fileName: $!",
  			 "Confirm current \$GNU_PATH: $GNU_PATH",
--- 437,442 ----
  	} else {
  	    @args = ('/usr/bin/compress', '-f', $fileName);
! 	}
! 	system(@args) == 0 or
  	    $self->throw("Failed to gzip/compress file $fileName: $!",
  			 "Confirm current \$GNU_PATH: $GNU_PATH",
***************
*** 459,463 ****
             :           If the supplied filename does not end with '.gz' or '.Z'
             :           a '.gz' will be appended before attempting to uncompress.
!            : tmp = boolean, 
             :    If true, (or if user is not the owner of the file)
             :         the file is uncompressed to a tmp file
--- 458,462 ----
             :           If the supplied filename does not end with '.gz' or '.Z'
             :           a '.gz' will be appended before attempting to uncompress.
!            : tmp = boolean,
             :    If true, (or if user is not the owner of the file)
             :         the file is uncompressed to a tmp file
***************
*** 483,488 ****
  #---------------
      my $self = shift;
!     my $fileName = shift;  
!     my $tmp = shift || 0;  
  
      if(not $fileName =~ /(\.gz|\.Z)$/) { $fileName .= '.gz'; }
--- 482,487 ----
  #---------------
      my $self = shift;
!     my $fileName = shift;
!     my $tmp = shift || 0;
  
      if(not $fileName =~ /(\.gz|\.Z)$/) { $fileName .= '.gz'; }
***************
*** 516,526 ****
  	} else {
  	    @args = ('/usr/bin/uncompress', '-f', $fileName);
! 	}	    
  	system(@args) == 0 or
  	    $self->throw("Failed to gunzip/uncompress file $fileName: $!",
  			 "Confirm current \$GNU_PATH: $GNU_PATH",
! 			 "Edit \$GNU_PATH in Bio::Root::Utilities.pm if necessary."); 
      }
!     
      return $uncompressed;
  }
--- 515,525 ----
  	} else {
  	    @args = ('/usr/bin/uncompress', '-f', $fileName);
! 	}
  	system(@args) == 0 or
  	    $self->throw("Failed to gunzip/uncompress file $fileName: $!",
  			 "Confirm current \$GNU_PATH: $GNU_PATH",
! 			 "Edit \$GNU_PATH in Bio::Root::Utilities.pm if necessary.");
      }
! 
      return $uncompressed;
  }
***************
*** 567,576 ****
   Usage   : $Util->untaint($value, $relax)
   Returns : String containing the untained data.
!  Argument: $value = string 
           : $relax = boolean
   Comments:
       This general untaint() function may not be appropriate for every situation.
!      To allow only a more restricted subset of special characters 
!      (for example, untainting a regular expression), then using a custom 
       untainting mechanism would permit more control.
  
--- 566,575 ----
   Usage   : $Util->untaint($value, $relax)
   Returns : String containing the untained data.
!  Argument: $value = string
           : $relax = boolean
   Comments:
       This general untaint() function may not be appropriate for every situation.
!      To allow only a more restricted subset of special characters
!      (for example, untainting a regular expression), then using a custom
       untainting mechanism would permit more control.
  
***************
*** 581,585 ****
  #------------`
  sub untaint {
! #------------	
      my($self,$value,$relax) = @_;
      $relax ||= 0;
--- 580,584 ----
  #------------`
  sub untaint {
! #------------
      my($self,$value,$relax) = @_;
      $relax ||= 0;
***************
*** 587,591 ****
  
      $DEBUG and print STDERR "\nUNTAINT: $value\n";
!     
      defined $value || return;
  
--- 586,590 ----
  
      $DEBUG and print STDERR "\nUNTAINT: $value\n";
! 
      defined $value || return;
  
***************
*** 665,672 ****
      my $dir = $$href{-DIR} || './';
      my $print = $$href{-PRINT} || 0;
!     
      ### Make sure $dir ends with /
      $dir !~ /\/$/ and do{ $dir .=  '/'; $$href{-DIR} = $dir; };
!     
      open ( PIPE, "ls -1 $dir |" ) || $self->throw("Can't open input pipe: $!");
  
--- 664,671 ----
      my $dir = $$href{-DIR} || './';
      my $print = $$href{-PRINT} || 0;
! 
      ### Make sure $dir ends with /
      $dir !~ /\/$/ and do{ $dir .=  '/'; $$href{-DIR} = $dir; };
! 
      open ( PIPE, "ls -1 $dir |" ) || $self->throw("Can't open input pipe: $!");
  
***************
*** 688,692 ****
      }
      close PIPE;
!     
      if( $print) {
  	printf( "\n%4d %s\n", $$href{-TOTAL}, "total files+dirs in $dir");
--- 687,691 ----
      }
      close PIPE;
! 
      if( $print) {
  	printf( "\n%4d %s\n", $$href{-TOTAL}, "total files+dirs in $dir");
***************
*** 700,704 ****
  #=head2 file_info
  #
! # Title   : file_info 
  # Purpose : Obtains a variety of date for a given file.
  #	  : Provides an interface to Perl's stat().
--- 699,703 ----
  #=head2 file_info
  #
! # Title   : file_info
  # Purpose : Obtains a variety of date for a given file.
  #	  : Provides an interface to Perl's stat().
***************
*** 735,749 ****
  
  #------------
! sub delete { 
  #------------
!   my $self = shift; 
    my $fileName = shift;
    if(not -e $fileName) {
!     $self->throw("Can't delete file $fileName: Does not exist."); 
    } elsif(not -o $fileName) {
!     $self->throw("Can't delete file $fileName: Not owner."); 
!   } 
    my $ulval = unlink($fileName) > 0 or
!     $self->throw("Failed to delete file $fileName: $!"); 
  }
  
--- 734,748 ----
  
  #------------
! sub delete {
  #------------
!   my $self = shift;
    my $fileName = shift;
    if(not -e $fileName) {
!     $self->throw("Can't delete file $fileName: Does not exist.");
    } elsif(not -o $fileName) {
!     $self->throw("Can't delete file $fileName: Not owner.");
!   }
    my $ulval = unlink($fileName) > 0 or
!     $self->throw("Failed to delete file $fileName: $!");
  }
  
***************
*** 763,767 ****
             :                to a FileHandle object or typeglob. This is an
             :                optional parameter (if not defined, STDIN is used).
!  Returns   : Reference to a FileHandle object.   
   Throws    : Exception if cannot open a supplied file or if supplied with a
             : reference that is not a FileHandle ref.
--- 762,766 ----
             :                to a FileHandle object or typeglob. This is an
             :                optional parameter (if not defined, STDIN is used).
!  Returns   : Reference to a FileHandle object.
   Throws    : Exception if cannot open a supplied file or if supplied with a
             : reference that is not a FileHandle ref.
***************
*** 770,774 ****
             : the file is binary, it will be treated as a compressed (gzipped)
             : file and access it using gzip -ce. The problem here is that not
!            : all binary files are necessarily compressed. Therefore, 
             : this method should probably have a -mode parameter to
             : specify ascii or binary.
--- 769,773 ----
             : the file is binary, it will be treated as a compressed (gzipped)
             : file and access it using gzip -ce. The problem here is that not
!            : all binary files are necessarily compressed. Therefore,
             : this method should probably have a -mode parameter to
             : specify ascii or binary.
***************
*** 794,798 ****
  
      my ($handle_ref);
!     
      if($handle_ref = ref($file)) {
        if($handle_ref eq 'FileHandle') {
--- 793,797 ----
  
      my ($handle_ref);
! 
      if($handle_ref = ref($file)) {
        if($handle_ref eq 'FileHandle') {
***************
*** 828,832 ****
        $client->{'_input_type'} = "STDIN";
      }
!     
      return $FH;
    }
--- 827,831 ----
        $client->{'_input_type'} = "STDIN";
      }
! 
      return $FH;
    }
***************
*** 840,844 ****
             :                                   -FILE =>'usr/people/me/data.txt')
   Argument  : Same arguemnts as for create_filehandle().
!  Returns   : Reference to a FileHandle object.   
   Throws    : Propogates any exceptions thrown by Bio::Root::Utilities::get_newline().
  
--- 839,843 ----
             :                                   -FILE =>'usr/people/me/data.txt')
   Argument  : Same arguemnts as for create_filehandle().
!  Returns   : Reference to a FileHandle object.
   Throws    : Propogates any exceptions thrown by Bio::Root::Utilities::get_newline().
  
***************
*** 863,867 ****
      if($client->{'_input_type'} =~ /STDIN|Glob|compressed/) {
        # Can't taste from STDIN since we can't seek 0 on it.
!       # Are other non special Glob refs seek-able? 
        # Attempt to guess newline based on platform.
        # Not robust since we could be reading Unix files on a Mac, e.g.
--- 862,866 ----
      if($client->{'_input_type'} =~ /STDIN|Glob|compressed/) {
        # Can't taste from STDIN since we can't seek 0 on it.
!       # Are other non special Glob refs seek-able?
        # Attempt to guess newline based on platform.
        # Not robust since we could be reading Unix files on a Mac, e.g.
***************
*** 870,882 ****
        } else {
  	$NEWLINE = "\012";  # \n
!       }	
      } else {
        $NEWLINE = $self->taste_file($FH);
      }
  
!     close ($FH) unless ($client->{'_input_type'} eq 'STDIN' || 
                          $client->{'_input_type'} eq 'FileHandle' ||
                          $client->{'_input_type'} eq 'Glob' );
!     
      delete $client->{'_input_type'};
  
--- 869,881 ----
        } else {
  	$NEWLINE = "\012";  # \n
!       }
      } else {
        $NEWLINE = $self->taste_file($FH);
      }
  
!     close ($FH) unless ($client->{'_input_type'} eq 'STDIN' ||
                          $client->{'_input_type'} eq 'FileHandle' ||
                          $client->{'_input_type'} eq 'Glob' );
! 
      delete $client->{'_input_type'};
  
***************
*** 908,916 ****
  sub taste_file {
  #---------------
!   my ($self, $FH) = @_; 
    my $BUFSIZ = 256;   # Number of bytes read from the file handle.
    my ($buffer, $octal, $str, $irs, $i);
    my $wait = $TIMEOUT_SECS;
!   
    ref($FH) eq 'FileHandle' or $self->throw("Can't taste file: not a FileHandle ref");
  
--- 907,915 ----
  sub taste_file {
  #---------------
!   my ($self, $FH) = @_;
    my $BUFSIZ = 256;   # Number of bytes read from the file handle.
    my ($buffer, $octal, $str, $irs, $i);
    my $wait = $TIMEOUT_SECS;
! 
    ref($FH) eq 'FileHandle' or $self->throw("Can't taste file: not a FileHandle ref");
  
***************
*** 936,941 ****
    };
    if($@ =~ /Timed out!/) {
!     $self->throw("Timed out while waiting for input.", 
! 		 "Timeout period = $wait seconds.\nFor longer time before timing out, edit \$TIMEOUT_SECS in Bio::Root::Global.pm.");	
  
    } elsif(not $result) {
--- 935,940 ----
    };
    if($@ =~ /Timed out!/) {
!     $self->throw("Timed out while waiting for input.",
! 		 "Timeout period = $wait seconds.\nFor longer time before timing out, edit \$TIMEOUT_SECS in Bio::Root::Global.pm.");
  
    } elsif(not $result) {
***************
*** 1007,1011 ****
  sub file_flavor {
  #---------------
!     my ($self, $file) = @_; 
      my %flavors=("\012"    =>'unix (\n or 012 or ^J)',
                   "\015\012" =>'dos (\r\n or 015,012 or ^M^J)',
--- 1006,1010 ----
  sub file_flavor {
  #---------------
!     my ($self, $file) = @_;
      my %flavors=("\012"    =>'unix (\n or 012 or ^J)',
                   "\015\012" =>'dos (\r\n or 015,012 or ^M^J)',
***************
*** 1034,1038 ****
  
  sub mail_authority {
!     
      my( $self, $message ) = @_;
      my $script = $self->untaint($0,1);
--- 1033,1037 ----
  
  sub mail_authority {
! 
      my( $self, $message ) = @_;
      my $script = $self->untaint($0,1);
***************
*** 1047,1051 ****
   Title    : send_mail
   Usage    : $Util->send_mail( named_parameters )
!  Purpose  : Provides an interface to /usr/lib/sendmail  
   Returns  : n/a
   Argument : Named parameters:  (case-insensitive)
--- 1046,1050 ----
   Title    : send_mail
   Usage    : $Util->send_mail( named_parameters )
!  Purpose  : Provides an interface to /usr/lib/sendmail
   Returns  : n/a
   Argument : Named parameters:  (case-insensitive)
***************
*** 1060,1066 ****
            : Using default 'From:' information.
            :   sendmail options used:
!           :      -t: ignore the address given on the command line and 
            :          get To:address from the e-mail header.
!           :     -oi: prevents send_mail from ending the message if it 
            :          finds a period at the start of a line.
  
--- 1059,1065 ----
            : Using default 'From:' information.
            :   sendmail options used:
!           :      -t: ignore the address given on the command line and
            :          get To:address from the e-mail header.
!           :     -oi: prevents send_mail from ending the message if it
            :          finds a period at the start of a line.
  
***************
*** 1076,1085 ****
      my($recipient,$subj,$message,$cc) = $self->_rearrange([qw(TO SUBJ MSG CC)], at param);
  
!     $self->throw("Invalid or missing e-mail address: $recipient") 
  	if not $recipient =~ /\S+\@\S+/;
  
      $cc ||= ''; $subj ||= ''; $message ||= '';
  
!     open (SENDMAIL, "|/usr/lib/sendmail -oi -t") || 
  	$self->throw("Can't send mail: sendmail cannot fork: $!");
  
--- 1075,1084 ----
      my($recipient,$subj,$message,$cc) = $self->_rearrange([qw(TO SUBJ MSG CC)], at param);
  
!     $self->throw("Invalid or missing e-mail address: $recipient")
  	if not $recipient =~ /\S+\@\S+/;
  
      $cc ||= ''; $subj ||= ''; $message ||= '';
  
!     open (SENDMAIL, "|/usr/lib/sendmail -oi -t") ||
  	$self->throw("Can't send mail: sendmail cannot fork: $!");
  
***************
*** 1110,1114 ****
   Example : print +( $Util->yes_reply('Are you ok') ? "great!\n" : "sorry.\n" );
           : $Util->yes_reply('Continue') || die;
!  Returns : Boolean, true (1) if input string begins with 'y' or 'Y' 
   Argument: query_string = string to be used to prompt user (optional)
           : If not provided, 'Yes or no' will be used.
--- 1109,1113 ----
   Example : print +( $Util->yes_reply('Are you ok') ? "great!\n" : "sorry.\n" );
           : $Util->yes_reply('Continue') || die;
!  Returns : Boolean, true (1) if input string begins with 'y' or 'Y'
   Argument: query_string = string to be used to prompt user (optional)
           : If not provided, 'Yes or no' will be used.
***************
*** 1137,1141 ****
   Purpose : To request data from a user to be entered via keyboard (STDIN).
   Example : $name = $Util->request_data('Name');
!          : # User will see: % Enter Name: 
   Returns : String, (data entered from keyboard, sans terminal newline.)
   Argument: value_name = string to be used to prompt user.
--- 1136,1140 ----
   Purpose : To request data from a user to be entered via keyboard (STDIN).
   Example : $name = $Util->request_data('Name');
!          : # User will see: % Enter Name:
   Returns : String, (data entered from keyboard, sans terminal newline.)
   Argument: value_name = string to be used to prompt user.
***************
*** 1157,1161 ****
  
  sub quit_reply {
! # Not much used since you can use request_data() 
  # and test for an empty string.
      my $self = shift;
--- 1156,1160 ----
  
  sub quit_reply {
! # Not much used since you can use request_data()
  # and test for an empty string.
      my $self = shift;
***************
*** 1179,1184 ****
      my $self = shift;
      my $reqVersion  = shift;
!     
!     $] < $reqVersion and do { 
  	printf STDERR ( "\a\n%s %0.3f.\n", "** Sorry. This Perl script requires at least version", $reqVersion);
  	printf STDERR ( "%s %0.3f %s\n\n", "You are running Perl version", $], "Please update your Perl!\n\n" );
--- 1178,1183 ----
      my $self = shift;
      my $reqVersion  = shift;
! 
!     $] < $reqVersion and do {
  	printf STDERR ( "\a\n%s %0.3f.\n", "** Sorry. This Perl script requires at least version", $reqVersion);
  	printf STDERR ( "%s %0.3f %s\n\n", "You are running Perl version", $], "Please update your Perl!\n\n" );
***************
*** 1194,1199 ****
  
      my $date = localtime(time());
!     
!     my $tmpnam = 'tmpnam'; 
  
      if( $date =~ /([\d:]+)\s+(\d+)\s*$/ ) {
--- 1193,1198 ----
  
      my $date = localtime(time());
! 
!     my $tmpnam = 'tmpnam';
  
      if( $date =~ /([\d:]+)\s+(\d+)\s*$/ ) {
***************
*** 1227,1231 ****
      deal with file ownership issues.
  
! 3 Jun 1998, sac: 
      * Improved file_date() to be less reliant on the output of ls.
        (Note the word 'less'; it still relies on ls).
--- 1226,1230 ----
      deal with file ownership issues.
  
! 3 Jun 1998, sac:
      * Improved file_date() to be less reliant on the output of ls.
        (Note the word 'less'; it still relies on ls).

Index: IOManager.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Root/IOManager.pm,v
retrieving revision 1.20
retrieving revision 1.21
diff -C2 -d -r1.20 -r1.21
*** IOManager.pm	20 Sep 2006 08:58:50 -0000	1.20
--- IOManager.pm	24 Sep 2006 15:36:32 -0000	1.21
***************
*** 119,123 ****
    Bio::Root::Global.pm       - Manages global variables/constants
  
-   http://bio.perl.org/Projects/modules.html  - Online module documentation
    http://bio.perl.org/                       - Bioperl Project Homepage
  
--- 119,122 ----
***************
*** 148,152 ****
    http://bugzilla.open-bio.org/
  
! =head1 AUTHOR 
  
  Steve Chervitz E<lt>sac at bioperl.orgE<gt>
--- 147,151 ----
    http://bugzilla.open-bio.org/
  
! =head1 AUTHOR
  
  Steve Chervitz E<lt>sac at bioperl.orgE<gt>
***************
*** 230,234 ****
  	if(not ref $file and not -s $file) {
  	    $self->throw("File is empty or non-existent: $file");
! 	}	
  	$self->{'_file'} = $file;
      }
--- 229,233 ----
  	if(not ref $file and not -s $file) {
  	    $self->throw("File is empty or non-existent: $file");
! 	}
  	$self->{'_file'} = $file;
      }
***************
*** 381,385 ****
  	undef $self->{'_fh'};
      }
! }	
  
  
--- 380,384 ----
  	undef $self->{'_fh'};
      }
! }
  
  
***************
*** 442,446 ****
  	$self->set_fh(-PATH =>$where,
  		      -PRE  =>$mode);
!     } elsif( not defined $self->{'_fh'} or $where =~ /STDOUT/)  {	
  	return \*STDOUT;
      } else  {
--- 441,445 ----
  	$self->set_fh(-PATH =>$where,
  		      -PRE  =>$mode);
!     } elsif( not defined $self->{'_fh'} or $where =~ /STDOUT/)  {
  	return \*STDOUT;
      } else  {
***************
*** 489,493 ****
  	$self->set_fh(-PATH =>$where,
  		      -PRE  =>$mode);
!     } elsif( not defined $self->{'_fh'} or $where =~ /STDIN/)  {	
  	return \*STDIN;
      } else  {
--- 488,492 ----
  	$self->set_fh(-PATH =>$where,
  		      -PRE  =>$mode);
!     } elsif( not defined $self->{'_fh'} or $where =~ /STDIN/)  {
  	return \*STDIN;
      } else  {
***************
*** 529,533 ****
  	$self->set_fh(-PATH =>$where,
  		      -PRE  =>$mode);
!     } elsif( not defined $self->{'_fherr'} or $where =~ /STDERR/)  {	
  	return \*STDERR;
      } else  {
--- 528,532 ----
  	$self->set_fh(-PATH =>$where,
  		      -PRE  =>$mode);
!     } elsif( not defined $self->{'_fherr'} or $where =~ /STDERR/)  {
  	return \*STDERR;
      } else  {
***************
*** 742,746 ****
  	    # Uncomment to skip lines with only white space or record separators
  #	    next if m@^(\s*|$/*)$@;
! 	
  	    $lines++;
              $alarm_available and alarm(0);  # Deactivate the alarm as soon as we start reading.
--- 741,745 ----
  	    # Uncomment to skip lines with only white space or record separators
  #	    next if m@^(\s*|$/*)$@;
! 
  	    $lines++;
              $alarm_available and alarm(0);  # Deactivate the alarm as soon as we start reading.

Index: Object.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Root/Object.pm,v
retrieving revision 1.32
retrieving revision 1.33
diff -C2 -d -r1.32 -r1.33
*** Object.pm	20 Sep 2006 08:58:50 -0000	1.32
--- Object.pm	24 Sep 2006 15:36:32 -0000	1.33
***************
*** 5,10 ****
  # REVISION: $Id$
  # STATUS  : Alpha
! #            
! # For documentation, run this module through pod2html 
  # (preferably from Perl v5.004 or better).
  #
--- 5,10 ----
  # REVISION: $Id$
  # STATUS  : Alpha
! #
[...1889 lines suppressed...]
    _strict       Integer flag to set the sensitivity to exceptions/warnings
***************
*** 2137,2144 ****
  0.03, 16 Aug 1998, sac:
    * Calls to warn() or throw() now no longer result in Err.pm objects
!     being attached to the current object. For discussion about this 
      descision, see comments under err().
!   * Added the -RECORD_ERR constructor option and Global::record_err() 
!     method to enable the attachment of Err.pm object to the current 
      object.
    * Minor bug fixes with parameter handling (%param -> @param).
--- 2136,2143 ----
  0.03, 16 Aug 1998, sac:
    * Calls to warn() or throw() now no longer result in Err.pm objects
!     being attached to the current object. For discussion about this
      descision, see comments under err().
!   * Added the -RECORD_ERR constructor option and Global::record_err()
!     method to enable the attachment of Err.pm object to the current
      object.
    * Minor bug fixes with parameter handling (%param -> @param).

Index: Xref.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Root/Xref.pm,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** Xref.pm	4 Jul 2006 22:23:20 -0000	1.15
--- Xref.pm	24 Sep 2006 15:36:32 -0000	1.16
***************
*** 4,13 ****
  # CREATED : 8 May 1997
  # REVISION: $Id$
! # STATUS  : Pre-Alpha 
  #
  # WARNING: This is considered an experimental module.
  #
  # Copyright (c) 1997-8 Steve Chervitz. All Rights Reserved.
! #           This module is free software; you can redistribute it and/or 
  #           modify it under the same terms as Perl itself.
  #-----------------------------------------------------------------------------
--- 4,13 ----
  # CREATED : 8 May 1997
  # REVISION: $Id$
! # STATUS  : Pre-Alpha
  #
  # WARNING: This is considered an experimental module.
  #
  # Copyright (c) 1997-8 Steve Chervitz. All Rights Reserved.
! #           This module is free software; you can redistribute it and/or
  #           modify it under the same terms as Perl itself.
  #-----------------------------------------------------------------------------
***************
*** 79,88 ****
    Bio::Root::Global.pm       - Manages global variables/constants
  
!   http://bio.perl.org/Projects/modules.html  - Online module documentation
!   http://bio.perl.org/                       - Bioperl Project Homepage 
  
  =head1 FEEDBACK
  
! =head2 Mailing Lists 
  
  User feedback is an integral part of the evolution of this and other Bioperl modules.
--- 79,87 ----
    Bio::Root::Global.pm       - Manages global variables/constants
  
!   http://bio.perl.org/                       - Bioperl Project Homepage
  
  =head1 FEEDBACK
  
! =head2 Mailing Lists
  
  User feedback is an integral part of the evolution of this and other Bioperl modules.
***************
*** 99,105 ****
  web:
  
!   http://bugzilla.open-bio.org/           
  
! =head1 AUTHOR 
  
  Steve Chervitz E<lt>sac at bioperl.orgE<gt>
--- 98,104 ----
  web:
  
!   http://bugzilla.open-bio.org/
  
! =head1 AUTHOR
  
  Steve Chervitz E<lt>sac at bioperl.orgE<gt>
***************
*** 114,118 ****
  
  Copyright (c) 1997-8 Steve Chervitz. All Rights Reserved.
! This module is free software; you can redistribute it and/or 
  modify it under the same terms as Perl itself.
  
--- 113,117 ----
  
  Copyright (c) 1997-8 Steve Chervitz. All Rights Reserved.
! This module is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
***************
*** 142,146 ****
  
      $self->SUPER::_initialize(%param);
!     
      $self->{'_obj'} = ($param{-OBJ} || undef);
  
--- 141,145 ----
  
      $self->SUPER::_initialize(%param);
! 
      $self->{'_obj'} = ($param{-OBJ} || undef);
  
***************
*** 152,156 ****
      } else {
  	$self->{'_type'} = 'asym';
!     }	
  }
  
--- 151,155 ----
      } else {
  	$self->{'_type'} = 'asym';
!     }
  }
  
***************
*** 163,168 ****
  sub desc {my ($self) = shift; return $self->{'_desc'}; }
  sub type {my ($self) = shift; return $self->{'_type'}; }
!     
! sub set_desc {my ($self,$desc) = @_; 
  	     $self->{'_desc'} = $desc;
  	 }
--- 162,167 ----
  sub desc {my ($self) = shift; return $self->{'_desc'}; }
  sub type {my ($self) = shift; return $self->{'_type'}; }
! 
! sub set_desc {my ($self,$desc) = @_;
  	     $self->{'_desc'} = $desc;
  	 }
***************
*** 170,174 ****
  sub clear {
  ## Not implemented. Need to do this carefully.
! ## Not sure if this method is needed.    
      my ($self) = @_;
  }
--- 169,173 ----
  sub clear {
  ## Not implemented. Need to do this carefully.
! ## Not sure if this method is needed.
      my ($self) = @_;
  }
***************
*** 181,185 ****
  #####################################################################################
  
! =head1 DATA MEMBERS 
  
   _obj   : The object being cross-referenced to the parent.
--- 180,184 ----
  #####################################################################################
  
! =head1 DATA MEMBERS
  
   _obj   : The object being cross-referenced to the parent.

Index: Vector.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Root/Vector.pm,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -d -r1.17 -r1.18
*** Vector.pm	4 Jul 2006 22:23:20 -0000	1.17
--- Vector.pm	24 Sep 2006 15:36:32 -0000	1.18
***************
*** 85,89 ****
  =head1 USAGE
  
! For a usage demo of Bio::Root::Vector.pm see the scripts in the 
  examples/root_object/vector directory.
  
--- 85,89 ----
  =head1 USAGE
  
! For a usage demo of Bio::Root::Vector.pm see the scripts in the
  examples/root_object/vector directory.
  
***************
*** 127,131 ****
    http://bugzilla.open-bio.org/
  
! =head1 AUTHOR 
  
  Steve Chervitz  E<lt>sac at bioperl.orgE<gt>
--- 127,131 ----
    http://bugzilla.open-bio.org/
  
! =head1 AUTHOR
  
  Steve Chervitz  E<lt>sac at bioperl.orgE<gt>
***************
*** 156,160 ****
    Bio::Root::Global.pm    - Manages global variables/constants
  
-   http://bio.perl.org/Projects/modules.html  - Online module documentation
    http://bio.perl.org/                       - Bioperl Project Homepage
  
--- 156,159 ----
***************
*** 247,251 ****
      if( defined $self->{'_rank'} and not defined $self->{'_master'}->{'_rankBy'} ) {
  	return $self->master->warn('Rank defined without ranking criteria.');
!     }	
      1;
  }
--- 246,250 ----
      if( defined $self->{'_rank'} and not defined $self->{'_master'}->{'_rankBy'} ) {
  	return $self->master->warn('Rank defined without ranking criteria.');
!     }
      1;
  }
***************
*** 527,531 ****
  #	 do{
  #	     if($obj->name eq $name) { return $obj; }
! #	
  #	 } while($obj = $current->prev());
  
--- 526,530 ----
  #	 do{
  #	     if($obj->name eq $name) { return $obj; }
! #
  #	 } while($obj = $current->prev());
  

Index: Err.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Root/Err.pm,v
retrieving revision 1.21
retrieving revision 1.22
diff -C2 -d -r1.21 -r1.22
*** Err.pm	4 Jul 2006 22:23:20 -0000	1.21
--- Err.pm	24 Sep 2006 15:36:32 -0000	1.22
***************
*** 180,184 ****
    Bio::Root::Global.pm    - Manages global variables/constants
  
-   http://bio.perl.org/Projects/modules.html  - Online module documentation
    http://bio.perl.org/                       - Bioperl Project Homepage
  
--- 180,183 ----
***************
*** 467,471 ****
  #-------------------
      my( $self, $member, $data ) = @_;
! 	
      # Sensitive to data member name changes.
      $member = "_\l$member";
--- 466,470 ----
  #-------------------
      my( $self, $member, $data ) = @_;
! 
      # Sensitive to data member name changes.
      $member = "_\l$member";



More information about the Bioperl-guts-l mailing list