psyke.org - self injury information and support

#!/usr/bin/perl ################################################################################ ### print.pl ### generates printer friendly pages on www.psyke.org ### ### Copyright (C) 2002 Ratatosk / Morten Wulff ### ### This program 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 ### of the License, or (at your option) any later version. ### ### This program 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 program; if not, write to the Free Software ### Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ################################################################################ ### REVISIONS ### Begun : 30/06/2002 : Morten Wulff ### 1.0.0 : 04/07/2002 : Morten Wulff use strict; use CGI; ################################################################################ ### INIT ################################################################################ my $siteroot = 'http://url.of/site'; my $sitepath = '/path.to/site'; ### split on these tags my $start = ''; my $end = ''; ### only allow files from these paths my @legal = qw(accept1 accept2); ### name of search script (because we can't print from highlighted pages) my $search = 'search.pl'; ### remember to edit the template below the __DATA__ token ################################################################################ ### MAIN ################################################################################ my %legalpaths; my $CGI = new CGI; local $/; ### slurp mode ;-) @legalpaths{@legal} = ('1') x @legal; ### get path my $referer = $CGI->referer(); $referer =~ s/$siteroot//; ### get file my $file = $sitepath . $referer; my $source; if ( -f $file && legal($file) ) { open(SOURCE, $file) or die "Could not open source file: $file\n$!\n"; $source = ; close SOURCE; ### extract the html bits we need ($source) = ($source =~ /$start(.*)$end/s); $source ||= 'Document is empty!'; } else { if ( $file =~ /$search/ ) { my $original = $referer; $original =~ s/.*showurl=(.*)/$1/; $original =~ s/%3A/:/; $source = < Can't print from a page with highlighted search terms.

Please visit the normal version of the page and print from there.

HTML } else { $source = '

Access denied.

'; } } ### insert date into template and print the result my $html = ; $html =~ s/%%REFERER%%/$CGI->referer()/eg; $html =~ s/%%SOURCE%%/$source/eg; print $CGI->header(); print $html; ################################################################################ ### SUBS ################################################################################ sub legal { my $file = shift; my ($dir) = ( $file =~ m!.*/(.*)/.*\.html! ); return $legalpaths{$dir}; } ################################################################################ ### TEMPLATE ################################################################################ __DATA__ psyke.org - self injury information and support

%%SOURCE%%

%%REFERER%%