[Bioperl-guts-l] bioperl-live/Bio/Root Utilities.pm,1.26,1.27

[Steve Chervitz]

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

Modified Files:
	Utilities.pm 
Log Message:
* Added file_flavor() -- a simple wrapper around get_newline() that 
  returns the 'flavor' given a filename (unix, dos, mac).
* Added require FileHandle at the appropriate spot in
  create_filehandle() for convenience.


Index: Utilities.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Root/Utilities.pm,v
retrieving revision 1.26
retrieving revision 1.27
diff -C2 -d -r1.26 -r1.27
*** Utilities.pm	21 Dec 2005 11:30:58 -0000	1.26
--- Utilities.pm	24 Jan 2006 22:52:44 -0000	1.27
***************
*** 791,795 ****
      }
  
!     my $FH; # = new FileHandle;
  
      my ($handle_ref);
--- 791,795 ----
      }
  
!     my $FH;
  
      my ($handle_ref);
***************
*** 815,819 ****
  	$file = "${GNU_PATH}gzip -cd $file |"
        }
!       
        $FH = new FileHandle;
        open ($FH, $file) || $self->throw("Can't access data file: $file",
--- 815,820 ----
  	$file = "${GNU_PATH}gzip -cd $file |"
        }
! 
!       require FileHandle;
        $FH = new FileHandle;
        open ($FH, $file) || $self->throw("Can't access data file: $file",
***************
*** 840,844 ****
   Argument  : Same arguemnts as for create_filehandle().
   Returns   : Reference to a FileHandle object.   
!  Throws    : Propogates and exceptions thrown by Bio::Root::Utilities::get_newline().
  
  See Also : L<taste_file>(), L<create_filehandle>()
--- 841,845 ----
   Argument  : Same arguemnts as for create_filehandle().
   Returns   : Reference to a FileHandle object.   
!  Throws    : Propogates any exceptions thrown by Bio::Root::Utilities::get_newline().
  
  See Also : L<taste_file>(), L<create_filehandle>()
***************
*** 950,958 ****
  
    my @chars = split(//, $buffer);
  
    for ($i = 0; $i <$BUFSIZ; $i++) {
      if (($chars[$i] eq "\012")) {
        unless ($chars[$i-1] eq "\015") {
! 	# Unix
  	$octal = "\012";
  	$str = '\n';
--- 951,960 ----
  
    my @chars = split(//, $buffer);
+   my $flavor;
  
    for ($i = 0; $i <$BUFSIZ; $i++) {
      if (($chars[$i] eq "\012")) {
        unless ($chars[$i-1] eq "\015") {
! 	$flavor='Unix';
  	$octal = "\012";
  	$str = '\n';
***************
*** 961,965 ****
        }
      } elsif (($chars[$i] eq "\015") && ($chars[$i+1] eq "\012")) {
!       # DOS
        $octal = "\015\012";
        $str = '\r\n';
--- 963,967 ----
        }
      } elsif (($chars[$i] eq "\015") && ($chars[$i+1] eq "\012")) {
!       $flavor='DOS';
        $octal = "\015\012";
        $str = '\r\n';
***************
*** 967,971 ****
        last;
      } elsif (($chars[$i] eq "\015")) {
!       # Mac
        $octal = "\015";
        $str = '\r';
--- 969,973 ----
        last;
      } elsif (($chars[$i] eq "\015")) {
!       $flavor='Mac';
        $octal = "\015";
        $str = '\r';
***************
*** 978,984 ****
      $octal = "\012";
    } else {
! #    print STDERR "NEWLINE CHAR = $irs\n";
    }
    return($octal);
  }
  
--- 980,1020 ----
      $octal = "\012";
    } else {
! #    print STDERR "FLAVOR=$flavor, NEWLINE CHAR = $irs\n";
    }
    return($octal);
+ }
+ 
+ =head2 file_flavor
+ 
+  Usage     : $object->file_flavor( <filename> );
+  Purpose   : Returns the 'flavor' of a given file (unix, dos, mac)
+  Example   : print "$file has flavor: ", $Util->file_flavor($file);
+  Argument  : filename = string, full path name for file
+  Returns   : String describing flavor of file and handy info about line endings.
+            : One of these is returned:
+            :   unix (\n or 012 or ^J)
+            :   dos (\r\n or 015,012 or ^M^J)
+            :   mac (\r or 015 or ^M)
+            :   unknown
+  Throws    : Exception if argument is not a file
+            : Propogates any exceptions thrown by Bio::Root::Utilities::get_newline().
+ 
+ See Also : L<get_newline>(),  L<taste_file>()
+ 
+ =cut
+ 
+ #---------------
+ 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)',
+                  "\015"     =>'mac (\r or 015 or ^M)'
+                 );
+ 
+     -f $file or $self->throw("Can't determine flavor: arg '$file' is either non existant or is not a file.\n");
+     my $octal = $self->get_newline($file);
+     my $flavor = $flavors{$octal} || "unknown";
+     return $flavor;
  }