PciIds/Html/Util.pm

   1 package PciIds::Html::Util;
   2 use strict;
   3 use warnings;
   4 use HTML::Entities;
   5 use base 'Exporter';
   6 use PciIds::Users;
   7 use Apache2::Const qw(:common :http);
   8 use APR::Table;
   9
  10 our @EXPORT = qw(&genHtmlHead &htmlDiv &genHtmlTail &genTableHead &genTableTail &parseArgs &buildExcept &buildArgs &genMenu &genCustomMenu &encode &setAddrPrefix &HTTPRedirect &genPath &logItem &genLocMenu &genCustomHead &genPathBare);
  11
  12 sub encode( $ ) {
  13         return encode_entities( shift, "\"'&<>" );
  14 }
  15
  16 sub genHtmlHead( $$$ ) {
  17         my( $req, $caption, $metas ) = @_;
  18         $req->content_type( 'text/html; charset=utf-8' );
  19         $req->headers_out->add( 'Cache-control' => 'no-cache' );
  20         print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">'."\n";
  21         print '<html lang="en"><head><title>'.encode( $caption )."</title>\n";
  22         print "<link rel='stylesheet' type='text/css' media='screen' href='/static/screen.css'>\n";
  23         print "<link rel='stylesheet' type='text/css' media='print' href='/static/print.css'>\n";
  24         print $metas if( defined( $metas ) );
  25         print "</head><body>\n";
  26 }
  27
  28 sub genHtmlTail() {
  29         print '</body></html>';
  30 }
  31
  32 sub htmlDiv( $$ ) {
  33         my( $class, $text ) = @_;
  34         return '<div class="'.$class.'">'.$text.'</div>';
  35 }
  36
  37 sub item( $$ ) {
  38         my( $url, $label ) = @_;
  39         print "  <li><a href='".$url."'>$label</a>\n";
  40 }
  41
  42 sub genCustomMenu( $$$$ ) {
  43         my( $req, $address, $args, $list ) = @_;
  44         my $url;
  45         if( defined $address ) {
  46                 $url = '/'.$address->get().buildExcept( 'action', $args ).'?action=';
  47         } else {
  48                 $url = '/read/?action=';
  49         }
  50         print "<ul>\n";
  51         foreach( @{$list} ) {
  52                 my( $label, $action, $param ) = @{$_};
  53                 if( $action eq 'jump' ) {
  54                         print "<li>\n";
  55                         require PciIds::Html::Jump;
  56                         PciIds::Html::Jump::jumpWindow( $req, $args );
  57                 } else {
  58                         my $prefix = '/mods';
  59                         $prefix = '/read' if( !defined( $action ) or ( $action eq 'list' ) or ( $action eq '' ) or ( $action eq 'help' ) );
  60                         my $suffix = '';
  61                         $suffix = '?help='.$param if( $action eq 'help' );
  62                         item( 'http://'.$req->hostname().$prefix.$url.$action.$suffix, $label );
  63                 }
  64         }
  65         print "</ul>\n";
  66 }
  67
  68 sub logItem( $ ) {
  69         my( $auth ) = @_;
  70         if( defined( $auth->{'authid'} ) ) {
  71                 return [ 'Log out ('.encode( $auth->{'name'} ).')', 'logout' ];
  72         } else {
  73                 return [ 'Log in', 'login' ];
  74         }
  75 }
  76
  77 sub genMenu( $$$$$ ) {
  78         my( $req, $address, $args, $auth, $append ) = @_;
  79         my @list;
  80         if( defined $address ) {
  81                 push @list, [ 'Add item', 'newitem' ] if( $address->canAddItem() );
  82                 push @list, [ 'Discuss', 'newhistory' ] if( $address->canDiscuss() );
  83         }
  84         push @list, [ 'Administer', 'admin' ] if( hasRight( $auth->{'accrights'}, 'validate' ) );
  85         push @list, @{$append} if defined $append;
  86         if( @list ) {
  87                 print "<div class='lmenu'>\n";
  88                 genCustomMenu( $req, $address, $args, \@list );
  89                 print "</div>\n";
  90         }
  91         @list = ( logItem( $auth ) );
  92         push @list, [ 'Profile', 'profile' ] if defined $auth->{'authid'};
  93         push @list, [ 'Notifications', 'notifications' ] if defined $auth->{'authid'};
  94         print "<div class='rmenu'>\n";
  95         genCustomMenu( $req, $address, $args, \@list );
  96         print "</div>\n";
  97 }
  98
  99 sub genTableHead( $$$ ) {
 100         my( $class, $captions, $cols ) = @_;
 101         print '<table class="'.$class.'">';
 102         foreach( @{$cols} ) {
 103                 print "<col class='$_'>\n";
 104         }
 105         print "<tr>\n";
 106         foreach( @{$captions} ) {
 107                 print '<th>'.$_."\n";
 108         }
 109 }
 110
 111 sub genTableTail() {
 112         print '</table>';
 113 }
 114
 115 sub parseArgs( $ ) {
 116         my %result;
 117         foreach( split /\?/, shift ) {
 118                 next unless( /=/ );
 119                 my( $name, $value ) = /^([^=]+)=(.*)$/;
 120                 $result{$name} = $value;
 121         }
 122         return \%result;
 123 }
 124
 125 sub buildArgs( $ ) {
 126         my( $args ) = @_;
 127         my $result = '';
 128         foreach( keys %{$args} ) {
 129                 $result .= "?$_=".$args->{$_} if( defined $args->{$_} );
 130         }
 131         return $result;
 132 }
 133
 134 sub buildExcept( $$ ) {
 135         my( $except, $args ) = @_;
 136         my %backup = %{$args};
 137         delete $backup{$except};
 138         return buildArgs( \%backup );
 139 }
 140
 141 sub setAddrPrefix( $$ ) {
 142         my( $addr, $prefix ) = @_;
 143         $addr =~ s/\/(mods|read|static)//;
 144         return "/$prefix$addr";
 145 }
 146
 147 sub HTTPRedirect( $$ ) {
 148         my( $req, $link ) = @_;
 149         $req->headers_out->add( 'Location' => $link );
 150         return HTTP_SEE_OTHER;
 151 }
 152
 153 sub genPathBare( $$$$ ) {
 154         my( $req, $address, $printAddr, $started ) = @_;
 155         my $path;
 156         if( defined $address ) {
 157                 $path = $address->path();
 158                 unshift @{$path}, $address if( $printAddr );
 159         } else {
 160                 $path = [];
 161         }
 162         foreach my $addr ( reverse @{$path} ) {
 163                 if( $started ) {
 164                         print "&nbsp;-&gt;&nbsp;";
 165                 } else {
 166                         $started = 1;
 167                 }
 168                 print "<a href='http://".$req->hostname()."/read/".$addr->get()."'>".encode( $addr->pretty() )."</a>";
 169         }
 170 }
 171
 172 sub genPath( $$$ ) {
 173         my( $req, $address, $printAddr ) = @_;
 174         print "<div class='path'>\n";
 175         print "<p><a href='http://".$req->hostname()."/index.html'>Main page</a>";
 176         genPathBare( $req, $address, $printAddr, 1 );
 177         print "</div>\n";
 178 }
 179
 180 sub genLocMenu( $$$$$ ) {
 181         my( $req, $args, $addr, $lactions, $ractions ) = @_;
 182         print "<div class='lmenu'>\n";
 183         genCustomMenu( $req, $addr, $args, $lactions );
 184         print "</div>\n<div class='rmenu'>\n";
 185         genCustomMenu( $req, $addr, $args, $ractions );
 186         print "</div>\n";
 187 }
 188
 189 sub genCustomHead( $$$$$$ ) {
 190         my( $req, $args, $addr, $caption, $lactions, $ractions ) = @_;
 191         print "<div class='top'>\n";
 192         genLocMenu( $req, $args, $addr, $lactions, $ractions );
 193         print "<h1>$caption</h1>\n";
 194         print "<div class='clear'></div></div>\n";
 195         genPath( $req, $addr, 1 );
 196 }
 197
 198 1;