#!/usr/bin/perl use strict; use CGI qw/:standard/; use CGI::Carp qw(fatalsToBrowser carpout); ########################################################################### # # # addalias version 2.2 by deadlock (deadlock@cheeseheadz.net) # # # # This script can be used on a webpage for users to enter and edit their # # own info for the pisg ircstats program by mbrix. # # # # addalias v2+ is based on the original addalias program by Doomshammer # # # ########################################################################### ############################# ### Configuration section ### ############################# # File locations: my $pisg_config = "/path/to/pisg.cfg"; # Server URL # If your script resists in http://myserver/cgi-bin/addalias.pl you should # set it to: "/cgi-bin" my $url = "/cgi-bin"; # Page layout: my $c_bgcolor = "#FFFFFF"; my $c_text = "#000000"; my $c_link = "blue"; my $c_vlink = "#C0C0C0"; my $c_alink = "#C0FFC0"; my $c_border = "#FFFFFF"; my $title = "IRC statistics - user addition page"; # Text on the main page my $txthead1 = "In this form you can enter the settings (aliases, link and user picture) for your nickname in the IRC-stats."; my $txthead2 = "Nicknames are allowed only once."; my $txtnick = "Nickname"; my $txtalias = "Alias(es)"; my $txturl = "URL/E-Mail"; my $txtpic = "Userpic"; my $txtsex = "Sex"; my $txtmale = "M"; my $txtfemale = "F"; my $txtbot = "B"; my $txtignore = "Ignore me"; my $btnsubmit = "Submit"; my $btnupdate = "Update"; my $txtfoot1 = "To update your settings, just enter your nickname and click Submit to retrieve your current settings."; my $txthelp = "For help on this form click here."; my $txtlist = "For a complete list of known nicks please click here."; my $txtupdate = "These are your current settings. Edit them where needed and click Update to update your info."; my $txtaddok = "Your nickname was successfully added."; my $txtignoreon = "You activated ignore and will not appear in the stats."; my $txtupdateok = "Your info was successfully updated."; # Helptext: my $nickhelp = "Enter the name you want to use in the stats here."; my $aliashelp = "Add all aliases you use here, seperated by spaces, so they will be joined in the stats. A * is allowed as a wildcard. For example: MyNick[Zzz], MyNick-afk and MyNick-work could be entered as 'MyNick[Zzz] MyNick-*' or just as 'MyNick*'"; my $urlhelp = "You can enter a webpage or e-mail adress here to be linked to your nick in the stats."; my $pichelp = "If you enter a link to a picture here it will be added to your stats on the page."; my $sexhelp = "This setting is used to determine if lines in the stats should read 'his' or 'her' or 'bot' when referring to you."; my $ignorehelp = "If you don't want to be included in the stats, select this option."; ################################### ### End config section ### ### do not edit below this line ### ################################### # Main program my $path = path_info(); $path =~ s!^/!!; my (%oldnicks, @users, @nick); my ($frm_nick, $frm_alias, $frm_link, $frm_pic, $frm_sex, $frm_ignore); my ($old_nick, $old_alias, $old_link, $old_pic, $old_sex, $old_ignore); my ($old_sexm, $old_sexf, $old_sexb, $old_ignr); my ($cfg, $fnd); my ($submitbtn, $frmaction); htmlheader(); if (!$path) { $submitbtn = $btnsubmit; $frmaction="\"$url/addalias.pl/input\""; $txtupdate = ""; mainpage(); } elsif ($path eq 'help') { helppage(); } elsif ($path eq 'list') { $submitbtn = $btnsubmit; $frmaction="\"$url/addalias.pl/input\""; $txtupdate = ""; mainpage(); list(); } elsif ($path eq 'input') { readparams(); if ($frm_nick eq "") { no_nick(); $submitbtn = $btnsubmit; $frmaction="\"$url/addalias.pl/input\""; $txtupdate = ""; mainpage(); } else { $cfg = read_config(); if ($cfg ne "1") { $fnd = check_if_found(); if ($fnd eq "1") { $submitbtn = $btnupdate; $frmaction="\"update\""; $txtfoot1=""; mainpage(); } else { $submitbtn = $btnupdate; $frmaction="\"update\""; addinfo(); mainpage(); } } else { $submitbtn = $btnupdate; $frmaction="\"update\""; addinfo(); mainpage(); } } } elsif ($path eq 'update') { readparams(); if ($frm_nick eq "") { no_nick(); mainpage(); } else { $cfg = read_config(); $submitbtn = $btnupdate; $frmaction="\"update\""; updateinfo(); mainpage(); } } else { print "Illegal calling of script
\n"; } htmlfooter(); # Subs sub htmlheader { print < $title HTML } sub htmlfooter { print < HTML } sub mainpage { print <$txthead1
$txthead2

