#!/usr/bin/perl

# Copyright (C) 2006 Eric L. Wilhelm

# oovc - version-control OpenOffice documents

# tests: (need to live somewhere)
# cp ../SVGstage3.sxw .; oovc deconstruct SVGstage3.sxw; oovc reconstruct SVGstage3.sxw;unzip -lv ../SVGstage3.sxw ;unzip -lv SVGstage3.sxw;ls -l ../SVGstage3.sxw SVGstage3.sxw;diff  ../SVGstage3.sxw SVGstage3.sxw

use warnings;
use strict;

use File::Basename;
use File::Spec;

($0 eq __FILE__) and (exit(main(@ARGV)));

sub main {
	my @args = @_;
	my ($command, $src, $dest);
	foreach my $var ($command, $src, $dest) {
		$var or ($var = shift(@args));
	}
	$dest ||= File::Spec->join(
		dirname($src),
		'.' . basename($src) . '.d');
	$dest =~ s#/*$#/#;
	warn "do:  $command $src $dest\n";
	my $oovc = App::OOVC->new;
	if(my $cmd = $oovc->lookup_command($command)) {
		return(not $oovc->$cmd($src, $dest, @args));
	}
	else {
		warn "unknown command '$command'\n";
		return(1);
	}

	0;
} # end subroutine main definition
########################################################################
BEGIN {
# only in a block because it's equivalent to use()

package App::OOVC;

# XXX I want a use base('App::Dispatch') or something
# Mon Apr 10, 2006 update:  App::CLI has some of that, but seems to have
# a high startup cost, and I think dispatching to classes is a bit too
# much separation


use warnings;
use strict;
use Carp;

use base(qw(
	Class::Accessor
	));

__PACKAGE__->mk_ro_accessors(qw(
	vcs
	vc
	));

use YAML;
use Archive::Zip qw(
	:ERROR_CODES
	:CONSTANTS
	);

our $crc_file = 'checksums';

=head1 Constructor

=head2 new

  $oovc = App::OOVC->new(%options);

=cut
sub new {
	my $caller = shift;
	my $class = ref($caller) || $caller;
	my $self = {@_};
	$self->{vc} = 'OpenOffice::OODoc::VersionControl'; # XXX actual object?
	$self->{vcs} = VCS->new();
	bless($self, $class);
	return($self);
} # end subroutine new definition
########################################################################

=head1 The Plan

XXX need to do some thinking about the various scenarios:

o  Original file

  oovc init file.sxw -> create directory, checksum, set ignore (?), add files
  
  checkin is left up to (or dispatched to?) oovc ci

o  openoffice save file locally

  oovc ci file.sxw -> update checksum, deconstruct checkin

o  update directory via svn

  oovc up file.sxw

  with local changes -> verify checksum 
    ok -> svn update, reconstruct
    else ->
      deconstruct, svn up, complain
      resolve conflicts, reconstruct, update checksum, tell user to svn ci

  with remote changes only -> reconstruct, verify checksum

o copy/rename/delete (? s/delete/drop/ ?)

  Requires a change to the svn:ignore property.

  delete (or drop) should reconstruct the latest version

o cat/view

  Allows dumping a given revision, possibly with a "fork/exec, tmpfile,
  cleanup" approach for the viewer.

=head1 dispatch

=head2 lookup_command

  $oovc->lookup_command($cmd) or die "cannot run $cmd";

=cut
sub lookup_command {
	my $self = shift;
	my $cmd = shift;
	$cmd or croak("lookup_cmd() requires an argument");
	$cmd = 'cmd_' . $cmd;
	return($self->can($cmd) ? $cmd : '');
} # end subroutine lookup_command definition
########################################################################

=head2 cmd_unpack

  $oovc->cmd_unpack($file, $dir, @args);

=cut
sub cmd_unpack {
	my $self = shift;
	my ($file, $dir, @args) = @_;
	if(-d $dir) {
		warn "cannot unpack onto existing directory '$dir'" ,
			(0?"without --force option" : ''), # XXX fixme
			,"\n";
		return(0);
	}
	$self->vc->unpack($file, $dir);
} # end subroutine cmd_unpack definition
########################################################################

=head2 cmd_pack

  $oovc->cmd_pack($file, $dir, @args);

=cut
sub cmd_pack {
	my $self = shift;
	my ($file, $dir, @args) = @_;
	$self->vc->pack($file, $dir);
} # end subroutine cmd_pack definition
########################################################################

=head2 cmd_init

Unpack $file into $dir, add linebreaks, create checksum, set ignore
property, etc.

  $oovc->cmd_init($file, $dir, @args);

=cut
sub cmd_init {
	my $self = shift;
	my ($file, $dir, @args) = @_;
	(-d $dir) and die "dir: '$dir' exists";
	$self->cmd_deconstruct($file, $dir);
	$self->vcs->add($dir);
	$self->vcs->ignore($file);
	warn "you need to do the checkin";
	1;
} # end subroutine cmd_init definition
########################################################################

=head2 cmd_status

Print the status of the document ...

Has it been modified since the last deconstruction?
Since the last checkin?

  $oovc->cmd_status();

=cut
sub cmd_status {
	my $self = shift;
	die "write me";
} # end subroutine cmd_status definition
########################################################################

=head2 cmd_ci

  $oovc->cmd_ci($file, @args);

=cut
sub cmd_ci {
	my $self = shift;
	my ($file, @args) = @_;
	#$self->cmd_deconstruct($file, $dir);
	die "write me";

} # end subroutine cmd_ci definition
########################################################################

=head2 cmd_up

  $oovc->cmd_up($file, @args);

=cut
sub cmd_up {
	my $self = shift;
	my ($file, @args) = @_;
	# XXX we need a checksum of the oofile in our vc'd directory
	# update should allow us to merge content and resolve conflicts
	die "write me";
} # end subroutine cmd_up definition
########################################################################

=head2 cmd_deconstruct

  $oovc->cmd_deconstruct($file, $dir, @args);

=cut
sub cmd_deconstruct {
	my $self = shift;
	my ($file, $dir, @args) = @_;
	# XXX should work in a tmpdir ?
	$self->vc->unpack($file, $dir, force => 1);
	$self->vc->linebreak($dir);
	my $cfile = $dir . $crc_file; # XXX accessor?
	my %crc = $self->get_crcs($file);
	YAML::DumpFile($cfile, \%crc);
	1;
} # end subroutine cmd_deconstruct definition
########################################################################

=head2 cmd_reconstruct

  $oovc->cmd_reconstruct($file, $dir, @args);

=cut
sub cmd_reconstruct {
	my $self = shift;
	my ($file, $dir, @args) = @_;
	(-d $dir) or die "no directory: $dir\n";
	# XXX should work in a tmpdir
	# compare deconstructed crc's to existing file (if there's an
	# existing file)
	if(-e $file) {
		my $cfile = $dir . $crc_file; # XXX accessor?
		my ($dircrc) = YAML::LoadFile($cfile);
		my %fcrc = $self->get_crcs($file);
		# XXX compare deeply
	}
	my $tmpdir = $dir;
	$self->vc->linejoin($tmpdir);
	$self->vc->pack($file, $tmpdir);
} # end subroutine cmd_reconstruct definition
########################################################################

=head2 cmd_crc

  $oovc->cmd_crc();

=cut
sub cmd_crc {
	my $self = shift;
	my ($file, $dir, @args) = @_;
	my %crc = $self->get_crcs($file);
	print YAML::Dump(\%crc);
} # end subroutine cmd_crc definition
########################################################################

=head2 get_crcs

  $oovc->get_crcs($file);

=cut
sub get_crcs {
	my $self = shift;
	my ($file) = @_;
	my $z = Archive::Zip->new($file);
	my %crc;
	foreach my $m ($z->members) {
		$m->isDirectory and next;
		$crc{$m->fileName} = $m->crc32String;
	}
	return(%crc);
} # end subroutine get_crcs definition
########################################################################

package OpenOffice::OODoc::VersionControl;

use warnings;
use strict;
use Carp;

our @targets = qw(content.xml meta.xml settings.xml styles.xml);

use Archive::Zip qw(
	:ERROR_CODES
	:CONSTANTS
	);


# XXX these methods should really go in jmgdoc's cpan package

=head2 unpack

  $oodoc->unpack($file, $dir, %opts);

=cut
sub unpack {
	my $self = shift;
	my $file = shift;
	my $dir = shift;
	my %opts = @_;
	$dir =~ s#/*$#/#;
	if(-e $dir) {
		$opts{force} or return(0);
	}
	else {
		mkdir($dir) or return(0);
	}
	my $z = Archive::Zip->new($file);
	return($z->extractTree('', $dir) == AZ_OK);
} # end subroutine unpack definition
########################################################################

=head2 pack

Creates $file from $dir while ignoring .svn subdirs.

  $oodoc->pack($file, $dir);

=cut
sub pack {
	my $self = shift;
	my $file = shift;
	my $dir = shift;
	unless(-d $dir) {
		warn "cannot pack without source directory '$dir'\n";
		return(0);
	}
	$dir =~ s#/*$#/#;
	my $z = Archive::Zip->new;
	$z->addTree($dir, '',
		sub { (not -d $_) and
			($_ !~ m/^$dir.*\.svn/) and ($_ !~ m/^${dir}checksums/)});
	foreach my $name (qw(mimetype layout-cache meta.xml)) {
		$z->memberNamed($name)->desiredCompressionLevel(0);
	}
	return($z->writeToFileNamed($file) == AZ_OK);
} # end subroutine pack definition
########################################################################

=head2 linebreak

Insert linebreaks into the xml files.

  $oodoc->linebreak($dir);

=cut
sub linebreak {
	my $self = shift;
	my $dir = shift;
	foreach my $file (map({$dir . $_} @targets)) {
		open(FILE, $file) or die "no '$file'";
		local $/;
		my $lines = <FILE>;
		$lines =~ s/></><!--lb-->\n</g;
		open(FILE, ">$file") or die "cannot write to '$file' ($!)";
		print FILE $lines;
		close(FILE) or die "out of space? $!";
	}
} # end subroutine linebreak definition
########################################################################

=head2 linejoin

  $oodoc->linejoin($dir);

=cut
sub linejoin {
	my $self = shift;
	my $dir = shift;
	foreach my $file (map({$dir . $_} @targets)) {
		open(FILE, $file) or die;
		local $/;
		my $lines = <FILE>;
		$lines =~ s/><!--lb-->\n</></g;
		open(FILE, ">$file") or die "cannot write to '$file' ($!)";
		print FILE $lines;
		close(FILE) or die "out of space? $!";
	}
} # end subroutine linejoin definition
########################################################################

1;

# hasn't anyone written this one yet?
package VCS;



=head2 new

  $vcs = VCS->new($dir);

=cut
sub new {
	my $caller = shift;
	my $class = ref($caller) || $caller;
	my $dir = shift; # XXX doesn't do anything yet
	my $self = {@_};
	$self->{vcs} = 'svn'; # XXX needs to be detected
	$self->{vcs_cmd} = 'svn'; # XXX File::Which
	bless($self, $class);
	return($self);
} # end subroutine new definition
########################################################################

=head2 add

  $vcs->add();

=cut
sub add {
	my $self = shift;
	my $file = shift;
	($self->{vcs} eq 'sys') and return(1);
	# XXX IPC::Run! run!run!run!
	system($self->{vcs_cmd}, 'add', $file) and die;
	1;
} # end subroutine add definition
########################################################################

=head2 ignore

  $vcs->ignore($file);

=cut
sub ignore {
	my $self = shift;
	my $file = shift;
	# XXX what's the CVS incantation?
	# XXX assuming current directory is no good, maybe do rel2abs/etc?
	$self->propmerge('svn:ignore', $file, '.');
} # end subroutine ignore definition
########################################################################

=head2 propmerge

Put 

  $vcs->propmerge($prop, $propval, $target);

=cut
sub propmerge {
	my $self = shift;
	my ($p, $pv, $t) = @_;
	($self->{vcs} =~ m/^svk|n$/) or return();
	# XXX maybe shouldn't re-order them
	# XXX also, get IPC::Run involved and lose the backticks here
	my %cprops = map({chomp;$_ => 1} `$self->{vcs_cmd} propget $p $t`);
	#warn "cprops: ", join("|", keys(%cprops)), "\n";
	$cprops{$pv} = 1;
	system($self->{vcs_cmd}, 'propset', $p,
		join("\n", keys(%cprops)), $t) and die;
	return(1);
} # end subroutine propmerge definition
########################################################################

1;
}
1;