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