Snippets

Brian Medley 9885e: Untitled snippet

Created by Brian Medley
#!/opt/perl

use strict;
use warnings;
use autodie;

use Fcntl qw(SEEK_END SEEK_SET);

my $position = 0;

open(my $src, '<', "source");
while (read($src, my $src_byte, 1)) {
    my $tgt_byte = getByte();

    if ($src_byte ne $tgt_byte) {
        grow();
        setByte($src_byte);
    }

    ++$position;
}
close($src);

sub grow {
    my $new = shift;

    open(my $tgt, '+>>', "target");
    seek($tgt, -1, SEEK_END);
    read($tgt, my $buf, 1);
    print($tgt $buf);
    close($tgt);

    my $idx = 0;

    open($tgt, '+<', "target");
    foreach ($position .. -s $tgt) {
        seek($tgt, $idx-1, SEEK_END);
        read($tgt, my $buf, 1);
        seek($tgt, $idx, SEEK_END);
        print($tgt $buf);

        --$idx;
    }
    close($tgt);
}

sub setByte {
    my $byte = shift;

    open(my $tgt, '+<', "target");
    seek($tgt, $position, SEEK_SET);
    print($tgt $byte);
    close($tgt);
}

sub getByte {
    open(my $tgt, '<', "target");
    seek($tgt, $position, SEEK_SET);

    read($tgt, my $buf, 1);

    close($tgt);
    return($buf);
}

Comments (0)

HTTPS SSH

You can clone a snippet to your computer for local editing. Learn more.