#
# CVS -- cvs support for WebMake CGI.

package HTML::WebMake::CGI::CVS;

###########################################################################

use strict;

use HTML::WebMake::Main;
use HTML::WebMake::Util;

use File::Find;
use File::Basename;

use vars	qw{
  	@ISA $CVS
};

$CVS = 'cvs';

###########################################################################

sub new ($$$$$) {
  my $class = shift;
  $class = ref($class) || $class;

  my $self = {
    'cgibase'	=> shift
  };
  bless ($self, $class);

  $self;
}

# -------------------------------------------------------------------------

sub file_in_cvs {
  my ($self, $file) = @_;
  my $ents = dirname ($file) . "/CVS/Entries";
  my $fname = basename ($file);

  if (open (ENTS, "<$ents")) {
    while (<ENTS>) {
      /^\/([^\/]+?)\// or next;
      if ($1 eq $fname) { close ENTS; return 1; }
    }
    close ENTS;
  }
  return 0;
}

# -------------------------------------------------------------------------

sub cvs_update {
  my ($self) = @_;
  my $cmd = "$CVS -z3 update -dP";
  my $text = $self->run_cvs_command ("update", $cmd);

  if ($self->{conflicts}) {
    my $warn = qq{
      <hr />
      <p><font color=\"#cc0000\">
      Some conflicts occurred while updating!  Please check
      and correct errors in the files listed below in red.
      </font></p>
      <hr />
    };

    $text = $warn . $text;
  }

  return $text;
}

# ---------------------------------------------------------------------------

sub cvs_commit {
  my ($self, $msg) = @_;
  $msg =~ s/\'\"\0//gs;
  $self->run_cvs_command ("commit", "$CVS -z3 commit -m '".$msg."'");
}

# ---------------------------------------------------------------------------

sub do_cvs_adds {
  my ($self) = @_;

  my $text = '';
  my @addtxts = split (/\|/, $self->{cgibase}->{cvsadd});
  my @addbins = split (/\|/, $self->{cgibase}->{cvsaddbin});
  
  my %rms = ();
  foreach my $file (split (/\|/, $self->{cgibase}->{cvsrm})) {
    $rms{$file} = 1;
  }

  chdir ($self->{cgibase}->{file_base});

  # create any directories required first
  my @dirstocreate = ();
  my %skipfiles = ();

  foreach my $file (@addtxts, @addbins) {
    if ($self->file_in_cvs ($file) || defined($rms{$file})) {
      # $self->warn ("Not adding \"$file\", it is already in CVS.");
      $skipfiles{$file} = 1;
      next;
    }

    my $working = $file;
    while (1) {
      my $base = basename ($working);
      my $dir = dirname ($working);
      my $ents = $dir.'/CVS/Entries';

      last if ($dir eq '.');

      if (!-f $ents) {
	push (@dirstocreate, $dir);
	$working = $dir;
      } else {
	last;
      }
    }
  }

  # for a file "foo/bar/baz/newfile", @dirstocreate will look like:
  # qw(foo/bar/baz foo/bar foo) now.

  my $cmd;
  if (scalar @dirstocreate > 0) {
    $cmd = "cvs add '". join ("' '", reverse @dirstocreate)."'";
    $text .= $self->run_cvs_command ("add dirs", $cmd);
  }

  # now add the files.
  @addtxts = grep { !defined $skipfiles{$_} } @addtxts;
  @addbins = grep { !defined $skipfiles{$_} } @addbins;

  if (scalar @addtxts > 0) {
    $cmd = "cvs add '". join ("' '", @addtxts)."'";
    $text .= $self->run_cvs_command ("add files", $cmd);
  }

  if (scalar @addbins > 0) {
    $cmd = "cvs add -kb '". join ("' '", @addbins)."'";
    $text .= $self->run_cvs_command ("add files", $cmd);
  }

  $text;
}

# ---------------------------------------------------------------------------