$txtupdate
$txtnick
$txtalias
$txturl
$txtpic
$txtsex $txtmale$txtfemale$txtbot
$txtignore
$txtfoot1
$txthelp

$txtlist

HTML } sub helppage { print <$txtnick:
$nickhelp
$txtalias:
$aliashelp
$txturl:
$urlhelp
$txtpic:
$pichelp
$txtsex:
$sexhelp
$txtignore:
$ignorehelp
HTML } sub readparams { $frm_nick = param('nick'); $frm_alias = param('alias'); $frm_link = param('link'); $frm_pic = param('pic'); $frm_sex = param('sex'); $frm_ignore = param('ignore'); } sub list { open(FILE, "<$pisg_config") or die("Error opening pisg config file: $!"); my $i = 0; my $nick; my $alias; while() { if($_ =~ /^\n \n $txtnick$txtalias \n"; foreach (@users) { if ($users[$i] =~ /nick=.*/) { if ($users[$i] =~ /nick="(\S+)"(.*)/) { $nick = $1; } if ($users[$i] =~ /alias="(\S+)".*/ or $users[$i] =~ /alias="(.*)"\s.*/ or $users[$i] =~ /alias="(.*)">/ ) { $alias = $1; } print " \n $nick$alias\n \n"; } $i++ } } sub read_config { open(FILE, "<$pisg_config") or die("Error opening pisg config file: $!"); my $i = 0; while() { if($_ =~ /^/ ) { $oldnicks{$nick[$i]}{'alias'} = $1; } if ($users[$i] =~ /link="(\S+)"(.*)/) { $oldnicks{$nick[$i]}{'link'} = $1; } if ($users[$i] =~ /pic="(\S+)"(.*)/) { $oldnicks{$nick[$i]}{'pic'} = $1; } if ($users[$i] =~ /sex="(\S+)"(.*)/) { $oldnicks{$nick[$i]}{'sex'} = $1; } if ($users[$i] =~ /ignore="(\S+)"(.*)/) { my $ignore = $1; if($ignore eq "y" or $ignore eq "Y") { $ignore = 1; } else { $ignore = 0; } $oldnicks{$nick[$i]}{'ignore'} = $ignore; } } else { $search = 1; } $i++; } return $search; } sub no_nick { print <Error: No Nickname given!
HTML ; } sub check_if_found { my $found = 0; my $lcnick = lc($frm_nick); foreach (@nick) { if (lc($oldnicks{$_}{'nick'}) eq $lcnick) { $found = 1; last; } } if ($found eq "1") { $old_nick = $oldnicks{$lcnick}{'nick'}; $old_alias = $oldnicks{$lcnick}{'alias'}; $old_link = $oldnicks{$lcnick}{'link'}; $old_pic = $oldnicks{$lcnick}{'pic'}; $old_sex = $oldnicks{$lcnick}{'sex'}; $old_ignore = $oldnicks{$lcnick}{'ignore'}; if ($old_sex eq "m" or $old_sex eq "M"){ $old_sexm = "checked"; } elsif ($old_sex eq "f" or $old_sex eq "F"){ $old_sexf = "checked"; } elsif ($old_sex eq "b" or $old_sex eq "B"){ $old_sexb = "checked"; } if ($old_ignore eq "1"){ $old_ignr = "checked"; } } return $found; } sub addinfo { my $line_to_add = ">$pisg_config") or die("Error writing to configfile: $!"); print FILE "$line_to_add\n"; close(FILE); $old_nick = $frm_nick; $old_alias = $frm_alias; $old_link = $frm_link; $old_pic = $frm_pic; $old_sex = $frm_sex; $old_ignore = $frm_ignore; if ($old_sex eq "m" or $old_sex eq "M"){ $old_sexm = "checked"; } elsif ($old_sex eq "f" or $old_sex eq "F"){ $old_sexf = "checked"; } elsif ($old_sex eq "b" or $old_sex eq "B"){ $old_sexb = "checked"; } if ($old_ignore eq "1"){ $old_ignr = "checked"; } print "$txtaddok

\n"; } sub updateinfo { my $line; my $line_to_add = "; close(OLDFILE); open(NEWFILE, ">$pisg_config") or die("Error updating configfile: $!"); &lock_file(*NEWFILE); foreach $line (@lines) { if ($line =~ /^$txtupdateok

\n"; } sub lock_file { my $lock = 2; flock($_[0], $lock); }