#!/usr/local/bin/perl # # This Script and the readme may only be given away "as is", unmodified # and complete. The Script is Freeware. # Created and Copyright by Ralf Gueldemeister # on 25.12.98 # Traduzido por Marcelo Contart CGI-BRASIL http://www.brasilsites.com/cgi/ require config; # HTML # ######################## # WILLKOMMEN.HTML - Printed before user logs in sub willkommen_html { print << "[END]"; $html_title - Login $html_bodytag

$html_title

Entrada

Apelido:
Senha:

registrar novo apelido

[END] } #CHATINPUT.HTML sub chatinput_html { print <<"[END]"; $html_bodytag
[END] &select_user; print <<"[END]"; opções  inf.usuário   SAIR ! © ralf 99
[END] } #STILLALIVE.HTML - the users online frame sub stillalive_html_header { print <<"[END]"; $html_bodytag [END] } sub stillalive_html_footer { print <<"[END]"; [END] } #CHAT.HTML sub chat_html_header { print <<"[END]"; $html_bodytag [END] } sub chat_html_footer { print <<"[END]"; [END] } # END HTML PART. # ####################### # Main Part - DON'T CHANGE ANYTHING HERE! # ####################### &action; # Fuehrt je nach action variable gegebene sub aus # action im FORM definieren! exit; sub action { if ($qs eq "") { # Wenn query_string leer sprung zum &welcome; # welcome-teil, 1st visit seite } elsif ($query{'action'} eq "chatinput_html") { &header; &chatinput_html; } elsif ($query{'action'} eq "stillalive") { &stillalive; } elsif ($query{'action'} eq "chat") { &chat; } elsif ($query{'action'} eq "postmsg") { &postmsg; } else { &error; } } sub welcome { # Aufruf beim ersten Programmstart &header; &willkommen_html; } sub stillalive { # stillalive/who prozedur &checkpass; if (-e "$data_dir/$data_stillalive_file") { # SAfile oeffnen/erstellen } else { &create_file("$data_dir/$data_stillalive_file"); } open (SAFILE, "<$data_dir/$data_stillalive_file") || &error("opening safile failed"); flock(SAFILE,2); my $safile = ; # Daten aus safile an $safile uebergeben # flock(SAFILE,8); close SAFILE; @sa = split (/;;/, $safile); @sa = &repair_safile(@sa) if (($#sa+1) % 2 == 1); # wenn safile fehlerhaft -> repair $ownsaexists=0; for ($i=0; $i<=$#sa; $i+=2) { # eigenen Eintrag erneuern if ($sa[$i] eq $query{'name'}) { $sa[$i+1] = time; $ownsaexists=1; } } # Eintraege nach ueberfaelligen (aelter als 50s) durchsuchen und diese entfernen for ($i=1; $i<=$#sa; $i+=2) { if ($sa[$i] < (time - 50)) { # ist zeitstempel schon aelter als 50s? #print logout msg open (CHATFILE, ">>$data_dir/$data_msg_file"); flock(CHATFILE,2); print CHATFILE "".$sa[$i-1]." ".$logout_msg."\n"; close CHATFILE; $sa[$i] = "//2delete"; $sa[$i-1] = "//2delete"; # zu loeschende eintraege mit //2delete ersetzten } } # alle Felder mit //2delete entfernen $templsa = $#sa; # Laenge von @sa wird in templsa gespeichert; for ($i=0; $i<=$templsa; $i++) { $temp = shift(@sa); if ($temp ne "//2delete") { push(@sa,$temp); } } # if no own sa entry exists -> add if ($ownsaexists != 1) { $sa[++$#sa] = $query{'name'}; $sa[++$#sa] = time; } $safile = join(';;', @sa); open (SAFILE, ">$data_dir/$data_stillalive_file") || &error("opening safile failed"); flock(SAFILE,2); print SAFILE $safile; # flock(SAFILE,8); close SAFILE; &header; &stillalive_html_header; $nrusers = ($#sa+1) / 2; $s = $nrusers > 1 ? "s" : ""; print "

$nrusers usuário$s no chat!

"; for ($i=0; $i<=$#sa; $i+=2) { print "$sa[$i]
"; } &stillalive_html_footer; } sub chat { # Chatprocedure: show Messages if (-e "$data_dir/$data_msg_file") { # CHATFILE oeffnen/erstellen } else { &create_file("$data_dir/$data_msg_file"); } &checkpass; &header; &chat_html_header; open (CHATFILE, "<$data_dir/$data_msg_file") || &error("opening chatfile failed"); flock(CHATFILE,2); my @chatfile = ; # flock(CHATFILE,8); close CHATFILE; # Ausgabe Messages foreach(@chatfile) { while ($_ =~ /
Make your own free website on Tripod.com