marine

#!/usr/bin/perl
#*******************************************************************************
#   Mozilla Application Update Package Creator, version 1.0
#   Copyright (C) 2008, 2009 Sergei Zhirikov (sfzhi@yahoo.com)
#   This software is available under the GNU General Public License v3.0
#       (http://www.gnu.org/licenses/gpl-3.0.txt)
#*******************************************************************************
use strict;
use warnings;
use Pod::Usage;
use File::Find;
use Getopt::Std;
use File::Compare;
use File::Path qw(mkpath);
use File::Temp qw(tempdir);
use File::Spec::Functions
    qw(splitdir catfile abs2rel rel2abs splitpath catpath);
#*******************************************************************************
use constant UpdateManifestFile => 'update.manifest';
#*******************************************************************************
@ARGV or pod2usage(-exitval => 1, -verbose => 99, -sections => 'NAME|SYNOPSIS');
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
$Getopt::Std::STANDARD_HELP_VERSION = 1;
sub VERSION_MESSAGE {
    pod2usage(-exitval => 'NOEXIT', -verbose => 99, -sections => 'NAME');
}
sub HELP_MESSAGE {
    pod2usage(-exitval => 'NOEXIT', -verbose => 1);
}
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
our %opt;
getopts('vca:f:r:w:b:', \%opt) or die "Use '--help' for available options\n";
our ($log, $ext, $add, $rep, $rem, $tmp, $old) = @opt{qw[v c a f r w b]};
@ARGV == 2 or pod2usage(-exitval => 1, -verbose => 99, -sections => 'SYNOPSIS');
our ($new, $mar) = @ARGV;
#*******************************************************************************
!$old or -d $old or die "The base directory '$old' does not exist\n";
-d $new or die "The source directory '$new' does not exist\n";
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
our (@old, @new, %old, %new, %add, %rep, %rem);
no strict 'refs';
foreach my $var ($old? 'old': (), 'new') {
    my $dir = rel2abs($$var);
    find({follow => 0, no_chdir => 1, wanted => sub {
        push(@$var, abs2rel($_, $dir)) if (-f $_);
    }}, $dir);
    %$var = map { join('/', splitdir($_)) => $_ } @$var;
    @$var = sort(keys(%$var));
}
foreach my $var ('add', 'rep', 'rem') {
    if (defined($$var)) {
        if (($var ne 'rem') && ($$var eq '*')) {
            $$var = 1;
        } else {
            open(LST, '<', $$var) or die "Failed to open file '$$var': $!\n";
            while (<LST>) {
                chomp;
                $var->{$_} = 1 unless ($_ eq '');
            }
            close(LST);
            $$var = 0;
        }
    } else {
        $$var = 0;
    }
}
use strict 'refs';
#*******************************************************************************
if (!$tmp) {
    $tmp = tempdir(CLEANUP => 1);
} elsif (! -d $tmp) {
    die "'$tmp' does not exist or is not a directory\n";
}
#*******************************************************************************
our @upd;
foreach my $key (@new) {
    my $new = rel2abs($new{$key}, $new);
    my $tmp = rel2abs($new{$key}, $tmp);
    if ($add || exists($add{$key}) || (!exists($old{$key}))) {
        print("+ $key\n") if ($log);
        mkpath(catpath((splitpath($tmp))[0..1], ''));
        system(qq[bzip2 -cz9 "$new" > "$tmp"]) == 0
            or die "Failed to compress full content for '$key'\n";
        push(@upd, [$key, 'a']);
    } else {
        my $old = rel2abs($old{$key}, $old);
        my $cmp = compare($old, $new);
        if ($cmp == 0) {
            print("= $key\n") if ($log);
        } elsif ($cmp == 1) {
            mkpath(catpath((splitpath($tmp))[0..1], ''));
            system(qq[bzip2 -cz9 "$new" > "$tmp"]) == 0
                or die "Failed to compress full content for '$key'\n";
            if ($rep || exists($rep{$key})) {
                print("* $key\n") if ($log);
                push(@upd, [$key, 'a']);
            } else {
                system('mbsdiff', $old, $new, "$tmp.patch") == 0
                    or die "Failed to generate binary patch for '$key'\n";
                system('bzip2', '-z9', "$tmp.patch") == 0
                    or die "Failed to compress binary patch for '$key'\n";
                if (-s $tmp > -s "$tmp.patch.bz2") {
                    print("\% $key\n") if ($log);
                    unlink($tmp) or die "Failed to delete file '$tmp': $!\n";
                    rename("$tmp.patch.bz2", "$tmp.patch")
                        or die "Failed to rename file '$tmp.patch.bz2'\n";
                    push(@upd, [$key, 'p']);
                } else {
                    print("* $key\n") if ($log);
                    unlink("$tmp.patch.bz2")
                        or die "Failed to delete file '$tmp.patch.bz2': $!\n";
                    push(@upd, [$key, 'a']);
                }
            }
        } else {
            die "Failed to compare '$old' and '$new'\n";
        }
    }
}
foreach my $key (@old) {
    if (!exists($new{$key})) {
        print("- $key\n") if ($log);
        push(@upd, [$key, 'r']);
    }
}
#foreach my $key (@old) {
#    $rem{$key} = 0 unless (exists($new{$key}));
#}
foreach my $key (keys(%rem)) {
    unless (exists($old{$key}) || exists($new{$key})) {
        print("- $key\n") if ($log);
        push(@upd, [$key, 'r']);
    }
}
#*******************************************************************************
our $upd = catfile($tmp, UpdateManifestFile);
open(UPD, '|-', qq[bzip2 -cz9 > "$upd"])
    or die "Failed to run bzip2 to write to file '$upd': $!\n";
