PciIds/Html/Util.pm

   1 #       PciIds web database
   2 #       Copyright (C) 2008 Michal Vaner (vorner@ucw.cz)
   3 #
   4 #       This program is free software; you can redistribute it and/or modify
   5 #       it under the terms of the GNU General Public License as published by
   6 #       he Free Software Foundation; either version 2 of the License, or
   7 #       (at your option) any later version.
   8 #
   9 #       This program is distributed in the hope that it will be useful,
  10 #       but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 #       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 #
  13 #       GNU General Public License for more details.
  14 #
  15 #       You should have received a copy of the GNU General Public License
  16 #       along with this program; if not, write to the Free Software
  17 #       Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
  18
  19 package PciIds::Html::Util;
  20 use strict;
  21 use warnings;
  22 use HTML::Entities;
  23 use base 'Exporter';
  24 use PciIds::Users;
  25 use Apache2::Const qw(:common :http);
  26 use APR::Table;
  27
  28 our @EXPORT = qw(&genHtmlHead &htmlDiv &genHtmlTail &genTableHead &genTableTail &parseArgs &buildExcept &buildArgs &genMenu &genCustomMenu &encode &setAddrPrefix &HTTPRedirect &genPath &logItem &genLocMenu &genCustomHead &genPathBare &protoName);
  29
  30 sub encode( $ ) {
  31         return encode_entities( shift, "\"'&<>" );
  32 }
  33
  34 sub protoName( $ ) {
  35         my( $hasSSL ) = ( @_ );
  36         return 'http' . ( 's' x $hasSSL );
  37 }
  38
  39 sub genHtmlHead( $$$ ) {
  40         my( $req, $caption, $metas ) = @_;
  41         $req->content_type( 'text/html; charset=utf-8' );
  42         $req->headers_out->add( 'Cache-control' => 'no-cache' );
  43         print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">'."\n";
  44         print '<html lang="en"><head><title>'.encode( $caption )."</title>\n";
  45         print "<link rel='stylesheet' type='text/css' media='screen' href='/static/screen.css'>\n";
  46         print "<link rel='stylesheet' type='text/css' media='print' href='/static/print.css'>\n";
  47         print "<link rel='stylesheet' type='text/css' media='screen,print' href='/static/common.css'>\n";
  48         print $metas if( defined( $metas ) );
  49         print "</head><body>\n";
  50 }
  51
  52 sub genHtmlTail() {
  53         print '</body></html>';
  54 }
  55
  56 sub htmlDiv( $$ ) {
  57         my( $class, $text ) = @_;
  58         return '<div class="'.$class.'">'.$text.'</div>';
  59 }
  60
  61 sub item( $$ ) {
  62         my( $url, $label ) = @_;
  63         print "  <li><a href='".$url."'>$label</a>\n";
  64 }
  65
  66 sub genCustomMenu( $$$$ ) {
  67         my( $req, $address, $args, $list ) = @_;
  68         my $url;
  69         if( defined $address ) {
  70                 $url = '/'.$address->get().buildExcept( 'action', $args ).'?action=';
  71         } else {
  72                 $url = '/read/?action=';
  73         }
  74         print "<ul>\n";
  75         foreach( @{$list} ) {
  76                 my( $label, $action, $param ) = @{$_};
  77                 if( $action eq 'jump' ) {
  78                         print "<li>\n";
  79                         require PciIds::Html::Jump;
  80                         PciIds::Html::Jump::jumpWindow( $req, $args );
  81                 } else {
  82                         my $prefix = '/mods';
  83                         $prefix = '/read' if( !defined( $action ) or ( $action eq 'list' ) or ( $action eq '' ) or ( $action eq 'help' ) );
  84                         my $suffix = '';
  85                         $suffix = '?help='.$param if( $action eq 'help' );
  86                         item( $prefix.$url.$action.$suffix, $label );
  87                 }
  88         }
  89         print "</ul>\n";
  90 }
  91
  92 sub logItem( $ ) {
  93         my( $auth ) = @_;
  94         if( defined( $auth->{'authid'} ) ) {
  95                 return [ 'Log out ('.encode( $auth->{'name'} ).')', 'logout' ];
  96         } else {
  97                 return [ 'Log in', 'login' ];
  98         }
  99 }
 100
 101 sub genMenu( $$$$$ ) {
 102         my( $req, $address, $args, $auth, $append ) = @_;
 103         my @list;
 104         if( defined $address ) {
 105                 push @list, [ 'Add item', 'newitem' ] if( $address->canAddItem() );
 106                 push @list, [ 'Discuss', 'newhistory' ] if( $address->canDiscuss() );
 107         }
 108         push @list, [ 'Administer', 'admin' ] if( hasRight( $auth->{'accrights'}, 'validate' ) );
 109         push @list, @{$append} if defined $append;
 110         if( @list ) {
 111                 print "<div class='lmenu'>\n";
 112                 genCustomMenu( $req, $address, $args, \@list );
 113                 print "</div>\n";
 114         }
 115         @list = ( logItem( $auth ) );
 116         push @list, [ 'Profile', 'profile' ] if defined $auth->{'authid'};
 117         push @list, [ 'Notifications', 'notifications' ] if defined $auth->{'authid'};
 118         print "<div class='rmenu'>\n";
 119         genCustomMenu( $req, $address, $args, \@list );
 120         print "</div>\n";
 121 }
 122
 123 sub genTableHead( $$$ ) {
 124         my( $class, $captions, $cols ) = @_;
 125         print '<table class="'.$class.'">';
 126         foreach( @{$cols} ) {
 127                 print "<col class='$_'>\n";
 128         }
 129         print "<tr>\n";
 130         foreach( @{$captions} ) {
 131                 print '<th>'.$_."\n";
 132         }
 133 }
 134
 135 sub genTableTail() {
 136         print '</table>';
 137 }
 138
 139 sub parseArgs( $ ) {
 140         my %result;
 141         foreach( split /\?/, shift ) {
 142                 next unless( /=/ );
 143                 my( $name, $value ) = /^([^=]+)=(.*)$/;
 144                 $result{$name} = $value;
 145         }
 146         return \%result;
 147 }
 148
 149 sub buildArgs( $ ) {
 150         my( $args ) = @_;
 151         my $result = '';
 152         foreach( keys %{$args} ) {
 153                 $result .= "?$_=".$args->{$_} if( defined $args->{$_} );
 154         }
 155         return $result;
 156 }
 157
 158 sub buildExcept( $$ ) {
 159         my( $except, $args ) = @_;
 160         my %backup = %{$args};
 161         delete $backup{$except};
 162         return buildArgs( \%backup );
 163 }
 164
 165 sub setAddrPrefix( $$ ) {
 166         my( $addr, $prefix ) = @_;
 167         $addr =~ s/\/(mods|read|static)//;
 168         return "/$prefix$addr";
 169 }
 170
 171 sub HTTPRedirect( $$ ) {
 172         my( $req, $link ) = @_;
 173         $req->headers_out->add( 'Location' => $link );
 174         return HTTP_SEE_OTHER;
 175 }
 176
 177 sub genPathBare( $$$$ ) {
 178         my( $req, $address, $printAddr, $started ) = @_;
 179         my $path;
 180         if( defined $address ) {
 181                 $path = $address->path();
 182         } else {
 183                 $path = [];
 184         }
 185         foreach my $item ( reverse @{$path} ) {
 186                 my( $addr, $exception, $myAddr ) = @{$item};
 187                 if( $started ) {
 188                         if( $exception ) {
 189                                 print ", ";
 190                         } else {
 191                                 print " -&gt; ";
 192                         }
 193                 } else {
 194                         $started = 1;
 195                 }
 196                 print "(" if( $exception );
 197                 if( !$printAddr && $myAddr ) {
 198                         print "<strong>".encode( $addr->pretty() )."</strong>";
 199                 } else {
 200                         print "<a href='/read/".$addr->get()."'>".encode( $addr->pretty() )."</a>";
 201                 }
 202                 print ")" if( $exception );
 203         }
 204 }
 205
 206 sub genPath( $$$ ) {
 207         my( $req, $address, $printAddr ) = @_;
 208         print "<div class='path'>\n";
 209         print "<p><a href='/index.html'>Main</a>";
 210         genPathBare( $req, $address, $printAddr, 1 );
 211         print "</div>\n";
 212 }
 213
 214 sub genLocMenu( $$$$$ ) {
 215         my( $req, $args, $addr, $lactions, $ractions ) = @_;
 216         print "<div class='lmenu'>\n";
 217         genCustomMenu( $req, $addr, $args, $lactions );
 218         print "</div>\n<div class='rmenu'>\n";
 219         genCustomMenu( $req, $addr, $args, $ractions );
 220         print "</div>\n";
 221 }
 222
 223 sub genCustomHead( $$$$$$ ) {
 224         my( $req, $args, $addr, $caption, $lactions, $ractions ) = @_;
 225         print "<div class='top'>\n";
 226         genLocMenu( $req, $args, $addr, $lactions, $ractions );
 227         print "<h1>$caption</h1>\n";
 228         print "<div class='clear'></div></div>\n";
 229         genPath( $req, $addr, 1 );
 230 }
 231
 232 1;