File: ChangeLogReader.pm

package info (click to toggle)
chalow 1.0-4
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 444 kB
  • sloc: perl: 1,534; makefile: 52
file content (171 lines) | stat: -rwxr-xr-x 4,640 bytes parent folder | download | duplicates (6)
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/</&lt;/g;
    $user =~ s/>/&gt;/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;