cgi/Git/RepoCGI.pm

   1 package Git::RepoCGI;
   2
   3 use strict;
   4 use warnings;
   5
   6
   7 ### Administrativa
   8
   9 BEGIN {
  10         our $VERSION = '0.1';
  11         our @ISA = qw(Exporter);
  12         our @EXPORT = qw(scrypt 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 ### RepoCGI object
  21
  22 sub new {
  23         my $class = shift;
  24         my ($heading) = @_;
  25         my $repo = {};
  26
  27         $repo->{cgi} = CGI->new;
  28
  29         print $repo->{cgi}->header(-type=>'text/html', -charset => 'utf-8');
  30
  31         print <<EOT;
  32 <?xml version="1.0" encoding="utf-8"?>
  33 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
  34 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
  35
  36 <head>
  37 <title>repo.or.cz :: $heading</title>
  38 <link rel="stylesheet" type="text/css" href="/gitweb.css"/>
  39 <link rel="shortcut icon" href="/git-favicon.png" type="image/png"/>
  40 </head>
  41
  42 <body>
  43
  44 <div class="page_header">
  45 <a href="http://git.or.cz/" title="Git homepage"><img src="/git-logo.png" width="72" height="27" alt="git" style="float:right; border-width:0px;"/></a>
  46 <a href="/">repo.or.cz</a>
  47 <div class="search">
  48 Administration Interface
  49 </div>
  50 </div>
  51
  52 <h1>$heading</h1>
  53 EOT
  54
  55         bless $repo, $class;
  56 }
  57
  58 sub DESTROY {
  59         print <<EOT;
  60 </body>
  61 </html>
  62 EOT
  63 }
  64
  65 sub cgi {
  66         my $self = shift;
  67         $self->{cgi};
  68 }
  69
  70 sub err {
  71         my $self = shift;
  72         print "<p style=\"text-color: red\">@_</p>\n";
  73         $self->{err}++;
  74 }
  75
  76 sub err_check {
  77         my $self = shift;
  78         my $err = $self->{err};
  79         $err and print "<p>Operation aborted due to $err errors.</p>\n";
  80         $err;
  81 }
  82
  83 sub wparam {
  84         my $self = shift;
  85         my ($param) = @_;
  86         my $val = $self->{cgi}->param($param);
  87         $val =~ s/^\s*(.*?)\s*$/$1/;
  88         $val;
  89 }
  90
  91
  92 ### Random utility functions
  93
  94 sub scrypt {
  95         my ($pwd) = @_;
  96         crypt($pwd, join ('', ('.', '/', 2..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]));
  97 }
  98
  99 sub html_esc {
 100         my ($str) = @_;
 101         $str =~ s/&/&amp;/g;
 102         $str =~ s/</&lt;/g; $str =~ s/>/&gt;/g;
 103         $str =~ s/"/&quot;/g;
 104 }
 105
 106
 107 1;