#! /usr/bin/perl
use strict;

=head1 NAME

scandisk - read a raw device or file looking for defects.

=head1 SYNOPSIS

 scandisk /dev/rdisk0
 
=head1 DESCRIPTION

 scandisk will open a file, and start doing seeks and reads 
 to look for any blocks that give errors (or are slow to 
 seek and read).  
 
 the block size is increased during periods of successful reads
 to speed up the process, and to involve fewer system calls.
 
 during failures, the block size is reduced until it is down
 to 512 bytes.  failures at this size are actually reported.
 reads taking more than 3 seconds are also considered failures.
 
=head1 AUTHOR

 Jason Fesler <jfesler@gigo.com>

=cut

eval { '         use Time::HiRes qw ( time alarm sleep );' };    # Optional

my $bs     = 1024;
my $maxbs  = 1024 * 1024 * 16;
my $buffer = ' ' x $maxbs;
my $file   = shift @ARGV || die "usage: $0 /dev/rdisk";

my $pos    = 0;
my $inarow = 0;
my $errors = 0;
my ( $t1, $t2, $ec, $read );

open( FILE, "<$file" ) or die "failed to open $file : $!";
while (1) {
    my $s = Commify($pos);
    print STDERR "pos=$s bs=$bs            \r";

    $t1 = time;
    seek FILE, $pos, 0;
    $read = sysread FILE, $buffer, $bs;
    $ec   = $!;
    $t2   = time;

    # If we have errors and/or we were slow..
    if ( $ec || ( $t2 - $t1 > 3 ) ) {
        $inarow = 0;
        if ( $bs > 512 ) {
            $bs = $bs / 1024;              # Step down fast
            $bs = 512 if ( $bs < 512 );    # Minimum size
        } else {
            if ($ec) {
                print STDERR "ERROR at pos=$s bs=$bs  \n";
            } else {
                my $diff = $t2 - $t1;
                print STDERR "SLOW at pos=$s bs=$bs took $diff seconds \n";
            }
            $pos += $bs;
            $errors = 1;
        } ## end else [ if ( $bs > 512 )
    } ## end if ( $ec || ( $t2 - $t1...

    exit $errors if ( !$read );    # Exit on 0 byte reads
    $pos += $read;                 # Otherwise increment the $pos
    $inarow++;                     # After several good reads ..
    if ( $inarow > 50 ) {          # increase the buffer size
        if ( $bs < $maxbs ) {
            $bs *= 2;
            $inarow = 0;
        }
    } ## end if ( $inarow > 50 )
} ## end while (1)

# Pretty printer for numbers.
sub Commify {
    local ($_) = shift;
    1 while s/^(-?\d+)(\d{3})/$1,$2/;
    return $_;
}