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 &genHtmlFooter);
  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 genHtmlFooter( $$$ ) {
  57         my( $jump, $req, $args ) = @_;
  58         if( $jump ) {
  59                 require PciIds::Html::Jump;
  60                 PciIds::Html::Jump::jumpWindow( $req, $args );
  61         }
  62         print '
  63 <div class="footer"><hr>
  64 <p class="maintain">
  65 Maintained by <a href="http://mj.ucw.cz/">Martin Mares</a> and <a href="http://vorner.cz/">Michal
  66 Vaner</a> with great help by volunteers from the <a href="http://www.sourceforge.net/projects/pciids/">pciids project</a>
  67 at <a href="http://www.sourceforge.net/">SourceForge</a>.
  68 <p class="maintain">No counters, no frames, no syntax errors.
  69 </div>';
  70         genHtmlTail();
  71 }
  72
  73 sub htmlDiv( $$ ) {
  74         my( $class, $text ) = @_;
  75         return '<div class="'.$class.'">'.$text.'</div>';
  76 }
  77
  78 sub item( $$ ) {
  79         my( $url, $label ) = @_;
  80         print "  <li><a href='".$url."'>$label</a>\n";
  81 }
  82
  83 sub genCustomMenu( $$$$ ) {
  84         my( $req, $address, $args, $list ) = @_;
  85         my $url;
  86         if( defined $address ) {
  87                 $url = '/'.$address->get().buildExcept( 'action', $args ).'?action=';
  88         } else {
  89                 $url = '/?action=';
  90         }
  91         print "<ul>\n";
  92         foreach( @{$list} ) {
  93                 my( $label, $action, $param ) = @{$_};
  94                 if( $action eq 'jump' ) {
  95                         print "<li>\n";
  96                         require PciIds::Html::Jump;
  97                         PciIds::Html::Jump::jumpWindow( $req, $args );
  98                 } else {
  99                         my $prefix = '/mods';
 100                         $prefix = '/read' if( !defined( $action ) or ( $action eq 'list' ) or ( $action eq '' ) );
 101                         my $suffix = '';
 102                         $suffix = '?help='.$param if( $action eq 'help' );
 103                         item( $prefix.$url.$action.$suffix, $label );
 104                 }
 105         }
 106         print "</ul>\n";
 107 }
 108
 109 sub logItem( $ ) {
 110         my( $auth ) = @_;
 111         if( defined( $auth->{'authid'} ) ) {
 112                 return [ 'Log out ('.encode( $auth->{'name'} ).')', 'logout' ];
 113         } else {
 114                 return [ 'Log in', 'login' ];
 115         }
 116 }
 117
 118 sub genMenu( $$$$$ ) {
 119         my( $req, $address, $args, $auth, $append ) = @_;
 120         my @list;
 121         if( defined $address ) {
 122                 push @list, [ 'Add item', 'newitem' ] if( $address->canAddItem() );
 123                 push @list, [ 'Discuss', 'newhistory' ] if( $address->canDiscuss() );
 124         }
 125         push @list, [ 'Administer', 'admin' ] if( hasRight( $auth->{'accrights'}, 'validate' ) );
 126         push @list, @{$append} if defined $append;
 127         if( @list ) {
 128                 print "<div class='lmenu'>\n";
 129                 genCustomMenu( $req, $address, $args, \@list );
 130                 print "</div>\n";
 131         }
 132         @list = ( logItem( $auth ) );
 133         push @list, [ 'Profile', 'profile' ] if defined $auth->{'authid'};
 134         push @list, [ 'Notifications', 'notifications' ] if defined $auth->{'authid'};
 135         print "<div class='rmenu'>\n";
 136         genCustomMenu( $req, $address, $args, \@list );
 137         print "</div>\n";
 138 }
 139
 140 sub genTableHead( $$$ ) {
 141         my( $class, $captions, $cols ) = @_;
 142         print '<table class="'.$class.'">';
 143         foreach( @{$cols} ) {
 144                 print "<col class='$_'>\n";
 145         }
 146         print "<tr>\n";
 147         foreach( @{$captions} ) {
 148                 print '<th>'.$_."\n";
 149         }
 150 }
 151
 152 sub genTableTail() {
 153         print '</table>';
 154 }
 155
 156 sub parseArgs( $ ) {
 157         my %result;
 158         foreach( split /\?/, shift ) {
 159                 next unless( /=/ );
 160                 my( $name, $value ) = /^([^=]+)=(.*)$/;
 161                 $result{$name} = $value;
 162         }
 163         return \%result;
 164 }
 165
 166 sub buildArgs( $ ) {
 167         my( $args ) = @_;
 168         my $result = '';
 169         foreach( keys %{$args} ) {
 170                 $result .= "?$_=".$args->{$_} if( defined $args->{$_} );
 171         }
 172         return $result;
 173 }
 174
 175 sub buildExcept( $$ ) {
 176         my( $except, $args ) = @_;
 177         my %backup = %{$args};
 178         delete $backup{$except};
 179         return buildArgs( \%backup );
 180 }
 181
 182 sub setAddrPrefix( $$ ) {
 183         my( $addr, $prefix ) = @_;
 184         $addr =~ s/\/(mods|read|static)//;
 185         return "/$prefix$addr";
 186 }
 187
 188 sub HTTPRedirect( $$ ) {
 189         my( $req, $link ) = @_;
 190         $req->headers_out->add( 'Location' => $link );
 191         return HTTP_SEE_OTHER;
 192 }
 193
 194 sub genPathBare( $$$$$ ) {
 195         my( $req, $address, $printAddr, $started, $tables ) = @_;
 196         my $path;
 197         if( defined $address ) {
 198                 $path = $address->path();
 199         } else {
 200                 $path = [];
 201         }
 202         foreach my $item ( reverse @{$path} ) {
 203                 my( $addr, $exception, $myAddr ) = @{$item};
 204                 if( $started ) {
 205                         if( $exception ) {
 206                                 print ", ";
 207                         } else {
 208                                 print " -&gt; ";
 209                         }
 210                 } else {
 211                         $started = 1;
 212                 }
 213                 print "(" if( $exception );
 214                 if( !$printAddr && $myAddr ) {
 215                         print "<strong>".encode( $addr->pretty() )."</strong>";
 216                 } else {
 217                         my $title = '';
 218                         $title = ' title="'.encode( $tables->itemName( $addr->get() ) ).'"' if defined $tables;
 219                         print "<a href='/read/".$addr->get()."'$title>".encode( $addr->pretty() )."</a>";
 220                 }
 221                 print ")" if( $exception );
 222         }
 223 }
 224
 225 sub genPath( $$$ ) {
 226         my( $req, $address, $printAddr ) = @_;
 227         print "<div class='path'>\n";
 228         print "<p><a href='/'>Main</a>";
 229         genPathBare( $req, $address, $printAddr, 1, undef );
 230         print "</div>\n";
 231 }
 232
 233 sub genLocMenu( $$$$$ ) {
 234         my( $req, $args, $addr, $lactions, $ractions ) = @_;
 235         print "<div class='lmenu'>\n";
 236         genCustomMenu( $req, $addr, $args, $lactions );
 237         print "</div>\n<div class='rmenu'>\n";
 238         genCustomMenu( $req, $addr, $args, $ractions );
 239         print "</div>\n";
 240 }
 241
 242 sub genCustomHead( $$$$$$ ) {
 243         my( $req, $args, $addr, $caption, $lactions, $ractions ) = @_;
 244         print "<div class='top'>\n";
 245         genLocMenu( $req, $args, $addr, $lactions, $ractions );
 246         print "<div class='bluesquare'><h1>$caption</h1><p class='home'>The PCI ID Repository</div>\n";
 247         print "<div class='clear'></div></div>\n";
 248         genPath( $req, $addr, 1 );
 249 }
 250
 251 1;