lib/Vend/Page.pm

   1 # Vend::Page - Handle Interchange page routing
   2 #
   3 # $Id: Page.pm,v 2.26 2008-04-15 19:37:57 racke Exp $
   4 #
   5 # Copyright (C) 2002-2008 Interchange Development Group
   6 # Copyright (C) 1996-2002 Red Hat, Inc.
   7 #
   8 # This program was originally based on Vend 0.2 and 0.3
   9 # Copyright 1995 by Andrew M. Wilcox <amw@wilcoxsolutions.com>
  10 #
  11 # This program is free software; you can redistribute it and/or modify
  12 # it under the terms of the GNU General Public License as published by
  13 # the Free Software Foundation; either version 2 of the License, or
  14 # (at your option) any later version.
  15 #
  16 # This program is distributed in the hope that it will be useful,
  17 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 # GNU General Public License for more details.
  20 #
  21 # You should have received a copy of the GNU General Public
  22 # License along with this program; if not, write to the Free
  23 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
  24 # MA  02110-1301  USA.
  25
  26 package Vend::Page;
  27
  28 use Vend::Session;
  29 use Vend::Parse;
  30 use Vend::Data;
  31 use Vend::Interpolate;
  32 use Vend::Scan;
  33 use Vend::Util;
  34
  35 require Exporter;
  36 @ISA = qw(Exporter);
  37 @EXPORT = qw (
  38                                 display_special_page
  39                                 display_page
  40                                 do_page
  41                                 do_search
  42                                 do_scan
  43                         );
  44
  45 use strict;
  46
  47 use vars qw/$VERSION/;
  48
  49 $VERSION = substr(q$Revision: 2.26 $, 10);
  50
  51 my $wantref = 1;
  52
  53 sub display_special_page {
  54         my($name, $subject) = @_;
  55         my($page);
  56
  57         undef $Vend::write_redirect;
  58
  59         $name =~ m/[\[<]|[\@_]_[A-Z]\w+_[\@_]|\@\@[A-Z]\w+\@\@/
  60                 and do {
  61                         ::logGlobal(
  62                                         "Security violation -- scripting character in page name '%s'.",
  63                                         $name,
  64                                 );
  65                         $name = find_special_page('violation');
  66                         1 while $subject =~ s/[\@_]_/_/g;
  67                 };
  68
  69         $subject ||= 'unspecified error';
  70
  71         my $noname = $name;
  72         $noname =~ s:^\.\./::;
  73
  74         $page = readfile($noname, $Global::NoAbsolute, 1) || readin($name);
  75
  76         die ::get_locale_message(412, qq{Missing special page "%s" for subject "%s"\n}, $name, $subject)
  77                 unless defined $page;
  78         $page =~ s#\[subject\]#$subject#ig;
  79         $Global::Variable->{MV_SUBJECT} = $subject;
  80         $Vend::PageInit = 0;
  81         interpolate_html($page, 1);
  82         ::response();
  83 }
  84
  85 # Displays the catalog page NAME.  If the file is not found, displays
  86 # the special page 'missing'.
  87 #
  88
  89 sub display_page {
  90         my($name, $opt) = @_;
  91         my($page);
  92
  93         $name ||= $CGI::values{mv_nextpage};
  94
  95         $name =~ m/[\[<]|[\@_]_[A-Z]\w+_[\@_]|\@\@[A-Z]\w+\@\@/
  96                 and do {
  97                         ::logGlobal(
  98                                         "Security violation -- scripting character in page name '%s'.",
  99                                         $name,
 100                                 );
 101                         $name = find_special_page('violation');
 102                         return display_special_page($name);
 103                 };
 104
 105         if($Vend::Cfg->{ExtraSecure} and
 106                 $Vend::Cfg->{AlwaysSecure}->{$name}
 107                 and !$CGI::secure) {
 108                 $name = find_special_page('violation');
 109         }
 110
 111         $page = $Vend::VirtualPage || readin($name);
 112 # TRACK
 113         if (defined $page && $Vend::Track) {
 114                 $Vend::Track->view_page($name);
 115         }
 116 # END TRACK
 117
 118         my $inth_opt;
 119         # Try for on-the-fly if not there
 120         if(! defined $page) {
 121                 $page = Vend::Interpolate::fly_page($name)
 122                         and $inth_opt->{onfly} = 1;
 123         }
 124
 125         # Try one last time for page with index
 126         if(! defined $page and $Vend::Cfg->{DirectoryIndex}) {
 127                 my $try = $name;
 128                 $try =~ s!/*$!/$Vend::Cfg->{DirectoryIndex}!;
 129                 $page = readin($try);
 130         }
 131
 132         if (defined $page) {
 133                 $Vend::PageInit = 0;
 134                 if ($opt->{return}) {
 135                         return ::interpolate_html($page, 1, $inth_opt);
 136                 } else {
 137                         ::interpolate_html($page, 1, $inth_opt);
 138                 }
 139                 ::response();
 140                 return 1;
 141         }
 142         else {
 143                 my $handled;
 144                 my $newpage;
 145                 if(my $subname = $Vend::Cfg->{SpecialSub}{missing}) {
 146                         my $sub = $Vend::Cfg->{Sub}{$subname} || $Global::GlobalSub->{$subname};
 147                         ($handled, $newpage) = $sub->($name)
 148                                 if $sub;
 149                 }
 150                 if($handled) {
 151                         return display_page($newpage) if $newpage;
 152                         return 0;
 153                 }
 154                 HTML::Entities::encode($name, $ESCAPE_CHARS::std);
 155                 display_special_page(find_special_page('missing'), $name);
 156                 return 0;
 157         }
 158 }
 159
 160
 161 # Display the catalog page NAME.
 162
 163 sub do_page {
 164         display_page();
 165 }
 166
 167 sub _check_search_file {
 168         my ($c) = @_;
 169         my $f;
 170
 171         if ($c->{mv_search_file}) {
 172                 my(@files) = grep /\S/, split /\s*[,\0]\s*/, $c->{mv_search_file}, -1;
 173                 for $f (@files) {
 174                         unless (grep { $f eq $_ } @{$Vend::Cfg->{AllowRemoteSearch}}) {
 175                                 ::logGlobal("Security violation, trying to remote search '%s', doesn't match '%s'",
 176                                         $f, join ',' => @{$Vend::Cfg->{AllowRemoteSearch}});
 177                                 die "Security violation";
 178                         }
 179                 }
 180         }
 181 }
 182
 183 ## DO SEARCH
 184 sub do_search {
 185         my($c) = @_;
 186         ::update_user();
 187
 188         # If search parameters not passed in via function, then safely pull them from
 189         # the CGI values.
 190         if (!is_hash($c)) {
 191                 $c = find_search_params(\%CGI::values);
 192                 _check_search_file($c);
 193         }
 194
 195         if ($c->{mv_more_matches}) {
 196                 $Vend::Session->{last_search} = "scan/MM=$c->{mv_more_matches}";
 197                 $c->{mv_more_matches} =~ m/([a-zA-Z0-9])+/;
 198                 $c->{mv_cache_key} = $1;
 199         }
 200         else {
 201                 create_last_search($c);
 202         }
 203
 204         $c->{mv_cache_key} = generate_key($Vend::Session->{last_search})
 205                         unless defined $c->{mv_cache_key};
 206
 207         my $retval = perform_search($c);
 208
 209         if (ref($retval)) {
 210                 $::Instance->{SearchObject}{''} = $retval;
 211                 $CGI::values{mv_nextpage}       = $retval->{mv_search_page}
 212                         || find_special_page('search')
 213                                 if ! $CGI::values{mv_nextpage};
 214         }
 215         return 1;
 216 }
 217
 218 # Do SCAN
 219 # Same as search except path is source of search info
 220 sub do_scan {
 221         my($path) = @_;
 222         my ($key,$page);
 223
 224         my $c = {};
 225         $Vend::ScanPassed = "scan/$path";
 226         find_search_params($c,$path);
 227
 228         _check_search_file($c);
 229
 230         if ($c->{mv_more_matches}) {
 231                 $Vend::Session->{last_search} = "scan/MM=$c->{mv_more_matches}";
 232                 $Vend::More_in_progress = 1;
 233                 $c->{mv_more_id} = $CGI::values{mv_more_id} || undef;
 234                 $c->{mv_more_matches} =~ m/([a-zA-Z0-9])+/;
 235                 $c->{mv_cache_key} = $1;
 236                 $CGI::values{mv_nextpage} = $c->{mv_nextpage}
 237                         if ! defined $CGI::values{mv_nextpage};
 238         }
 239         else {
 240                 $c->{mv_cache_key} = generate_key(create_last_search($c));
 241         }
 242
 243         $::Instance->{SearchObject}{''} = perform_search($c);
 244         $CGI::values{mv_nextpage} = $::Instance->{SearchObject}{''}->{mv_search_page}
 245                                                                 || find_special_page('search')
 246                 if ! $CGI::values{mv_nextpage};
 247         return 1;
 248 }
 249
 250 sub output_test {
 251         my ($tag) = @_;
 252         my $ary;
 253         return '' unless $ary = $Vend::OutPtr{lc $tag};
 254         for(@$ary) {
 255                 next unless $Vend::Output[$_];
 256                 next unless length(${$Vend::Output[$_]});
 257                 return 1;
 258         }
 259         return '';
 260 }
 261
 262 sub output_cat {
 263         my ($tag) = @_;
 264         my $ary;
 265         return '' unless $ary = $Vend::OutPtr{lc $tag};
 266         my $out = '';
 267         for(@$ary) {
 268                 next unless $Vend::Output[$_];
 269                 $out .= ${$Vend::Output[$_]};
 270                 undef $Vend::Output[$_];
 271         }
 272         $out =~ s/^\s+// if $::Pragma->{strip_white};
 273         return $out;
 274 }
 275
 276 sub output_ary {
 277         my ($tag) = @_;
 278         my $ary;
 279         return '' unless $ary = $Vend::OutPtr{lc $tag};
 280         my @out;
 281         for(@$ary) {
 282                 next unless $Vend::Output[$_];
 283                 push @out, ${$Vend::Output[$_]};
 284                 undef $Vend::Output[$_];
 285         }
 286         return \@out;
 287 }
 288
 289 sub output_rest {
 290         my ($tag) = @_;
 291         my $out = '';
 292         for(@$Vend::Output) {
 293                 next unless $_;
 294                 $out .= ${$Vend::Output[$_]};
 295                 undef $Vend::Output[$_];
 296         }
 297         return $out;
 298 }
 299
 300 sub templatize {
 301         my ($template) = @_;
 302         $template ||= $Vend::Cfg->{PageTemplate} || '{:REST}';
 303 #::logDebug("Templatizing, template length=" . length($template));
 304         my $body = $template;
 305
 306         $body =~ s!\{\{\@([A-Z][A-Z_0-9]*[A-Z0-9])\}\}(.*?)\{\{/\@\1\}\}!
 307                                         my $tag = lc $1;
 308                                         my $ary;
 309                                         return '' unless $ary = $Vend::OutPtr{$tag};
 310                                         my $tpl = $2;
 311                                         my $out = '';
 312                                         for(@$ary) {
 313                                                 my $ref = $Vend::Output[$_]
 314                                                         or next;
 315                                                 my $chunk = $tpl;
 316                                                 $chunk =~ s/\{$tag\}/$$ref/;
 317                                                 undef $Vend::Output[$_];
 318                                                 $out .= $chunk;
 319                                         }
 320                                         $out;
 321                                 !sge;
 322         1 while $body =~ s!\{\{([A-Z][A-Z_0-9]*[A-Z0-9])\?\}\}(.*?)\{\{/\1\?\}\}! output_test(lc $1) ? $2 : ''!egs;
 323         1 while $body =~ s!\{\{([A-Z][A-Z_0-9]*[A-Z0-9])\:\}\}(.*?)\{\{/\1\:\}\}! output_test(lc $1) ? '' : $2!egs;
 324         $body =~ s!\{\{([A-Z][A-Z_0-9]*[A-Z0-9])\}\}!output_cat($1)!eg;
 325         $body =~ s!\{\{:DEFAULT\}\}!output_cat('')!e;
 326         $body =~ s!\{\{:REST\}\}!output_rest('')!e;
 327         @Vend::Output = (\$body);
 328 }
 329
 330 1;