A few people asked me for the Stefan Hornburg's script. I lost the names.
Duh --> me. So, I'm just forwarding it to the list. Hope no one minds.
Cut and Copy it somewhere ( I use /usr/local/bin) and add this line to
your .procmailrc:
: 0
* ^To:.freshmeat-news
| splitfmnews | formail -ds cat >> $HOME/mail/freshmeat
( remember to make it executable. )
---------- Forwarded message ----------
Date: 13 Jan 1999 19:50:17 +0100
From: Stefan Hornburg <[EMAIL PROTECTED]>
To: [EMAIL PROTECTED]
Subject: Re: splitfmnews
Hello !
Yes, I noticed the format change too, but I hadn't the time to adapt the
script (I'm programming a Webshop as hired programmer and designing a
Website for my one simultaneously). Furthermore, there was no feedback
on my script, so I assumed that no one used it. Anyway, below is the
new version.
#! /usr/bin/perl -w
#
# splitfmnews -- Perl script that slices Freshmeat newsletters
#
# Copyright (C) 1998, 1999 Stefan Hornburg
#
# Author: Stefan Hornburg <[EMAIL PROTECTED]>
# Maintainer: Stefan Hornburg <[EMAIL PROTECTED]>
# Version: 0.2.0
#
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 2, or (at your option) any
# later version.
#
# This file is distributed in the hope that it will be
# useful, but WITHOUT ANY WARRANTY; without even the implied warranty
# of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this file; see the file COPYING. If not, write to the Free
# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
#
# CHANGES
# Wed Jan 13 18:43:50 1999 Stefan Hornburg <[EMAIL PROTECTED]>
# * splitfmnews v0.2.0 released
# * adapted to new freshmeat format
# Thu Jul 2 15:36:28 1998 Stefan Hornburg <[EMAIL PROTECTED]>
# * splitfmnews v0.1.2 released
# * treat the equal sign as line continuation character
# Thu Jul 2 14:39:25 1998 Stefan Hornburg <[EMAIL PROTECTED]>
# * splitfmnews v0.1.1 released
# * pass original message only if necessary
# Thu Jul 2 12:56:01 1998 Stefan Hornburg <[EMAIL PROTECTED]>
# * splitfmnews v0.1 released
use strict;
require 5.002; # prototypes
# CONSTANTS
# Summary header and footer
my $sumheader = '[ article list ]';
my $sumfooter = '[ article details ]';
my $articlefooter = "that's it for today.";
# Separator between entries in the newsletter
my $sep = '--- - --- ------ - --- -- - - - -- -';
# STATE VARIABLES
# Line with subject found ?
my $subjectline;
# Number of first line within entry
my $firstline;
# Header of the mail
my ($header_before, $header_subject, $header_after);
# Text of current entry
my $entrytext;
# Hash with entries
my %entries;
# Body of the mail
my $contents;
# Errors
my @errors;
# Main program
# ============
# Record mail header
while (fetchline()) {
if (/^subject:\s+(.*?)\s*$/i) {
if (defined $header_subject) {
fault ("input line $.",
"duplicate subject found in the mailheader");
} else {
$header_subject = $1;
}
} else {
if (defined $header_subject) {
$header_after .= $_;
} else {
$header_before .= $_;
}
}
last if ! /\S/;
}
unless (defined $header_subject) {
fault ("no subject found in the mailheader");
}
# Skip to summary
while (fetchline()) {
$contents .= $_;
last if issepline ($sumheader);
}
# Fetch entry subjects from summary
while (fetchline()) {
$contents .= $_;
last if issepline ($sumfooter);
# skip blank lines
next if ! /\S/;
# check format
if (/^\s*o\s*(.*?)\s*$/) {
$entries{$1} = undef;
} else {
chomp;
fault ("input line $.",
"unexpected format (summary line assumed, found: $_)");
}
}
# Read entries
$firstline = $. + 1;
while (fetchline()) {
$contents .= $_;
# Check for new entries
if (issepline ($sep)) {
if (defined $subjectline) {
# Entry mentioned in summary ?
if (exists $entries{$subjectline}) {
$entrytext =~ s/^\s*//; $entrytext =~ s/\s*$//;
$entries{$subjectline} = $entrytext;
} else {
fault ($subjectline, "entry not mentioned in the
summary");
}
undef $subjectline;
} else {
fault ("input lines $firstline - $.", "invalid entry");
}
# Reset entry-local variables
$firstline = $. + 1;
undef $entrytext;
next;
}
# Check for subject lines
if (/^\s*subject:\s*(.*?)\s*$/) {
$subjectline = $1;
} else {
$entrytext .= $_;
}
# Check for end of mail
last if issepline ($articlefooter);
}
# Check for unresolved entries ...
if (defined $subjectline) {
fault ($subjectline, "incomplete entry detected");
}
# .. and create mails
my ($key, $value);
while (($key, $value) = each %entries) {
if (defined $value) {
print $header_before, "Subject: $key\n", $header_after, $value, "\n\n";
} else {
fault ($key, "entry appears only in the summary");
}
}
# create error message and pass through original message in case of errors
if ($#errors >= 0) {
print $header_before, "Subject: Error log for $header_subject\n",
$header_after, join ("\n", @errors), "\n\n";
print $header_before, "Subject: Erroneous $header_subject\n",
$header_after, $contents;
}
exit ($#errors != -1);
# ----------------------------------------------------
# FUNCTION: fetchline
#
# Gets one line from standard input. Concatenate lines
# terminating with a equal sign with the next line.
# ----------------------------------------------------
sub fetchline () {
my $line = ''; my $terminator;
while (<>) {
chomp;
if (($terminator = chop) eq '=') {
$line .= $_;
} else {
$line .= "$_$terminator\n";
last;
}
}
$_ = $line;
}
# ----------------------------------------------------------
# FUNCTION: issepline SEP
#
# Checks if the current line is a separator between entries.
# Trims first input line and compares than with SEP.
# ----------------------------------------------------------
sub issepline ($) {
my $sep = shift;
my $line = $_;
$line =~ s/^\s*//; $line =~ s/\s*$//;
$line eq $sep;
}
# ------------------------------------------------------
# FUNCTION: fault ARG ...
#
# Issues error message composed of the arguments and the
# script name, concatenated by the string `: '.
# ------------------------------------------------------
sub fault ($@) {
my $msg = join (': ', @_);
push (@errors, $msg);
print STDERR $0, ': ', $msg, "\n";
}
# Local Variables:
# mode: perl
# End:
--
Racke's Package and Resource Database (http://www.han.de/~racke/pard/)
486 packages, 60 resources, 10 distributions covered
-
To get out of this list, please send email to [EMAIL PROTECTED] with
this text in its body: unsubscribe suse-linux-e
Check out the SuSE-FAQ at http://www.suse.com/Support/Doku/FAQ/ and the
archiv at http://www.suse.com/Mailinglists/suse-linux-e/index.html
