1package Pisg; 2 3# Documentation(POD) for this module is found at the end of the file. 4 5# Copyright (C) 2001-2005 <Morten Brix Pedersen> - morten@wtf.dk 6# Copyright (C) 2003-2006 Christoph Berg <cb@df7cb.de> 7# 8# This program is free software; you can redistribute it and/or modify 9# it under the terms of the GNU General Public License as published by 10# the Free Software Foundation; either version 2 of the License, or 11# (at your option) any later version. 12# 13# This program is distributed in the hope that it will be useful, 14# but WITHOUT ANY WARRANTY; without even the implied warranty of 15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16# GNU General Public License for more details. 17# 18# You should have received a copy of the GNU General Public License 19# along with this program; if not, write to the Free Software 20# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 21 22use strict; 23$^W = 1; 24 25sub new 26{ 27 my $type = shift; 28 my %args = @_; 29 my $self = { 30 override_cfg => $args{override_cfg}, 31 use_configfile => $args{use_configfile}, 32 search_path => $args{search_path}, 33 chans => [], 34 users => {}, 35 cfg => {}, 36 tmps => {}, 37 }; 38 39 # Set the default configuration settings. 40 get_default_config_settings($self); 41 42 # Import common functions in Pisg::Common 43 require Pisg::Common; 44 Pisg::Common->import(); 45 46 bless($self, $type); 47 return $self; 48} 49 50sub run 51{ 52 my $self = shift; 53 54 print "pisg v$self->{cfg}->{version} - Perl IRC Statistics Generator\n\n" 55 unless ($self->{cfg}->{silent}); 56 57 # Init the configuration file (aliases, ignores, channels, etc) 58 my $r; 59 if ($self->{use_configfile}) { 60 foreach my $c ($self->{cfg}->{configfile}, $self->{search_path} . "/$self->{cfg}->{configfile}") { 61 if (open(CONFIG, $c)) { 62 $self->{cfg}->{configfile} = $c; 63 print "Using config file: $self->{cfg}->{configfile}\n\n" 64 unless ($self->{cfg}->{silent}); 65 $r = $self->init_config(\*CONFIG); 66 last; 67 } else { 68 print STDERR "Warning: $c: $!\n\n" if -e $c; 69 } 70 } 71 } 72 73 # Get translations from langfile 74 $self->get_language_templates(); 75 76 # Parse any channels in <channel> statements 77 $self->parse_channels(); 78 79 # Optionaly parse the channel we were given in override_cfg. 80 $self->do_channel() 81 if (!$self->{cfg}->{chan_done}{$self->{cfg}->{channel}}); 82 83} 84 85sub get_default_config_settings 86{ 87 my $self = shift; 88 89 # This is all the default settings of pisg. They can be overriden by the 90 # pisg.cfg file, or by using the override_cfg argument to the new 91 # constructor. 92 93 $self->{cfg} = { 94 channel => '', 95 logtype => 'Logfile', 96 logfile => [], 97 format => '', 98 network => 'SomeIRCNet', 99 outputfile => 'index.html', 100 outputtag => '', 101 maintainer => 'MAINTAINER', 102 pagehead => 'none', 103 pagefoot => 'none', 104 configfile => 'pisg.cfg', 105 imagepath => '', 106 imageglobpath => '', 107 defaultpic => '', 108 logdir => [], 109 nfiles => 0, 110 lang => 'EN', 111 langfile => '/usr/local/share/pisg/lang.txt', 112 cssdir => '/usr/local/share/pisg/layout/', 113 colorscheme => 'default', 114 altcolorscheme => 'none', 115 logprefix => '', 116 logsuffix => '', 117 silent => 0, 118 cachedir => '', 119 userpics => 'y', 120 121 # Colors / Layout 122 123 hicell => '#BABADD', # FIXME 124 hicell2 => '#CCCCCC', # FIXME 125 126 picwidth => '', 127 picheight => '', 128 129 pic_v_0 => 'blue-v.png', 130 pic_v_6 => 'green-v.png', 131 pic_v_12 => 'yellow-v.png', 132 pic_v_18 => 'red-v.png', 133 pic_h_0 => 'blue-h.png', 134 pic_h_6 => 'green-h.png', 135 pic_h_12 => 'yellow-h.png', 136 pic_h_18 => 'red-h.png', 137 piclocation => '.', 138 139 # Stats settings 140 141 showactivetimes => 1, 142 showactivenicks => 1, 143 showbignumbers => 1, 144 showtopics => 1, 145 showlinetime => 0, 146 showwordtime => 0, 147 showlines => 1, 148 showtime => 1, 149 showwords => 0, 150 showwpl => 0, 151 showcpl => 0, 152 showlastseen => 1, 153 showlegend => 1, 154 showkickline => 1, 155 showactionline => 1, 156 showfoulline => 0, 157 showfouldecimals => 1, 158 showshoutline => 1, 159 showviolentlines => 1, 160 showrandquote => 1, 161 showmuw => 1, 162 showmrn => 1, 163 showsmileys => 0, 164 showkarma => 0, 165 showmru => 1, 166 showcharts => 0, 167 showops => 1, 168 showvoices => 0, 169 showhalfops => 0, 170 showmostnicks => 0, 171 showactivegenders => 0, 172 showmostactivebyhour => 0, 173 showmostactivebyhourgraph => 1, 174 showonlytop => 0, 175 176 # Less important things 177 178 timeoffset => '+0', 179 minquote => 25, 180 maxquote => 65, 181 quotewidth => 80, 182 bignumbersthreshold => 'sqrt', 183 wordlength => 5, 184 dailyactivity => 0, 185 activenicks => 25, 186 activenicks2 => 30, 187 activenicksbyhour => 10, 188 topichistory => 3, 189 urlhistory => 5, 190 chartshistory => 5, 191 nickhistory => 5, 192 smileyhistory => 10, 193 karmahistory => 5, 194 wordhistory => 10, 195 mostnickshistory => 5, 196 mostnicksverbose => 1, 197 nicklimit => 10, 198 nicktracking => 0, 199 charset => 'iso-8859-1', 200 logcharset => '', 201 logcharsetfallback => '', 202 203 # sorting 204 sortbywords => 0, 205 206 # Misc settings 207 208 foulwords => 'ass fuck bitch shit scheisse schei�e kacke arsch ficker ficken schlampe', 209 violentwords => 'slaps beats smacks', 210 chartsregexp => '(?:is )?(?:np:|(?:now )?playing:? |listening to:? )(?:MPEG stream from)?\s*(.*)', 211 ignorewords => '', 212 noignoredquotes => 0, 213 tablewidth => 574, 214 regexpaliases => 0, 215 216 botnicks => '', # Needed for DCpp format (non-irc) 217 218 statsdump => '', # Debug option 219 modules_dir => '', # set in get_cmdline_options 220 cchannels => '', # set in get_cmdline_options 221 222 version => "0.73" 223 }; 224 225 # This enables us to use the search_path in other modules 226 $self->{cfg}->{search_path} = $self->{search_path}; 227 228 # Parse the optional overriden configuration variables 229 foreach my $key (keys %{$self->{override_cfg}}) { 230 if ($self->{override_cfg}->{$key}) { 231 unless (defined($self->{cfg}->{$key})) { 232 print STDERR "Warning: No such configuration option: -cfg $key\n"; 233 next; 234 } 235 $self->{cfg}->{$key} = $self->{override_cfg}->{$key}; 236 } 237 } 238} 239 240sub get_language_templates 241{ 242 my $self = shift; 243 244 open(FILE, $self->{cfg}->{langfile}) or open (FILE, $self->{search_path} . "/$self->{cfg}->{langfile}") or die("$0: Unable to open language file($self->{cfg}->{langfile}): $!\n"); 245 246 while (my $line = <FILE>) 247 { 248 next if ($line =~ /^#/); 249 250 if ($line =~ /<lang name=\"([^"]+)\"(?: charset=\"(.*)\")?>/i) { 251 # Found start tag, setting the current language 252 my $current_lang = uc($1); 253 $self->{tmps}->{$current_lang}{lang_charset} = lc($2); 254 255 while (<FILE>) { 256 next if ($_ =~ /^#/); 257 last if ($_ =~ /<\/lang>/i); 258 259 # Get 'template = "Text"' in language file: 260 if ($_ =~ /^(\w+)\s*=\s*"(.*)"\s*$/) { 261 warn "duplicate translation $1 -> $2" 262 if $self->{tmps}->{$current_lang}{$1} and !$self->{cfg}->{silent}; 263 $self->{tmps}->{$current_lang}{$1} = $2; 264 } 265 } 266 267 } 268 269 } 270 271 close(FILE); 272} 273 274sub init_config 275{ 276 my $self = shift; 277 my $fh = shift; 278 while (my $line = <$fh>) 279 { 280 next if ($line =~ /^\s*#/); 281 chomp $line; 282 283 if ($line =~ /<user.*>/) { 284 my $nick; 285 286 if ($line =~ /\bnick=(["'])(.+?)\1/) { 287 $nick = $2; 288 add_alias($nick, $nick); 289 } else { 290 print STDERR "Warning: $self->{cfg}->{configfile}, line $.: No nick specified\n"; 291 next; 292 } 293 294 if ($line =~ /\balias=(["'])(.+?)\1/) { 295 my @thisalias = split(/\s+/, lc($2)); 296 foreach (@thisalias) { 297 if ($self->{cfg}->{regexpaliases} and /[\|\[\]\{\}\(\)\?\+\.\*\^\\]/) { 298 add_aliaswild($nick, $_); 299 } elsif (not $self->{cfg}->{regexpaliases} and s/\*/\.\*/g) { 300 # quote it if it is a wildcard 301 s/([\|\[\]\{\}\(\)\?\+\^\\])/\\$1/g; 302 add_aliaswild($nick, $_); 303 } else { 304 add_alias($nick, $_); 305 } 306 } 307 } 308 309 if ($line =~ /\bpic=(["'])(.+?)\1/) { 310 $self->{users}->{userpics}{$nick} = $2; 311 } 312 313 if ($line =~ /\bbigpic=(["'])(.+?)\1/) { 314 $self->{users}->{biguserpics}{$nick} = $2; 315 } 316 317 if ($line =~ /\blink=(["'])(.+?)\1/) { 318 $self->{users}->{userlinks}{$nick} = $2; 319 } 320 321 if ($line =~ /\bignore=(["'])Y\1/i) { 322 add_ignore($nick); 323 } 324 325 if ($line =~ /\bsex=(["'])([MmFfBb])\1/) { 326 $self->{users}->{sex}{$nick} = lc($2); 327 } 328 } elsif ($line =~ /<link(.*)>/) { 329 330 if ($line =~ /\burl=(["'])(.+?)\1/) { 331 my $url = $2; 332 if ($line =~ /ignore="Y"/i) { 333 add_url_ignore($url); 334 } 335 } else { 336 print STDERR "Warning: $self->{cfg}->{configfile}, line $.: No URL specified\n"; 337 } 338 339 340 } elsif ($line =~ /<set(.*)>/) { 341 342 my $settings = $1; 343 if ($settings !~ /=["'](.*)["']/ || $settings =~ /(\w)>/ ) { 344 print STDERR "Warning: $self->{cfg}->{configfile}, line $.: Missing or wrong quotes near $1\n"; 345 } 346 347 while ($settings =~ s/[ \t]([^=]+?)=(["'])(.*?)\2//) { 348 my $var = lc($1); 349 my $val = $3; 350 $var =~ s/ //; # Remove whitespace 351 352 if (!defined($self->{cfg}->{$var})) { 353 print STDERR "Warning: $self->{cfg}->{configfile}, line $.: No such configuration option: '$var'\n"; 354 next; 355 } 356 357 unless (($self->{cfg}->{$var} eq $val) || $self->{override_cfg}->{$var}) { 358 $self->{cfg}->{$var} = $val; 359 } 360 } 361 362 } elsif ($line =~ /<channel=(['"])(.+?)\1(.*)>/i) { 363 my ($channel, $settings, $tmp) = ($2, $3, {}); 364 $tmp->{$channel}->{channel} = $channel; 365 $self->{cfg}->{chan_done}{$self->{cfg}->{channel}} = 1; # don't parse channel in $self->{cfg}->{channel} if a channel statement is present 366 while ($settings =~ s/\s([^=]+)=(["'])(.*?)\2//) { 367 my $var = lc($1); 368 my $val = $3; 369 if ($var eq "logdir" || $var eq "logfile") { 370 push(@{$tmp->{$channel}{$var}}, $val); 371 } else { 372 $tmp->{$channel}{$var} = $val; 373 } 374 } 375 while (<$fh>) { 376 next if /^\s*#/; 377 if ($_ =~ /<\/*channel>/i) { 378 push @{ $self->{chans} }, $tmp; 379 last; 380 } 381 if ($_ =~ /^\s*(\w+)\s*=\s*(["'])(.*?)\2/) { 382 my $var = lc($1); 383 my $val = $3; 384 unless ((($var eq "logdir" || $var eq "logfile") && scalar(@{$self->{override_cfg}->{$var}}) > 0) || (($var ne "logdir" && $var ne "logfile") && $self->{override_cfg}->{$var})) { 385 386 if($var eq "logdir" || $var eq "logfile") { 387 push @{$tmp->{$channel}{$var}}, $val; 388 } else { 389 $tmp->{$channel}{$var} = $val; 390 } 391 392 } 393 } elsif ($_ !~ /^$/) { 394 print STDERR "Warning: $self->{cfg}->{configfile}, line $.: Unrecognized line: $_"; 395 } 396 } 397 } elsif ($line =~ /<include\s*=\s*(["'])(.+?)\1\s*>/) { 398 my $include_cfg = $2; 399 my $backup_cfg = $self->{cfg}->{configfile}; 400 $self->{cfg}->{configfile} = $include_cfg; 401 my $r; 402 foreach my $c ($self->{cfg}->{configfile}, $self->{search_path} . "/$self->{cfg}->{configfile}") { 403 if (open(INCLUDE, $c)) { 404 $self->{cfg}->{configfile} = $c; 405 $r = $self->init_config(\*INCLUDE); 406 last; 407 } else { 408 print STDERR "Warning: $backup_cfg, line $.: $c: $!\n" 409 if -e $c; 410 } 411 } 412 print "Included config file: $self->{cfg}->{configfile}\n\n" 413 if ($r && !$self->{cfg}->{silent}); 414 print STDERR "Warning: $backup_cfg, line $.: $self->{cfg}->{configfile} not found\n" 415 if (!$r); 416 $self->{cfg}->{configfile} = $backup_cfg; 417 } elsif ($line =~ /<(\w+)?.*[^>]$/) { 418 print STDERR "Warning: $self->{cfg}->{configfile}, line $.: Missing end on element <$1 (probably multi-line?)\n"; 419 } elsif ($line =~ /\S/) { 420 $line =~ s/\n//; 421 print STDERR "Warning: $self->{cfg}->{configfile}, line $.: Unrecognized line: $line\n"; 422 } 423 } 424 425 close($fh); 426} 427 428sub init_pisg 429{ 430 my $self = shift; 431 432 my $timestamp = time(); 433 $self->{cfg}->{start} = time(); 434 435 if ($self->{cfg}->{timeoffset} =~ /\+(\d+)/) { 436 # We must plus some hours to the time 437 $timestamp += 3600 * $1; # 3600 seconds per hour 438 439 } elsif ($self->{cfg}->{timeoffset} =~ /-(\d+)/) { 440 # We must remove some hours from the time 441 $timestamp -= 3600 * $1; # 3600 seconds per hour 442 } 443 $self->{cfg}->{timestamp} = $timestamp; 444 445 # convert wordlists 446 $self->{cfg}->{foulwords} = wordlist_regexp($self->{cfg}->{foulwords}, $self->{cfg}->{regexpaliases}); 447 $self->{cfg}->{ignorewords} = wordlist_regexp($self->{cfg}->{ignorewords}, $self->{cfg}->{regexpaliases}); 448 $self->{cfg}->{violentwords} = wordlist_regexp($self->{cfg}->{violentwords}, $self->{cfg}->{regexpaliases}); 449 450 # Add trailing slash when it's not there.. 451 $self->{cfg}->{imagepath} =~ s/([^\/])$/$1\//; 452 # Set ImageGlobPath default 453 $self->{cfg}->{imageglobpath} ||= $self->{cfg}->{imagepath}; 454 $self->{cfg}->{imageglobpath} =~ s/([^\/])$/$1\//; 455 456 # Set number of picture columns to show 457 if ($self->{cfg}->{userpics} =~ /^n/i) { 458 $self->{cfg}->{userpics} = 0; 459 } elsif ($self->{cfg}->{userpics} =~ /^y/i) { 460 $self->{cfg}->{userpics} = 1; 461 } elsif ($self->{cfg}->{userpics} !~ /^\d+$/) { 462 print STDERR "Warning: $self->{cfg}->{configfile}, line $.: Invalid UserPics setting\n"; 463 } 464 465 unless ($self->{cfg}->{silent}) { 466 print "Statistics for channel $self->{cfg}->{channel} \@ $self->{cfg}->{network} by $self->{cfg}->{maintainer}\n\n"; 467 } 468} 469 470sub do_channel 471{ 472 my $self = shift; 473 if (!$self->{cfg}->{channel}) { 474 print STDERR "No channels defined.\n"; 475 } elsif ((!@{$self->{cfg}->{logfile}}) && (!@{$self->{cfg}->{logdir}})) { 476 print STDERR "No logfile or logdir defined for " . $self->{cfg}->{channel} . "\n"; 477 } elsif (!$self->{cfg}->{format}) { 478 print STDERR "No format defined for $self->{cfg}->{channel}.\n"; 479 } else { 480 $self->init_pisg(); # Init some general things 481 482 store_aliases(); # Save the aliases so we can restore them 483 # later, we don't want to add the aliases 484 # for this channel to the next channel 485 486 # Pick our stats generator. 487 my $analyzer; 488 eval <<_END; 489use Pisg::Parser::$self->{cfg}->{logtype}; 490\$analyzer = new Pisg::Parser::$self->{cfg}->{logtype}( 491 { cfg => \$self->{cfg}, users => \$self->{users} } 492); 493_END 494 if ($@) { 495 print STDERR "Could not load stats analyzer for '$self->{cfg}->{logtype}': $@\n"; 496 return undef; 497 } 498 499 my $stats = $analyzer->analyze(); 500 $self->{cfg}->{analyzer} = $analyzer; # we need the parser in _format_line 501 502 # Initialize HTMLGenerator object 503 my $generator; 504 eval <<_END; 505use Pisg::HTMLGenerator; 506\$generator = new Pisg::HTMLGenerator( 507 cfg => \$self->{cfg}, 508 stats => \$stats, 509 users => \$self->{users}, 510 tmps => \$self->{tmps} 511); 512_END 513 514 if ($@) { 515 print STDERR "Could not load stats generator (Pisg::HTMLGenerator): $@\n"; 516 return undef; 517 } 518 519 # Create our HTML page if the logfile has any data. 520 if (defined $stats) { 521 if ($stats->{parsedlines} > 0) { 522 foreach my $lang (split /\s*,\s*/, uc $self->{cfg}->{lang}) { 523 $lang =~ s/-/_/g; # PT_BR was called PT-BR before 524 die sprintf "No such language: %s\n", $_ unless $self->{tmps}->{$lang}; 525 $generator->create_output($lang); 526 } 527 } else { 528 print STDERR <<_END unless $self->{cfg}->{silent}; 529No parseable lines found in logfile ($stats->{totallines} total lines). Skipping. 530-> You might be using the wrong format. 531-> A common error is that the logs do not contain timestamps for each line. 532_END 533 } 534 } 535 536 restore_aliases(); 537 538 $self->{cfg}->{chan_done}{$self->{cfg}->{channel}} = 1; 539 } 540} 541 542sub parse_channels 543{ 544 my $self = shift; 545 my %origcfg = %{ $self->{cfg} }; 546 547 # make a list of channels to do 548 my @chanlist; 549 if (scalar @ {$self->{cfg}->{cchannels} } > 0) { 550 foreach my $channel (@{ $self->{cfg}->{cchannels} }) { 551 my $hits = 0; 552 foreach ( @{ $self->{chans} }) { 553 my $chan = (keys %{ $_ })[0]; 554 if (lc($channel) eq lc($chan)) { 555 push @chanlist, $_; 556 $hits++; 557 } 558 } 559 if ($hits < 1) { 560 print STDERR "Channel $channel not in config file, ignoring\n"; 561 } 562 } 563 } else { 564 push @chanlist, $_ foreach (@{ $self->{chans} }); 565 } 566 567 foreach my $channel (@chanlist) { 568 foreach my $chan (keys %{ $channel }) { # import channel specific config 569 $self->{cfg}->{$_} = $channel->{$chan}->{$_} foreach (keys %{ $channel->{$chan} }); 570 } 571 $self->do_channel(); 572 $origcfg{chan_done} = $self->{cfg}->{chan_done}; 573 %{ $self->{cfg} } = %origcfg; 574 } 575} 576 5771; 578 579__END__ 580 581=head1 NAME 582 583Pisg - Perl IRC Statistics Generator main module 584 585=head1 SYNOPSIS 586 587 use Pisg; 588 589 $pisg = new Pisg( 590 use_configfile => '1', 591 override_cfg => { network => 'MyNetwork', format => 'eggdrop' } 592 ); 593 594 $pisg->run(); 595 596=head1 DESCRIPTION 597 598C<Pisg> is a statistic generator for IRC logfiles or the like, delivering 599the results in a HTML page. 600 601=head1 CONSTRUCTOR 602 603=over 4 604 605=item new ( [ OPTIONS ] ) 606 607This is the constructor for a new Pisg object. C<OPTIONS> are passed in a hash like fashion, using key and value pairs. 608 609Possible options are: 610 611B<use_configfile> - When set to 1, pisg will look up it's channels in it's 612configuration file, defined by the configuration option 'configfile'. 613 614B<override_cfg> - This defines whichever configuration variables you want to 615override from the configuration file. If you set use_configfile to 0, then 616you'll have to set at least channel and logfile here. 617 618B<search_path> - This defines an optional search path. It's used when you want to hardcode an alternative path where pisg should look after its language and config file. 619 620=back 621 622=head1 AUTHOR 623 624Morten Brix Pedersen <morten@wtf.dk> 625 626=head1 COPYRIGHT 627 628Copyright (C) 2001 Morten Brix Pedersen. All rights resereved. 629This program is free software; you can redistribute it and/or modify it 630under the terms of the GPL, license is included with the distribution of 631this file. 632 633=cut 634