#!perl -Tw # framechat v2.04 by epoptai, view help for changes and credits # http://www.perlmonks.org/index.pl?node=framechat # usage: # Must set first few config variables first, then call it from a web browser. # On first run you'll be prompted for the password you set in config vars. # Make sure that access to your script installation is secure. # Intended for use on localhost but other setups should work. # Once running select 'help' for usage details. use strict; use CGI::Cookie; use CGI qw(param header url escape unescape redirect -debug); eval "use XML::Simple 'XMLin'"; # required xml parser $@ && install_xml_simple(); use Data::Dumper; use URI::Escape; use LWP::UserAgent; use LWP::Simple 'get'; use HTML::Entities; use HTTP::Cookies; use HTTP::Request::Common; use vars qw( $bodytag $boxmem $boxmode $broken $config_cols $config_rows $expand_titles $fborder $font_open $frame_top_2columns $frame_column1_rows $frame_column2_rows @friends $history %launch_urls $mnt $msgt $newestnodes $nnnodes $nnt $nodes $nr $password $perlmonks $perlmonks_off $proxy $proxyid $proxypass $rct $refresh_chat $refresh_nn $refresh_pchat $refresh_rep $refresh_user $refresh_xp $repframe_rows $repurl $reverse_inbox $reverse_pchat $search_max $stylesheet $tablestyle @tags $temp $trgt $use_proxy $username @verb ); # declare all config variables # NOTE: If a config file exists it will override the following settings! # begin config variables, must set first 5 (don't edit this line) $perlmonks = 'www.perlmonks.org'; # the domain you usually use for perlmonks, should have a www. prefix $perlmonks_off = ''; # a domain for which you have no browser cookie for perlmonks $username = ''; # perlmonks username $password = ''; # perlmonks password $temp = './'; # dir where files are saved, must be able to create, write and read files in the temp dir. # must also have a trailing directory delimiter! $broken = ''; # set to 'yes' if running on IIS (see perlmonks node 76003) # display options @friends = qw(); # put usernames you want bold in the userlist $bodytag = '
'; # used everywhere $stylesheet = ''; # global stylesheet $tablestyle = ''; # small fonts in td tags $font_open = ''; # chat and userlist font, use or for smaller text $mnt = ' target="monks"'; # username target window $trgt = ' target="_blank"'; # user supplied link target $nodes = ' target="_blank"'; # target for new, best, worst, etc. $nnt = ' target="newnodes"'; # new nodes target $rct = ' target="repnodes"'; # rep change target $reverse_pchat = 'yes'; # yes for msgchat message order newest first $reverse_inbox = 'yes'; # yes for active inbox message order newest first $expand_titles = 'yes'; # yes to lookup node titles for [id://node_id] links @verb = qw(lurking romping hanging wandering stumbling floating); # n others $verb[x] around the monastery push @friends, $username; # comment this to not bold own name in userlist $newestnodes = ''; # url to newest nodes client, blank = perlmonks link $nnnodes = 60; # default minutes worth of new nodes, redefined later by a cookie $config_cols = 80; # width of textarea where config is edited $config_rows = 30; # height # frames $fborder = 2; # frameborder, less than 2 is hard to grab onto $frame_top_2columns = '*,20%'; # parent frame for 2 columns of 3 rows: inbox/chat/input & xp/users/links $frame_column1_rows = '20%,*,20%'; # inbox/chat/input $frame_column2_rows = '20%,*,20%'; # xp/users/links $repframe_rows = '50%,50%'; # rep/chat frame $boxmode = 'url'; # default top frame: either 'inbox', 'url', or 'nn' $boxmem = 'yes'; # leave blank to always load $boxmode, 'yes' for cookie memory # refresh rates (seconds) $refresh_chat = 12; # chatterbox $refresh_user = 30; # userlist $refresh_xp = 120; # xp nodelet $refresh_pchat = 15; # private chat $refresh_nn = 90; # new nodes default, redefined by a cookie $refresh_rep = 5; # rep change MINUTES default, redefined by a cookie $nr = 500; # 1 in $nr chance of a nodereaper quip # history $history = 'on'; # 'on' enables daily history file $search_max = 5000; # max history search results # proxy $use_proxy = ''; # 'on' enables use thru a proxy $proxy = 'http://proxy.dom:port'; # must define this $proxyid = ''; $proxypass = ''; # menus %launch_urls = ( # launchpad menu, add your favorite search engines! default => 'default', google => 'http://www.google.com/search?q=', lucky => 'http://www.google.com/search?btnI=lucky&q=', cpan => 'http://search.cpan.org/search?mode=module&query=', isbn => 'http://www1.fatbrain.com/asp/BookInfo/BookInfo.asp?from=MDZ411&theisbn=', merlyn => 'http://www.stonehenge.com/perl/googlecolumnsearch?search_for=', perldoc => 'http://www.perldoc.com/cgi-bin/htsearch?words=', define => 'http://www.dict.org/bin/Dict?Form=Dict1&Strategy=*&Database=*&Query=', jargon => 'http://www.science.uva.nl/cng/search/htsearch.CGI?restrict=%2F%7Emes%2Fjargon%2F&words=', kobe => 'http://theoryx5.uwinnipeg.ca/mod_perl/cpan-search?filetype=+distribution+name+or+description&j&case=clike&search=', pad => "http://$perlmonks/index.pl?node_id=108949&user=", ); # tag menu - tags to insert in input area # these values are used for the menu display, and are the inserted data @tags = ( '/me ', '/msg ', '[id://] ', '[pad://] ', '[cpan://] ', '[kobe://] ', '[perldoc://] ', '[jargon://] ', '[google://] ', '[lucky://] ', '[isbn://] ', '[http://] ', '[ftp://] ', '</code> ',
' ',
' ',
'/ignore ',
'/unignore ',
'/login ',
'/logout '
);
# end config variables (don't edit this line)
my%i = map {$_ => param($_)} param; # param hash
# files
my$present = time;
my@time = localtime $present; # current history, prefix with _ as of v1.3
my$today = sprintf("${temp}_%4u%02u%02u.txt", $time[5]+1900, $time[4]+1, $time[3]); # don't change this
my$normfile = $temp.'framechat-norm';
my$cookies = $temp.'framechat-cookies';
my$config = $temp.'framechat-config';
my$repfile = $temp.'framechat-rep';
my$rephistfile = $temp.'framechat-rephist';
eval "require '$config'"; # use external config file if it exists and has valid syntax
my(@ck,$c,$erc) = ();
if($@){ # internal config
$c = CGI::Cookie->new(-name=>"config",-value=>'0',-expires=>'+10y');
push @ck, $c;
$erc = 0
}
else{ # external config
$c = CGI::Cookie->new(-name=>"config",-value=>'1',-expires=>'+10y');
push @ck, $c;
$erc = 1
}
my%cookie = CGI::Cookie->fetch(); # get cookies
my$cookie_names = 'framechatpass|nnnodes|refresh_n?r?|xp|boxmode|logout|config';
my$userpass = crypt($password,$username);
my$state = $present; # used in authentication
# html
my$nb = ' ';
my$pbr = '
';
my$bq = '
';
my$eh = '