#!/usr/bin/perl -T # Copyright (C) 2003 by Paul Roub. Use as you wish, go nuts. # # $Log: mtmstitch.txt,v $ # Revision 1.2 2004/10/12 20:56:49 roub # copied over # # Revision 1.5 2004/03/17 19:13:54 roub # version --> revision # # Revision 1.4 2004/03/17 19:11:45 roub # added version and source link # # Revision 1.3 2003/06/18 18:51:56 roub # html/css tweaks on index page # # Revision 1.2 2003/06/18 16:23:08 roub # slight cleanup # use strict; use CGI; use LWP::UserAgent; use CGI::Carp qw(fatalsToBrowser); my $server = 'http://www.meet-the-makers.com'; my $docRoot = ''; my $firstPage = ''; my $script = 'http://roub.net/mtmstitch.cgi'; my $verstr = '$Revision: 1.2 $'; my $styleBlock = <<_ENDBLOCK; _ENDBLOCK my $q = new CGI; print $q->header(-type => 'text/html', -charset => 'iso-8859-1'); if ($q->param('conversation')) { $docRoot = "$server/conversations/" . escape($q->param('conversation')) . "/"; $firstPage = $docRoot . "1/"; } else { printList(); exit(); } my $ua = new LWP::UserAgent; $ua->agent("MtMstich/0.1 " . $ua->agent); my $first = 1; my @docs = ( $firstPage ); my %seen = (); my $prologue = ''; my $epilogue = ''; while (@docs > 0) { my $page = shift @docs; if (defined( $seen{$page} )) { next; } $seen{$page} = 1; my $req = new HTTP::Request GET => $page; my $res = $ua->request($req); my $content = ''; my $fullcontent = ''; if ($res->is_success) { $content = $res->content; $content =~ s!!$styleBlock\n!; if ($content =~ m!^(.*)(.*?)(Next.*?(.*?)

!

$1

!; $content =~ s!

Page.*?

!!ig; $content =~ s!(code . " " . $res->message . "\n"; } if ($first) { $prologue =~ s!( MtM Conversations, formatted for printing
    _END_HEADER_ my $ua = new LWP::UserAgent; $ua->agent("MtMstich/0.1 " . $ua->agent); my $req = new HTTP::Request GET => "$server/conversations/"; my $res = $ua->request($req); my %convos = (); my @keys = (); if ($res->is_success) { my @refs = ($res->content =~ m!

    (.*?)!g); while (@refs > 1) { my $key = shift @refs; my $desc = shift @refs; if (! defined($convos{$key})) { $convos{$key} = $desc; push @keys, $key; } } } foreach my $convo ( @keys ) { print "

  • $convos{$convo}
    • \n"; } print <<_END_FOOTER_;
$verstr
script source
_END_FOOTER_ } sub escape { my ($st) = @_; $st =~ s/([^_A-Z0-9])/sprintf("%%%02lx", unpack("c",$1))/gei; $st =~ s/ /\+/g; return $st; }