#!/usr/bin/perl -w
#                              -*- Mode: Perl -*- 
# setup.pl --- 
# Author           : Manoj Srivastava ( srivasta@tiamat.datasync.com ) 
# Created On       : Wed Mar  4 15:11:47 1998
# Created On Node  : tiamat.datasync.com
# Last Modified By : Manoj Srivastava
# Last Modified On : Wed Mar  4 18:31:32 1998
# Last Machine Used: tiamat.datasync.com
# Update Count     : 61
# Status           : Unknown, Use with caution!
# HISTORY          : 
# Description      : 
# This file is designed to go into /usr/lib/deity/methods/setup
# 

use strict;
use diagnostics;

# Handle the arguments
my $vardir=$ARGV[0];
my $method=$ARGV[1];
my $option=$ARGV[2];

my $boldon=`setterm -bold on`;
my $boldoff=`setterm -bold off`;

my $arch=`dpkg --print-installation-architecture`;
chop $arch;
if ($arch eq "") {
    echo("Warning: cannot find installation architecture, defaulting to i386.");
    $arch="i386";
}

my @known_types           = ('deb');
my @known_access          = ('http', 'ftp', 'file', 'mirror');
my @typical_distributions = ('stable', 'unstable', 'frozen');
my @typical_components    = ('main', 'contrib', 'non-free');

my %known_access           = map {($_,$_)} @known_access;
my %typical_distributions  = map {($_,$_)} @typical_distributions;

# Read the config file, creating source records
sub read_config {
  my %params = @_;
  my @Config = ();
  
  die "Required parameter Filename Missing" unless
    $params{'Filename'};
  
  open (CONFIG, "$params{'Filename'}") ||
    die "Could not open $params{'Filename'}: $!";
  while (<CONFIG>) {
    chomp;
    my $rec = {};
    my ($type, $urn, $distribution, $components) = 
      m/^\s*(\S+)\s+(\S+)\s+(\S+)\s+(\S.*)$/o;
    $rec->{'Type'}          = $type;
    $rec->{'URN'}           = $urn;
    $rec->{'Distribution'}  = $distribution;
    $rec->{'Components'}    = $components;
    push @Config, $rec;
  }
  close(CONFIG);
  
  return @Config;
}

# write the config file; writing out the current set of source records
sub write_config {
  my %params = @_;
  my $rec;
  my %Seen = ();
  
  die "Required parameter Filename Missing" unless
    $params{'Filename'};
  die "Required parameter Config Missing" unless
    $params{'Config'};
  
  open (CONFIG, ">$params{'Filename'}") ||
    die "Could not open $params{'Filename'} for writing: $!";
  for $rec (@{$params{'Config'}}) {
        my $line = "$rec->{'Type'} $rec->{'URN'} $rec->{'Distribution'} ";
    $line .= "$rec->{'Components'}" if $rec->{'Components'};
    $line .= "\n";
    printCONFIG $line unless $Seen{$line}++;
  }
  close(CONFIG);
}

# write the config file; writing out the current set of source records
sub print_config {
  my %params = @_;
  my $rec;
  my %Seen = ();
  
  die "Required parameter Config Missing" unless
    $params{'Config'};
  
  for $rec (@{$params{'Config'}}) {
    my $line = "$rec->{'Type'} $rec->{'URN'} $rec->{'Distribution'} ";
    $line .= "$rec->{'Components'}" if $rec->{'Components'};
    $line .= "\n";
    print $line unless $Seen{$line}++;
  }
}

# Ask for and add a source record
sub get_source {
  my $rec = {};
  my $answer;
  
  $rec->{'Type'} = 'deb';
  $| = 1;

  my $done = 0;
  
  while (!$done) {
    print "\n";
    print "$boldon URL [http://llug.sep.bnl.gov/debian]: $boldoff";
    
    $answer=<STDIN>;
    chomp ($answer);
    $answer =~ s/\s*//og;
    
    if ($answer =~ /^\s*$/o) {
      $rec->{'URN'} = "http://llug.sep.bnl.gov/debian";
      last;
    }
    else {
      my ($scheme) = $answer =~ /^\s*([^:]+):/o;
      if (! defined $known_access{$scheme}) {
	print "Unknown access scheme $scheme in $answer\n";
	print "    The available access methods known to me are\n";
	print join (' ', @known_access), "\n";
	print "\n";
      }
      else {
	$rec->{'URN'} = $answer;
	last;
      }
    }
  }

  print "\n";
  
  print " Please give the distribution tag to get or a path to the\n";
  print " package file ending in a /. The distribution\n";
  print " tags are typically something like:$boldon ";
  print join(' ', @typical_distributions), "$boldoff\n";
  print "\n";
  print "$boldon Distribution [stable]:$boldoff ";
  $answer=<STDIN>;
  chomp ($answer);
  $answer =~ s/\s*//og;
  
  if ($answer =~ /^\s*$/o) {
    $rec->{'Distribution'} = "stable";
    $rec->{'Components'}   = &get_components();
  }
  elsif ($answer =~ m|/$|o) {
    $rec->{'Distribution'} = "$answer";
    $rec->{'Components'}   = "";
    last;
  }
    else {
      # A distribution tag, eh?
      warn "$answer does not seem to be a typical distribution tag\n"
	unless defined $typical_distributions{$answer};
      
      $rec->{'Distribution'} = "$answer";
      $rec->{'Components'}   = &get_components();
    }

  return $rec;
}

sub get_components {
  my $answer;
  
  print "\n";
  print " Please give the components to get\n";
  print " The components are typically something like:$boldon ";
  print join(' ', @typical_components), "$boldoff\n";
  print "\n";
  print "$boldon Components [main contrib non-free]:$boldoff ";
  $answer=<STDIN>;
  chomp ($answer);
  $answer =~ s/\s+/ /og;
  
  if ($answer =~ /^\s*$/o) {
    return "main contrib non-free";
  }
  else {
    return $answer;
  }
}

sub get_sources {
  my @Config = ();
  my $done = 0;
  
  print "\t$boldon Set up a list of distribution source locations $boldoff \n";
  print "\n";

  print " Please give the base URL of the debian distribution.\n";
  print " The access schemes I know about are:$boldon ";
  print join (' ', @known_access), "$boldoff\n";
  print " The mirror scheme is special  that it does not specify the\n";
  print " location of a debian archive but specifies the location\n";
  print " of a list of mirrors to use to access the archive.\n";
  print "\n";
  print " For example:\n";
  print "              file:/mnt/debian,\n";
  print "              ftp://ftp.debian.org/debian,\n";
  print "              http://ftp.de.debian.org/debian,\n";
  print " and the special mirror scheme,\n";
  print "              mirror:http://www.debian.org/archivemirrors \n";
  print "\n";

  while (!$done) {
    push (@Config, &get_source());
    print "\n";
    print "$boldon Would you like to add another source?[y/N]$boldoff ";
    my $answer = <STDIN>;
    chomp ($answer);
    $answer =~ s/\s+/ /og;
    if ($answer =~ /^\s*$/o) {
      last;
    }
    elsif ($answer !~ m/\s*y/io) {
      last;
    } 
  }
  
  return @Config;
}

sub main {
  my @Config = &get_sources();
  &print_config('Config' => \@Config);
}

&main();


