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