Re: It's working
Hi,
This is a forst cut at the sort of thing wanted. Please test
this out, and let me know about the calling interface (to test, save
the excerpt into a file called setup, chmod +x it, and fire away. In
the current configuraton, it asks questions, and then spits out the
formatted lines at the end.
dselect normally call these methods with arguments, and
expects also an expect method, but I am not sure where this gets
plugged in.
manoj
--
Trying to shoot yourself in the foot in: Forth: yourself foot
shoot. akarna
Manoj Srivastava <srivasta@acm.org> <http://www.datasync.com/%7Esrivasta/>
Key C7261095 fingerprint = CB D9 F4 12 68 07 E4 05 CC 2D 27 12 1D F5 E8 6E
______________________________________________________________________
#!/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();
__END__
Reply to: