#$rcs_binary_dir  = "/mit/gnu/gbin";
$rcs_binary_dir = "/usr/athena/bin";
$root_people_dir = "/afs/sipb.mit.edu/project/www/root/people";
$db_checked_out = 0;

if (! open(FTEST, ("</mit/gnu/bin"))) {
    print "Error in checking for gnu locker was was $?\n";
    $rcs_binary_dir = "/afs/athena.mit.edu/contrib/watchmaker/bin";
    print "No gnu binaries available for RCS. Attempting to use\n";
    print "watchmaker RCS binaries.\n";
}
close(FTEST);

$mail_cmd = &pick_a_binary('/usr/sbin/sendmail',
			   '/usr/lib/sendmail');

$hesinfo_cmd = &pick_a_binary('/bin/athena/hesinfo',
			      '/usr/athena/bin/hesinfo',
			      'hesinfo');

$rlog_cmd = pick_a_binary('/usr/bin/rlog',
			  '/usr/athena/bin/rlog',
			  'rlog');
$ci_cmd = pick_a_binary('/usr/bin/ci',
			  '/usr/athena/bin/ci',
			  'ci');
$co_cmd = pick_a_binary('/usr/bin/co',
			  '/usr/athena/bin/co',
			  'co');

sub pick_an_index {
    local($fullname, $verify_p) = @_;
    local($first, $last, $guess, $ok);

    $guess = $fullname;
    $guess =~ tr/A-Z/a-z/;
    
    $guess =~ s/\&aelig\;/ae/g;

    # This translates things of the form "&agrave;" to "a". Looking at
    # a list of ISO Latin 1 character entities
    # (http://www.w3.org/hypertext/WWW/MarkUp/ISOlat1.html), it turns out
    # that this is a very reasonable translation methodology, and will be
    # fairly "correct" most of the time.
    $guess =~ s/\&(.).+\;/$1/g;

    $guess =~ /^(.*\S)\s+(\S+)$/;
    $first = $1;
    $last = $2;

    $last =~ s/[^a-zA-Z]//g;
    $last = &studcap($last);
    
    $first =~ s/[^ a-zA-Z]//g;
    $first = join("", grep($_ = &studcap($_), split(" ", $first)));

    $guess = $last . $first;

    if ( $verify_p ne "") {
	return ($guess);
    }

    print "This person's name is \"$fullname\".\n\n";
    print "Is their sort index \"$guess\" ?\n>>";
    if ( &accept()) {
	return $guess;
    } else {
	$ok = 0;
	while (!$ok) {
	    print "What is their sort index?\n>>";
	    $input = (<STDIN>);
	    chop($input);
	    if ($input) {$ok = 1}
	}
	return $input;
    }
}

sub SIGINTHNDLR {
   die "\ndatabase is checked out, check it in by hand.\n";
}

sub rcs_check_out_file {
    local($filename) = @_;

    # This may cause serious problems if we get a webmaster named "strict".
    # Roleplay accordingly.

    $rlog_output = `$rlog_cmd -h $filename`;
    $rlog_output =~ s/locks: strict//;

    if ($rlog_output =~ /locks:/) {
	if ($rlog_output !~ /locks: \S*\s*$ENV{'USER'}/) {
	    print "WWW: Error: $filename is RCS-locked\n";
	    print "WWW:        by another user. Aborting.\n";
	    exit(-1);
	}
    } else {
	`$co_cmd -l -q $filename`;
	print "WWW :  Checking out $filename via RCS....\n";
    }

    $SIG{INT} = \&SIGINTHNDLR;
    $db_checked_out = 1;
}

sub rcs_check_in_file {
    local($filename, $reason) = @_;

    open(CI, "|$ci_cmd -q -u $filename");
    print CI ($reason . "\n.\n");
    close CI;

    print "WWW :  Checking in $filename via RCS....\n";

    $SIG{INT} = 'DEFAULT';
    $db_checked_out = 0;
}

sub studcap {
    local($word) = @_;

    # this returns a word Studcapped -- first letter upcase, rest is downcase.

    $word =~ tr/A-Z/a-z/;
    substr($word, 0, 1) =~ tr/a-z/A-Z/;

    return $word;
}

