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