Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Bit Checker

by ikegami (Pope)
on Feb 16, 2009 at 20:11 UTC ( #744191=CUFP: print w/replies, xml ) Need Help??

#!/usr/bin/perl # # bit_checker # # Checks to make sure the file only contains valid bits. # Only values of 0 and 1 are considered valid for bits. # # usage: bit_checker [<file> [...] ] # # Exit code 0 if no errors. # Nonzero exit code on error. # # Assumes an 8-bit per byte system # # Inspired by http://thedailywtf.com/Articles/Some-Crazy-Reason.aspx # use strict; use warnings; sub process { my ($fh, $name) = @_; my $error = 0; my $offset = 0; local $/ = \(64*1024); while (my $blk = <$fh>) { for my $byte_idx ( 0 .. length($blk)-1 ) { my $byte = ord(substr($blk, $byte_idx, 1)); for my $bit_idx ( reverse 0 .. 7 ) { my $bit = ( $byte >> $bit_idx ) & 1; if ($bit != 0 && $bit != 1) { $error = 1; warn("Found bad bit ($bit) in $name" ." at pos ".( $offset+$byte_idx ).":$bit_idx" .\n"); } } } $offset += length($blk); } return $error; } { my $error = 0; if (@ARGV) { for my $qfn (@ARGV) { # Raw stream without disabling buffering. open(my $fh, '<:unix:perlio', $qfn) or die("Can't open \"$qfn\": $!\n"); $error = process($fh, "file \"$qfn\"") || $error; } } else { binmode(*STDIN); $error = process(*STDIN, 'STDIN'); } exit($error); }

Getting 100% test coverage is going to be hard...

Replies are listed 'Best First'.
Re: Bit Checker
by jwkrahn (Monsignor) on Feb 16, 2009 at 22:57 UTC

    Let's hope you don't try to run it on one of these.

      Then it would need a trit checker.

      The intelligent reader will judge for himself. Without examining the facts fully and fairly, there is no way of knowing whether vox populi is really vox dei, or merely vox asinorum. — Cyrus H. Gordon
      Actually, I think a machine like that is precisely why this script would be useful - you can check for portability. :-)

      --
      use JAPH;
      print JAPH::asString();

Re: Bit Checker
by oxone (Friar) on Feb 19, 2009 at 16:37 UTC
    Do pointless things more elegantly using vec:
    ... while (my $blk = <$fh>) { for(my $bit_idx = 0; $bit_idx < length($blk)*8; ++$bit_idx) { my $bit = vec($blk, $bit_idx, 1); if ($bit != 0 && $bit != 1) { # Error & warn ... } } } ...

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://744191]
Approved by Corion
Front-paged by grinder
help
Chatterbox?
[msh210]: About time... last time I was right was... I don't even remember when.
[shmem]: perl -e 'warn "test$/", ^@^ '
[Eily]: well, at least it's right about warn doing the same thing as die :)
[shmem]: same with undef as last element
[msh210]: oh, good point. It's the best kind of correct
[shmem]: msh210: but I'd not call it a lie outright. That's when you do know the truth.
[msh210]: I don't have sendmail (I'm on MS Windows), so does one of you think you can report the bug?
[shmem]: msh210: 'tis about time to tell the sad truth to perl5porters - via perlbug
[msh210]: probably whoever wrote that actually knows the truth
[shmem]: msh210: you can save the perlbug text in a file and send that via your mail agent of choice

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (15)
As of 2017-04-24 12:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    I'm a fool:











    Results (439 votes). Check out past polls.