sub pick_symlink_for_file {
    local($path, $verify_p) = @_;
    local($username, $rest, $old, $new, $standard, $ok, $page);
    $old = "";
    $new = "";


    $ok = 1;
    $standard = 1;
    do {
        unless($ok) {
            print "Enter path\n>>";
            $path = <STDIN>;
            chomp $path;
            $ok = 1;
        }
	if ($path =~ /http:\/\/(www|stuff)\.mit\.edu\/~(\w+)\/?(.*)/) {
	  print STDERR "Guessing path...\n";
	  $path = primary_filsys($2) . '/www/' . $2;
	}
        if ($path !~ /^\/afs\/(sipb|athena)\.mit\.edu\/user\//) {
            $standard = 0;
    	    print "The path ($path) is nonstandard, you'll have to enter the information by hand.\nContinue? ";
            $ok = &accept();
        }
    } until($ok);

    if($standard) {
        $path =~ /^(\/afs\/(sipb|athena)\.mit\.edu\/user\/.*\/)(.*)$/;

        $userdir = $1;
        $userfile = $3;

        if ($path =~ /^\/afs\/athena\.mit\.edu\/user\/\S\/\S\/([^\/]*)\//) {
	    $username = $1;
        } elsif ($path =~ /^\/afs\/athena\.mit\.edu\/user\/other\/([^\/]*)\//) {
    	    $username = $1;
        } elsif ($path =~ /^\/afs\/sipb\.mit\.edu\/user\/([^\/]*)\//) {
	    $username = $1;
        }
    } else {
        print "Enter the username\n>> ";
        $username = <STDIN>;
        chomp $username;
        print "Enter the full path and filename of the homepage\n>> ";
        $page = <STDIN>;
        chomp $page;
        if($page =~ m#(.+/)([^/]*)#) {
            ($userdir, $userfile) = ($1, $2);
        } else {
            die("parse failed. this is a bug or you made a typo");
        }
    }

    if (-d $userdir) {

	if ($verify_p eq "") {
	    print "Should I add a symlink from people/$username to\n";
	    print "\"$userdir\" ?\n >>";
	}

	# allow for premature exiting from this subroutine
	if(($verify_p ne "") || &accept()) {
	    $relative_url_for_homepage =
		("/people/" . $username . "/" . $userfile);
	    # second returned value is symlink_old
	    # third  returned value is symlink_new
	    return ($relative_url_for_homepage, $userdir,
		    $web_people_dir . $username);
	} else {
	    return;
	}
    } else {
	print "$userdir is not a directory. I don't know what to do.\n";
        print "database is checked out, check it in by hand\n" if $db_checked_out;
	exit;
    }
}

sub add_to_database {
    local($url, $username, $name, $sort_index, $old, $new) = @_;
    local($db_file, $we_should_run_webfile);

    unshift (@INC, '/afs/sipb.mit.edu/project/www/src/db');
    require 'dbparse.pl';

    $db_file = $DB'default_home;

#    print "Do you want to run webfile on the updated files?\n >";
#    if (&accept) {
# 	$we_should_run_webfile = "yes";
#    }

    &rcs_check_out_file($db_file);

    if (&DB'ParseHome($db_file) == 0) {
        print "Cannot open $db_file. Aborting.\n";
        exit(0);
    }

    &DB'AddUser($username, $url, $name, $sort_index, $old, &cooldate());

    if (&DB'SpewHome($db_file) == 0) {
        print "Cannot write $db_file. Aborting.\n";
        print "The database file may be in an inconsistent state. Beware.\n";
        exit(0); 
    }

    &rcs_check_in_file($db_file, "adding homepage for $username w/ magic");

    # This is here so it can be tested at some point in the future.
    $addition_succeeded = 1;
    if ($addition_succeeded) {
        # If the symlink is to and from something existing, make it.
        if (($old ne "") && ($new ne "")) {
	    unlink($new);
            symlink($old, $new);
	    print "WWW :  Symlink to $old made.\n";
        }

	&send_user_mail($username, $name, $url);
	if ($we_should_run_webfile eq "yes") {
	    if ($new =~ /\S/) {
		&copy_to_web_server($homepage_file, $alpha_dir, $new);
	    } else {
		&copy_to_web_server($homepage_file, $alpha_dir);
	    }
	}
    } else {
	print "------------------------------------------\n";
	print "Command failed. Reason unknown.\n";
	print "Homepage was not added; mail was not sent.\n";
    }
}

sub nuke_link {
    local($linkname, $need_confirm) = @_;

    if(-l "$root_people_dir/$linkname") {
        print "symlink $linkname exists.  delete it?\n>>" if $need_confirm;
        if(!$need_confirm || &accept()) {
            if(!unlink("$root_people_dir/$linkname")) {
                warn "unlink $root_people_dir/$linkname failed: $!\n";
                return 0;
            }
        }
    } elsif(-e "$root_people_dir/$linkname") {
        warn "$linkname should be a symlink, but isn't.  i'm not touching it.\n";
        return 0;
    }
    return 1;
}

