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
|
#! /usr/bin/perl -w
#
# $Id$
chomp(my $htmldir = `kde-config --expandvars --install html`);
sub from($) {
open(F, "<$_[0]") || die "Can't open $_[0] for read: $!\n";
chomp(my @lines = <F>);
close(F);
return @lines;
}
sub collect_specified($) {
my $cmd = "find $htmldir/*/kioslave -name $_[0].docbook";
open(F, "$cmd |") || die "Can't run $cmd: $!\n";
chomp(my @lines = <F>);
close F;
return grep(!/HTML\/default/, @lines);
}
sub get_id($) {
my @lines = from($_[0]);
foreach (@lines) {
if (/\<article\s+.*id=\"(.+)\".*\>/i) {
return "$1";
}
last if /\<title\>/i;
}
return "";
}
sub usage {
die "Usage: kiodoc-update -a|-r kioslaveName";
}
sub update_cache($) {
my $cache = $_[0];
$cache =~ s/index\.docbook/index\.cache\.bz2/;
system("meinproc --check --cache $cache $_[0]");
}
sub add_doc($) {
my @files = collect_specified($_[0]);
return if ($#files lt 0);
foreach $idx (@files) {
my $id = get_id($idx);
die "Can't read ID attribute in $idx\n" if ($id eq "");
my $ed = '<!ENTITY kio-' . $id . ' SYSTEM "' .
"$_[0].docbook" . '">';
my $er = '&kio-' . $id . ';';
$idx =~ s/$_[0]\.docbook/index\.docbook/;
next if (!(-e $idx));
my @lines = from("$idx");
my $state = 0;
my @out = ();
foreach (@lines) {
$state = 3 if (($state == 2) && (/\&kio-/));
$state = 1 if (($state == 0) && (/\<\!ENTITY kio-/));
if ($state == 1) {
if (/% addindex/) {
push @out, "$ed\n";
$state = 2;
}
if ($_ gt $ed) {
push @out, "$ed\n";
$state = 2;
}
}
elsif ($state == 3) {
if ($_ gt $er) {
push @out, "$er\n";
$state = 4;
}
if (/<\/part\>/i) {
push @out, "$er\n";
$state = 4;
}
}
next if (/^$er$/);
next if (/^$ed$/);
push @out, "$_\n";
}
open(F, ">$idx") || die "Can't open $idx for write: $!\n";
print F @out;
close(F);
update_cache($idx);
}
}
sub remove_doc($) {
my @files = collect_specified($_[0]);
return if ($#files lt 0);
my $re = "kio-" . get_id($files[0]) . '[\s;]';
foreach $idx (@files) {
$idx =~ s/$_[0]\.docbook/index\.docbook/;
my @lines = from($idx);
@lines = grep(!/$re/, @lines);
open(F, ">$idx") || die "Can't open $idx for write: $!\n";
print F join("\n", @lines) . "\n";
close(F);
update_cache($idx);
}
}
my $worker = \&usage;
while (defined ($ARGV[0])) {
$_ = shift;
if (/^-a$/) {
$worker = \&add_doc;
}
elsif (/^-r$/) {
$worker = \&remove_doc;
}
else {
&$worker($_);
}
}
|
