mIRC.pm 2.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105
  1. package Pisg::Parser::Format::mIRC;
  2. # Documentation for the Pisg::Parser::Format modules is found in Template.pm
  3. use strict;
  4. $^W = 1;
  5. sub new
  6. {
  7. my ($type, %args) = @_;
  8. my $self = {
  9. cfg => $args{cfg},
  10. normalline => '^\[(\d+):\d+[^ ]+ <([^>]+)> (.*)',
  11. actionline => '^\[(\d+):\d+[^ ]+ \* (\S+) (.*)',
  12. thirdline => '^\[(\d+):(\d+)[^ ]+ \*\*\* (.+)'
  13. };
  14. bless($self, $type);
  15. return $self;
  16. }
  17. sub normalline
  18. {
  19. my ($self, $line, $lines) = @_;
  20. my %hash;
  21. if ($line =~ /$self->{normalline}/o) {
  22. $hash{hour} = $1;
  23. $hash{nick} = remove_prefix($2);
  24. $hash{saying} = $3;
  25. return \%hash;
  26. } else {
  27. return;
  28. }
  29. }
  30. sub actionline
  31. {
  32. my ($self, $line, $lines) = @_;
  33. my %hash;
  34. if ($line =~ /$self->{actionline}/o) {
  35. $hash{hour} = $1;
  36. $hash{nick} = remove_prefix($2);
  37. $hash{saying} = $3;
  38. return \%hash;
  39. } else {
  40. return;
  41. }
  42. }
  43. sub thirdline
  44. {
  45. my ($self, $line, $lines) = @_;
  46. my %hash;
  47. if ($line =~ /$self->{thirdline}/o) {
  48. my @line = split(/\s/, $3);
  49. $hash{hour} = $1;
  50. $hash{min} = $2;
  51. $hash{nick} = remove_prefix($line[0]);
  52. if ($#line >= 4 && ($line[1].$line[2]) eq 'waskicked') {
  53. $hash{kicker} = $line[4];
  54. } elsif ($#line >= 4 && ($line[1] eq 'changes')) {
  55. $hash{newtopic} = join(' ', @line[4..$#line]);
  56. $hash{newtopic} =~ s/^'//;
  57. $hash{newtopic} =~ s/'$//;
  58. } elsif ($#line >= 3 && ($line[1].$line[2]) eq 'setsmode:') {
  59. $hash{newmode} = $line[3];
  60. } elsif ($#line >= 3 && ($line[2].$line[3]) eq 'hasjoined') {
  61. $hash{newjoin} = $line[0];
  62. } elsif ($#line >= 5 && ($line[2].$line[3]) eq 'nowknown') {
  63. $hash{newnick} = $line[5];
  64. }
  65. return \%hash;
  66. } else {
  67. return;
  68. }
  69. }
  70. sub remove_prefix
  71. {
  72. my $str = shift;
  73. $str =~ s/^@//;
  74. $str =~ s/^\+//;
  75. return $str;
  76. }
  77. 1;