#!/sw/local/bin/perl # $| = 1; # $basedir = '/lysator/www3/top/nordic/log/parsed/scn/data/'; $codedir = '/lysator/www/projects/nordic/perl/'; $basedir = $codedir; $sp=' 'x4; use lib "/sw/local/lib/perl5/site_perl" ; require LWP; # for http-requests # require "/usr/www/cgi/cgi-lib.pl"; # dbmopen(%titles,$basedir.'titles',0666); # dbmopen(%homepages,$basedir.'homepages',0666); # dbmopen(%names,$basedir.'names',0666); %titles = (); %homepages = (); %names = (); # make the input look the same under roxen and phttpd foreach (keys %ENV) { if (m/^PHTTPD_QUERY/) { my $new_key = $_; $new_key =~ s/^PHTTPD_//; $ENV{$new_key} = $ENV{$_}; delete $ENV{$_}; }; }; $recipient = $ENV{'QUERY_to'}; $homepage = $ENV{'QUERY_hp'}; $referer = $ENV{'QUERY_ref'}; $identity = $ENV{'QUERY_id'}; $reference = $ENV{'HTTP_REFERER'}; $reference =~ s§/(\([^\)]*\))/§/§; $prestates = $1; if ($identity =~ m/_vem/) { $identity =''; }; if ($identity) { $names{$recipient}=$identity } else { $identity=$names{$recipient}; }; print ('Content-type: text/html', "\n\n"); print ('', "\n", '', "\n", 'Message for ', $recipient, '', "\n", '',"\n", '', "\n", ); print ('',"\n"); require "/lysator/www/projects/nordic/perl/dbmsubst.pl"; &read_hash (\%titles, $basedir.'titles',0666); &read_hash (\%homepages, $basedir.'homepages',0666); &read_hash (\%names, $basedir.'names',0666); print (#'', "\n", #'', "\n", #'', "\n", #'', "\n", #'
', "\n", '
', "\n", ); if ($identity) { print ('Message for ', "\n", $identity, '', "\n", '
', '<', $recipient, '>', '', "\n", ); } else { print ('Message for ', "\n", '<', $recipient, '>', '', "\n"); }; print ('

You do not neccessarily need an e-mail address of your own', "\n", '
to comment the FAQ.

', "\n"); unless ($homepage) { $homepage=$homepages{$recipient}; } elsif ($homepages{$recipient} eq '') { my %tmp = (); $tmp{$recipient} = $homepage; &amend_hash(\%homepages, \%tmp); $homepages{$recipient} = $homepage; }; if ($homepage) { print ('

You can also visit the homepage at ', "\n", '
<', 'http://'.$homepage.'>

', "\n"); }; print ('

Please consider directing your question to', "\n", '
all of the ', 'soc.culture.nordic newsgroup

', "\n"); print ('
', "\n"); print ('
', "\n", #'
', "\n", '
', "\n", '', "\n", '', "\n", '', "\n", '

', "\n", '

', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '', "\n", '
', "\n", '
From:', $sp, '', 'Name:
', "\n", '', "\n", '
', "\n", '
E-mail:', '
', "\n", '', "\n", '
', "\n", '
Telephone:', '
', "\n", '', "\n", '
', "\n", '
Country:', '
', "\n", '', "\n", '
', "\n", '
Subject:', "\n", '
', "\n", '', "\n", '
', "\n", '
Message:', "\n", '
', "\n", '', "\n", '
', "\n", '', "\n", ); if ($reference) { print ('', 'Return to previous page', "\n"); }; print ('
', "\n", '', "\n", #'
>', "\n", '

', "\n", #'
', "\n", ); if (0) { print "
";
    foreach (sort keys %ENV)
    {
	print "\$ENV\{$_\} = $ENV{$_}\n";
    };
    print "[ sub write_hash ]\n";
    
    &write_hash (\%titles);
    &write_hash (\%homepages);
    &write_hash (\%names); 

    print "[ sub write_hash done! ]\n";
    
    print "
"; }; print "\n"; print "\n"; sub get_title { my $fil = $_[0]; $fil =~ s§\/\([^\)]+\)§§; $fil =~ s§\#.*§§; my $http = $fil; # $fil =~ s§^http\://[^/]+/[^/]+§§; my $title = $titles{$fil}; if ($title eq '') { # initialize LWP-object $ua = new LWP::UserAgent; $ua->agent("webmail robot/v1.3"); $header = new HTTP::Headers 'Date' => HTTP::Date::time2str(time), # Convert machine time to a format suitable for the HTTP server 'Accept' => 'text/html', # Tell the server we can accept HTML 'Accept' => 'text/plain', # Tell the server we can accept HTML 'Accept' => 'text/ftp-dir-listing', # Tell the server we can accept ftp directories ; # do the very http-request my $request = new HTTP::Request('GET', $http, $header); $response = $ua->request($request); unless ( $response->is_error ) { if ($response->content =~ m/\]*\>([^\<]*)/i ) { my $found_title = $1; $titles{$fil} = $found_title; my %tmp = (); $tmp{$fil} = $found_title; &amend_hash(\%titles, \%tmp); return $found_title; }; }; }; return $title; };