Algorithm-GDiffDelta
view release on metacpan or search on metacpan
GDiffDelta.pm view on Meta::CPAN
=item gdiff_apply(I<$file1>, I<$file2>, I<$delta_file>)
Takes three file handles. The first two are read from, and it must
be possible to seek in them. The third is written to.
This generates a binary delta describing the changes from I<$file1>
to I<$file2>. The delta will allow I<$file2> to be reconstructed
from I<$file1> later.
No value is returned. Errors will cause this function to croak
with a suitable error message.
=item gdiff_delta(I<$file1>, I<$delta_file>, I<$file2>)
Takes three file handles. The first two are read from, and it must
be possible to seek in them. The third is written to.
The delta is used to reconstruct I<$file2> from I<$file1>.
The delta must be a valid GDIFF file.
No value is returned. Errors will cause this function to croak
with a suitable error message.
=back
=head1 ALGORITHM AND DELTA FORMAT
The algorithm and some of the code used in this module was derived
from the xdiff library. It has been adjusted to write GDIFF deltas,
rather than the custom format used by xdiff (which was funtionally
equivalent but a little simpler than GDIFF).
GDiffDelta.xs view on Meta::CPAN
/* TODO - possibly use newSVpvn_share to avoid the memcpy
* and extra allocation for buf? */
XPUSHs(sv_2mortal(buf = newSVpvn("", 0)));
XPUSHs(sv_2mortal(newSVuv(size)));
PUTBACK;
n = call_method("read", G_SCALAR);
assert(n == 0 || n == 1);
SPAGAIN;
ret = n ? POPs : &PL_sv_undef;
if (!SvOK(ret))
croak("error reading from %s: %s", from,
SvPV_nolen(get_sv("!", FALSE)));
if (SvUV(ret) != size)
croak("%s ends unexpectedly", from);
if (!SvPOK(buf) || SvCUR(buf) != size)
croak("'read' method left buffer badly set up", from);
str = SvPV(buf, len);
assert(len == size);
memcpy(ptr, str, size);
PUTBACK;
FREETMPS;
LEAVE;
}
else {
int r = PerlIO_read(IoIFP(sv_2io(f)), ptr, size);
if (r < 0)
croak("error reading from %s: %s", from, strerror(errno));
else if ((size_t) r != size)
croak("%s ends unexpectedly", from);
}
}
static void
careful_fwrite (const void *ptr, size_t size, SV *f, const char *to)
{
I32 n;
SV *ret;
GDiffDelta.xs view on Meta::CPAN
PUTBACK;
n = call_method("write", G_SCALAR);
assert(n == 0 || n == 1);
SPAGAIN;
ret = n ? POPs : &PL_sv_no;
n = SvTRUE(ret);
PUTBACK;
FREETMPS;
LEAVE;
if (!n)
croak("error writing to %s: %s", to,
SvPV_nolen(get_sv("!", FALSE)));
}
else {
if ((size_t) PerlIO_write(IoIFP(sv_2io(f)), ptr, size) != size)
croak("error writing to %s: %s", to, strerror(errno));
}
}
static void
careful_fseek_whence (SV *f, Off_t offset, const char *from, int whence)
{
assert(whence == SEEK_SET || whence == SEEK_CUR || whence == SEEK_END);
#ifdef QEF_DEBUG_IO
fprintf(stderr, "seek %p (%s): %s %u\n", (void *) f, from,
(whence == SEEK_SET ? "SEEK_SET" :
GDiffDelta.xs view on Meta::CPAN
PUTBACK;
n = call_method("seek", G_SCALAR);
assert(n == 0 || n == 1);
SPAGAIN;
ret = n ? POPs : &PL_sv_undef;
n = SvTRUE(ret);
PUTBACK;
FREETMPS;
LEAVE;
if (!n)
croak("error seeking in %s: %s", from,
SvPV_nolen(get_sv("!", FALSE)));
}
else {
if (PerlIO_seek(IoIFP(sv_2io(f)), offset, whence))
croak("error seeking in %s: %s", from, strerror(errno));
}
}
QEF_INLINE static void
careful_fseek (SV *f, Off_t offset, const char *from)
{
careful_fseek_whence(f, offset, from, SEEK_SET);
}
static Off_t
GDiffDelta.xs view on Meta::CPAN
offset = (Off_t) -1;
if (n) {
ret = POPs;
if (SvOK(ret))
offset = SvUV(ret);
}
PUTBACK;
FREETMPS;
LEAVE;
if (offset == (Off_t) -1)
croak("error getting position in %s: %s", from,
SvPV_nolen(get_sv("!", FALSE)));
}
else {
offset = PerlIO_tell(IoIFP(sv_2io(f)));
if (offset == (Off_t) -1)
croak("error getting position in %s: %s", from, strerror(errno));
}
return offset;
}
QEF_INLINE static size_t
read_ubyte (SV *f)
{
unsigned char buf;
careful_fread(&buf, 1, f, "delta");
compile_gdiff view on Meta::CPAN
my %COPY_OPCODE = (
ushort_ubyte => "\xF9",
ushort_ushort => "\xFA",
ushort_int => "\xFB",
int_ubyte => "\xFC",
int_ushort => "\xFD",
int_int => "\xFE",
long_int => "\xFF",
);
binmode STDOUT or die "error setting stdout to binmode: $!";
# The header is always the same.
print "\xD1\xFF\xD1\xFF\x04";
while (<>) {
chomp;
next unless /\S/;
next if /^\s*#/;
my ($opcode, @arg) = split ' ';
t/20apply.t view on Meta::CPAN
'make sure delta in IO::Scalar still OK');
is("$ios_new_file", $new, 'apply example delta using IO::Scalar');
# Now test with real files, using sample data in 't/data'.
for (1 .. 2) {
my $orig_filename = catfile($data_dir, "$_.orig");
my $delta_filename = catfile($data_dir, "$_.gdiff");
my $new_filename = catfile($data_dir, "$_.new");
open my $orig_file, '<', $orig_filename
or die "error opening $orig_filename: $!";
open my $delta_file, '<', $delta_filename
or die "error opening $delta_filename: $!";
my $tmp_filename = tmpnam();
open my $output_file, '>', $tmp_filename
or die "error opening $tmp_filename: $!";
gdiff_apply($orig_file, $delta_file, $output_file);
close $output_file; # to flush it
my $expected_new = read_file($new_filename);
my $actual_new = read_file($tmp_filename);
is($actual_new, $expected_new,
"apply sample files numbered $_ with real file handles");
}
sub read_file
{
my ($filename) = @_;
open my $file, '<', $filename
or die "error opening $filename: $!";
my $data = do { local $/; <$file> };
die "error reading from $filename: $!" unless defined $data;
return $data;
}
# vim:ft=perl ts=4 sw=4 expandtab:
t/30delta.t view on Meta::CPAN
predefined_2 => [ 433, 435 ],
);
# Now test with real files, using sample data in 't/data'.
for (1 .. 2) {
my $orig_filename = catfile($data_dir, "$_.orig");
my $delta_filename = catfile($data_dir, "$_.gdiff");
my $new_filename = catfile($data_dir, "$_.new");
open my $orig_file, '<', $orig_filename
or die "error opening $orig_filename: $!";
open my $new_file, '<', $new_filename
or die "error opening $new_filename: $!";
my $tmp_filename = tmpnam();
open my $output_file, '>', $tmp_filename
or die "error opening $tmp_filename: $!";
gdiff_delta($orig_file, $new_file, $output_file);
close $output_file; # to flush it
open $output_file, '<', $tmp_filename
or die "error opening $tmp_filename: $!";
seek $orig_file, 0, 0 or die "error seeking in $orig_filename: $!";
my $tmp_filename2 = tmpnam();
open my $output_file2, '>', $tmp_filename2
or die "error opening $tmp_filename2: $!";
gdiff_apply($orig_file, $output_file, $output_file2);
close $output_file2; # to flush it
is(read_file($tmp_filename2), read_file($new_filename),
"delta for sample files numbered $_ produces right output");
# Make sure the delta is a reasonable size.
my @stat = stat $output_file or die "error stating $tmp_filename: $!";
my $size = $stat[7];
my $expected_size = $DELTA_MAX_LEN{"predefined_$_"};
ok($size >= $expected_size->[0],
"delta for $_ should be at least $expected_size->[0] bytes");
ok($size <= $expected_size->[1],
"delta for $_ should be at no more than $expected_size->[1] bytes");
}
sub read_file
{
my ($filename) = @_;
open my $file, '<', $filename
or die "error opening $filename: $!";
my $data = do { local $/; <$file> };
die "error reading from $filename: $!" unless defined $data;
return $data;
}
# vim:ft=perl ts=4 sw=4 expandtab:
foreach (@pm) {
# Warnings are sent to a temporary file.
my ($log_file, $log_filename) = tempfile();
my $s = podchecker($_, $log_file, '-warnings' => 2);
close $log_file;
warn "\n$_: no documentation.\n" if $s < 0;
if ($s > 0) {
$log_file = IO::File->new($log_filename, 'r')
or die "$0: error rereading log file '$log_filename': $!\n";
my $log = do { local $/; <$log_file> };
warn "\n$log\n";
}
ok($s <= 0, "POD in $_ is valid");
unlink $log_filename;
}
# Local Variables:
# mode: perl
( run in 0.919 second using v1.01-cache-2.11-cpan-65fba6d93b7 )