view release on metacpan or  search on metacpan

Bio/Root/Utilities.pm  view on Meta::CPAN

                        $client->{'_input_type'} eq 'FileHandle' ||
                        $client->{'_input_type'} eq 'Glob' );

    delete $client->{'_input_type'};

    return $NEWLINE || $DEFAULT_NEWLINE;
}


=head2 taste_file

 Usage     : $object->taste_file( <FileHandle> );
           : Mainly a utility method for get_newline().
 Purpose   : Sample a filehandle to determine the character(s) used for a newline.
 Example   : $char = $Util->taste_file($FH)
 Argument  : Reference to a FileHandle object.
 Returns   : String containing an octal represenation of the newline character string.
           :   Unix = "\012"  ("\n")
           :   Win32 = "\012\015" ("\r\n")
           :   Mac = "\015"  ("\r")
 Throws    : Exception if no input is read within $TIMEOUT_SECS seconds.
           : Exception if argument is not FileHandle object reference.
           : Warning if cannot determine neewline char(s).
 Comments  : Based on code submitted by Vicki Brown (vlb@deltagen.com).

See Also : L<get_newline()|get_newline>

=cut

#---------------
sub taste_file {
#---------------
    my ($self, $FH) = @_;
    my $BUFSIZ = 256;   # Number of bytes read from the file handle.
    my ($buffer, $octal, $str, $irs, $i);

    ref($FH) eq 'FileHandle' or $self->throw("Can't taste file: not a FileHandle ref");

    $buffer = '';

    # this is a quick hack to check for availability of alarm(); just copied
    # from Bio/Root/IOManager.pm HL 02/19/01
    my $alarm_available = 1;
    eval {
        alarm(0);
    };
    if($@) {
        # alarm() not available (ActiveState perl for win32 doesn't have it.
        # See jitterbug PR#98)
        $alarm_available = 0;
    }
    $SIG{ALRM} = sub { die "Timed out!"; };
    my $result;
    eval {
        $alarm_available && alarm( $TIMEOUT_SECS );
        $result = read($FH, $buffer, $BUFSIZ); # read the $BUFSIZ characters of file
        $alarm_available && alarm(0);
    };
    if($@ =~ /Timed out!/) {
        $self->throw( "Timed out while waiting for input.",
                      "Timeout period = $TIMEOUT_SECS seconds.\n"
                     ."For longer time before timing out, edit \$TIMEOUT_SECS in Bio::Root::Utilities.pm.");

    } elsif(not $result) {
        my $err = $@;
        $self->throw("read taste failed to read from FileHandle.", $err);

    } elsif($@ =~ /\S/) {
        my $err = $@;
        $self->throw("Unexpected error during read: $err");
    }

    seek($FH, 0, 0) or $self->throw("seek failed to seek 0 on FileHandle.");

    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';
                $irs = "^J";
                last;
            }
        } elsif (($chars[$i] eq "\015") && ($chars[$i+1] eq "\012")) {
            $flavor='DOS';
            $octal = "\015\012";
            $str = '\r\n';
            $irs = "^M^J";
            last;
        } elsif (($chars[$i] eq "\015")) {
            $flavor='Mac';
            $octal = "\015";
            $str = '\r';
            $irs = "^M";
            last;
        }
    }
    if (not $octal) {
        $self->warn("Could not determine newline char. Using '\012'");
        $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