our @mar = (UpdateManifestFile);
our $pre = '(?:.*?/)?'; # ''
foreach (@upd) {
    my ($key, $act) = @$_;
    if ($act eq 'a') {
        push(@mar, $key);
        if ($ext && ($key =~ m<^(${pre}extensions/[^/]+)/>o)) {
            print UPD qq[add-if "$1" "$key"\n];
        } else {
            print UPD qq[add "$key"\n];
        }
    } elsif ($act eq 'p') {
        push(@mar, "$key.patch");
        if ($ext && ($key =~ m<^(${pre}extensions/[^/]+)/>o)) {
            print UPD qq[patch-if "$1" "$key.patch" "$key"\n];
        } elsif ($ext && ($key =~ m<^${pre}searchplugins/>o)) {
            print UPD qq[patch-if "$key" "$key.patch" "$key"\n];
        } else {
            print UPD qq[patch "$key.patch" "$key"\n];
        }
    } elsif ($act eq 'r') {
        print UPD qq[remove "$key"\n];
    }
}
close(UPD);
$? == 0 or die "bzip2 failed to compress file '$upd'\n";
#*******************************************************************************
system('mar', '-C', $tmp, '-c', rel2abs($mar), @mar) == 0
    or die "Failed to package the update archive '$mar'\n";
#*******************************************************************************
=pod

=head1 NAME

marine - Mozilla Application Update Package Creator, v1.0

=head1 SYNOPSIS

marine [options] sourcedir update.mar

=head1 ARGUMENTS

=over 2

=item B<sourcedir>

The directory containing the tree to be included in the update package.

=item B<update.mar>

The file name of the output update package. If the file exists it will
be overwritten.

=back

Additionally, the following options may be specified:

=over 2

=item B<-b basedir>

The base directory to compare the B<sourcedir> to. If this option is specified
the created package will contain partial (incremental) update. If this option
is omitted it is equivalent to the base directory being empty, that means a
full update package will be created.

=item B<-w workdir>

The temporary directory to be used to store intermediate files. If this option
is specified it must be an existing empty directory. If the directory is not
empty the process may fail or the resulting update package may contain garbage
entries. If this option is omitted a temporary directory is created in the
location typical for the operating system being used. In most cases there is no
need to specify this option other than for debugging purposes.

=item B<-v>

This option specifies that for each file is B<sourcedir> one line of text is
written to the standard output indicating the way that file is being processed.
The information lines can have one of the following forms:

=over 2

=item B<= filename>

The file is skipped, because it is the same as in the B<basedir>.

=item B<+ filename>

The file is added, because it does not exist in the B<basedir>.

=item B<% filename>

The file is patched, because in the B<basedir> it is slightly different from
its counterpart in the B<sourcedir>.

=item B<* filename>

The file is replaced, because in the B<basedir> it is significantly different
from its counterpart in the B<sourcedir>.

=item B<- filename>

The file is removed, because it does not exist in the B<sourcedir>.

=back

Note: the operation performed on the file can be influenced by one or more of
the command line options, as described below.

=item B<-a filelist>

Specifies a text file containing the list of files to be forced to be added.
Those files will be processed as if they did not exist in the B<basedir>.

If the value of B<filelist> is C<*> then this option applies to all files found
in the B<sourcedir>. This is not the same as not having B<basedir> at all,
because in this case, additionally, the files that exist in the B<basedir> but
not in the B<sourcedir> will be removed. Note, C<*> must be quoted or escaped
properly when using a command shell that treats asterisk characters specially
(like most UNIX shells).

=item B<-f filelist>

Specifies a text file containing the list of files to be forced to be replaced
rather than patched. This only applies to the files that exist both in the
B<basedir> and in the B<sourcedir> and are different.

If the vale of B<filelist> is C<*> then this option applies to all files found
in the B<sourcedir>. Note, C<*> must be quoted or escaped properly when using
a command shell that treats asterisk characters specially (like most UNIX
shells).

=item B<-r filelist>

Specifies a text file containing the list of files to be forced to be removed.
This means a C<remove> instruction will be added to the update manifest for
the files that exist neither in the B<basedir> nor in the B<sourcedir>.

This is useful in case some files are created by the application at runtime and
they should be removed upon update. If the list contains some files that exist
either in the B<basedir> or in the B<sourcedir> those entries will be ignored.

=item B<-c>

Use conditional instructions for extensions and search plugins, just like the
Mozilla update scripts do. Normally this option should be specified if the
application contains or may contain extensions or search plugins.

=back

=head1 DESCRIPTION

The command examines the contents of the source and the base directories,
creates necessary binary patch files using B<mbsdiff> (whenever those can be
compressed by B<bzip2> to a smaller size than the corresponding complete files),
generates C<update.manifest> file containing the instructions for the updater,
and puts everything into the specified B<.mar> file.

=head1 KNOWN ISSUES

None so far.

=head1 DEPENDENCIES

bzip2, mar, mbsdiff

=head1 HOME PAGE

L<http://www.softlights.net/projects/mxtools/>

=head1 AUTHORS

Copyright (C) 2008, 2009 Sergei Zhirikov (sfzhi@yahoo.com)

=cut