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, $extrahead) = @_;
  22         my $gcgi = {};
  23
  24         $heading = CGI::escapeHTML($heading || '');
  25         $section = CGI::escapeHTML($section || 'administration');
  26         $extrahead = CGI::escapeHTML($extrahead || '');
  27         my $name = CGI::escapeHTML($Girocco::Config::name || '');
  28
  29         $gcgi->{cgi} = CGI->new;
  30
  31         my $cgiurl = $gcgi->{cgi}->url(-absolute => 1);
  32         ($gcgi->{srcname}) = ($cgiurl =~ m#^.*/\([a-zA-Z0-9_.\/-]+?\.cgi\)$#); #
  33         $gcgi->{srcname} = "cgi/".$gcgi->{srcname} if $gcgi->{srcname};
  34
  35         print $gcgi->{cgi}->header(-type=>'text/html', -charset => 'utf-8');
  36
  37         print <<EOT;
  38 <?xml version="1.0" encoding="utf-8"?>
  39 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
  40 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
  41
  42 <head>
  43 <title>$name :: $heading</title>
  44 <link rel="stylesheet" type="text/css" href="$Girocco::Config::gitwebfiles/gitweb.css"/>
  45 <link rel="stylesheet" type="text/css" href="$Girocco::Config::gitwebfiles/girocco.css"/>
  46 <link rel="shortcut icon" href="$Girocco::Config::gitwebfiles/git-favicon.png" type="image/png"/>
  47 <script src="$Girocco::Config::gitwebfiles/mootools.js" type="text/javascript"></script>
  48 <script src="$Girocco::Config::gitwebfiles/girocco.js" type="text/javascript"></script>
  49 $extrahead</head>
  50
  51 <body>
  52
  53 <div class="page_header">
  54 <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>
  55 <a href="$Girocco::Config::gitweburl">$name</a> / $section / $heading
  56 </div>
  57
  58 EOT
  59
  60         bless $gcgi, $class;
  61 }
  62
  63 sub DESTROY {
  64         my $self = shift;
  65         if ($self->{srcname} and $Girocco::Config::giroccourl) {
  66                 my $hb = $Girocco::Config::giroccobranch ?
  67                         "hb=$Girocco::Config::giroccobranch;" : "";
  68                 print <<EOT;
  69 <div align="right">
  70 <a href="$Girocco::Config::giroccourl?a=blob;${hb}f=$self->{srcname}">(view source)</a>
  71 </div>
  72 EOT
  73         }
  74         print <<EOT;
  75 </body>
  76 </html>
  77 EOT
  78 }
  79
  80 sub cgi {
  81         my $self = shift;
  82         $self->{cgi};
  83 }
  84
  85 sub err {
  86         my $self = shift;
  87         print "<p style=\"color: red\">@_</p>\n";
  88         $self->{err}++;
  89 }
  90
  91 sub err_check {
  92         my $self = shift;
  93         my $err = $self->{err};
  94         my $s = $err == 1 ? '' : 's';
  95         $err and print "<p style=\"font-weight: bold\">Operation aborted due to $err error$s.</p>\n";
  96         $err;
  97 }
  98
  99 sub wparam {
 100         my $self = shift;
 101         my ($param) = @_;
 102         my $val = $self->{cgi}->param($param);
 103         defined $val and $val =~ s/^\s*(.*?)\s*$/$1/;
 104         $val;
 105 }
 106
 107 sub srcname {
 108         my $self = shift;
 109         my ($srcname) = @_;
 110         $self->{srcname} = $srcname if $srcname;
 111         $self->{srcname};
 112 }
 113
 114 sub html_esc {
 115         my ($str) = @_;
 116         $str =~ s/&/&amp;/g;
 117         $str =~ s/</&lt;/g; $str =~ s/>/&gt;/g;
 118         $str =~ s/"/&quot;/g;
 119         $str;
 120 }
 121
 122 sub print_form_fields {
 123         my $self = shift;
 124         my ($fieldmap, $valuemap, @fields) = @_;
 125
 126         foreach my $field (map { $fieldmap->{$_} } @fields) {
 127                 print '<tr><td class="formlabel">'.$field->[0].':</td><td>';
 128                 if ($field->[2] eq 'text') {
 129                         print '<input type="text" name="'.$field->[1].'" size="80"';
 130                         print ' value="'.$valuemap->{$field->[1]}.'"' if $valuemap;
 131                         print ' />';
 132                 } else {
 133                         print '<textarea name="'.$field->[1].'" rows="5" cols="80">';
 134                         print $valuemap->{$field->[1]} if $valuemap;
 135                         print '</textarea>';
 136                 }
 137                 print "</td></tr>\n";
 138         }
 139 }
 140
 141
 142 1;