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-03-13                      #
   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 {
 448   my $smsg = shift;
 449
 450   my ($z, $oldlevel, @path) = (0,0,0);
 451
 452   for (@$smsg)
 453   {
 454     if ($_ -> {'deleted'})
 455     {
 456       my $n = $_ -> {'answers'} + 1;
 457       $smsg -> [$_] -> {'answers'} -= $n for (@path);
 458       splice @$smsg,$z,$n;
 459     }
 460     else
 461     {
 462       if ($_ -> {'level'} > $oldlevel)
 463       {
 464         push @path,$z;
 465         $oldlevel = $_ -> {'level'};
 466       }
 467       elsif ($_ -> {'level'} < $oldlevel)
 468       {
 469         splice @path,$_ -> {'level'} - $oldlevel;
 470         $oldlevel = $_ -> {'level'};
 471       }
 472       else
 473       {
 474         $path[-1] = $z;
 475       }
 476
 477       $z++;
 478     }
 479   }
 480
 481   return;
 482 }
 483
 484 ### get_all_threads () #########################################################
 485 #
 486 # Read and Parse the main file (without any XML-module, they are too slow)
 487 #
 488 # Params: $file     /path/to/filename of the main file
 489 #         $deleted  hold deleted (invisible) messages in result (1) oder not (0)
 490 #         $sorted   direction of message sort: descending (0) (default) or ascending (1)
 491 # Return: scalar context: hash reference
 492 #           list context: list (\%threads, $last_thread, $last_message, $dtd, \@unids)
 493 #
 494 sub get_all_threads ($$;$)
 495 {
 496   my ($file, $deleted, $sorted) = @_;
 497   my ($last_thread, $last_message, $dtd, @unids, %threads);
 498   local (*FILE, $/);
 499
 500   open FILE, $file or return undef;
 501   my $xml = join '', <FILE>;
 502   close(FILE) or return undef;
 503
 504   if (wantarray)
 505   {
 506     ($dtd)          = $xml =~ /<!DOCTYPE\s+\S+\s+SYSTEM\s+"([^"]+)">/;
 507     ($last_thread)  = map {/(\d+)/} $xml =~ /<Forum.+?lastThread="([^"]+)"[^>]*>/;
 508     ($last_message) = map {/(\d+)/} $xml =~ /<Forum.+?lastMessage="([^"]+)"[^>]*>/;
 509   }
 510
 511   my $reg_msg = qr~(?:</Message>
 512                      |<Message\s+id="m(\d+)"\s+unid="([^"]*)"(?:\s+invisible="([^"]*)")?(?:\s+archive="([^"]*)")?[^>]*>\s*
 513                       <Header>[^<]*(?:<(?!Name>)[^<]*)*
 514                         <Name>([^<]+)</Name>[^<]*(?:<(?!Category>)[^<]*)*
 515                         <Category>([^<]*)</Category>\s*
 516                         <Subject>([^<]+)</Subject>\s*
 517                         <Date\s+longSec="(\d+)"[^>]*>\s*
 518                       </Header>\s*(?:(<)/Message>|(?=(<)Message\s*)))~sx;
 519
 520   while ($xml =~ /<Thread id="t(\d+)">([^<]*(?:<(?!\/Thread>)[^<]*)*)<\/Thread>/g)
 521   {
 522     my ($tid, $thread) = ($1, $2);
 523     my ($level, $cmno, @msg, @stack) = (0);
 524
 525     while ($thread =~ m;$reg_msg;g)
 526     {
 527       if (defined($10))
 528       {
 529         push @stack,$cmno if (defined $cmno);
 530         push @msg, {mid     => $1,
 531                     unid    => $2,
 532                     deleted => $3,
 533                     archive => $4,
 534                     name    => $5,
 535                     cat     => $6,
 536                     subject => $7,
 537                     time    => $8,
 538                     level   => $level++,
 539                     unids   => [],
 540                     kids    => [],
 541                     answers => 0};
 542
 543         if (defined $cmno)
 544         {
 545           push @{$msg[$cmno] -> {kids}}  => $#msg;
 546           push @{$msg[$cmno] -> {unids}} => $2;
 547         }
 548         else
 549         {
 550           push @unids => $2;
 551         }
 552
 553         $msg[$_] -> {answers}++ for (@stack);
 554
 555         $cmno=$#msg;
 556
 557         $msg[-1] -> {name}    =~ s/&amp;/&/g;
 558         $msg[-1] -> {cat}     =~ s/&amp;/&/g;
 559         $msg[-1] -> {subject} =~ s/&amp;/&/g;
 560
 561       }
 562       elsif (defined ($9))
 563       {
 564         push @msg, {mid     => $1,
 565                     unid    => $2,
 566                     deleted => $3,
 567                     archive => $4,
 568                     name    => $5,
 569                     cat     => $6,
 570                     subject => $7,
 571                     time    => $8,
 572                     level   => $level,
 573                     unids   => [],
 574                     kids    => [],
 575                     answers => 0};
 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 Mail 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 Mail 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 # ====================================================
 734 # Modulinitialisierung
 735 # ====================================================
 736
 737 # making require happy
 738 1;