sub create_link {
    local($linkname, $symlink, $need_confirm) = @_;
    local($nevermind, $go_for_it) = (0, 0);

    if(-l "$root_people_dir/$linkname") {
        $collision = readlink("$root_people_dir/$linkname");
        if($collision eq $symlink) {
            $nevermind = 1;
        } else {
            print "symlink $linkname already exists and points to $collision\nreplace it?\n>>" if $need_confirm;
            if(!$need_confirm || &accept()) {
                if(!unlink("$root_people_dir/$linkname")) {
                    warn "unlink $root_people_dir/$linkname failed: $!\n";
                    return 0;
                }
                $go_for_it = 1;
            }
        }
    }
    if(! -e "$root_people_dir/$linkname") {
        if(!$go_for_it && $need_confirm) {
            print "symlink $linkname does not exist.  create it pointing to $symlink?\n>>";
        }
        if($go_for_it || !$need_confirm || &accept()) {
            if(!symlink($symlink, "$root_people_dir/$linkname")) {
                warn "error symlinking $linkname: $!\n";
                return 0;
            }
        }
    } elsif(!$nevermind) {
        warn "$linkname doesn't seem to be a symlink.  i'm not going to touch it.\n";
        return 0;
    }
    return 1;
}

sub make_user_email {
  my ($username) = @_;
  if ($username =~ /\@/) {
    return $username;
  } else {
    return ($username . '@mit.edu');
  }
}
sub send_user_mail {
    local($username, $name, $url) = @_;

    my $user_email = make_user_email($username);
    $whole_mail_cmd = "|" . $mail_cmd . " -t";    
    open(MAIL, $whole_mail_cmd);
    print MAIL "To: $user_email\n";
    print MAIL "Bcc: webm-mtg\@charon.mit.edu\n";
    print MAIL "From: $ENV{'USER'}\n";
    print MAIL "Reply-To: stuffmaster\@mit.edu\n";
    print MAIL "Subject: Your homepage\n\n";
    print MAIL "Your homepage has been added to the list of homepages on the\n";
    print MAIL "MIT SIPB WWW server.\n\n";
    print MAIL "Your name is listed as:  $name\n";
    #Differentiate b/w local and external pages
    if ($url=~/^http/) 
    {
      print MAIL "Your URL is:  $url\n\n";
    }
    else
    {
      print MAIL "Your URL is:  http://www.mit.edu$url\n\n";
      print MAIL "Note that this *new* URL is linked to your home page directory.\n";
      print MAIL "It will not affect your pages on other servers (e.g., web.mit.edu).\n\n";
    }
    print MAIL "If either of these appears incorrect, please let us know.  Consult\n";
    print MAIL "http://stuff.mit.edu/doc/how-to-hp.html for additional assistance.\n\n";
    print MAIL "Please note: this change may not be visible until the day after\n";
    print MAIL "this mail was sent.\n\n";

    print MAIL "Also note that we do not maintain the finger listings or lists on\n";
    print MAIL "web.mit.edu.  finger help_url\@mit.edu if you need to change your\n";
    print MAIL "URL in the finger information.  Thanks!\n\n";
    print MAIL "  -- The MIT SIPB Webmasters\n";

    close MAIL;

    print "Mail was sent to $username\n";
    print "confirming that their homepage was added.\n";
}

sub pick_a_binary {
    local(@to_try) = @_;
    local($best);

    while ($#to_try > -1) {
	$best = splice(@to_try, 0, 1);
	if ( -x $best ) {
	    @to_try = ();
	}
    }
    if (! (-x $best)) {
	print "Cannot find a version of $best. Aborting.";
        print "database is checked out, check it in by hand.\n" if $db_checked_out;
	exit(-1);
    }
    return $best;
}

sub primary_filsys {
    local($name) = @_;
    local($answer);

    if ($name =~ /[\;\&]/) {
	print "Yo. \"$name\" is a really bogus name. Aborting.\n";
    }

    open(HES, ($hesinfo_cmd . " " . $name . " filsys|"));
    $answer = <HES>;
    close HES;
    if ($answer !~ s/^AFS //) {
	print "We checked the filsys entry for $name. It's not in AFS.\n";
	print "Sorry, your time is up.\n";
        print "Let's show him what he could won, Bob.\n";
	exit(-1);
    }
    $answer =~ /^(\S+)\s/;
    return $1;
}

sub accept {
    local($input);

    $input = (<STDIN>);
    chop($input);
    if ($input =~ /^[yY][eE]?[sS]?$/) {return 1;}
    return 0;
}

sub cooldate {
    local(@t, $year, $month, $day);
    @t = localtime();
    $year  =  $t[5];
    $month = ($t[4] + 1);
    $day   =  $t[3];
    return &padzero($year) . &padzero($month) . &padzero($day);
}

sub padzero {
    local($n) = @_;
    ($n<10)?("0" . $n):$n;
}

1;