Logfile.pm 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750
  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. return $self;
  46. }
  47. # The function to choose which module to use.
  48. sub _choose_format
  49. {
  50. my $self = shift;
  51. my $format = shift;
  52. $self->{parser} = undef;
  53. eval <<_END;
  54. use lib '$self->{cfg}->{modules_dir}';
  55. use Pisg::Parser::Format::$format;
  56. \$self->{parser} = new Pisg::Parser::Format::$format(
  57. cfg => \$self->{cfg},
  58. );
  59. _END
  60. if ($@) {
  61. print STDERR "Could not load parser for '$format': $@\n";
  62. return undef;
  63. }
  64. return $self->{parser};
  65. }
  66. sub analyze
  67. {
  68. my $self = shift;
  69. my (%stats, %lines);
  70. unless (defined $self->{parser}) {
  71. print STDERR "Skipping channel '$self->{cfg}->{channel}' due to lack of parser.\n";
  72. return undef
  73. }
  74. my $starttime = time();
  75. # Just initialize these to 0
  76. $stats{days} = 0;
  77. $stats{parsedlines} = 0;
  78. $stats{totallines} = 0;
  79. my @logfiles = @{$self->{cfg}->{logfile}};
  80. # expand wildcards
  81. @logfiles = map { if(/[\[*?]/) { glob; } else { $_; } } @logfiles;
  82. if (scalar(@{$self->{cfg}->{logdir}}) > 0) {
  83. push @logfiles, $self->_parse_dir(); # get all files in dir
  84. }
  85. my $count = @logfiles;
  86. my $shift = 0;
  87. if($self->{cfg}->{nfiles} > 0) { # chop list to maximal length
  88. $shift = @logfiles - $self->{cfg}->{nfiles};
  89. splice(@logfiles, 0, $shift) if $shift > 0;
  90. }
  91. unless ($self->{cfg}->{silent}) {
  92. my $msg = "";
  93. $msg = ", parsing the last $self->{cfg}->{nfiles}" if ($shift > 0);
  94. print "$count logfile(s) found$msg, using $self->{cfg}->{format} format...\n\n"
  95. }
  96. my %state = (
  97. lastnick => '',
  98. monocount => 0,
  99. lastnormal => '',
  100. oldtime => 24
  101. );
  102. foreach my $logfile (@logfiles) {
  103. # Run through the logfile
  104. $self->_parse_file(\%stats, \%lines, $logfile, \%state);
  105. }
  106. $self->_pick_random_lines(\%stats, \%lines);
  107. _uniquify_nicks(\%stats);
  108. my ($sec,$min,$hour) = gmtime(time() - $starttime);
  109. my $processtime = sprintf('%02d hours, %02d minutes and %02d seconds', $hour, $min, $sec);
  110. $stats{processtime}{hours} = sprintf('%02d', $hour);
  111. $stats{processtime}{mins} = sprintf('%02d', $min);
  112. $stats{processtime}{secs} = sprintf('%02d', $sec);
  113. print "Channel analyzed successfully in $processtime on ",
  114. scalar localtime(time()), "\n\n"
  115. unless ($self->{cfg}->{silent});
  116. return \%stats;
  117. }
  118. sub _parse_dir
  119. {
  120. my $self = shift;
  121. # Loop through each logdir we were given
  122. foreach my $logdir (@{$self->{cfg}->{logdir}}) {
  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. }
  207. # This parses the file...
  208. sub _parse_file
  209. {
  210. my $self = shift;
  211. my ($stats, $lines, $file, $state) = @_;
  212. print "Analyzing log $file... "
  213. unless ($self->{cfg}->{silent});
  214. if ($file =~ /.bz2?$/ && -f $file) {
  215. open (LOGFILE, "bunzip2 -c $file |") or
  216. die("$0: Unable to open logfile($file): $!\n");
  217. } elsif ($file =~ /.gz$/ && -f $file) {
  218. open (LOGFILE, "gunzip -c $file |") or
  219. die("$0: Unable to open logfile($file): $!\n");
  220. } else {
  221. open (LOGFILE, $file) or
  222. die("$0: Unable to open logfile($file): $!\n");
  223. }
  224. my $lastnormal = '';
  225. while(my $line = <LOGFILE>) {
  226. $line = _strip_mirccodes($line);
  227. $line =~ s/\r+$//; # Strip DOS Formatting
  228. if($self->{iconv}) { # iconv is defined only if LogCharset is set
  229. my $line2 = $self->{iconv}->convert($line);
  230. if(not $line2 and $self->{iconvfallback}) {
  231. $line2 = $self->{iconvfallback}->convert($line);
  232. }
  233. if($line2) {
  234. $line = $line2;
  235. } else {
  236. print "Charset conversion failed for '$line'\n"
  237. unless ($self->{cfg}->{silent});
  238. }
  239. }
  240. my $hashref;
  241. # Match normal lines.
  242. if ($hashref = $self->{parser}->normalline($line, $.)) {
  243. my $repeated = 0;
  244. if (defined $hashref->{repeated}) {
  245. $repeated = $hashref->{repeated};
  246. }
  247. my ($hour, $nick, $saying, $i);
  248. for ($i = 0; $i <= $repeated; $i++) {
  249. if ($i > 0) {
  250. $hashref = $self->{parser}->normalline($lastnormal, $.);
  251. #Increment number of lines for repeated lines
  252. }
  253. $hour = $self->_adjusttimeoffset($hashref->{hour});
  254. $nick = find_alias($hashref->{nick});
  255. checkname($hashref->{nick}, $nick, $stats) if ($self->{cfg}->{showmostnicks});
  256. $saying = $hashref->{saying};
  257. if ($hour < $state->{oldtime}) {
  258. $stats->{days}++;
  259. $stats->{day_times}{$stats->{days}}[0] = 0;
  260. $stats->{day_times}{$stats->{days}}[1] = 0;
  261. $stats->{day_times}{$stats->{days}}[2] = 0;
  262. $stats->{day_times}{$stats->{days}}[3] = 0;
  263. $stats->{day_lines}{$stats->{days}} = 0;
  264. }
  265. $state->{oldtime} = $hour;
  266. if (!is_ignored($nick)) {
  267. $stats->{parsedlines}++;
  268. # Timestamp collecting
  269. $stats->{times}{$hour}++;
  270. $stats->{day_times}{$stats->{days}}[int($hour/6)]++;
  271. $stats->{day_lines}{$stats->{days}}++;
  272. $stats->{lines}{$nick}++;
  273. $stats->{lastvisited}{$nick} = $stats->{days};
  274. $stats->{line_times}{$nick}[int($hour/6)]++;
  275. # Count up monologues
  276. if ($state->{lastnick} eq $nick) {
  277. $state->{monocount}++;
  278. if ($state->{monocount} == 5) {
  279. $stats->{monologues}{$nick}++;
  280. }
  281. } else {
  282. $state->{monocount} = 0;
  283. }
  284. $state->{lastnick} = $nick;
  285. my $len = length($saying);
  286. if ($len > $self->{cfg}->{minquote} && $len < $self->{cfg}->{maxquote}) {
  287. push @{ $lines->{sayings}{$nick} }, $saying;
  288. } elsif (!$lines->{sayings}{$nick}) {
  289. # Just fill the users first saying in if he hasn't
  290. # said anything yet, to get rid of empty quotes.
  291. push @{ $lines->{sayings}{$nick} }, substr($saying, 0, $self->{cfg}->{maxquote});
  292. }
  293. $stats->{lengths}{$nick} += $len;
  294. $stats->{questions}{$nick}++
  295. if (index($saying, '?') > -1);
  296. $stats->{shouts}{$nick}++
  297. if (index($saying, '!') > -1);
  298. if ($saying !~ /[a-z]/o && $saying =~ /[A-Z]/o) {
  299. # Ignore single smileys on a line. eg. '<user> :P'
  300. if ($saying !~ /^[8;:=][ ^-o]?[)pPD}\]>]$/o) {
  301. $stats->{allcaps}{$nick}++;
  302. push @{ $lines->{allcaplines}{$nick} }, $line;
  303. }
  304. }
  305. if ($self->{foulwords_regexp} and my @foul = $saying =~ /$self->{foulwords_regexp}/) {
  306. $stats->{foul}{$nick} += scalar @foul;
  307. push @{ $lines->{foullines}{$nick} }, $line;
  308. }
  309. # Who smiles the most?
  310. # A regex matching al lot of smilies
  311. $stats->{smiles}{$nick}++
  312. if ($saying =~ /[8;:=][ ^-o]?[)pPD}\]>]/o);
  313. if ($saying =~ /[8;:=][ ^-]?[\(\[\\\/{]/o and
  314. $saying !~ /\w+:\/\//o) {
  315. $stats->{frowns}{$nick}++;
  316. }
  317. if ($self->{cfg}->{showkarma}) {
  318. # require 2 chars (catches C++), nick must not end in [+=-]
  319. if ($saying =~ /^(\S*\w\S*\w\S*(?<![+=-]))(\+\+|==|--)$/o) {
  320. my $thing = lc $1;
  321. my $k = $2 eq "++" ? 1 : ($2 eq "==" ? 0 : -1);
  322. $stats->{karma}{$thing}{$nick} = $k
  323. if !is_ignored($thing) and $thing ne lc($nick);
  324. }
  325. }
  326. # Find URLs
  327. if (my @urls = match_urls($saying)) {
  328. foreach my $url (@urls) {
  329. if(!url_is_ignored($url)) {
  330. $stats->{urlcounts}{$url}++;
  331. $stats->{urlnicks}{$url} = $nick;
  332. }
  333. }
  334. }
  335. if (my $s = $self->{users}->{sex}{$nick}) {
  336. $stats->{sex_lines}{$s}++;
  337. $stats->{sex_line_times}{$s}[int($hour/6)]++;
  338. }
  339. _parse_words($stats, $saying, $nick, $self->{ignorewords_regexp}, $hour);
  340. }
  341. }
  342. $lastnormal = $line;
  343. $repeated = 0;
  344. } # normal lines
  345. # Match action lines.
  346. elsif ($hashref = $self->{parser}->actionline($line, $.)) {
  347. $stats->{parsedlines}++;
  348. my ($hour, $nick, $saying);
  349. $hour = $self->_adjusttimeoffset($hashref->{hour});
  350. $nick = find_alias($hashref->{nick});
  351. checkname($hashref->{nick}, $nick, $stats) if ($self->{cfg}->{showmostnicks});
  352. $saying = $hashref->{saying};
  353. if ($hour < $state->{oldtime}) {
  354. $stats->{days}++;
  355. $stats->{day_times}{$stats->{days}}[0] = 0;
  356. $stats->{day_times}{$stats->{days}}[1] = 0;
  357. $stats->{day_times}{$stats->{days}}[2] = 0;
  358. $stats->{day_times}{$stats->{days}}[3] = 0;
  359. $stats->{day_lines}{$stats->{days}} = 0;
  360. }
  361. $state->{oldtime} = $hour;
  362. if (!is_ignored($nick)) {
  363. # Timestamp collecting
  364. $stats->{times}{$hour}++;
  365. $stats->{day_times}{$stats->{days}}[int($hour/6)]++;
  366. $stats->{day_lines}{$stats->{days}}++;
  367. $stats->{actions}{$nick}++;
  368. push @{ $lines->{actionlines}{$nick} }, $line;
  369. $stats->{lines}{$nick}++;
  370. $stats->{lastvisited}{$nick} = $stats->{days};
  371. $stats->{line_times}{$nick}[int($hour/6)]++;
  372. if ($self->{violentwords_regexp} and $saying =~ /$self->{violentwords_regexp}/) {
  373. my $victim;
  374. unless ($victim = is_nick($2)) {
  375. foreach my $trynick (split(/\s+/, $3)) {
  376. last if ($victim = is_nick($trynick));
  377. }
  378. unless ($victim) {
  379. $victim = $2;
  380. }
  381. }
  382. if (!is_ignored($victim)) {
  383. $stats->{violence}{$nick}++;
  384. $stats->{attacked}{$victim}++;
  385. push @{ $lines->{violencelines}{$nick} }, $line;
  386. push @{ $lines->{attackedlines}{$victim} }, $line;
  387. }
  388. }
  389. $stats->{lengths}{$nick} += length($saying);
  390. if (my $s = $self->{users}->{sex}{$nick}) {
  391. $stats->{sex_lines}{$s}++;
  392. $stats->{sex_line_times}{$s}[int($hour/6)]++;
  393. }
  394. _parse_words($stats, $saying, $nick, $self->{ignorewords_regexp}, $hour);
  395. }
  396. } # action lines
  397. # Match *** lines.
  398. elsif (($hashref = $self->{parser}->thirdline($line, $.)) and $hashref->{nick}) {
  399. $stats->{parsedlines}++;
  400. my ($hour, $min, $nick, $kicker, $newtopic, $newmode, $newjoin);
  401. my ($newnick);
  402. $hour = $self->_adjusttimeoffset($hashref->{hour});
  403. $min = $hashref->{min};
  404. $nick = find_alias($hashref->{nick});
  405. checkname($hashref->{nick}, $nick, $stats) if ($self->{cfg}->{showmostnicks});
  406. $kicker = find_alias($hashref->{kicker})
  407. if ($hashref->{kicker});
  408. $newtopic = $hashref->{newtopic};
  409. $newmode = $hashref->{newmode};
  410. $newjoin = $hashref->{newjoin};
  411. $newnick = $hashref->{newnick};
  412. if ($hour < $state->{oldtime}) {
  413. $stats->{days}++;
  414. $stats->{day_times}{$stats->{days}}[0]=0;
  415. $stats->{day_times}{$stats->{days}}[1]=0;
  416. $stats->{day_times}{$stats->{days}}[2]=0;
  417. $stats->{day_times}{$stats->{days}}[3]=0;
  418. $stats->{day_lines}{$stats->{days}}=0;
  419. }
  420. $state->{oldtime} = $hour;
  421. if (!is_ignored($nick)) {
  422. # Timestamp collecting
  423. $stats->{times}{$hour}++;
  424. $stats->{day_times}{$stats->{days}}[int($hour/6)]++;
  425. $stats->{day_lines}{$stats->{days}}++;
  426. $stats->{lastvisited}{$nick} = $stats->{days};
  427. if (defined($kicker)) {
  428. if (!is_ignored($kicker)) {
  429. $stats->{kicked}{$kicker}++;
  430. $stats->{gotkicked}{$nick}++;
  431. push @{ $lines->{kicklines}{$nick} }, $line;
  432. }
  433. } elsif (defined($newtopic) && $newtopic ne '') {
  434. _topic_change($stats, $newtopic, $nick, $hour, $min);
  435. } elsif (defined($newmode)) {
  436. _modechanges($stats, $newmode, $nick);
  437. } elsif (defined($newjoin)) {
  438. $stats->{joins}{$nick}++;
  439. } elsif (defined($newnick) and ($self->{cfg}->{nicktracking} == 1)) {
  440. # Resolve new nick to the correct alias (this will create a hard-alias if it is using a regex)
  441. $newnick = find_alias($newnick);
  442. add_alias($nick, $newnick);
  443. checkname($nick, $newnick, $stats) if ($self->{cfg}->{showmostnicks});
  444. }
  445. }
  446. } # *** lines
  447. unless ($stats->{parsedlines} % 10000) { # keep only recent quotes to same mem
  448. foreach my $n (keys %{$lines->{sayings}}) {
  449. my $x = @{$lines->{sayings}->{$n}};
  450. splice(@{$lines->{sayings}->{$n}}, 0, ($x - 50)) if ($x > 75);
  451. }
  452. foreach my $n (keys %{$lines->{actionlines}}) {
  453. my $y = @{$lines->{actionlines}->{$n}};
  454. splice(@{$lines->{actionlines}->{$n}}, 0, ($y - 50)) if ($y > 75);
  455. }
  456. }
  457. } # while(my $line = <LOGFILE>)
  458. $stats->{totallines} = $.;
  459. close(LOGFILE);
  460. print "$stats->{days} days, $stats->{parsedlines} lines total\n"
  461. unless ($self->{cfg}->{silent});
  462. }
  463. sub _topic_change
  464. {
  465. my $stats = shift;
  466. my $newtopic = shift;
  467. my $nick = shift;
  468. my $hour = shift;
  469. my $min = shift;
  470. my $tcount = 0;
  471. if (defined $stats->{topics}) {
  472. $tcount = @{ $stats->{topics} };
  473. }
  474. $stats->{topics}[$tcount]{topic} = $newtopic;
  475. $stats->{topics}[$tcount]{nick} = $nick;
  476. $stats->{topics}[$tcount]{hour} = $hour;
  477. $stats->{topics}[$tcount]{min} = $min;
  478. }
  479. sub _modechanges
  480. {
  481. my $stats = shift;
  482. my $newmode = shift;
  483. my $nick = shift;
  484. my (@voice, @halfops, @ops, $plus);
  485. foreach (split(//, $newmode)) {
  486. if ($_ eq 'o') {
  487. $ops[$plus]++;
  488. } elsif ($_ eq 'h') {
  489. $halfops[$plus]++;
  490. } elsif ($_ eq 'v') {
  491. $voice[$plus]++;
  492. } elsif ($_ eq '+') {
  493. $plus = 0;
  494. } elsif ($_ eq '-') {
  495. $plus = 1;
  496. }
  497. }
  498. $stats->{gaveops}{$nick} += $ops[0] if $ops[0];
  499. $stats->{tookops}{$nick} += $ops[1] if $ops[1];
  500. $stats->{gavehalfops}{$nick} += $halfops[0] if $halfops[0];
  501. $stats->{tookhalfops}{$nick} += $halfops[1] if $halfops[1];
  502. $stats->{gavevoice}{$nick} += $voice[0] if $voice[0];
  503. $stats->{tookvoice}{$nick} += $voice[1] if $voice[1];
  504. }
  505. sub _parse_words
  506. {
  507. my ($stats, $saying, $nick, $ignorewords_regexp, $hour) = @_;
  508. # Cache time of day
  509. my $tod = int($hour/6);
  510. foreach my $word (split(/[\s,!?.:;)(\"]+/o, $saying)) {
  511. $stats->{words}{$nick}++;
  512. $stats->{word_times}{$nick}[$tod]++;
  513. # remove uninteresting words
  514. next if $ignorewords_regexp and $word =~ m/$ignorewords_regexp/i;
  515. # ignore contractions
  516. next if ($word =~ m/'.{1,2}$/o);
  517. # Also ignore stuff from URLs.
  518. next if ($word =~ m/^https?$|^\/\//o);
  519. my $lcword = lc $word;
  520. $stats->{wordcounts}{$lcword}++;
  521. $stats->{wordnicks}{$lcword} = $nick;
  522. $stats->{word_upcase}{$lcword} ||= $word; # remember first-seen case
  523. }
  524. }
  525. sub _pick_random_lines
  526. {
  527. my ($self, $stats, $lines) = @_;
  528. foreach my $key (keys %{ $lines }) {
  529. foreach my $nick (keys %{ $lines->{$key} }) {
  530. $stats->{$key}{$nick} = $self->_random_line($stats, $lines, $key, $nick, 0);
  531. }
  532. }
  533. }
  534. sub _random_line
  535. {
  536. my ($self, $stats, $lines, $key, $nick, $count) = @_;
  537. my $random = ${ $lines->{$key}{$nick} }[rand@{ $lines->{$key}{$nick} }];
  538. if ($self->{cfg}->{noignoredquotes} and $self->{ignorewords_regexp} and $random =~ /$self->{ignorewords_regexp}/i) {
  539. return '' if ($count > 20);
  540. return $self->_random_line($stats, $lines, $key, $nick, ++$count);
  541. } else {
  542. return $random;
  543. }
  544. }
  545. sub _uniquify_nicks {
  546. my ($stats) = @_;
  547. foreach my $word (keys %{ $stats->{wordcounts} }) {
  548. if (my $realnick = lc(is_nick($word))) {
  549. if ($realnick ne $word) { # word is always lc
  550. $stats->{wordcounts}{$realnick} += $stats->{wordcounts}{$word};
  551. $stats->{wordnicks}{$realnick} ||= $stats->{wordnicks}{$word};
  552. $stats->{word_upcase}{$realnick} ||= $stats->{word_upcase}{$word};
  553. delete $stats->{wordcounts}{$word};
  554. delete $stats->{wordnicks}{$word};
  555. delete $stats->{word_upcase}{$word};
  556. }
  557. }
  558. }
  559. }
  560. sub _strip_mirccodes
  561. {
  562. my $line = shift;
  563. # boldcode = chr(2) = oct 001
  564. # colorcode = chr(3) = oct 003
  565. # plaincode = chr(15) = oct 017
  566. # reversecode = chr(22) = oct 026
  567. # underlinecode = chr(31) = oct 037
  568. # Strip mIRC color codes
  569. $line =~ s/\003\d{1,2},\d{1,2}//go;
  570. $line =~ s/\003\d{0,2}//go;
  571. # Strip mIRC bold, plain, reverse and underline codes
  572. $line =~ s/[\002\017\026\037]//go;
  573. return $line;
  574. }
  575. sub checkname {
  576. # This function tracks nickchanges and puts them all in a hash->array,
  577. # so we can show all nicks that I user had later (only works properly
  578. # when nicktracking is enabled)
  579. my ($nick, $newnick, $stats) = @_;
  580. $stats->{nicks}{$newnick}{lc($nick)} = $nick;
  581. }
  582. sub _adjusttimeoffset
  583. {
  584. my ($self, $hour) = @_;
  585. if ($self->{cfg}{timeoffset} != 0) {
  586. # Adjust time
  587. $hour += $self->{cfg}{timeoffset};
  588. $hour = $hour % 24;
  589. }
  590. return sprintf('%02d', $hour);
  591. }
  592. 1;
  593. __END__
  594. =head1 NAME
  595. Pisg::Parser::Logfile - class to parse a normal logfile
  596. =head1 DESCRIPTION
  597. C<Pisg::Parser::Logfile> parses a logfile using the configuration variables set in the 'cfg' option passed to the constructor.
  598. =head1 SYNOPSIS
  599. use Pisg::Parser::Logfile;
  600. $analyzer = new Pisg::Parser::Logfile(
  601. { cfg => $self->{cfg}, users => $self->{users} }
  602. );
  603. =head1 CONSTRUCTOR
  604. =over 4
  605. =item new ( [ OPTIONS ] )
  606. This is the constructor for a new Pisg::Parser::Logfile object.
  607. The first option must be a reference to a hash containing the cfg and users structures.
  608. =back
  609. =head1 AUTHOR
  610. Morten Brix Pedersen <morten@wtf.dk>
  611. =head1 COPYRIGHT
  612. Copyright (C) 2001 Morten Brix Pedersen. All rights resereved.
  613. This program is free software; you can redistribute it and/or modify it
  614. under the terms of the GPL, license is included with the distribution of
  615. this file.
  616. =cut