sub do_cvs_deletes {
  my ($self) = @_;

  my $text = '';
  my @delfiles = split (/\|/, $self->{cgibase}->{cvsrm});
  my @deldirs = split (/\|/, $self->{cgibase}->{cvsrmdir});

  # ensure the arrays are sorted so that subdirectories and subfiles
  # are listed deepest first.

  @deldirs = sort {
    count_slashes($b) <=> count_slashes($a)
  } @deldirs;

  my @newdeldirs = ();
  my %delfiles_hash = ();

  foreach my $dir (@deldirs) {
    my $ents = $dir.'/CVS/Entries';

    if (!-f $ents) {
      $self->warn ("\"$dir\" is not in CVS (no CVS/Entries file)");
      next;
    }

    open (ENTS, "<$ents");
    while (<ENTS>) {
      /^\/([^\/]+?)\// or next;
      $delfiles_hash{$1} = 1;
    }
    close ENTS;

    push (@newdeldirs, $dir);
  }
  @deldirs = @newdeldirs;

  foreach my $file (@delfiles) {
    if (!$self->file_in_cvs ($file)) {
      # $self->warn ("Not deleting \"$file\", it is not in CVS.");
      next;
    }
    $delfiles_hash{$file} = 1;
  }

  @delfiles = sort {
    count_slashes($b) <=> count_slashes($a)
  } keys %delfiles_hash;

  # now we have a full list of:
  # - files we were asked to delete
  # - directories we were asked to delete, that are in CVS
  # - and all CVS files in those dirs
  # now process them.

  if (scalar @delfiles > 0) {
    my $cmd = "cvs remove '". join ("' '", @delfiles)."'";
    $text .= $self->run_cvs_command ("delete files", $cmd);
  }

  # er, that's it; we don't need to explicitly delete the directories.
  # once they're empty of files, we're done.

  $text;
}

# ---------------------------------------------------------------------------

sub run_cvs_command {
  my ($self, $opdesc, $cmd) = @_;

  if (!chdir ($self->{cgibase}->{file_base})) {
    $self->warn ("Cannot chdir to {WMROOT}, not performing site $opdesc");
    return '';
  }

  my $text = '';
  $text .= qq{
    <p><em>$cmd</em>:</p> <blockquote>
  };

  if (!open (CVS, "$cmd 2>&1 |")) {
    $self->warn ("$opdesc failed: '$cmd': $!");
    goto failed;
  }

  my $conflicts = 0;

  while (<CVS>) {
    $_ = $self->txt2html($_);

    if ($opdesc eq 'update') {
      if (/^C (.*)$/) { $conflicts++; }
      s/^[UP] (.*)$/<font color=\"#666666\">Updated: $1<\/font>/g;
      s/^A (.*)$/<font color=\"#666666\">Added: $1<\/font>/g;
      s/^R (.*)$/<font color=\"#666666\">Removed: $1<\/font>/g;
      s/^M (.*)$/<font color=\"#00aa00\">Commit required: $1<\/font>/g;
      s/^C (.*)$/<font color=\"#aa0000\">CONFLICT, please edit:  $1<\/font>/g;
      s/^\? (.*)$/<font color=\"#0000aa\">Not in CVS: $1<\/a>/g;
      s/^(cvs update: Updating .*)$/<font color=\"#888888\">$1<\/font>/g;
    }

    if ($opdesc eq 'commit') {
      s/^\? (.*)$/<font color=\"#0000aa\">Not in CVS: $1<\/a>/g;
      s/^(cvs commit: Examining .*)$/<font color=\"#888888\">$1<\/font>/g;
      s/^(new revision: .*)$/<font color=\"#888888\">$1<\/font>/g;
      s/^(done)$/<font color=\"#888888\">$1<\/font>/g;
      s/^(.* \&lt;-- .*)$/<font color=\"#888888\">$1<\/font>/g;
    }

    $text .= $_;
  }

  $self->{conflicts} = $conflicts;

  close CVS;
  my $status = ($? >> 8);
  $text .= "<font color=\"#888888\">(exit status $status)<\/font>";

  if ($status != 0) {
    $self->warn ("$opdesc failed: command '$cmd' exited badly");
    goto failed;
  }

failed:
  $text .= qq{
    </blockquote>
  };
  $text;
}

# ---------------------------------------------------------------------------

sub count_slashes {
  my $dir = shift;
  my @slashes = ($dir =~ m/\//g);
  return scalar @slashes;
}

# ---------------------------------------------------------------------------

sub warn {
  my ($self) = shift; $self->{cgibase}->warn (@_);
}

sub txt2html {
  my ($self) = shift; $self->{cgibase}->txt2html (@_);
}

# ---------------------------------------------------------------------------

1;