Girocco/CGI.pm

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