comparc@twwells.uucp (comp.archives) (02/02/89)
Firstly, sorry I've been off the air the last month. While I normally
let a couple of weeks go by before delving into comp.archives, I try
to get to it some time near the middle of the month. Well, the middle
of the month came and so did a ton of work. So, little Usenet and no
comp.archives for me the last two weeks. (Question: Would it have
been appropriate for me to have posted a short note? Or was the delay
short enough that no one got worried?)
I'll be digging through my boxes and posting things shortly, but one
thing I did notice: the many requests for that perl script. There
were so many that it seems reasonable to post it. It is appended to
this message.
Some good news: I've now got my modem & UUCP almost behaving and will
be setting up a login for access to my database. You'll know that it
is working when I post an entry for myself.
Some more good news: I've got some vacation time coming. That means
that, instead of waiting till people send me their entries, I'll have
time to make up some myself from the publicly available information
and to pester (I'll be gentle!) archivists for entries.
---
Bill
{ uunet!proxftl | novavax } !twwells!bill
send comp.archives postings to twwells!comp-archives
send comp.archives related mail to twwells!comp-archives-request
#!/bin/sh
: make a subdirectory, cd to it, and run this through sh.
echo 'If this kit is complete, "End of kit" will echo at the end'
echo Extracting archart
sed >archart <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
Xchdir '/usr/spool/archives' || die "Can't cd to /usr/spool/archives";
X
Xwhile (<>) {
X last if /^Subject:/;
X}
X
Xdie "Invalid Subject:" unless /^Subject: DB:/;
X
Xwhile (<>) {
X last if /^@/;
X}
X
Xwhile ($_) {
X $line = $.;
X if (/^@ADD SITE/) {
X $NM = '';
X $sitedata = '';
X while (<>) {
X last if /^@/;
X $NM = $1 if /^NM ([-a-zA-Z._0-9!]+)/;
X $sitedata .= $_;
X }
X if ($NM) {
X open(NM,">site/$NM") || die "Can't add site $NM at line $line\n";
X print NM $sitedata;
X close NM;
X print stderr "ADD SITE $NM\n";
X }
X else {
X print stderr "Nameless site at line $line\n";
X }
X }
X elsif (/^@DEL SITE ([-a-zA-Z._0-9!]+)/) {
X $NM = $1;
X print stderr "DEL SITE $NM\n";
X if (-f "site/$NM") {
X (unlink "site/$NM") || print stderr "Can't del $NM at line $line";
X }
X else {
X print stderr "(No $NM to delete)\n";
X }
X $_ = <>;
X }
X elsif (/^@ADD INFO/) {
X $NM = '';
X $infodata = '';
X while (<>) {
X last if /^@/;
X $NM = $1 if /^NM ([-a-zA-Z._0-9!]+)/;
X $infodata .= $_;
X }
X if ($NM) {
X open(NM,">info/$NM") || die "Can't add info $NM at line $line\n";
X print NM $infodata;
X close NM;
X print stderr "ADD INFO $NM\n";
X }
X else {
X print stderr "Nameless info at line $line\n";
X }
X }
X elsif (/^@DEL INFO ([-a-zA-Z._0-9!]+)/) {
X $NM = $1;
X print stderr "DEL INFO $NM\n";
X if (-f "info/$NM") {
X (unlink "info/$NM") || print stderr "Can't del $NM at line $line";
X }
X else {
X print stderr "(No $NM to delete)\n";
X }
X $_ = <>;
X }
X elsif (/^@DELALL INDEX ([-a-zA-Z._0-9!]+)/) {
X $NM = $1;
X print stderr "DELALL INDEX $NM\n";
X if (-f "index/$NM") {
X (unlink "index/$NM") || print stderr "Can't delall index $NM at line $line";
X }
X else {
X print stderr "(No $NM to delall)\n";
X }
X $_ = <>;
X }
X elsif (/^@ADD INDEX/) {
X $indexdata = '';
X $oldsite = '';
X while (<>) {
X last if /^@/;
X ($item,$version,$site,$method,$handle) = split(/;/);
X $site =~ s|[^-a-zA-Z._0-9!].*||; # no weird site names
X if ($site ne $oldsite) {
X do update_index($oldsite) if $oldsite;
X $oldsite = $site;
X }
X $Xseen{"$method;$handle"} = 1;
X $indexdata .= $_;
X }
X do update_index($oldsite) if $oldsite;
X }
X elsif (/^@DEL INDEX (\S+)/) {
X $key = $1;
X ($site,$method,$handle) = split(/;/,$key);
X $indexdata = ''; # add nothing
X $Xseen{"$method;$handle"} = 1;
X do update_index($site); # just an update with no additions
X }
X elsif (/^@END/) {
X exit;
X }
X else { # unimplemented
X while (<>) {
X last if /^@/;
X }
X print stderr "(Skipping unimplemented operation at line $line)\n";
X }
X}
X
Xdie "Missing @END: Truncated article?\n";
X
Xsub update_index {
X local($site) = @_;
X local($olddata,$_) = ('');
X if (open(IN,"index/$site")) {
X unlink "index/$site";
X open(NM,">index/$site") || die "Can't modify index/$site";
X while (<IN>) {
X ($item,$version,$site,$method,$handle) = split(/;/);
X $olddata .= $_ unless $Xseen{"$method;$handle"};
X }
X print NM $olddata,$indexdata;
X }
X else {
X open(NM,">index/$site") || die "Can't create index/$site";
X print NM $indexdata;
X }
X reset 'X';
X $indexdata = '';
X close NM;
X print stderr "ADD INDEX $site\n";
X}
!STUFFY!FUNK!
echo ""
echo "End of kit"
: I do not append .signature, but someone might mail this.
exit