#!/usr/bin/perl -CSDAL

use strict;
use warnings;
use utf8;

use Fcntl ();

if( @ARGV < 1 || @ARGV > 3 || $ARGV[0] =~ /^--?h(?:elp)?$/ ) {
    print <<EOF;
usage: poke.pl <file> [ <offset> [ <length> ] ]
Reads data from standard input and writes it to a region in <file> without
truncating it, starting from byte <offset> (or 0) and <length> bytes long or
until end of input.
EOF
    exit 1;
}

my %multi= ( "" => 1, k => 1024, m => 1024*1024, g => 1024*1024*1024 );

my ($offset, $len)= (0, -1);
if( @ARGV >= 2 ) {
    $ARGV[1] =~ s/^\s+//;
    die "Offset \`$ARGV[1]' does not look numeric.\n" unless $ARGV[1] =~ /^[-+(]*\d/;
    if( $ARGV[1] =~ /^(\d+)([kmg]?)\s*$/i ) {
        $offset= $1 * $multi{lc $2};
    }
    else {
        $offset= eval $ARGV[1];
        die "Cannot evaluate offset \`$ARGV[1]': $@\n" if $@;
        die "Offset $offset is negative.\n" if $offset < 0;
    }
}
if( @ARGV >= 3 ) {
    $ARGV[2] =~ s/^\s+//;
    die "Offset \`$ARGV[2]' does not look numeric.\n" unless $ARGV[2] =~ /^[-+(]*\d/;
    if( $ARGV[2] =~ /^(\d+)([kmg]?)\s*$/i ) {
        $len= $1 * $multi{lc $2};
    }
    else {
        $len= eval $ARGV[2];
        die "Cannot evaluate length \`$ARGV[2]': $@\n" if $@;
        die "Length $len is negative.\n" if $len < 0;
    }
    exit 0 if $len == 0;
}

open OUT, "+<", $ARGV[0]
    or die "Cannot open $ARGV[0] for writing: $!\n";
binmode OUT;
if( $offset ) {
    sysseek OUT, $offset, Fcntl::SEEK_SET
        or die "Cannot seek to start offset: $!\n";
}

binmode STDIN;
my $chunksize= 0x1000000;
my $data;

while( $len != 0 ) {
    $chunksize= $len if $len > 0 && $len < $chunksize;
    my $got= read STDIN, $data, $chunksize;
    last unless $got;
    if( $len > 0 ) {
        $len -= $got;
        $len= 0 if $len < 0;
    }
    my $done= syswrite OUT, $data, $got;
    die "Write error: $!\n" unless defined($done) && $done == $got;
}

close OUT;