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);
  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, $action ) = @_;
  39         print "  <li><a href='".$url.$action."'>$label</a>\n";
  40 }
  41
  42 sub genCustomMenu( $$$ ) {
  43         my( $address, $args, $list ) = @_;
  44         my $url = '/'.$address->get().buildExcept( 'action', $args ).'?action=';
  45         print "<div class='menu'>\n<ul>\n";
  46         foreach( @{$list} ) {
  47                 my( $label, $action ) = @{$_};
  48                 my $prefix = '/mods';
  49                 $prefix = '/read' if( !defined( $action ) or ( $action eq 'list' ) or ( $action eq '' ) );
  50                 item( $prefix.$url, $label, $action );
  51         }
  52         print "</ul></div>\n";
  53 }
  54
  55 sub genMenu( $$$ ) {
  56         my( $address, $args, $auth ) = @_;
  57         my @list;
  58         if( defined( $auth->{'authid'} ) ) {
  59                 push @list, [ 'Log out', 'logout' ];
  60         } else {
  61                 push @list, [ 'Log in', 'login' ];
  62         }
  63         push @list, [ 'Add item', 'newitem' ] if( $address->canAddItem() );
  64         push @list, [ 'Discuss', 'newhistory' ] if( $address->canAddComment() );
  65         push @list, [ 'Administrate', 'admin' ] if( hasRight( $auth->{'accrights'}, 'validate' ) );
  66         push @list, [ 'Profile', 'profile' ] if defined $auth->{'authid'};
  67         push @list, [ 'Notifications', 'notifications' ] if defined $auth->{'authid'};
  68         genCustomMenu( $address, $args, \@list );
  69 }
  70
  71 sub genTableHead( $$$ ) {
  72         my( $class, $captions, $cols ) = @_;
  73         print '<table class="'.$class.'">';
  74         foreach( @{$cols} ) {
  75                 print "<col class='$_'>\n";
  76         }
  77         print "<tr>\n";
  78         foreach( @{$captions} ) {
  79                 print '<th>'.$_."\n";
  80         }
  81 }
  82
  83 sub genTableTail() {
  84         print '</table>';
  85 }
  86
  87 sub parseArgs( $ ) {
  88         my %result;
  89         foreach( split /\?/, shift ) {
  90                 next unless( /=/ );
  91                 my( $name, $value ) = /^([^=]+)=(.*)$/;
  92                 $result{$name} = $value;
  93         }
  94         return \%result;
  95 }
  96
  97 sub buildArgs( $ ) {
  98         my( $args ) = @_;
  99         my $result = '';
 100         $result .= "?$_=".$args->{$_} foreach( keys %{$args} );
 101         return $result;
 102 }
 103
 104 sub buildExcept( $$ ) {
 105         my( $except, $args ) = @_;
 106         my %backup = %{$args};
 107         delete $backup{$except};
 108         return buildArgs( \%backup );
 109 }
 110
 111 sub setAddrPrefix( $$ ) {
 112         my( $addr, $prefix ) = @_;
 113         $addr =~ s/\/(mods|read|static)//;
 114         return "/$prefix$addr";
 115 }
 116
 117 sub HTTPRedirect( $$ ) {
 118         my( $req, $link ) = @_;
 119         $req->headers_out->add( 'Location' => $link );
 120         return HTTP_SEE_OTHER;
 121 }
 122
 123 sub genPath( $$ ) {
 124         my( $address, $printAddr ) = @_;
 125         my $path = $address->path();
 126         push @{$path}, $address if( $printAddr );
 127         print "<div class='navigation'><ul>\n";
 128         foreach my $addr ( @{$path} ) {
 129                 print "  <li><a href='/read/".$addr->get()."/'>".encode( $addr->pretty() )."</a>\n";
 130         }
 131         print "<li><a href='/index.html'>Main page</a>\n";
 132         print "</div>\n";
 133 }
 134
 135 1;