File: check.pl

package info (click to toggle)
gri 2.12.26-1
  • links: PTS
  • area: main
  • in suites: buster, sid
  • size: 5,952 kB
  • ctags: 2,396
  • sloc: cpp: 36,598; sh: 4,196; lisp: 3,764; perl: 1,362; ansic: 1,046; makefile: 606
file content (144 lines) | stat: -rwxr-xr-x 4,264 bytes parent folder | download
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
#!/usr/bin/perl
use Date::Manip; 
# For more on how Date::Manip works, see for example
#    http://theoryx5.uwinnipeg.ca/CPAN/data/DateManip/Manip.html
# or other CPAN sites.

sub indicate_age($$) {
    my $before = $_[0];
    my $item = $_[1];
    $age = &DateCalc(&ParseDate("now"), $before);
    $s = 0;			# prevent warning
    ($y, $mo, $w, $d, $h, $min, $s) = split(/:/, "$age");
#    print "<$age> [age]\n";
#    print "<$y>   [year]\n";
    $future = 0 if ("$y" eq "-0");
    $future = 1 if ("$y" eq "+0");
#    print "NEW \n" if $new;
    if ($future) {
	print "\t... $item is from $y years, $mo months, $w weeks, $d days into the future\n";
    } else {
	if ($y > 0) {
	    print "\t... $item was last updated $y years and $mo months ago\n";
	} elsif ($mo > 0) {
	    print "\t... $item was last updated $mo months and $w weeks ago\n";
	} elsif ($w > 0) {
	    print "\t... $item was last updated $w weeks ago\n";
	} else {
	    print "\t... $item was last updated $d days ago\n";
	}
    }
}


$version_makefile = "?";

print "Check 1: do the version numbers match?\n";
sub version_mismatch() {
    print "\t... No!\n";
    print "    Version is $version_makefile in the Makefile file.\n";
    print "    Version is $version_doc in the doc/gri.texi file.\n";
    print "    Version is $version_spec in the gri.spec file.\n";
    print "    Version is $version_cmd in the gri.cmd file.\n";
    return "    ... this error was detected";
}

open(MAKEFILE, "Makefile") or die "Cannot open Makefile";
$version_makefile = "?.?.?";
while(<MAKEFILE>) {
    if (/^VERSION = (.*)/) {
	$version_makefile = $1;
	close (MAKEFILE);
	last;
    }
}

open(DOC, "doc/gri.texi") or die "Cannot open doc/gri.texi";
$version_doc = "?.?.?";
while(<DOC>) {
    if (/^\@set GRI-VERSION (.*)/) {
	$version_doc = $1;
	close (DOC);
	last;
    }
}
die version_mismatch() if $version_makefile ne $version_doc;
print "\t... Makefile and doc/gri.texi match\n";

open(SPEC, "gri.spec") or die "Cannot open gri.spec";
$version_spec = "?.?.?";
while(<SPEC>) {
    if (/^\%define griversion (.*)/) {
	$version_spec = "$1";
	close (SPEC);
	last;
    }
}
die version_mismatch() if $version_spec ne $version_makefile;
print "\t... gri.spec also matches\n";

open(CMD, "gri.cmd") or die "Cannot open gri.cmd";
$version_cmd = "?.?.?";
$_ = <CMD>;
close(CMD);
chop;
s/.*version //;
s/\)//;
$version_cmd = $_;
die version_mismatch() if $version_cmd ne $version_makefile;
print "\t... gri.cmd  also matches\n";

#### #### #### #### #### #### #### #### #### 
print "Check 2: have various dated files been updated recently?\n";

# ChangeLog
open(CHANGELOG, "changelog") or die "Can't open changelog file";
$_ = <CHANGELOG>;
close(CHANGELOG);
@_ = split;
$date_changelog = &ParseDate($_[0]);
indicate_age($date_changelog, "       ChangeLog");

# gri.spec
open(SPEC, "gri.spec") or die "Can't open gri.spec";
while(<SPEC>) {
    next if !/^%changelog/;
    $_ = <SPEC>;
    close(SPEC);
    @_ = split;
    $date_spec = &ParseDate("$_[1] $_[2] $_[3] $_[4]");
    last;
}
indicate_age($date_spec, "        gri.spec");

# debian/changelog
open(DEBIAN_CHANGELOG, "debian/changelog") or die "Can't open debian/changelog";
#print "DEBUG.  Now examine debian/changelog file.\n";
#print "BUG: need to examine WHOLE file and find MOST RECENT date!\n";
#print "\n";
#print "For reference, the present date is $now\n";
$latest = &ParseDate("1971"); # pre-history, basically
while(<DEBIAN_CHANGELOG>) {
    if (/ \-\- (.*) <(.*)> (.*), (.*)/) {
	$date_debian_changelog = &ParseDate($4);
	#print "the sequence '$4' parses to $date_debian_changelog\n";
	#print "latest $latest    $date_debian_changelog\n";
	$latest = $date_debian_changelog if (&Date_Cmp($date_debian_changelog, $latest) > 0);
    }
}
$date_debian_changelog = $latest;
indicate_age($date_debian_changelog, "debian/changelog");

# doc/gri.texi
open (DOC, "doc/gri.texi") or die "Cannot open doc/gri.texi";
$latest = &ParseDate("1971"); # pre-history, basically
while(<DOC>) {
    if (/\@subsubsection\s*Version\s*(.*)\s*\[(.*)\]\s*$/) {
	#print;
	$date_doc = $2;
	$latest = $date_doc if (&Date_Cmp($date_doc, $latest) > 0);
	#printf "$date_doc [date_doc] $latest [latest]\n";
    }
}
$date_doc = $latest;
indicate_age($date_doc, "   doc/gri.texi");