#!/usr/bin/perl
#
#  net_sccs
#  Copyright 1998 Kyle R. Burton
#
#  This is free software; you can redistribute it and/or modify
#  it under the tearms of the GNU General Public License as published by 
#  the Free Software Foundation; either version 2, or (at your option)
#  any later version.
# 
#  This file is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#  
#  You should have received a copy of the GNU General Public License
#  along with this software; see the file COPYING.  If not, write to
#  the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
# 

#
# file:    net_sccs.cgi
#
# description: this is the cgi process that provides the interface 
# between the front end, and the implemented source code control system.
#
# author: 
#   Kyle R. Burton  
#   mortis@voicenet.com
#   http://www.voicenet.com/~mortis
#     
# revision list:
#   Sat May  2 14:14:51 EDT 1998  KRB - moved config information out of this
#     file, and into /etc/net_sccs.conf
#   Sun May  3 21:45:13 EDT 1998  KRB - coinciding with the re-write of the 
#     front end utility, some of the variable names have been changed to 
#     match the names in the front end
#
#
use CGI;		# make use of God's gift to CGI programmers...
use rcs_if;             # this is the specific interface we're using
use scs_if;             # the scs interface...

my $query = new CGI;
my $scs = new scs_if('rcs_if');

my $html_author = "mortis\@voicenet.com";
my $bgcolor = "C0C0C0";
my $sccs_repository = $scs->param('net_sccs_repository');
my $html = defined( $query->param('html') );
my $default_action = "show_html_login";
my $action = $query->param('action');
my $user_name = $query->param('user_name');
my $password = $query->param('password');
my $h1,$_h1;

$bgcolor = $scs->param('bgcolor') if $scs->param('bgcolor');

# set up some simple html tags...
if( $html ) {
  $h1 = "<h1>";      $_h1 = "</h1>";
  $pre = "<pre>";    $_pre = "</pre>";
}

# these are all the allowed actions, mapped to the subs that 
# perform them
%actions = (
  "show_html_login" => \&show_html_login,
  "add"         => \&add_file,
  "get"         => \&get_file,
  "checkout"    => \&checkout_file,
  "checkin"     => \&checkin_file
);

print $query->header();

## 
## start some invocation checks...
## 

# are we being accessed via something that doesn't 
# know how to talk to us?
if( !defined( $actions{$action} ) ) {
  $html = 1;
  $action = $default_action;
}

# did the http client not pass us a username/password?
if( ($action != "show_html_login") && (!defined($user_name) || !defined($password)) ) {
  &print_header();
  print "$h1 Error $_h1\n";
  print "You must supply a username and password\n";
  &print_footer();
  exit(0);
}

# handle the request...
&print_header();
&{$actions{$action}}();
&print_footer();
exit(0);
#####################################################################

sub show_html_login
{
  print "<h1>Network Source Code Control System</h1>\n";
  print "<hr></hr>\n";
  print "The interface won't be Browser enabled at first, use the command ",
    "line tools for now.\n";
}

#####################################################################
sub add_file
{
  my $file = $query->param('file_name');
  my $path = $query->param('path');
  my $comment = $query->param('comment');
  my $file_data = $query->param('file');

  # clean off leading '/' from file, and trailing '/' from path...
  $file =~ s/^\///;
  $path =~ s/\/$//;
  $path =~ s/^\///;

  print "$h1 Adding File $_h1\n";
  print "path = $path\n";
  print "file_name = $file\n";
  print "file size = ", length($file_data),"\n";

  if( !( -d "$sccs_repository/$path" ) ) {
    print "creating new project directory: $sccs_repository/$path\n";
    mkdir "$sccs_repository/$path", 0777;
  }

  chdir "$sccs_repository/$path";
  print "changed dir to: ",`pwd`,"\n";
  mkdir "RCS", 0755;
  open( FILE, ">$file" );
  print FILE $file_data;
  close( FILE );

  # now add it to the scs...
  print "adding file: $file  \"$comment\"\n";
  if( defined( $error = $scs->add( $file, $comment ) ) ) {
    # error
    print "Error adding file:  $error\n";
  }

  if( -e $file ) {
    print "error adding file: $file\n";
    unlink $file;
  }
  else {
    print "file checked in\n";
  }
}


#####################################################################
sub get_file
{
  my $file = $query->param('file_name');
  my $path = $query->param('path');
  my $version = $query->param('version');

  # clean off leading '/' from file, and trailing '/' from path...
  $file =~ s/^\///;
  $path =~ s/\/$//;
  $path =~ s/^\///;

  # chdir into the repository...
  print "attempting to retreive: $path/$file\n";
  chdir "$sccs_repository/$path";
  print "pwd is ",`pwd`,"\n";
  if( defined( $error = $scs->get_by_version( $file, $version ) ) ) {
    print "error returned from rc_scs::get_by_version:  $error\n";
  }

  if( open( FILE, "<$file" )  ) {
    print "<!--begin file-->\n";
    while(<FILE>) {
      print;
    }
    close(FILE);
    print "<!--end file-->\n";
  }
  else {
    print "Error opening file for return to client: $path/$file\n";
  }

  unlink "$file";
  if( -e $file ) {
    print "Error removing temporary file: $file from directory: $path\n";
  }
}

#####################################################################
sub checkout_file
{
  print "$pre\n";

  my $user = $query->param('user_name');
  my $file = $query->param('file_name');
  my $path = $query->param('path');
  my $version = $query->param('version');

  print "checkout:\n";
  print "  file: $file\n";
  print "  path: $path\n";
  print "  version: $version\n";
  print "  user: $user\n";

  $path =~ s/^\///;
  $path =~ s/\/$//;
  chdir "$sccs_repository/$path";
  print "pwd is: ", `pwd`, "\n";

  $scs->checkout( $file, $version );

  print "<!--begin file-->\n";
  open( FILE, "<$file" );
  while( <FILE> ) {
    print;
  }
  close( FILE );
  print "<!--end file-->\n";
  # unlink $file;

  print "$_pre\n";
}

#####################################################################
sub checkin_file
{
  print "$pre\n";
  print "checkin -- not yet implemented...\n";
  print "$_pre\n";
}

#####################################################################
sub checkout_file
{
  print "$pre\n";
  print "checkout -- not yet implemented...\n";
  print "$_pre\n";
}

#####################################################################
sub print_header
{
  if( $html ) {
    # print $query->header();
    print $query->start_html(
      -title => "Net SCCS",
      -author => $html_author,
      -bgcolor => $bgcolor
    );
    print "\n";
  }
}

#####################################################################
sub print_footer
{
  if( $html ) {
    print $query->end_html();
  }
}

__END__