lib/Packages/HTML.pm

   1 package Packages::HTML;
   2
   3 use strict;
   4 use warnings;
   5
   6 use URI::Escape;
   7 use HTML::Entities;
   8
   9 #use Packages::Util;
  10 #use Packages::I18N::Locale;
  11 #use Packages::I18N::Languages;
  12 #use Packages::I18N::LanguageNames;
  13 #use Generated::Strings qw( gettext dgettext );
  14
  15 # dummy routines
  16 sub get_charset { return "utf-8" };
  17 sub gettext { return $_[0]; };
  18
  19 our @ISA = qw( Exporter );
  20 our @EXPORT = qw( header title trailer file_changed time_stamp
  21                   read_md5_hash write_md5_hash simple_menu
  22                   ds_begin ds_item ds_end note title marker pdesc
  23                   pdeplegend pkg_list pmoreinfo );
  24
  25 our $HOME = "http://www.debian.org";
  26 our $CONTACT_MAIL = 'debian-www@lists.debian.org';
  27 our $WEBMASTER_MAIL = 'webmaster@debian.org';
  28 our $SEARCH_PAGE = "http://packages.debian.org/";
  29 our $CGI_ROOT = "http://packages.debian.org/cgi-bin";
  30 our $CN_HELP_URL = "${HOME}/intro/cn";
  31 our $CHANGELOG_URL = '/changelogs';
  32 our $COPYRIGHT_URL = '/changelogs';
  33 our $SEARCH_URL = '/cgi-bin/search_packages.pl?searchon=names&amp;version=all&amp;exact=1&amp;keywords=';
  34 our $SRC_SEARCH_URL = '/cgi-bin/search_packages.pl?searchon=sourcenames&amp;version=all&amp;exact=1&amp;keywords=';
  35 our $BUG_URL = 'http://bugs.debian.org/';
  36 our $SRC_BUG_URL = 'http://bugs.debian.org/src:';
  37 our $QA_URL = 'http://packages.qa.debian.org/';
  38
  39
  40 my %img_trans = ( pt_BR => "pt", pt_PT => "pt", sv_SE => "sv" );
  41
  42 sub img {
  43     my ( $root, $url, $src, $alt, %attr ) = @_;
  44     my @attr;
  45
  46     foreach my $a ( keys %attr ) {
  47         push @attr, "$a=\"$attr{$a}\"";
  48     }
  49
  50     return "<a href=\"$root$url\"><img src=\"$root$src\" alt=\"$alt\" @attr></a>";
  51 }
  52
  53 sub simple_menu {
  54     my $str = "";
  55     foreach my $entry (@_) {
  56         $str .= "[&nbsp;$entry->[0] <a title=\"$entry->[1]\" href=\"$entry->[2]\">$entry->[3]</a>&nbsp;]\n";
  57     }
  58     return $str;
  59 }
  60
  61 sub title {
  62     return "<h1>$_[0]</h1>\n";
  63 }
  64
  65 sub marker {
  66     return "[<span class=\"pred\">$_[0]</span>]";
  67 }
  68
  69 sub note {
  70     my ( $title, $note ) = @_;
  71     my $str = "";
  72
  73     if ($note) {
  74         $str .= "<h2 class=\"pred\">$title</h2>";
  75     } else {
  76         $note = $title;
  77     }
  78     $str .= "<p>$note</p>";
  79     return $str;
  80 }
  81
  82 sub pdesc {
  83     my ( $short_desc, $long_desc ) = @_;
  84     my $str = "";
  85
  86     $str .= "<div id=\"pdesc\">\n";
  87     $str .= "<h2>$short_desc</h2>\n";
  88
  89     $str .= "<p>$long_desc\n";
  90     $str .= "</div> <!-- end pdesc -->\n";
  91
  92     return $str;
  93 }
  94
  95 sub pdeplegend {
  96     my $str = "<table border=\"1\" summary=\"legend\"><tr>\n";
  97
  98     foreach my $entry (@_) {
  99         $str .= "<td><img src=\"../../Pics/$entry->[0].gif\" alt=\"[$entry->[0]]\" width=\"16\" height=\"16\">= $entry->[1]</td>";
 100     }
 101
 102     $str .= "\n</tr></table>\n";
 103     return $str;
 104 }
 105
 106 sub pkg_list {
 107     my ( $pkgs, $lang, $env ) = @_;
 108
 109     my $str = "";
 110     foreach my $p ( @$pkgs ) {
 111         my $p_pkg = $env->{db}->get_pkg( $p );
 112
 113         if ( $p_pkg ) {
 114             if ($p_pkg->is_virtual) {
 115                 $str .= "<dt><a href=\"../virtual/$p\">$p</a></dt>\n".
 116                     "\t<dd>".gettext("Virtual package")."</dd>\n";
 117             } else {
 118                 my %subsections = $p_pkg->get_arch_fields( 'section',
 119                                                            $env->{archs} );
 120                 my $subsection = $subsections{max_unique};
 121                 my %desc_md5s = $p_pkg->get_arch_fields( 'description-md5',
 122                                                          $env->{archs} );
 123                 my $short_desc = conv_desc( $lang,
 124                                             encode_entities( $env->{db}->get_short_desc( $desc_md5s{max_unique}, $lang ), "<>&\"" ) );
 125                 $str .= "<dt><a href=\"../$subsection/$p\">$p</a></dt>\n".
 126                     "\t<dd>$short_desc</dd>\n";
 127             }
 128         } else {
 129             $str .= "<dt>$p</dt>\n\t<dd>".gettext("Not available")."</dd>\n";
 130         }
 131     }
 132     if ($str) {
 133         $str = "<dl>$str</dl>\n";
 134     }
 135
 136     return $str;
 137 }
 138
 139 sub pmoreinfo {
 140     my %info = @_;
 141
 142     my $name = $info{name} or return;
 143     my $env = $info{env} or return;
 144     my $d = $info{data} or return;
 145     my $is_source = $info{is_source};
 146
 147     my $str = "<div id=\"pmoreinfo\">";
 148     $str .= sprintf( "<h2>".gettext( "More Information on %s" )."</h2>",
 149                      $name );
 150
 151
 152     if ($info{bugreports}) {
 153         my $bug_url = $is_source ? $SRC_BUG_URL : $BUG_URL;
 154         $str .= "<p>\n".sprintf( gettext( "Check for <a href=\"%s\">Bug Reports</a> about %s." )."<br>\n",
 155                          $bug_url.$name, $name );
 156     }
 157
 158     if ($info{sourcedownload}) {
 159         $str .= gettext( "Source Package:" );
 160         $str .= " <a href=\"../source/$d->{src_name}\">$d->{src_name}</a>, ".
 161             gettext( "Download" ).":\n";
 162
 163         unless ($d->{src_files}) {
 164             $str .= gettext( "Not found" );
 165         } else {
 166             foreach( @{$d->{src_files}} ) {
 167                 my ($src_file_md5, $src_file_size, $src_file_name) = @$_;
 168                 if ($d->{is_security}) {
 169                     $str .= "<a href=\"$env->{opts}{security_site}/$d->{src_directory}/$src_file_name\">[";
 170                 } elsif ($d->{is_volatile}) {
 171                     $str .= "<a href=\"$env->{opts}{volatile_site}/$d->{src_directory}/$src_file_name\">[";
 172                 } elsif ($d->{is_nonus}) {
 173                     $str .= "<a href=\"$env->{opts}{nonus_site}/$d->{src_directory}/$src_file_name\">[";
 174                 } else {
 175                     $str .= "<a href=\"$env->{opts}{debian_site}/$d->{src_directory}/$src_file_name\">[";
 176                 }
 177                 if ($src_file_name =~ /dsc$/) {
 178                     $str .= "dsc";
 179                 } else {
 180                     $str .= $src_file_name;
 181                 }
 182                 $str .= "]</a>\n";
 183             }
 184         }
 185 #           $package_page .= sprintf( gettext( " (These sources are for version %s)\n" ), $src_version )
 186 #               if ($src_version ne $version) && !$src_version_given_in_control;
 187     }
 188
 189     if ($info{changesandcopy}) {
 190         if ( $d->{src_directory} ) {
 191             my $src_dir = $d->{src_directory};
 192             (my $src_basename = $d->{src_version}) =~ s,^\d+:,,; # strip epoche
 193             $src_basename = "$d->{src_name}_$src_basename";
 194             $src_dir =~ s,pool/updates,pool,o;
 195             $src_dir =~ s,pool/non-US,pool,o;
 196             $str .= "<br>".sprintf( gettext( "View the <a href=\"%s\">Debian changelog</a>" ),
 197                                     "$CHANGELOG_URL/$src_dir/$src_basename/changelog" )."<br>\n";
 198             my $copyright_url = "$COPYRIGHT_URL/$src_dir/$src_basename/";
 199             $copyright_url .= ( $is_source ? 'copyright' : "$name.copyright" );
 200
 201             $str .= sprintf( gettext( "View the <a href=\"%s\">copyright file</a>" ),
 202                              $copyright_url )."</p>";
 203         }
 204     }
 205
 206     if ($info{maintainers}) {
 207         my @uploaders = @{$d->{uploaders}};
 208         foreach (@uploaders) {
 209             $_->[0] = encode_entities( $_->[0], '&<>' );
 210         }
 211         my ($maint_name, $maint_mail ) = @{shift @uploaders};
 212         unless (@uploaders) {
 213             $str .= "<p>\n".sprintf( gettext( "%s is responsible for this Debian package." ).
 214                                      "\n",
 215                                      "<a href=\"mailto:$maint_mail\">$maint_name</a>"
 216                                      );
 217         } else {
 218             my $up_str = "<a href=\"mailto:$maint_mail\">$maint_name</a>";
 219             my @uploaders_str;
 220             foreach (@uploaders) {
 221                 push @uploaders_str, "<a href=\"mailto:$_->[1]\">$_->[0]</a>";
 222             }
 223             my $last_up = pop @uploaders_str;
 224             $up_str .= ", ".join ", ", @uploaders_str if @uploaders_str;
 225             $up_str .= sprintf( gettext( " and %s are responsible for this Debian package." ), $last_up );
 226             $str .= "<p>\n$up_str ";
 227         }
 228
 229         $str .= sprintf( gettext( "See the <a href=\"%s\">developer information for %s</a>." )."</p>", $QA_URL.$d->{src_name}, $name );
 230     }
 231
 232     if ($info{search}) {
 233         my $encodedname = uri_escape( $name );
 234         my $search_url = $is_source ? $SRC_SEARCH_URL : $SEARCH_URL;
 235         $str .= "<p>".sprintf( gettext( "Search for <a href=\"%s\">other versions of %s</a>" ), $search_url.$encodedname, $name )."</p>\n";
 236     }
 237
 238     $str .= "</div> <!-- end pmoreinfo -->\n";
 239     return $str;
 240 }
 241
 242 my $ds_begin = '<dl>';
 243 my $ds_item_desc  = '<dt>';
 244 my $ds_item = ':</dt><dd>';
 245 my $ds_item_end = '</dd>';
 246 my $ds_end = '</dl>';
 247 #           my $ds_begin = '<table><tbody>';
 248 #           my $ds_item_desc  = '<tr><td>';
 249 #           my $ds_item = '</td><td>';
 250 #           my $ds_item_end = '</td></tr>';
 251 #           my $ds_end = '</tbody></table>';
 252
 253 sub ds_begin {
 254     return $ds_begin;
 255 }
 256 sub ds_item {
 257     return "$ds_item_desc$_[0]$ds_item$_[1]$ds_item_end\n";
 258 }
 259 sub ds_end {
 260     return $ds_end;
 261 }
 262
 263 sub header {
 264     my (%params) = @_;
 265
 266     my $DESC_LINE;
 267     if (defined $params{desc}) {
 268         $DESC_LINE = "<meta name=\"Description\" content=\"$params{desc}\">";
 269     }
 270     else {
 271         $DESC_LINE = '';
 272     }
 273
 274     my $title_keywords = $params{title_keywords} || $params{title} || '';
 275     my $title_tag = $params{title_tag} || $params{title} || '';
 276     my $title_in_header = $params{page_title} || $params{title} || '';
 277     my $page_title = $params{page_title} || $params{title} || '';
 278     my $meta = $params{meta} || '';
 279
 280     if ($params{print_title_above}) {
 281         $title_in_header = "<h1>$title_in_header</h1>";
 282     } else {
 283         $title_in_header = '';
 284     }
 285
 286     my $search_in_header = '';
 287     $params{print_search_field} ||= "";
 288     if ($params{print_search_field} eq 'packages') {
 289         my %values = %{$params{search_field_values}};
 290         my %checked_searchon = ( names => "",
 291                                  all => "",
 292                                  sourcenames => "", );
 293         $checked_searchon{$values{searchon}} = "checked=\"checked\"";
 294         $search_in_header = <<MENU;
 295 <form method="GET" action="$CGI_ROOT/search_packages.pl">
 296 <div id="hpacketsearch">
 297 <input type="hidden" name="suite" value="$values{suite}">
 298 <input type="hidden" name="subword" value="$values{subword}">
 299 <input type="hidden" name="exact" value="$values{exact}">
 300 <input type="hidden" name="arch" value="$values{arch}">
 301 <input type="hidden" name="section" value="$values{section}">
 302 <input type="hidden" name="case" value="$values{case}">
 303 <input type="text" size="30" name="keywords" value="$values{keywords}" id="kw">
 304 <input type="submit" value="Search">
 305 <span style="font-size: 60%"><a href="$SEARCH_PAGE#search_packages">Full options</a></span>
 306 <br>
 307 <div style="font-size: 80%">Search on:
 308 <input type="radio" name="searchon" value="names" id="onlynames" $checked_searchon{names}>
 309 <label for="onlynames">Package names only</label>&nbsp;&nbsp;
 310 <input type="radio" name="searchon" value="all" id="descs" $checked_searchon{all}>
 311 <label for="descs">Descriptions</label>
 312 <br>
 313 <input type="radio" name="searchon" value="sourcenames" id="src" $checked_searchon{sourcenames}>
 314 <label for="src">Source package names</label>
 315 </div>
 316 </div> <!-- end hpacketsearch -->
 317 </form>
 318 MENU
 319 ;
 320     } elsif ($params{print_search_field} eq 'contents') {
 321         my %values = %{$params{search_field_values}};
 322         my %checked_searchmode = ( searchfiles => "",
 323                                    searchfilesanddirs => "",
 324                                    searchword => "",
 325                                    filelist => "", );
 326         $checked_searchmode{$values{searchmode}} = "checked=\"checked\"";
 327         $search_in_header = <<MENU;
 328 <form method="GET" action="$CGI_ROOT/search_contents.pl">
 329 <div id="hpacketsearch">
 330 <input type="hidden" name="version" value="$values{version}" />
 331 <input type="hidden" name="arch" value="$values{arch}" />
 332 <input type="hidden" name="case" value="$values{case}" />
 333 <input type="text" size="30" name="word" id="keyword" value="$values{keyword}">&nbsp;
 334 <input type="submit" value="Search">
 335 <span style="font-size: 60%"><a href="$SEARCH_PAGE#search_contents">Full options</a></span>
 336 <br>
 337 <div style="font-size: 80%">Display:
 338 <input type=radio name="searchmode" value="searchfiles" id="searchfiles" $checked_searchmode{searchfiles}>
 339 <label for="searchfiles">files</label>
 340 <input type=radio name="searchmode" value="searchfilesanddirs" id="searchfilesanddirs" $checked_searchmode{searchfilesanddirs}>
 341 <label for="searchfilesanddirs">files &amp; directories</label>
 342 <br>
 343 <input type=radio name="searchmode" value="searchword" id="searchword" $checked_searchmode{searchword}>
 344 <label for="searchword">subword matching</label>
 345 <input type=radio name="searchmode" value="filelist" id="filelist" $checked_searchmode{filelist}>
 346 <label for="filelist">content list</label>
 347 </div>
 348 </div> <!-- end hpacketsearch -->
 349 </form>
 350 MENU
 351 ;
 352     }
 353
 354     my $keywords = $params{keywords} || '';
 355     my $KEYWORDS_LINE = "<meta name=\"Keywords\" content=\"debian, $keywords $title_keywords\">";
 356
 357     my $LANG = $params{lang};
 358     my $img_lang = $img_trans{$LANG} || $LANG;
 359     my $charset = get_charset($LANG);
 360     my $txt = <<HEAD;
 361 <!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
 362 <html lang="$LANG">
 363 <head>
 364 <title>Debian -- $title_tag</title>
 365 <link rev="made" href="mailto:$WEBMASTER_MAIL">
 366 <meta http-equiv="Content-Type" content="text/html; charset=$charset">
 367 <meta name="Author" content="Debian Webmaster, $WEBMASTER_MAIL">
 368 $KEYWORDS_LINE
 369 $DESC_LINE
 370 $meta
 371 <link href="$HOME/debian.css" rel="stylesheet" type="text/css" media="all">
 372 </head>
 373 <body>
 374 <div id="header">
 375    <div id="upperheader">
 376    <div id="logo">
 377   <a href="$HOME/"><img src="$HOME/logos/openlogo-nd-50.png" alt="" /></a>
 378 HEAD
 379 ;
 380
 381     $txt .= img( "$HOME/", "", "Pics/debian.png", gettext( "Debian Project" ),
 382                  width => 179, height => 61 );
 383     $txt .= <<HEADEND;
 384
 385 </div> <!-- end logo -->
 386 HEADEND
 387 ;
 388
 389     $txt .= <<NAVBEGIN;
 390 $search_in_header
 391 </div> <!-- end upperheader -->
 392
 393 NAVBEGIN
 394 ;
 395 # $title_in_header
 396     $txt .= "<p class=\"hidecss\"><a href=\"\#inner\">" . gettext("Skip Site Navigation")."</a></p>\n";
 397     $txt .= "<div id=\"navbar\">\n<ul>".
 398         "<li><a href=\"$HOME/intro/about\">".gettext( "About&nbsp;Debian" )."</a></li>\n".
 399         "<li><a href=\"$HOME/News/\">".gettext( "News" )."</a></li>\n".
 400         "<li><a href=\"$HOME/distrib/\">".gettext( "Getting&nbsp;Debian" )."</a></li>\n".
 401         "<li><a href=\"$HOME/support\">".gettext( "Support" )."</a></li>\n".
 402         "<li><a href=\"$HOME/devel/\">".gettext( "Development" )."</a></li>\n".
 403         "<li><a href=\"$HOME/sitemap\">".gettext( "Site map" )."</a></li>\n".
 404         "<li><a href=\"http://search.debian.org/\">".gettext( "Search" )."</a></li>\n";
 405     $txt .= "</ul>\n";
 406     $txt .= <<ENDNAV;
 407 </div> <!-- end navbar -->
 408 </div> <!-- end header -->
 409 ENDNAV
 410 ;
 411     $txt .= <<BEGINCONTENT;
 412 <div id="outer">
 413 <div id="inner">
 414
 415 BEGINCONTENT
 416 ;
 417     if ($params{print_title_above}) {
 418         $txt .= "<h1>$page_title</h1>\n";
 419     }
 420     if ($params{print_title_below}) {
 421         $txt .= "<h1>$page_title</h1>\n";
 422     }
 423
 424     return $txt;
 425 }
 426
 427 sub trailer {
 428     my ($ROOT, $NAME, $LANG, @USED_LANGS) = @_;
 429     my $txt = "</div> <!-- end inner -->\n<div id=\"footer\">\n";
 430     my $langs = languages( $NAME, $LANG, @USED_LANGS );
 431     my $bl_class = $langs ? ' class="bordertop"' : "";
 432     $txt .=
 433         $langs.
 434         "\n<hr class=\"hidecss\">\n" .
 435         "<p$bl_class>".
 436         sprintf( gettext( "Back to: <a href=\"%s/\">Debian Project homepage</a> || <a href=\"%s/\">Packages search page</a>" ), $HOME, $ROOT ).
 437         "</p>\n<hr class=\"hidecss\">\n".
 438         "<div id=\"fineprint\" class=\"bordertop\"><p>".
 439         sprintf( gettext( "To report a problem with the web site, e-mail <a href=\"mailto:%s\">%s</a>. For other contact information, see the Debian <a href=\"%s/contact\">contact page</a>." ), $CONTACT_MAIL, $CONTACT_MAIL, $HOME).
 440         "</p>\n".
 441         "<p>". gettext( "Last Modified: " ). "LAST_MODIFIED_DATE".
 442         "<br>\n".
 443         sprintf( gettext( "Copyright &copy; 1997-2005 <a href=\"http://www.spi-inc.org\">SPI</a>; See <a href=\"%s/license\">license terms</a>." ), "$HOME/" )."<br>\n".
 444         gettext( "Debian is a registered trademark of Software in the Public Interest, Inc." ).
 445         "</div> <!-- end fineprint -->\n".
 446         "</div> <!-- end footer -->\n".
 447         "</div> <!-- end outer -->\n".
 448         "</body>\n</html>\n";
 449
 450     return $txt;
 451 }
 452
 453 sub languages {
 454     my ( $name, $lang, @used_langs ) = @_;
 455
 456     my $str = "";
 457
 458     if (@used_langs) {
 459         $str .= "<hr class=\"hidecss\">\n";
 460         $str .= "<!--UdmComment-->\n<p>\n";
 461         $str .= gettext( "This page is also available in the following languages:\n" );
 462         $str .= "</p><p class=\"navpara\">\n";
 463
 464         my @printed_langs = ();
 465         foreach (@used_langs) {
 466             next if $_ eq $lang; # Never print the current language
 467             unless (get_selfname($_)) { warn "missing language $_"; next } #DEBUG
 468             push @printed_langs, $_;
 469         }
 470         return "" unless scalar @printed_langs;
 471         # Sort on uppercase to work with languages which use lowercase initial
 472         # letters.
 473         foreach my $cur_lang (sort langcmp @printed_langs) {
 474             my $tooltip = dgettext( "langs", get_language_name($cur_lang) );
 475             $str .= "<a href=\"$name.$cur_lang.html\" title=\"$tooltip\" hreflang=\"$cur_lang\" lang=\"$cur_lang\" rel=\"alternate\">".get_selfname($cur_lang);
 476             $str .= " (".get_transliteration($cur_lang).")" if defined get_transliteration($cur_lang);
 477             $str .= "</a>\n";
 478         }
 479         $str .= "\n</p><p>\n";
 480         $str .= sprintf( gettext( "How to set <a href=\"%s\">the default document language</a></p>" ), $CN_HELP_URL );
 481         $str .= "\n<!--/UdmComment-->\n";
 482     }
 483
 484     return $str;
 485 }
 486
 487 1;