Merge branch 'pu/dselect-method' into 'main'

Cleanup dselect method

See merge request apt-team/apt!423

1 files changed, 35 insertions, 36 deletions

diff --git a/dselect/setup b/dselect/setup
index 522362e68..aed7baa26 100755
--- a/dselect/setup
+++ b/dselect/setup
@@ -1,41 +1,39 @@
-#!/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 : Tue May 19 11:25:32 1998
-# Last Machine Used: tiamat.datasync.com
-# Update Count     : 87
-# Status           : Unknown, Use with caution!
-# HISTORY          : 
-# Description      : 
-# This file is designed to go into /usr/lib/apt/methods/setup
-# 
+#!/usr/bin/perl
+# Copyright (c) 1998 Manoj Srivastava <srivasta@tiamat.datasync.com>
+#
+# SPDX-License-Identifier: GPL-2.0+
 
-#use strict;
+use strict;
+use warnings;
 #use diagnostics;
 #printf STDERR "DEBUG: Arguments $ARGV[0];$ARGV[1];$ARGV[2];\n";
 
 
+use Term::ANSIColor;
+
 # Handle the arguments
 my $vardir=$ARGV[0];
 my $method=$ARGV[1];
 my $option=$ARGV[2];
 my $config_file = '/etc/apt/sources.list';
 
-my $boldon=`setterm -bold on`;
-my $boldoff=`setterm -bold off`;
+my $boldon = color('bold');
+my $boldoff = color('reset');
 
-my @known_types           = ('deb');
-my @known_access         = ('http', 'ftp', 'file');
-my @typical_distributions = ('stable', 'unstable', 'testing');
-my @typical_components    = ('main', 'contrib', 'non-free', 'non-free-firmware');
+my @known_types           = qw(deb);
+my @known_access          = qw(https http ftp file);
+my @typical_distributions = qw(stable unstable testing);
+my @typical_components    = qw(main contrib non-free non-free-firmware);
 
 my %known_access           = map {($_,$_)} @known_access;
 my %typical_distributions  = map {($_,$_)} @typical_distributions;
 
+sub print_bold {
+    my $msg = shift;
+
+    print "$boldon$msg$boldoff";
+}
+
 # Read the config file, creating source records
 sub read_config {
   my %params = @_;
@@ -118,7 +116,7 @@ sub get_source {
   }
 
   $type         = 'deb';
-  $urn          = "http://deb.debian.org/debian" unless $urn;
+  $urn          = "https://deb.debian.org/debian" unless $urn;
   $distribution = "stable" unless $distribution;
   $components   = "main contrib non-free non-free-firmware" unless $components;
 
@@ -130,7 +128,7 @@ sub get_source {
   
   while (!$done) {
     print "\n";
-    print "$boldon URL [$urn]: $boldoff";
+    print_bold(" URL [$urn]: ");
     
     $answer=<STDIN>;
     chomp ($answer);
@@ -159,10 +157,10 @@ sub get_source {
   
   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 " tags are typically something like: ";
+  print_bold(join(' ', @typical_distributions) . "\n");
   print "\n";
-  print "$boldon Distribution [$distribution]:$boldoff ";
+  print_bold(" Distribution [$distribution]: ");
   $answer=<STDIN>;
   chomp ($answer);
   $answer =~ s/\s*//og;
@@ -193,10 +191,10 @@ sub get_components {
   
   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 " The components are typically something like: ";
+  print_bold(join(' ', @typical_components) . "\n");
   print "\n";
-  print "$boldon Components [$default]:$boldoff ";
+  print_bold(" Components [$default]: ");
   $answer=<STDIN>;
   chomp ($answer);
   $answer =~ s/\s+/ /og;
@@ -219,12 +217,12 @@ sub get_sources {
     @Oldconfig = &read_config('Filename' => $config_file)
   }
 
-  print "\t$boldon Set up a list of distribution source locations $boldoff \n";
+  print_bold("\t Set up a list of distribution source locations\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 access schemes I know about are: ";
+  print_bold(join (' ', @known_access) . "\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";
@@ -232,6 +230,7 @@ sub get_sources {
   print " For example:\n";
   print "              file:/mnt/debian,\n";
   print "              ftp://ftp.example.org/debian,\n";
+  print "              https://deb.debian.org/debian,\n";
   print "              http://deb.debian.org/debian,\n";
 #  print " and the special mirror scheme,\n";
 #  print "              mirror:http://www.debian.org/archivemirrors \n";
@@ -246,7 +245,7 @@ sub get_sources {
       push (@Config, &get_source());
     }
     print "\n";
-    print "$boldon Would you like to add another source?[y/N]$boldoff ";
+    print_bold(" Would you like to add another source? [y/N] ");
     my $answer = <STDIN>;
     chomp ($answer);
     $answer =~ s/\s+/ /og;
@@ -265,11 +264,11 @@ sub main {
   if (-e $config_file) {
     my @Oldconfig = &read_config('Filename' => $config_file);
     
-    print "$boldon I see you already have a source list.$boldoff\n";
+    print_bold(" I see you already have a source list.\n");
     print "-" x 72, "\n";
     &print_config('Config' => \@Oldconfig);
     print "-" x 72, "\n";
-    print "$boldon Do you wish to overwrite it? [y/N]$boldoff ";
+    print_bold(" Do you wish to overwrite it? [y/N] ");
     my $answer = <STDIN>;
     chomp ($answer);
     $answer =~ s/\s+/ /og;