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