Logfile.pm 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774
  1. package Pisg::Parser::Logfile;
  2. # Copyright and license, as well as documentation(POD) for this module is
  3. # found at the end of the file.
  4. use strict;
  5. $^W = 1;
  6. # test for Text::Iconv
  7. my $have_iconv = 1;
  8. eval 'use Text::Iconv';
  9. $have_iconv = 0 if $@;
  10. sub new
  11. {
  12. my $type = shift;
  13. my $self = shift; # get cfg and users
  14. # Import common functions in Pisg::Common
  15. require Pisg::Common;
  16. Pisg::Common->import();
  17. bless($self, $type);
  18. # Pick our parser.
  19. $self->{parser} = $self->_choose_format($self->{cfg}->{format});
  20. if($self->{cfg}->{logcharsetfallback} and not $self->{cfg}->{logcharset}) {
  21. print "LogCharset undefined, assuming LogCharset = LogCharsetFallback\n"
  22. unless ($self->{cfg}->{silent});
  23. $self->{cfg}->{logcharset} = $self->{cfg}->{logcharsetfallback};
  24. }
  25. if($self->{cfg}->{logcharset}) {
  26. if($have_iconv) {
  27. # use converter if charsets differ or there is a fallback charset
  28. # (in the latter case the converter is also used to test if the
  29. # line is in the proper charset)
  30. if(($self->{cfg}->{logcharset} ne $self->{cfg}->{charset}) or $self->{cfg}->{logcharsetfallback}) {
  31. $self->{iconv} = Text::Iconv->new($self->{cfg}->{logcharset}, $self->{cfg}->{charset});
  32. }
  33. if($self->{cfg}->{logcharsetfallback}) {
  34. $self->{iconvfallback} = Text::Iconv->new($self->{cfg}->{logcharsetfallback}, $self->{cfg}->{charset});
  35. }
  36. } else {
  37. print "Text::Iconv is not installed, skipping charset conversion of logfiles\n"
  38. unless ($self->{cfg}->{silent});
  39. }
  40. }
  41. # precompile the regexps used (we can't use /o since the config might be different per channel)
  42. $self->{foulwords_regexp} = qr/($self->{cfg}->{foulwords})/i if $self->{cfg}->{foulwords};
  43. $self->{ignorewords_regexp} = qr/$self->{cfg}->{ignorewords}/i if $self->{cfg}->{ignorewords};
  44. $self->{violentwords_regexp} = qr/^($self->{cfg}->{violentwords}) (\S+)(.*)/i if $self->{cfg}->{violentwords};
  45. $self->{chartsregexp} = qr/^$self->{cfg}->{chartsregexp}/i if $self->{cfg}->{chartsregexp};
  46. return $self;
  47. }
  48. # The function to choose which module to use.
  49. sub _choose_format
  50. {
  51. my $self = shift;
  52. my $format = shift;
  53. $self->{parser} = undef;
  54. eval <<_END;
  55. use lib '$self->{cfg}->{modules_dir}';
  56. use Pisg::Parser::Format::$format;
  57. \$self->{parser} = new Pisg::Parser::Format::$format(
  58. cfg => \$self->{cfg},
  59. );
  60. _END
  61. if ($@) {
  62. print STDERR "Could not load parser for '$format': $@\n";
  63. return undef;
  64. }
  65. return $self->{parser};
  66. }
  67. sub analyze
  68. {
  69. my $self = shift;
  70. my (%stats, %lines);
  71. unless (defined $self->{parser}) {
  72. print STDERR "Skipping channel '$self->{cfg}->{channel}' due to lack of parser.\n";
  73. return undef
  74. }
  75. my $starttime = time();
  76. # Just initialize these to 0
  77. $stats{days} = 0;
  78. $stats{parsedlines} = 0;
  79. $stats{totallines} = 0;
  80. my @logfiles = @{$self->{cfg}->{logfile}};
  81. # expand wildcards
  82. @logfiles = map { if(/[\[*?]/) { glob; } else { $_; } } @logfiles;
  83. foreach my $logdir (@{$self->{cfg}->{logdir}}) {
  84. push @logfiles, $self->_parse_dir($logdir); # get all files in dir
  85. }
  86. my $count = @logfiles;
  87. my $shift = 0;
  88. if($self->{cfg}->{nfiles} > 0) { # chop list to maximal length
  89. $shift = @logfiles - $self->{cfg}->{nfiles};
  90. splice(@logfiles, 0, $shift) if $shift > 0;
  91. }
  92. unless ($self->{cfg}->{silent}) {
  93. my $msg = "";
  94. $msg = ", parsing the last $self->{cfg}->{nfiles}" if ($shift > 0);
  95. print "$count logfile(s) found$msg, using $self->{cfg}->{format} format...\n\n"
  96. }
  97. my %state = (
  98. lastnick => '',
  99. monocount => 0,
  100. lastnormal => '',
  101. oldtime => 24
  102. );
  103. foreach my $logfile (@logfiles) {
  104. # Run through the logfile
  105. $self->_parse_file(\%stats, \%lines, $logfile, \%state);
  106. }
  107. $self->_pick_random_lines(\%stats, \%lines);
  108. _uniquify_nicks(\%stats);
  109. my ($sec,$min,$hour) = gmtime(time() - $starttime);
  110. my $processtime = sprintf('%02d hours, %02d minutes and %02d seconds', $hour, $min, $sec);
  111. $stats{processtime}{hours} = sprintf('%02d', $hour);
  112. $stats{processtime}{mins} = sprintf('%02d', $min);
  113. $stats{processtime}{secs} = sprintf('%02d', $sec);
  114. print "Channel analyzed successfully in $processtime on ",
  115. scalar localtime(time()), "\n\n"
  116. unless ($self->{cfg}->{silent});
  117. return \%stats;
  118. }
  119. sub _parse_dir
  120. {
  121. my $self = shift;
  122. my $logdir = shift;
  123. # Add trailing slash when it's not there..
  124. $logdir =~ s/([^\/])$/$1\//;
  125. unless ($self->{cfg}->{silent}) {
  126. print "Looking for logfiles in $logdir...\n\n"
  127. }
  128. my @filesarray;
  129. opendir(LOGDIR, $logdir) or
  130. die("Can't opendir ${logdir}: $!");
  131. @filesarray = grep {
  132. /^[^\.]/ && /^$self->{cfg}->{logprefix}/ && -f "$logdir/$_"
  133. } readdir(LOGDIR) or
  134. die("No files in \"$logdir\" matched prefix \"$self->{cfg}->{logprefix}\"");
  135. closedir(LOGDIR);
  136. if ($self->{cfg}->{logsuffix} ne '') {
  137. my @temparray;
  138. my %months = (
  139. 'jan' => '0',
  140. 'feb' => '1',
  141. 'mar' => '2',
  142. 'apr' => '3',
  143. 'may' => '4',
  144. 'jun' => '5',
  145. 'jul' => '6',
  146. 'aug' => '7',
  147. 'sep' => '8',
  148. 'oct' => '9',
  149. 'nov' => '10',
  150. 'dec' => '11',
  151. );
  152. my ($mreg, $dreg, $yreg) = split(/\|\|/, $self->{cfg}->{logsuffix});
  153. my (@month, @day, @year);
  154. for my $file (@filesarray) {
  155. LOOPSTART:
  156. if ($file =~ /$mreg/) {
  157. my $month = $1;
  158. $month = lc $month;
  159. $month = $months{$month}
  160. if (defined $months{$month});
  161. push @month, $month;
  162. } else {
  163. splice(@filesarray,$#month + 1, 1);
  164. if ($file = $filesarray[$#month + 1]) {
  165. goto LOOPSTART;
  166. } else {
  167. last;
  168. }
  169. }
  170. if ($file =~ /$dreg/) {
  171. push @day, $1;
  172. } else {
  173. splice(@filesarray,$#day + 1, 1);
  174. splice(@month,$#day + 1);
  175. if ($file = $filesarray[$#day + 1]) {
  176. goto LOOPSTART;
  177. } else {
  178. last;
  179. }
  180. }
  181. if ($file =~ /$yreg/) {
  182. push @year, $1;
  183. } else {
  184. splice(@filesarray,$#year + 1, 1);
  185. splice(@month,$#year + 1);
  186. splice(@day,$#year + 1);
  187. if ($file = $filesarray[$#year + 1]) {
  188. goto LOOPSTART;
  189. } else {
  190. last;
  191. }
  192. }
  193. }
  194. @filesarray = @filesarray[ sort {
  195. $year[$a] <=> $year[$b]
  196. ||
  197. $month[$a] <=> $month[$b]
  198. ||
  199. $day[$a] <=> $day[$b]
  200. } 0..$#filesarray ];
  201. } else {
  202. @filesarray = sort {lc($a) cmp lc($b)} @filesarray;
  203. }
  204. return map { "$logdir$_" } @filesarray;
  205. }
  206. # This parses the file...
  207. sub _parse_file
  208. {
  209. my $self = shift;
  210. my ($stats, $lines, $file, $state) = @_;
  211. print "Analyzing log $file... "
  212. unless ($self->{cfg}->{silent});
  213. if ($file =~ /.bz2?$/ && -f $file) {
  214. open (LOGFILE, "bunzip2 -c $file |") or
  215. die("$0: Unable to open logfile($file): $!\n");
  216. } elsif ($file =~ /.gz$/ && -f $file) {
  217. open (LOGFILE, "gunzip -c $file |") or
  218. die("$0: Unable to open logfile($file): $!\n");
  219. } else {
  220. open (LOGFILE, $file) or
  221. die("$0: Unable to open logfile($file): $!\n");
  222. }
  223. my $lastnormal = '';
  224. while(my $line = <LOGFILE>) {
  225. $line = _strip_mirccodes($line);
  226. $line =~ s/\r+$//; # Strip DOS Formatting
  227. if($self->{iconv}) { # iconv is defined only if LogCharset is set
  228. my $line2 = $self->{iconv}->convert($line);
  229. if(not $line2 and $self->{iconvfallback}) {
  230. $line2 = $self->{iconvfallback}->convert($line);
  231. }
  232. if($line2) {
  233. $line = $line2;
  234. } else {
  235. print "Charset conversion failed for '$line'\n"
  236. unless ($self->{cfg}->{silent});
  237. }
  238. }
  239. my $hashref;
  240. # Match normal lines.
  241. if ($hashref = $self->{parser}->normalline($line, $.)) {
  242. my $repeated = 0;
  243. if (defined $hashref->{repeated}) {
  244. $repeated = $hashref->{repeated};
  245. }
  246. my ($hour, $nick, $saying, $i);
  247. for ($i = 0; $i <= $repeated; $i++) {
  248. if ($i > 0) {
  249. $hashref = $self->{parser}->normalline($lastnormal, $.);
  250. #Increment number of lines for repeated lines
  251. }
  252. $hour = $self->_adjusttimeoffset($hashref->{hour});
  253. $nick = find_alias($hashref->{nick});
  254. checkname($hashref->{nick}, $nick, $stats) if ($self->{cfg}->{showmostnicks});
  255. $saying = $hashref->{saying};
  256. if ($hour < $state->{oldtime}) {
  257. $stats->{days}++;
  258. $stats->{day_times}{$stats->{days}}[0] = 0;
  259. $stats->{day_times}{$stats->{days}}[1] = 0;
  260. $stats->{day_times}{$stats->{days}}[2] = 0;
  261. $stats->{day_times}{$stats->{days}}[3] = 0;
  262. $stats->{day_lines}{$stats->{days}} = 0;
  263. }
  264. $state->{oldtime} = $hour;
  265. if (!is_ignored($nick)) {
  266. $stats->{parsedlines}++;
  267. # Timestamp collecting
  268. $stats->{times}{$hour}++;
  269. $stats->{day_times}{$stats->{days}}[int($hour/6)]++;
  270. $stats->{day_lines}{$stats->{days}}++;
  271. $stats->{lines}{$nick}++;
  272. $stats->{lastvisited}{$nick} = $stats->{days};
  273. $stats->{line_times}{$nick}[int($hour/6)]++;
  274. # Count up monologues
  275. if ($state->{lastnick} eq $nick) {
  276. $state->{monocount}++;
  277. if ($state->{monocount} == 5) {
  278. $stats->{monologues}{$nick}++;
  279. }
  280. } else {
  281. $state->{monocount} = 0;
  282. }
  283. $state->{lastnick} = $nick;
  284. my $len = length($saying);
  285. if ($len > $self->{cfg}->{minquote} && $len < $self->{cfg}->{maxquote}) {
  286. push @{ $lines->{sayings}{$nick} }, $saying;
  287. } elsif (!$lines->{sayings}{$nick}) {
  288. # Just fill the users first saying in if he hasn't
  289. # said anything yet, to get rid of empty quotes.
  290. push @{ $lines->{sayings}{$nick} }, substr($saying, 0, $self->{cfg}->{maxquote});
  291. }
  292. $stats->{lengths}{$nick} += $len;
  293. $stats->{questions}{$nick}++
  294. if (index($saying, '?') > -1);
  295. $stats->{shouts}{$nick}++
  296. if (index($saying, '!') > -1);
  297. if ($saying !~ /[a-z]/o && $saying =~ /[A-Z]/o) {
  298. # Ignore single smileys on a line. eg. '<user> :P'
  299. if ($saying !~ /^[8;:=][ ^-o]?[)pPD\}\]>]$/o) {
  300. $stats->{allcaps}{$nick}++;
  301. push @{ $lines->{allcaplines}{$nick} }, $line;
  302. }
  303. }
  304. if ($self->{foulwords_regexp} and my @foul = $saying =~ /$self->{foulwords_regexp}/) {
  305. $stats->{foul}{$nick} += scalar @foul;
  306. push @{ $lines->{foullines}{$nick} }, $line;
  307. }
  308. # Who smiles the most?
  309. # A regex matching al lot of smilies
  310. $stats->{smiles}{$nick}++
  311. if ($saying =~ /[8;:=][ ^-o]?[)pPD\}\]>]/o);
  312. if ($saying =~ /[8;:=][ ^-]?[\(\[\\\/\{]/o and
  313. $saying !~ /\w+:\/\//o) {
  314. $stats->{frowns}{$nick}++;
  315. }
  316. if ($self->{cfg}->{showkarma}) {
  317. # require 2 chars (catches C++), nick must not end in [+=-]
  318. if ($saying =~ /^(\S*\w\S*\w\S*(?<![+=-]))(\+\+|==|--)$/o) {
  319. my $thing = lc $1;
  320. my $k = $2 eq "++" ? 1 : ($2 eq "==" ? 0 : -1);
  321. $stats->{karma}{$thing}{$nick} = $k
  322. if !is_ignored($thing) and $thing ne lc($nick);
  323. }
  324. }
  325. # Find URLs
  326. if (my @urls = match_urls($saying)) {
  327. foreach my $url (@urls) {
  328. if(!url_is_ignored($url)) {
  329. $stats->{urlcounts}{$url}++;
  330. $stats->{urlnicks}{$url} = $nick;
  331. }
  332. }
  333. }
  334. if ($self->{cfg}->{showcharts}) {
  335. if ($saying =~ /$self->{chartsregexp}/i) {
  336. my $Song = $1;
  337. $Song =~ s/_/ /g;
  338. $Song =~ s/\d+ ?- ?//;
  339. $Song =~ s/\.mp3//g;
  340. $Song =~ s/ \.\.\.$//;
  341. my $song = lc $Song;
  342. $stats->{word_upcase}{$song} = $Song;
  343. $stats->{chartcounts}{$song}++;
  344. $stats->{chartnicks}{$song} = $nick;
  345. }
  346. }
  347. if (my $s = $self->{users}->{sex}{$nick}) {
  348. $stats->{sex_lines}{$s}++;
  349. $stats->{sex_line_times}{$s}[int($hour/6)]++;
  350. }
  351. _parse_words($stats, $saying, $nick, $self->{ignorewords_regexp}, $hour);
  352. } # ignored
  353. } # repeated
  354. $lastnormal = $line;
  355. $repeated = 0;
  356. } # normal lines
  357. # Match action lines.
  358. elsif ($hashref = $self->{parser}->actionline($line, $.)) {
  359. $stats->{parsedlines}++;
  360. my ($hour, $nick, $saying);
  361. $hour = $self->_adjusttimeoffset($hashref->{hour});
  362. $nick = find_alias($hashref->{nick});
  363. checkname($hashref->{nick}, $nick, $stats) if ($self->{cfg}->{showmostnicks});
  364. $saying = $hashref->{saying};
  365. if ($hour < $state->{oldtime}) {
  366. $stats->{days}++;
  367. $stats->{day_times}{$stats->{days}}[0] = 0;
  368. $stats->{day_times}{$stats->{days}}[1] = 0;
  369. $stats->{day_times}{$stats->{days}}[2] = 0;
  370. $stats->{day_times}{$stats->{days}}[3] = 0;
  371. $stats->{day_lines}{$stats->{days}} = 0;
  372. }
  373. $state->{oldtime} = $hour;
  374. if (!is_ignored($nick)) {
  375. # Timestamp collecting
  376. $stats->{times}{$hour}++;
  377. $stats->{day_times}{$stats->{days}}[int($hour/6)]++;
  378. $stats->{day_lines}{$stats->{days}}++;
  379. $stats->{actions}{$nick}++;
  380. push @{ $lines->{actionlines}{$nick} }, $line;
  381. $stats->{lines}{$nick}++;
  382. $stats->{lastvisited}{$nick} = $stats->{days};
  383. $stats->{line_times}{$nick}[int($hour/6)]++;
  384. if ($self->{violentwords_regexp} and $saying =~ /$self->{violentwords_regexp}/) {
  385. my $victim;
  386. unless ($victim = is_nick($2)) {
  387. foreach my $trynick (split(/\s+/, $3)) {
  388. last if ($victim = is_nick($trynick));
  389. }
  390. unless ($victim) {
  391. $victim = $2;
  392. }
  393. }
  394. if (!is_ignored($victim)) {
  395. $stats->{violence}{$nick}++;
  396. $stats->{attacked}{$victim}++;
  397. push @{ $lines->{violencelines}{$nick} }, $line;
  398. push @{ $lines->{attackedlines}{$victim} }, $line;
  399. }
  400. }
  401. if ($self->{cfg}->{showcharts}) {
  402. if ($saying =~ /$self->{chartsregexp}/i) {
  403. my $song = lc $1;
  404. $stats->{word_upcase}{$song} = $1;
  405. $stats->{chartcounts}{$song}++;
  406. $stats->{chartnicks}{$song} = $nick;
  407. }
  408. }
  409. $stats->{lengths}{$nick} += length($saying);
  410. if (my $s = $self->{users}->{sex}{$nick}) {
  411. $stats->{sex_lines}{$s}++;
  412. $stats->{sex_line_times}{$s}[int($hour/6)]++;
  413. }
  414. _parse_words($stats, $saying, $nick, $self->{ignorewords_regexp}, $hour);
  415. } # ignored
  416. } # action lines
  417. # Match *** lines.
  418. elsif (($hashref = $self->{parser}->thirdline($line, $.)) and $hashref->{nick}) {
  419. $stats->{parsedlines}++;
  420. my ($hour, $min, $nick, $kicker, $newtopic, $newmode, $newjoin);
  421. my ($newnick);
  422. $hour = $self->_adjusttimeoffset($hashref->{hour});
  423. $min = $hashref->{min};
  424. $nick = find_alias($hashref->{nick});
  425. checkname($hashref->{nick}, $nick, $stats) if ($self->{cfg}->{showmostnicks});
  426. $kicker = find_alias($hashref->{kicker})
  427. if ($hashref->{kicker});
  428. $newtopic = $hashref->{newtopic};
  429. $newmode = $hashref->{newmode};
  430. $newjoin = $hashref->{newjoin};
  431. $newnick = $hashref->{newnick};
  432. if ($hour < $state->{oldtime}) {
  433. $stats->{days}++;
  434. $stats->{day_times}{$stats->{days}}[0]=0;
  435. $stats->{day_times}{$stats->{days}}[1]=0;
  436. $stats->{day_times}{$stats->{days}}[2]=0;
  437. $stats->{day_times}{$stats->{days}}[3]=0;
  438. $stats->{day_lines}{$stats->{days}}=0;
  439. }
  440. $state->{oldtime} = $hour;
  441. if (!is_ignored($nick)) {
  442. # Timestamp collecting
  443. $stats->{times}{$hour}++;
  444. $stats->{day_times}{$stats->{days}}[int($hour/6)]++;
  445. $stats->{day_lines}{$stats->{days}}++;
  446. $stats->{lastvisited}{$nick} = $stats->{days};
  447. if (defined($kicker)) {
  448. if (!is_ignored($kicker)) {
  449. $stats->{kicked}{$kicker}++;
  450. $stats->{gotkicked}{$nick}++;
  451. push @{ $lines->{kicklines}{$nick} }, $line;
  452. }
  453. } elsif (defined($newtopic) && $newtopic ne '') {
  454. _topic_change($stats, $newtopic, $nick, $hour, $min, $stats->{days});
  455. } elsif (defined($newmode)) {
  456. _modechanges($stats, $newmode, $nick);
  457. } elsif (defined($newjoin)) {
  458. $stats->{joins}{$nick}++;
  459. } elsif (defined($newnick) and ($self->{cfg}->{nicktracking} == 1)) {
  460. # Resolve new nick to the correct alias (this will create a hard-alias if it is using a regex)
  461. $newnick = find_alias($newnick);
  462. add_alias($nick, $newnick);
  463. checkname($nick, $newnick, $stats) if ($self->{cfg}->{showmostnicks});
  464. }
  465. }
  466. } # *** lines
  467. unless ($stats->{parsedlines} % 10000) { # keep only recent quotes to same mem
  468. foreach my $n (keys %{$lines->{sayings}}) {
  469. my $x = @{$lines->{sayings}->{$n}};
  470. splice(@{$lines->{sayings}->{$n}}, 0, ($x - 50)) if ($x > 75);
  471. }
  472. foreach my $n (keys %{$lines->{actionlines}}) {
  473. my $y = @{$lines->{actionlines}->{$n}};
  474. splice(@{$lines->{actionlines}->{$n}}, 0, ($y - 50)) if ($y > 75);
  475. }
  476. }
  477. } # while(my $line = <LOGFILE>)
  478. $stats->{totallines} = $.;
  479. close(LOGFILE);
  480. print "$stats->{days} days, $stats->{parsedlines} lines total\n"
  481. unless ($self->{cfg}->{silent});
  482. }
  483. sub _topic_change
  484. {
  485. my $stats = shift;
  486. my $newtopic = shift;
  487. my $nick = shift;
  488. my $hour = shift;
  489. my $min = shift;
  490. my $days = shift;
  491. my $tcount = 0;
  492. if (defined $stats->{topics}) {
  493. $tcount = @{ $stats->{topics} };
  494. }
  495. $stats->{topics}[$tcount]{topic} = $newtopic;
  496. $stats->{topics}[$tcount]{nick} = $nick;
  497. $stats->{topics}[$tcount]{hour} = $hour;
  498. $stats->{topics}[$tcount]{min} = $min;
  499. $stats->{topics}[$tcount]{days} = $days;
  500. }
  501. sub _modechanges
  502. {
  503. my $stats = shift;
  504. my $newmode = shift;
  505. my $nick = shift;
  506. my (@voice, @halfops, @ops, $plus);
  507. foreach (split(//, $newmode)) {
  508. if ($_ eq 'o') {
  509. $ops[$plus]++;
  510. } elsif ($_ eq 'h') {
  511. $halfops[$plus]++;
  512. } elsif ($_ eq 'v') {
  513. $voice[$plus]++;
  514. } elsif ($_ eq '+') {
  515. $plus = 0;
  516. } elsif ($_ eq '-') {
  517. $plus = 1;
  518. }
  519. }
  520. $stats->{gaveops}{$nick} += $ops[0] if $ops[0];
  521. $stats->{tookops}{$nick} += $ops[1] if $ops[1];
  522. $stats->{gavehalfops}{$nick} += $halfops[0] if $halfops[0];
  523. $stats->{tookhalfops}{$nick} += $halfops[1] if $halfops[1];
  524. $stats->{gavevoice}{$nick} += $voice[0] if $voice[0];
  525. $stats->{tookvoice}{$nick} += $voice[1] if $voice[1];
  526. }
  527. sub _parse_words
  528. {
  529. my ($stats, $saying, $nick, $ignorewords_regexp, $hour) = @_;
  530. # Cache time of day
  531. my $tod = int($hour/6);
  532. foreach my $word (split(/[\s,!?.:;)(\"]+/o, $saying)) {
  533. $stats->{words}{$nick}++;
  534. $stats->{word_times}{$nick}[$tod]++;
  535. # remove uninteresting words
  536. next if $ignorewords_regexp and $word =~ m/$ignorewords_regexp/i;
  537. # ignore contractions
  538. next if ($word =~ m/'.{1,2}$/o);
  539. # Also ignore stuff from URLs.
  540. next if ($word =~ m/^https?$|^\/\//o);
  541. my $lcword = lc $word;
  542. $stats->{wordcounts}{$lcword}++;
  543. $stats->{wordnicks}{$lcword} = $nick;
  544. $stats->{word_upcase}{$lcword} ||= $word; # remember first-seen case
  545. }
  546. }
  547. sub _pick_random_lines
  548. {
  549. my ($self, $stats, $lines) = @_;
  550. foreach my $key (keys %{ $lines }) {
  551. foreach my $nick (keys %{ $lines->{$key} }) {
  552. $stats->{$key}{$nick} = $self->_random_line($stats, $lines, $key, $nick, 0);
  553. }
  554. }
  555. }
  556. sub _random_line
  557. {
  558. my ($self, $stats, $lines, $key, $nick, $count) = @_;
  559. my $random = ${ $lines->{$key}{$nick} }[rand@{ $lines->{$key}{$nick} }];
  560. if ($self->{cfg}->{noignoredquotes} and $self->{ignorewords_regexp} and $random =~ /$self->{ignorewords_regexp}/i) {
  561. return '' if ($count > 20);
  562. return $self->_random_line($stats, $lines, $key, $nick, ++$count);
  563. } else {
  564. return $random;
  565. }
  566. }
  567. sub _uniquify_nicks {
  568. my ($stats) = @_;
  569. foreach my $word (keys %{ $stats->{wordcounts} }) {
  570. if (my $realnick = lc(is_nick($word))) {
  571. if ($realnick ne $word) { # word is always lc
  572. $stats->{wordcounts}{$realnick} += $stats->{wordcounts}{$word};
  573. $stats->{wordnicks}{$realnick} ||= $stats->{wordnicks}{$word};
  574. $stats->{word_upcase}{$realnick} ||= $stats->{word_upcase}{$word};
  575. delete $stats->{wordcounts}{$word};
  576. delete $stats->{wordnicks}{$word};
  577. delete $stats->{word_upcase}{$word};
  578. }
  579. }
  580. }
  581. }
  582. sub _strip_mirccodes
  583. {
  584. my $line = shift;
  585. # boldcode = chr(2) = oct 001
  586. # colorcode = chr(3) = oct 003
  587. # plaincode = chr(15) = oct 017
  588. # reversecode = chr(22) = oct 026
  589. # underlinecode = chr(31) = oct 037
  590. # Strip mIRC color codes
  591. $line =~ s/\003\d{1,2},\d{1,2}//go;
  592. $line =~ s/\003\d{0,2}//go;
  593. # Strip mIRC bold, plain, reverse and underline codes
  594. $line =~ s/[\002\017\026\037]//go;
  595. return $line;
  596. }
  597. sub checkname {
  598. # This function tracks nickchanges and puts them all in a hash->array,
  599. # so we can show all nicks that a user had later (only works properly
  600. # when nicktracking is enabled)
  601. my ($nick, $newnick, $stats) = @_;
  602. $stats->{nicks}{$newnick}{lc($nick)} = $nick;
  603. }
  604. sub _adjusttimeoffset
  605. {
  606. my ($self, $hour) = @_;
  607. if ($self->{cfg}{timeoffset} != 0) {
  608. # Adjust time
  609. $hour += $self->{cfg}{timeoffset};
  610. $hour = $hour % 24;
  611. }
  612. return sprintf('%02d', $hour);
  613. }
  614. 1;
  615. __END__
  616. =head1 NAME
  617. Pisg::Parser::Logfile - class to parse a normal logfile
  618. =head1 DESCRIPTION
  619. C<Pisg::Parser::Logfile> parses a logfile using the configuration variables set in the 'cfg' option passed to the constructor.
  620. =head1 SYNOPSIS
  621. use Pisg::Parser::Logfile;
  622. $analyzer = new Pisg::Parser::Logfile(
  623. { cfg => $self->{cfg}, users => $self->{users} }
  624. );
  625. =head1 CONSTRUCTOR
  626. =over 4
  627. =item new ( [ OPTIONS ] )
  628. This is the constructor for a new Pisg::Parser::Logfile object.
  629. The first option must be a reference to a hash containing the cfg and users structures.
  630. =back
  631. =head1 AUTHOR
  632. Morten Brix Pedersen <morten@wtf.dk>
  633. =head1 COPYRIGHT
  634. Copyright (C) 2001-2005 Morten Brix Pedersen. All rights resereved.
  635. Copyright (C) 2003-2005 Christoph Berg <cb@df7cb.de>.
  636. This program is free software; you can redistribute it and/or modify it
  637. under the terms of the GPL, license is included with the distribution of
  638. this file.
  639. =cut