selfforum-cgi/shared/Posting/_lib.pm

   1 package Posting::_lib;
   2
   3 ################################################################################
   4 #                                                                              #
   5 # File:        shared/Posting/_lib.pm                                          #
   6 #                                                                              #
   7 # Authors:     André Malo <nd@o3media.de>, 2001-06-11                          #
   8 #              Frank Schoenmann <fs@tower.de>, 2001-06-04                      #
   9 #                                                                              #
  10 # Description: Message access interface, time format routines                  #
  11 #                                                                              #
  12 ################################################################################
  13
  14 use strict;
  15
  16 use Encode::Plain; $Encode::Plain::utf8 = 1;
  17
  18 use Time::German;
  19 use XML::DOM;
  20
  21 # ====================================================
  22 # Export
  23 # ====================================================
  24
  25 use constant SORT_ASCENT  => 0; # (young postings first)
  26 use constant SORT_DESCENT => 1;
  27 use constant KEEP_DELETED => 1;
  28 use constant KILL_DELETED => 0;
  29
  30 use base qw(Exporter);
  31 @Posting::_lib::EXPORT_OK = qw(
  32   get_message_header
  33   get_message_body
  34   get_message_node
  35   get_body_node
  36   parse_single_thread
  37   parse_xml_file
  38   create_new_thread
  39   create_message
  40
  41   hr_time
  42   short_hr_time
  43   long_hr_time
  44   very_short_hr_time
  45   month
  46
  47   get_all_threads
  48   create_forum_xml_string
  49
  50   save_file
  51
  52   SORT_ASCENT
  53   SORT_DESCENT
  54   KEEP_DELETED
  55   KILL_DELETED
  56 );
  57
  58 # ====================================================
  59 # Access via XML::DOM
  60 # ====================================================
  61
  62 ### sub create_message ($$) ####################################################
  63 #
  64 # create the 'Message' subtree
  65 #
  66 # Params: $xml - XML::DOM::Document object
  67 #         $par - hash reference
  68 #                (msg, ip, name, email, home, image, category, subject, time)
  69 #
  70 # Return: XML::DOM::Element object
  71 #
  72 sub create_message ($$) {
  73   my ($xml,$par) = @_;
  74
  75   my $message = $xml -> createElement ('Message');
  76   $message -> setAttribute ('id' => $par -> {msg});
  77   $message -> setAttribute ('ip' => $par -> {ip});
  78
  79   my $header = $xml -> createElement ('Header');
  80   my $author = $xml -> createElement ('Author');
  81   $header  -> appendChild ($author);
  82
  83   my @may = (
  84     ['name'     => 'Name'        => $author],
  85     ['email'    => 'Email'       => $author],
  86     ['home'     => 'HomepageUrl' => $author],
  87     ['image'    => 'ImageUrl'    => $author],
  88     ['category' => 'Category'    => $header],
  89     ['subject'  => 'Subject'     => $header]
  90   );# key       => element name  => superior
  91
  92   for (@may) {
  93
  94     # create element
  95     my $obj = $xml -> createElement ($_->[1]);
  96
  97     # insert content
  98     $obj -> addText (
  99         defined $par -> {$_->[0]}
 100       ? $par -> {$_->[0]}
 101       : ''
 102     );
 103
 104     # link to superior element
 105     $_ -> [2] -> appendChild ($obj);
 106   }
 107
 108   my $date = $xml -> createElement ('Date');
 109   $date -> setAttribute ('longSec'=> $par -> {time});
 110
 111   $header  -> appendChild ($date);
 112   $message -> appendChild ($header);
 113
 114   # return
 115   #
 116   $message;
 117 }
 118
 119 ### sub create_new_thread ($) ##################################################
 120 #
 121 # create a XML::DOM::Document object of a thread containing one posting
 122 #
 123 # Params: hash reference
 124 #         (dtd, thread, msg, body, ip, name, email, home,
 125 #          image, category, subject, time)
 126 #
 127 # Return: XML::DOM::Document object
 128 #
 129 sub create_new_thread ($) {
 130   my $par = shift;
 131
 132   # new document
 133   #
 134   my $xml = new XML::DOM::Document;
 135
 136   # xml declaration
 137   #
 138   my $decl = new XML::DOM::XMLDecl;
 139   $decl -> setVersion  ('1.0');
 140   $decl -> setEncoding ('UTF-8');
 141   $xml -> setXMLDecl ($decl);
 142
 143   # set doctype
 144   #
 145   my $dtd = $xml -> createDocumentType ('Forum' => $par -> {dtd});
 146   $xml -> setDoctype ($dtd);
 147
 148   # create root element 'Forum'
 149   # create element 'Thread'
 150   # create 'Message' subtree
 151   # create element 'ContentList'
 152   # create 'MessageContent' subtree
 153   #
 154   my $forum    = $xml -> createElement ('Forum');
 155   my $thread   = $xml -> createElement ('Thread');
 156     $thread -> setAttribute ('id' => $par -> {thread});
 157   my $message  = create_message ($xml,$par);
 158   my $content  = $xml -> createElement ('ContentList');
 159   my $mcontent = $xml -> createElement ('MessageContent');
 160     $mcontent -> setAttribute ('mid' => $par -> {msg});
 161     $mcontent -> appendChild (
 162       $xml -> createCDATASection (${$par -> {body}})
 163     );
 164
 165   # link all the nodes to
 166   # their superior elements
 167   #
 168   $thread  -> appendChild ($message);
 169   $forum   -> appendChild ($thread);
 170   $content -> appendChild ($mcontent);
 171   $forum   -> appendChild ($content);
 172   $xml     -> appendChild ($forum);
 173
 174   # return
 175   #
 176   $xml;
 177 }
 178
 179 ### get_message_header () ######################################################
 180 #
 181 # Read message header, return as a hash
 182 #
 183 # Params: $node - XML message node
 184 # Return: hash reference (name, category, subject, email, home, image, time)
 185 #
 186 sub get_message_header ($)
 187 {
 188   my $node = shift;
 189   my %conf;
 190
 191   my $header    = $node   -> getElementsByTagName ('Header'     , 0) -> item (0);
 192     my $author  = $header -> getElementsByTagName ('Author'     , 0) -> item (0);
 193       my $name  = $author -> getElementsByTagName ('Name'       , 0) -> item (0);
 194       my $email = $author -> getElementsByTagName ('Email'      , 0) -> item (0);
 195       my $home  = $author -> getElementsByTagName ('HomepageUrl', 0) -> item (0);
 196       my $image = $author -> getElementsByTagName ('ImageUrl'   , 0) -> item (0);
 197     my $cat     = $header -> getElementsByTagName ('Category'   , 0) -> item (0);
 198     my $subject = $header -> getElementsByTagName ('Subject'    , 0) -> item (0);
 199     my $date    = $header -> getElementsByTagName ('Date'       , 0) -> item (0);
 200
 201   %conf = (
 202     name     => ($name    -> hasChildNodes)?$name    -> getFirstChild -> getData:undef,
 203     category => ($cat     -> hasChildNodes)?$cat     -> getFirstChild -> getData:undef,
 204     subject  => ($subject -> hasChildNodes)?$subject -> getFirstChild -> getData:undef,
 205     email    => (defined ($email) and $email -> hasChildNodes)?$email -> getFirstChild -> getData:undef,
 206     home     => (defined ($home)  and $home  -> hasChildNodes)?$home  -> getFirstChild -> getData:undef,
 207     image    => (defined ($image) and $image -> hasChildNodes)?$image -> getFirstChild -> getData:undef,
 208     time     => $date -> getAttribute ('longSec')
 209   );
 210
 211   \%conf;
 212 }
 213
 214 ### get_body_node () ########################################################
 215 #
 216 # Search a specific message body in a XML tree
 217 #
 218 # Params: $xml  XML::DOM::Document Object (Document Node)
 219 #         $mid  Message ID
 220 #
 221 # Return: MessageContent XML node (or -none-)
 222 #
 223 sub get_body_node ($$)
 224 {
 225   my ($xml, $mid) = @_;
 226
 227   for ($xml -> getElementsByTagName ('ContentList', 1) -> item (0) -> getElementsByTagName ('MessageContent', 0)) {
 228     return $_ if ($_ -> getAttribute ('mid') eq $mid);
 229   }
 230
 231   return;
 232 }
 233
 234 ### get_message_body () ########################################################
 235 #
 236 # Read message body
 237 #
 238 # Params: $xml  XML::DOM::Document Object (Document Node)
 239 #         $mid  Message ID
 240 #
 241 # Return: Scalar reference
 242 #
 243 sub get_message_body ($$)
 244 {
 245   my $cnode = get_body_node ($_[0], $_[1]);
 246   my $body;
 247
 248   $body = ($cnode -> hasChildNodes)?$cnode -> getFirstChild -> getData:'' if $cnode;
 249
 250   \$body;
 251 }
 252
 253 ### get_message_node () ########################################################
 254 #
 255 # Search a specific message in a XML tree
 256 #
 257 # Params: $xml  XML::DOM::Document Object (Document Node)
 258 #         $tid  Thread ID
 259 #         $mid  Message ID
 260 #
 261 # Return: Message XML node, Thread XML node (or -none-)
 262 #
 263 sub get_message_node ($$$)
 264 {
 265   my ($xml, $tid, $mid) = @_;
 266   my ($mnode, $tnode);
 267
 268   for ($xml->getElementsByTagName ('Thread')) {
 269     if ($_->getAttribute ('id') eq $tid) {
 270       $tnode = $_;
 271
 272       for ($tnode -> getElementsByTagName ('Message')) {
 273         if ($_ -> getAttribute ('id') eq $mid) {
 274           $mnode = $_;
 275           last;
 276         }
 277       }
 278       last;
 279     }
 280   }
 281
 282   wantarray
 283   ? ($mnode, $tnode)
 284   : $mnode;
 285 }
 286
 287 ### sub parse_xml_file ($) #####################################################
 288 #
 289 # load the specified XML-File and create the DOM tree
 290 # this sub is only to avoid errors and to centralize the parse process
 291 #
 292 # Params: $file filename
 293 #
 294 # Return: XML::DOM::Document Object (Document Node) or false
 295 #
 296 sub parse_xml_file ($) {
 297   my $file = shift;
 298
 299   my $xml = eval {
 300     local $SIG{__DIE__};      # CGI::Carp works unreliable ;-(
 301     new XML::DOM::Parser(KeepCDATA => 1)->parsefile ($file);
 302   };
 303
 304   return if ($@);
 305
 306   $xml;
 307 }
 308
 309 ###########################
 310 # sub parse_single_thread
 311 #
 312 # einzelne Threaddatei
 313 # parsen
 314 ###########################
 315
 316 sub parse_single_thread ($$;$) {
 317   my ($tnode, $deleted, $sorted) = @_;
 318   my ($header, @msg, %mno);
 319
 320   for ($tnode -> getElementsByTagName ('Message')) {
 321     $header = get_message_header ($_);
 322
 323     push @msg,{mid     => ($_ -> getAttribute ('id') =~ /(\d+)/)[0],
 324                ip      => $_ -> getAttribute ('ip'),
 325                kids    => [$_ -> getElementsByTagName ('Message', 0)],
 326                answers => $_ -> getElementsByTagName ('Message') -> getLength,
 327                deleted => $_ -> getAttribute ('invisible'),
 328                archive => $_ -> getAttribute ('archive'),
 329                name    => plain($header -> {name}),
 330                cat     => plain($header -> {category} or ''),
 331                subject => plain($header -> {subject}),
 332                time    => plain($header -> {time})};
 333     $mno{$_} = $#msg;}
 334
 335   # Eintraege ergaenzen und korrigieren
 336   my $level;
 337   $msg[0] -> {level} = 0;
 338   for (@msg) {
 339     $level = $_ -> {level} + 1;
 340     @{$_ -> {kids}} = map {$msg[$mno{$_}] -> {level} = $level; $mno{$_}} @{$_ -> {kids}};}
 341
 342   # ============
 343   # Sortieren und bei Bedarf
 344   # geloeschte Messages entfernen
 345
 346   my $smsg = sort_thread (\@msg, $sorted);
 347   delete_messages ($smsg) unless ($deleted);
 348
 349   $smsg;
 350 }
 351
 352 ###########################
 353 # sub create_message_xml
 354 #
 355 # Message-XML-String
 356 # erzeugen
 357 ###########################
 358
 359 sub create_message_xml ($$$) {
 360   my ($xml, $msges, $num) = @_;
 361
 362   my $msg = $msges -> [$num];
 363
 364   my $message = $xml -> createElement ('Message');
 365   $message -> setAttribute ('id', 'm'.$msg -> {mid});
 366   $message -> setAttribute ('invisible', '1') if ($msg -> {deleted});
 367   $message -> setAttribute ('archive', '1') if ($msg -> {archive});
 368
 369   # Header erzeugen
 370   my $header   = $xml -> createElement ('Header');
 371
 372   # alles inside of 'Header'
 373   my $author   = $xml -> createElement ('Author');
 374
 375   my $name     = $xml -> createElement ('Name');
 376   $name -> addText (toUTF8($msg -> {name}));
 377
 378   my $email    = $xml -> createElement ('Email');
 379
 380   my $category = $xml -> createElement ('Category');
 381   $category -> addText (toUTF8($msg -> {cat}));
 382
 383   my $subject  = $xml -> createElement ('Subject');
 384   $subject -> addText (toUTF8($msg -> {subject}));
 385
 386   my $date     = $xml -> createElement ('Date');
 387   $date -> setAttribute ('longSec', $msg -> {time});
 388
 389     $author -> appendChild ($name);
 390     $author -> appendChild ($email);
 391     $header -> appendChild ($author);
 392     $header -> appendChild ($category);
 393     $header -> appendChild ($subject);
 394     $header -> appendChild ($date);
 395   $message -> appendChild ($header);
 396
 397   if ($msg -> {kids}) {
 398     for (@{$msg -> {kids}}) {
 399       $message -> appendChild (&create_message_xml ($xml, $msges, $_));
 400     }
 401   }
 402
 403   $message;
 404 }
 405
 406 # ====================================================
 407 # XML-Parsen von Hand
 408 # ====================================================
 409
 410 ###########################
 411 # sub sort_thread
 412 #
 413 # Messages eines
 414 # Threads sortieren
 415 ###########################
 416
 417 sub sort_thread ($$) {
 418   my ($msg, $sorted) = @_;
 419
 420   my ($z, %mhash) = (0);
 421
 422   if ($sorted) {  # aelteste zuerst
 423     for (@$msg) {
 424       @$msg[@{$_ -> {kids}}] = sort {$a -> {mid} <=> $b -> {mid}} @$msg[@{$_ -> {kids}}] if (@{$_ -> {kids}} > 1);
 425       $mhash{$_ -> {mid}} = [@$msg[@{$_ -> {kids}}]];}}
 426
 427   else {          # juengste zuerst
 428     for (@$msg) {
 429       @$msg[@{$_ -> {kids}}] = sort {$b -> {mid} <=> $a -> {mid}} @$msg[@{$_ -> {kids}}] if (@{$_ -> {kids}} > 1);
 430       $mhash{$_ -> {mid}} = [@$msg[@{$_ -> {kids}}]];}}
 431
 432   # Kinder wieder richtig einsortieren
 433   my @smsg = ($msg -> [0]);
 434   for (@smsg) {
 435     ++$z;
 436     splice @smsg,$z,0,@{$mhash{$_ -> {mid}}} if ($_ -> {answers});
 437     delete $_ -> {kids};}
 438
 439   \@smsg;
 440 }
 441
 442 ### delete_messages () #########################################################
 443 #
 444 # Filter out deleted messages
 445 #
 446 # Params: $smsg  Reference of array of references of hashs
 447 # Return: -none-
 448 #
 449 sub delete_messages ($) {
 450   my $smsg = shift;
 451   my ($z, $oldlevel, @path) = (0,0,0);
 452
 453   while ($z <= $#{$smsg}) {
 454
 455     if ($smsg -> [$z] -> {level} > $oldlevel) {
 456       push @path => $z;
 457       $oldlevel = $smsg -> [$z] -> {level};
 458     }
 459     elsif ($smsg -> [$z] -> {level} < $oldlevel) {
 460       splice @path, $smsg -> [$z] -> {level};
 461       push @path => $z;
 462       $oldlevel = $smsg -> [$z] -> {'level'};
 463     }
 464     else {
 465       $path[-1] = $z;
 466     }
 467
 468     if ($smsg -> [$z] -> {deleted}) {
 469       my $n = $smsg -> [$z] -> {answers} + 1;
 470       $smsg -> [$_] -> {answers} -= $n for (@path);
 471       splice @$smsg, $z, $n;
 472     }
 473     else {
 474       $z++;
 475     }
 476   }
 477
 478   return;
 479 }
 480
 481 ### get_all_threads () #########################################################
 482 #
 483 # Read and Parse the main file (without any XML-module, they are too slow)
 484 #
 485 # Params: $file    - /path/to/filename of the main file
 486 #         $deleted - hold deleted (invisible) messages in result (1) oder not (0)
 487 #         $sorted  - direction of message sort: descending (0) (default) or ascending (1)
 488 #
 489 # Return: scalar context: hash reference (\%threads)
 490 #           list context: list (\%threads, $last_thread, $last_message, $dtd, \@unids)
 491 #
 492 sub get_all_threads ($$;$) {
 493   my ($file, $deleted, $sorted) = @_;
 494   my ($last_thread, $last_message, $dtd, @unids, %threads);
 495   local (*FILE, $/);
 496
 497   open FILE,"< $file" or return;
 498   my $xml = join '', <FILE>;
 499   close(FILE) or return;
 500
 501   if (wantarray) {
 502     ($dtd)          = $xml =~ /<!DOCTYPE\s+\S+\s+SYSTEM\s+"([^"]+)">/;
 503     ($last_thread)  = map {/(\d+)/} $xml =~ /<Forum.+?lastThread="([^"]+)"[^>]*>/;
 504     ($last_message) = map {/(\d+)/} $xml =~ /<Forum.+?lastMessage="([^"]+)"[^>]*>/;
 505   }
 506
 507   my $reg_msg = qr~(?:</Message>
 508                      |<Message\s+id="m(\d+)"\s+unid="([^"]*)"(?:\s+invisible="([^"]*)")?(?:\s+archive="([^"]*)")?[^>]*>\s*
 509                       <Header>[^<]*(?:<(?!Name>)[^<]*)*
 510                         <Name>([^<]+)</Name>[^<]*(?:<(?!Category>)[^<]*)*
 511                         <Category>([^<]*)</Category>\s*
 512                         <Subject>([^<]+)</Subject>\s*
 513                         <Date\s+longSec="(\d+)"[^>]*>\s*
 514                       </Header>\s*(?:(<)/Message>|(?=(<)Message\s*)))~sx;
 515
 516   while ($xml =~ /<Thread id="t(\d+)">([^<]*(?:<(?!\/Thread>)[^<]*)*)<\/Thread>/g)
 517   {
 518     my ($tid, $thread) = ($1, $2);
 519     my ($level, $cmno, @msg, @stack) = (0);
 520
 521     while ($thread =~ m;$reg_msg;g)
 522     {
 523       if (defined($10))
 524       {
 525         push @stack,$cmno if (defined $cmno);
 526         push @msg, {
 527           mid     => $1,
 528           unid    => $2,
 529           deleted => $3 || 0,
 530           archive => $4 || 0,
 531           name    => $5,
 532           cat     => $6,
 533           subject => $7,
 534           time    => $8,
 535           level   => $level++,
 536           unids   => [],
 537           kids    => [],
 538           answers => 0
 539         };
 540
 541         if (defined $cmno)
 542         {
 543           push @{$msg[$cmno] -> {kids}}  => $#msg;
 544           push @{$msg[$cmno] -> {unids}} => $2;
 545         }
 546         else
 547         {
 548           push @unids => $2;
 549         }
 550
 551         $msg[$_] -> {answers}++ for (@stack);
 552
 553         $cmno=$#msg;
 554
 555         $msg[-1] -> {name}    =~ s/&amp;/&/g;
 556         $msg[-1] -> {cat}     =~ s/&amp;/&/g;
 557         $msg[-1] -> {subject} =~ s/&amp;/&/g;
 558
 559       }
 560       elsif (defined ($9))
 561       {
 562         push @msg, {
 563           mid     => $1,
 564           unid    => $2,
 565           deleted => $3 || 0,
 566           archive => $4 || 0,
 567           name    => $5,
 568           cat     => $6,
 569           subject => $7,
 570           time    => $8,
 571           level   => $level,
 572           unids   => [],
 573           kids    => [],
 574           answers => 0
 575         };
 576
 577         if (defined $cmno)
 578         {
 579           push @{$msg[$cmno] -> {kids}}  => $#msg;
 580           push @{$msg[$cmno] -> {unids}} => $2;
 581           $msg[$cmno] -> {answers}++;
 582         }
 583         else
 584         {
 585           push @unids => $2;
 586         }
 587
 588         $msg[$_] -> {answers}++ for (@stack);
 589
 590         $msg[-1] -> {name}    =~ s/&amp;/&/g;
 591         $msg[-1] -> {cat}     =~ s/&amp;/&/g;
 592         $msg[-1] -> {subject} =~ s/&amp;/&/g;
 593       }
 594       else
 595       {
 596         $cmno = pop @stack; $level--;
 597       }
 598     }
 599
 600     my $smsg = sort_thread (\@msg, $sorted);    # sort messages
 601     delete_messages ($smsg) unless ($deleted);  # remove invisible messages
 602
 603     $threads{$tid} = $smsg if (@$smsg);
 604   }
 605
 606   wantarray
 607     ? (\%threads, $last_thread, $last_message, $dtd, \@unids)
 608     : \%threads;
 609 }
 610
 611 ### create_forum_xml_string () #################################################
 612 #
 613 # compose main file xml string
 614 #
 615 # Params: $threads - parsed threads (see also 'get_all_threads')
 616 #         $params  - hashref (see doc for details)
 617 #
 618 # Return: scalarref of the xml string
 619 #
 620 sub create_forum_xml_string ($$) {
 621   my ($threads, $param) = @_;
 622   my ($level, $thread, $msg);
 623
 624   my $xml =
 625       '<?xml version="1.0" encoding="UTF-8"?>'."\n"
 626     . '<!DOCTYPE Forum SYSTEM "'.$param -> {dtd}.'">'."\n"
 627     . '<Forum lastMessage="'.$param -> {lastMessage}.'" lastThread="'.$param -> {lastThread}.'">';
 628
 629   for $thread (sort {$b <=> $a} keys %$threads) {
 630     $xml .= '<Thread id="t'.$thread.'">';
 631     $level = -1;
 632
 633     for $msg (@{$threads -> {$thread}}) {
 634       $xml  .= '</Message>' x ($level - $msg -> {level} + 1) if ($msg -> {level} <= $level);
 635
 636       $level = $msg -> {level};
 637       $xml  .=
 638           '<Message id="m'.$msg -> {mid}.'"'
 639             . ' unid="'.$msg -> {unid}.'"'
 640             . (($msg -> {deleted})?' invisible="1"':'')
 641             . (($msg -> {archive})?' archive="1"':'')
 642             . '>'
 643         . '<Header>'
 644         . '<Author>'
 645         . '<Name>'
 646             . plain($msg -> {name})
 647         . '</Name>'
 648         . '<Email />'
 649         . '</Author>'
 650         . '<Category>'
 651             . ((length $msg -> {cat})?plain($msg -> {cat}):'')
 652         . '</Category>'
 653         . '<Subject>'
 654             . plain($msg -> {subject})
 655         . '</Subject>'
 656         . '<Date longSec="'
 657             . $msg -> {time}
 658             . '"/>'
 659         . '</Header>';
 660     }
 661
 662     $xml .= '</Message>' x ($level + 1);
 663     $xml .= '</Thread>';}
 664
 665   $xml.='</Forum>';
 666
 667   \$xml;
 668 }
 669
 670 ### save_file () ###############################################################
 671 #
 672 # Save a file
 673 #
 674 # Params: $filename  Filename
 675 #         $content   File content as scalar reference
 676 # Return: Status (1 - ok, 0 - error)
 677 #
 678 sub save_file ($$)
 679 {
 680   my ($filename, $content) = @_;
 681   local *FILE;
 682
 683   open FILE, ">$filename.temp" or return;
 684
 685   unless (print FILE $$content)
 686   {
 687     close FILE;
 688     return;
 689   }
 690
 691   close FILE or return;
 692
 693   rename "$filename.temp", $filename or return;
 694
 695   1;
 696 }
 697
 698 ################################################################################
 699 #
 700 # several time formatting routines
 701 #
 702 # hr_time
 703 #     02. Januar 2001, 12:02 Uhr
 704 #
 705 # short_hr_time
 706 #     02. 01. 2001, 12:02 Uhr
 707 #
 708 # long_hr_time
 709 #     Dienstag, 02. Januar 2001, 12:02:01 Uhr
 710 #
 711 # very_short_hr_time
 712 #     02. 01. 2001
 713 #
 714 sub month($) {
 715   (qw(Januar Februar), "M\303\244rz", qw(April Mai Juni Juli August September Oktober November Dezember))[shift (@_) - 1];
 716                        # ^^^^^^^^ - UTF8 #
 717 }
 718
 719 sub hr_time ($) {
 720   my (undef, $min, $hour, $day, $mon, $year) = germantime (shift);
 721
 722   sprintf ('%02d. %s %04d, %02d:%02d Uhr', $day, month($mon+1), $year+1900, $hour, $min);
 723 }
 724
 725 sub short_hr_time ($) {
 726   my (undef, $min, $hour, $day, $mon, $year) = germantime (shift);
 727
 728   sprintf ('%02d. %02d. %04d, %02d:%02d Uhr', $day, $mon+1, $year+1900, $hour, $min);
 729 }
 730
 731 sub long_hr_time ($) {
 732   my @wday  = qw(Sonntag Montag Dienstag Mittwoch Donnerstag Freitag Samstag);
 733   my ($sek, $min, $hour, $day, $mon, $year, $wday) = germantime (shift);
 734
 735   sprintf ('%s, %02d. %s %04d, %02d:%02d:%02d Uhr', $wday[$wday], $day, month($mon+1), $year+1900, $hour, $min, $sek);
 736 }
 737
 738 sub very_short_hr_time($) {
 739   my (undef, $min, $hour, $day, $mon, $year) = germantime (shift);
 740
 741   sprintf ('%02d. %02d. %04d', $day, $mon+1, $year+1900);
 742 }
 743
 744 # keep 'require' happy
 745 1;
 746
 747 #
 748 #
 749 ### end of Posting::_lib #######################################################