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