Girocco/CGI.pm

   1 package Girocco::CGI;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Girocco::Config;
   7
   8 BEGIN {
   9         our $VERSION = '0.1';
  10         our @ISA = qw(Exporter);
  11         our @EXPORT = qw(html_esc);
  12
  13         use CGI qw(:standard :escapeHTML -nosticky);
  14         use CGI::Util qw(unescape);
  15         use CGI::Carp qw(fatalsToBrowser);
  16 }
  17
  18
  19 sub new {
  20         my $class = shift;
  21         my ($heading, $section) = @_;
  22         my $gcgi = {};
  23
  24         $section ||= 'administration';
  25
  26         $gcgi->{cgi} = CGI->new;
  27
  28         my $cgiurl = $gcgi->{cgi}->url(-absolute => 1);
  29         ($gcgi->{srcname}) = ($cgiurl =~ m#^.*/\([a-zA-Z0-9_.\/-]+?\.cgi\)$#); #
  30         $gcgi->{srcname} = "cgi/".$gcgi->{srcname} if $gcgi->{srcname};
  31
  32         print $gcgi->{cgi}->header(-type=>'text/html', -charset => 'utf-8');
  33
  34         print <<EOT;
  35 <?xml version="1.0" encoding="utf-8"?>
  36 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
  37 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
  38
  39 <head>
  40 <title>$Girocco::Config::name :: $heading</title>
  41 <link rel="stylesheet" type="text/css" href="$Girocco::Config::gitwebfiles/gitweb.css"/>
  42 <link rel="stylesheet" type="text/css" href="$Girocco::Config::gitwebfiles/girocco.css"/>
  43 <link rel="shortcut icon" href="$Girocco::Config::gitwebfiles/git-favicon.png" type="image/png"/>
  44 <script src="$Girocco::Config::gitwebfiles/girocco.js" type="text/javascript"></script>
  45 </head>
  46
  47 <body>
  48
  49 <div class="page_header">
  50 <a href="http://git.or.cz/" title="Git homepage"><img src="$Girocco::Config::gitwebfiles/git-logo.png" width="72" height="27" alt="git" style="float:right; border-width:0px;"/></a>
  51 <a href="$Girocco::Config::gitweburl">$Girocco::Config::name</a> / $section / $heading
  52 </div>
  53
  54 EOT
  55
  56         bless $gcgi, $class;
  57 }
  58
  59 sub DESTROY {
  60         my $self = shift;
  61         if ($self->{srcname} and $Girocco::Config::giroccourl) {
  62                 print <<EOT;
  63 <div align="right">
  64 <a href="$Girocco::Config::giroccourl?a=blob;f=$self->{srcname}">(view source)</a>
  65 </div>
  66 EOT
  67         }
  68         print <<EOT;
  69 </body>
  70 </html>
  71 EOT
  72 }
  73
  74 sub cgi {
  75         my $self = shift;
  76         $self->{cgi};
  77 }
  78
  79 sub err {
  80         my $self = shift;
  81         print "<p style=\"color: red\">@_</p>\n";
  82         $self->{err}++;
  83 }
  84
  85 sub err_check {
  86         my $self = shift;
  87         my $err = $self->{err};
  88         $err and print "<p style=\"font-weight: bold\">Operation aborted due to $err errors.</p>\n";
  89         $err;
  90 }
  91
  92 sub wparam {
  93         my $self = shift;
  94         my ($param) = @_;
  95         my $val = $self->{cgi}->param($param);
  96         defined $val and $val =~ s/^\s*(.*?)\s*$/$1/;
  97         $val;
  98 }
  99
 100 sub srcname {
 101         my $self = shift;
 102         my ($srcname) = @_;
 103         $self->{srcname} = $srcname if $srcname;
 104         $self->{srcname};
 105 }
 106
 107 sub html_esc {
 108         my ($str) = @_;
 109         $str =~ s/&/&amp;/g;
 110         $str =~ s/</&lt;/g; $str =~ s/>/&gt;/g;
 111         $str =~ s/"/&quot;/g;
 112         $str;
 113 }
 114
 115
 116 1;