ChangeLogReader.pm

   1 package ChangeLogReader;
   2 use strict;
   3 #use vars qw(@ISA @EXPORT $VERSION $OLD_CODE);
   4 #require Exporter;
   5 #@ISA = qw(Exporter);
   6 #@EXPORT = qw(store_changelog store_entry store_entry2 debug_print);
   7 #$VERSION = '0.1';
   8
   9 sub new {
  10     my $class = shift;
  11     my $self = {};
  12     my %param = @_;
  13     for (keys %param) { $self->{lc($_)} = $param{$_} }
  14     return bless $self, $class;
  15 }
  16
  17 sub debug_print {
  18     my ($self) = @_;
  19     foreach my $ymd (reverse sort keys %{$self->{all}}) {
  20         my $ent = $self->{all}->{$ymd};
  21         print "=" x 60, "\n";
  22         print "ENTRY ID: $ymd\n";
  23         print "message-top:",$ent->{'message-top'},"\n"
  24             if (defined $ent->{'message-top'});
  25         print "message-bottom:",$ent->{'message-bottom'},"\n"
  26             if (defined $ent->{'message-bottom'});
  27         for (my $i = $ent->{curid}; $i >= 1; $i--) {
  28             print "-" x 60, "\n";
  29             print "ITEM ID: $ymd-$i\n";
  30             print "ITEM HEADER:>>>>",$ent->{$i}->{ho},"<<<<\n";
  31             print "ITEM CATEGORY:",join(",",@{$ent->{$i}->{cat}}),"\n"
  32                 if (defined $ent->{$i}->{cat});
  33             print "ITEM AUTHOR:>>>>",$ent->{$i}->{a},"<<<<\n";
  34             print "ITEM CONTENT:>>>>",$ent->{$i}->{co},"<<<<\n";
  35         }
  36     }
  37 }
  38
  39
  40 sub store_changelog_file {
  41     my ($self, $fname) = @_;
  42
  43     open(F, $fname) || die "file open error $fname : $!";
  44     binmode(F);
  45     my @entlines;
  46     while (<F>) {
  47         if (/^(\d{4}-\d\d-\d\d)/) {
  48             $self->store_entry(\@entlines) if (@entlines > 0);
  49             @entlines = ();
  50         } elsif (/^\t?__DATA__.*$/) {
  51             last;
  52         } elsif (/^\s*Local Variables:/) { # emacs stuff at the end
  53             last;
  54         }
  55         push @entlines, $_;
  56     }
  57     $self->store_entry(\@entlines) if (@entlines > 0);
  58     close F;
  59 }
  60
  61
  62 sub store_entry {
  63     my ($self, $linesp) = @_;
  64
  65     # Processing entry header
  66     my $eh = shift @$linesp;
  67
  68     return unless ($eh =~ /^\d{4}-\d\d-\d\d/);
  69
  70     my ($ymd, $y, $m, $d, $user)
  71         = ($eh =~ /^((\d\d\d\d)-(\d\d)-(\d\d))(?:.*?\s\s)(.+)?/);
  72
  73     $self->{all}->{$ymd}->{eh} = $ymd;
  74     my $entp = $self->{all}->{$ymd};
  75
  76     $user =~ s/</&lt;/g;
  77     $user =~ s/>/&gt;/g;
  78 #    print "($ymd, $y, $m, $d, $user) \n";
  79 #    print "<<<<<$eh>>>>>>>\n";
  80
  81     # Processing each item
  82     my @ilines;
  83     my @items;
  84     foreach (@$linesp) {
  85         if (s/^( {8}| {0,7}\t|)\* //) {
  86             push @items, [@ilines] if (@ilines > 0 and $ilines[0] !~ /^\s*$/);
  87             @ilines = ();
  88         }
  89         push @ilines, $_;
  90     }
  91     push @items, [@ilines] if (@ilines > 0 and $ilines[0] !~ /^\s*$/);
  92
  93     foreach (reverse @items) {
  94         $self->store_item($entp, $_, $ymd, $user);
  95     }
  96
  97     if ($entp->{curid} == 0) {
  98         # If the entry doesn't have any item, delete it.
  99         # It will be happend when all items in the entry are private items.
 100         # Notice: pragma items are ignored.
 101         delete $self->{all}->{$ymd};
 102         return;
 103     }
 104
 105     my $ent = $self->{all}->{$ymd};
 106     for (my $i = $ent->{curid}; $i >= 1; $i--) {
 107         if (defined $ent->{$i}->{cat}) {
 108             map {$self->{CAT}->{$_}++} @{$ent->{$i}->{cat}};
 109         }
 110     }
 111
 112     $self->{STAT}->{ym}{$y."-".$m}++; # for month_page_list
 113     $self->{STAT}->{md}{$m."-".$d}{$y} = 1; # for SameDateJump
 114     # {"ym"} : ³ÆÇ¯·î¤Ë´Þ¤Þ¤ì¤Æ¤¤¤ëÆüÉÕ¥¨¥ó¥È¥ê¿ô
 115     # {"md"} : Æ±¤¸·îÆü¤ò»ý¤ÄÇ¯ for same date jump
 116
 117     if ($self->{stop_date} != 0) {
 118         my $cdate = $y * 10000 + $m * 100 + $d;
 119         if ($self->{stop_date} > $cdate) {
 120             delete $self->{all}->{$ymd};
 121         }
 122     }
 123 }
 124
 125
 126 # Ê¸»ú¥³¡¼¥É¤ò euc ¤Ë¤·¤Æ¤ª¤¯???????
 127 sub store_item {
 128     my ($self, $entp, $linesp, $ymd, $user) = @_;
 129 #    $entp = $self->{all}->{$ymd};
 130
 131     my $ih = shift @$linesp;
 132     # item header - case 1: "* AAA: \n"
 133     # item header - case 2: "* AAA:\n"
 134     # item header - case 3: "* AAA: BBB\n"
 135     # item header - case 4: "* AAA\n"
 136     my ($rest) = ($ih =~ s/:(\s.*)$/:/s) ? $1 : ""; # for case 1,2,3
 137     $rest =~ s/^ +//;
 138     my $cont = $rest.join("", @$linesp);
 139     if ($ih =~ /^p:/) { # Ignoring private items
 140         return;
 141     } elsif ($ih =~ /^(message-top|message-bottom):/) { # pragma items
 142         $entp->{$1} = $rest.$cont;
 143         return;
 144     }
 145
 146     # item ID : Y in XXXX-XX-XX-Y
 147     $entp->{curid}++;
 148
 149     # Processing item header
 150     # # If 1st line doesn't have ": ", it will become item header.
 151     my @cat;
 152 #    $ih =~ s/(:|\s+)$//g;
 153     $ih =~ s/(:|\s*)$//sg;      # Triming trailing spaces and ":"
 154 #    print "[[[[$ih]]]\n";
 155     if ($ih =~ s/\s*\[(.+)\]$//) { # category
 156         @cat = split(/\s*\]\s*\[\s*/, $1);
 157     }
 158
 159     # Processing item content
 160     $cont =~ s/^( {8}| {0,7}\t)//gsm;
 161     $cont =~ s/\s+$/\n/g;               # Triming trailing spaces and CR
 162     $cont =~ s/\r//g;
 163
 164     # Storing item information in hash
 165     $entp->{$entp->{curid}}{ho} = $ih;
 166     $entp->{$entp->{curid}}{co} = $cont;
 167     $entp->{$entp->{curid}}{a} = $user if (defined $user);
 168     @{$entp->{$entp->{curid}}{cat}} = @cat if (@cat > 0);
 169
 170 #    print "<<<<<$ih>>>>>>>\n";
 171 }
 172
 173 1;