Re: Recompilation to remove dependency on libc6 2.0.7u (Was: Status of Slink (fwd)

[Paul Crowley <paul@hedonism.demon.co.uk>]

Brandon Mitchell <bhmit1@mail.wm.edu> writes:
> Deal, I'll spare your email box.  We need a script that does this (maybe
> even some kind of debian-devel package).

If the script below my .sig works properly, then Joey's email will be
receiving a copy just now, masked as a complaint about cthugha.  I
hope you don't mind my directly including it here, since it isn't that 
long, and it takes forever for my Web space to reflect changes.  I
guess I might as well make it the usual Perl Artistic/GPL at your
option, though if it needs different terms let me know.  Joey, please
tell us if you got that OK since there's nothing like a live test...

It could do with the friendly eye of a competent Perl hacker before
seeing real use, but it seems to work as far as I can tell.

hope this helps,
-- 
  __
\/ o\ paul@hedonism.demon.co.uk         Edinburgh fetish club Permission \ /
/\__/ Paul Crowley     Dec 13 http://www.hedonism.demon.co.uk/permission /~\

#!/usr/bin/perl
# -*- mode: perl -*-

$rcsid = q$Id: mail-people,v 1.2 1998/12/10 20:58:28 paul Exp $;
$rcsrevision = q$Revision: 1.2 $;

use strict;
no strict 'vars';

use Getopt::Long;
use Mail::Send;
use Dpkg::Package::List;

$opt_verbose = 1;
$opt_help = 0;
$opt_version = 0;
$opt_send = 0;
$opt_package_file = '/var/lib/dpkg/available';
$opt_subject = 'Alert concerning Debian packages you maintain';

GetOptions qw(version help verbose!),
  qw(send! package-file=s package-list=s subject=s message=s),
  or die "Couldn't parse command line (try --help), stopped";

if ($opt_help) {
  print 
"Usage: $0 --package-list=filename --message=filename [OPTION]...
  or:  $0 --help
  or:  $0 --version

  --package-list=filename
  --package-file=filename
  --message=filename
  --subject=string
  --[no]send
  --[no]verbose
  --help
  --version
";
  exit;
}

if ($opt_version) {
  print "RCS version information: $rcsid\n";
  exit;
}

if (scalar(@ARGV) > 0) {
  die "Unparsed options on command line (try --help): \"" . join(' ', @ARGV) ."\", stopped";
}

die "--package-list option is mandatory, stopped" 
  unless (defined $opt_package_list);

die "--message option is mandatory, stopped" 
  unless (defined $opt_message);

print "Starting work...\n";

print "Reading message file...\n" if $opt_verbose;

open MESSAGE, $opt_message
  or die "Couldn't open message $message: $!, stopped";

@message = <MESSAGE>;

close MESSAGE or die "Failed to close file: $!, stopped";  

print "Reading package list...\n" if $opt_verbose;

%affected_packages = ();

open PACKAGE_LIST, $opt_package_list 
  or die "Couldn't open package list $package_list: $!, stopped";

while (<PACKAGE_LIST>) {
  chomp;
  $affected_packages{$_} = 1;
}

close PACKAGE_LIST or die "Failed to close file: $!, stopped";

print "Reading packages file...\n" if $opt_verbose;

$packages = new Dpkg::Package::List filename => $opt_package_file;

print "Finding maintainers...\n" if $opt_verbose;

%maintainer_map = ();

foreach $package (@{$packages->packages}) {
  my $pname = $package->{'package'};
  if (exists $affected_packages{$pname}) {
    push @{$maintainer_map{$package->{'maintainer'}}}, $pname;
    delete $affected_packages{$pname};
  }
}

if (@unhandled = keys %affected_packages) {
  print "Package for which no maintainer was found: ", 
  join(" ", @unhandled), "\n";
  die "Packages without maintainers found, stopped";
}

# Send the mails

print "Sending mails...\n" if $opt_verbose;

while (($maintainer, $package_list) = each %maintainer_map) {
  print "Mailing: $maintainer\n";
  print "Concerning: ", join(" ", @$package_list), "\n";
  if ($opt_send) {
    my $msg = new Mail::Send Subject => $opt_subject, To => $maintainer;
    # This doesn't seem to work and I don't know why not
    # $msg->set('X-Mailer', 
    #          "Debian automated maintainer mailer version $rcsrevision");
    my $fh = $msg->open;
    print $fh "A package or packages that you maintain is affected by the\n";
    print $fh "attached notice.  The affected packages are:\n";
    print $fh "\n";
    foreach $package (@$package_list) {
      print $fh "    $package\n";
    }
    print $fh "\n";
    print $fh "The notice is as follows:\n";
    print $fh "\n";
    print $fh @message;
    $fh->close;
  } else {
    print "Send suppressed, use --send flag to enable.\n";
  }
}

print "Done.\n" if $opt_verbose;


--  
To UNSUBSCRIBE, email to debian-testing-request@lists.debian.org
with a subject of "unsubscribe". Trouble? Contact listmaster@lists.debian.org