line
stmt
bran
cond
sub
pod
time
code
1
##############################################################################
2
# The Faq-O-Matic is Copyright 1997 by Jon Howell, all rights reserved. #
3
# #
4
# This program is free software; you can redistribute it and/or #
5
# modify it under the terms of the GNU General Public License #
6
# as published by the Free Software Foundation; either version 2 #
7
# of the License, or (at your option) any later version. #
8
# #
9
# This program is distributed in the hope that it will be useful, #
10
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
11
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
12
# GNU General Public License for more details. #
13
# #
14
# You should have received a copy of the GNU General Public License #
15
# along with this program; if not, write to the Free Software #
16
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.#
17
# #
18
# Jon Howell can be contacted at: #
19
# 6211 Sudikoff Lab, Dartmouth College #
20
# Hanover, NH 03755-3510 #
21
# jonh@cs.dartmouth.edu #
22
# #
23
# An electronic copy of the GPL is available at: #
24
# http://www.gnu.org/copyleft/gpl.html #
25
# #
26
##############################################################################
27
28
1
1
6
use strict;
1
2
1
46
29
30
###
31
### A FAQ::OMatic::Item is a data structure that contains an entire item
32
### from the FAQ. (One file.)
33
###
34
35
package FAQ::OMatic::Item;
36
37
1
1
748
use FAQ::OMatic::Part;
1
3
1
43
38
1
1
15
use FAQ::OMatic;
1
2
1
22
39
1
1
774
use FAQ::OMatic::Auth;
1
4
1
72
40
1
1
11
use FAQ::OMatic::Appearance;
1
2
1
25
41
1
1
6
use FAQ::OMatic::Groups;
1
2
1
18
42
1
1
558
use FAQ::OMatic::Words;
1
4
1
36
43
1
1
435
use FAQ::OMatic::HelpMod;
1
5
1
28
44
1
1
478
use FAQ::OMatic::Versions;
1
3
1
31
45
1
1
6
use FAQ::OMatic::Set;
1
3
1
20
46
1
1
6
use FAQ::OMatic::I18N;
1
1
1
194
47
48
BEGIN {
49
# This code use Japanese environment only.
50
# see http://chasen.aist-nara.ac.jp/index.html.en
51
#
52
1
50
1
6
if (FAQ::OMatic::I18N::language() eq 'ja_JP.EUC') {
53
0
require NKF; import NKF;
0
54
}
55
}
56
57
my @monthMap; # a constant array, no cache problem for mod_perl
58
59
sub new {
60
0
0
0
my ($class) = shift;
61
0
my ($arg) = shift; # what file the item data lives in
62
0
my ($dir) = shift; # what dir we should look in for the item data
63
# (default $FAQ::OMatic::Config::itemDir)
64
0
my $item = {};
65
0
bless $item;
66
67
# if we have the item loaded already, use the in-core copy!
68
0
my $itemCache = FAQ::OMatic::getLocal('itemCache');
69
0
0
0
if ($arg and (defined $itemCache->{$arg})) {
70
0
return $itemCache->{$arg};
71
}
72
73
0
$item->{'class'} = $class;
74
0
$item->{'Parts'} = [];
75
76
0
0
if ($arg) {
77
0
$item->loadFromFile($arg,$dir);
78
0
0
if ($item->{'filename'}) {
79
0
$itemCache->{$item->{'filename'}} = $item;
80
0
FAQ::OMatic::setLocal('itemCache', $itemCache);
81
}
82
} else {
83
0
$item->setProperty('Title', gettext("New Item"));
84
}
85
86
# ensure every item has a sequence number.
87
# sequence numbers are used to:
88
# 1. detect conflicting edits. We discard the later submission;
89
# no attempt is made to prevent simultaneous edits in the first place.
90
# The assumption is that simultaneous edits are uncommon, and stale
91
# locks would probably be less convenient than occasional conflicts.
92
# 2. incremental transfers for mirrored faqs
93
0
0
$item->{'SequenceNumber'} = 0 if (not defined($item->{'SequenceNumber'}));
94
95
0
return $item;
96
}
97
98
# used for emptying trash.
99
sub destroyItem {
100
0
0
0
my $self = shift;
101
0
0
my $deferUpdate = shift || '';
102
# only works for things in Config::itemDir
103
104
0
my $filename = $self->{'filename'};
105
106
# remove item from internal cache so we don't try to re-save it out.
107
0
my $itemCache = FAQ::OMatic::getLocal('itemCache');
108
0
delete $itemCache->{$filename};
109
110
# detach the item from its parent
111
0
my $parent = $self->getParent();
112
0
$parent->removeSubItem($filename, $deferUpdate);
113
114
# TODO note that we don't do anything about symlinks (faqomatic: refs)
115
# to this missing item; they'll become "missing or broken item". We
116
# should probably handle that issue during the "Move to trash" operation,
117
# since you don't really want symlinks into the trash, anyway.
118
# TODO note that the file simply disappears, so if we lose the
119
# biggestFileHint, we might accidentally reallocate this file number.
120
# That's not horrible, but perhaps worth avoiding.
121
# TODO I don't delete the RCS file, because disk space is free.
122
# I'm emptying the trash just to reduce the amount of cruft that piles
123
# up in user-visible space! If someone really cares, they could delete
124
# the RCS file, too. (On the other hand, one might worry about
125
# disk space for bag deletion.)
126
0
destroyItemRaw($self->{'filename'});
127
}
128
129
sub destroyItemRaw {
130
0
0
0
my $filename = shift;
131
132
# zero file on disk
133
# we leave a stub there so that new files won't be created with the
134
# same file name. That keeps links by filename from changing their
135
# destination.
136
0
0
my $dir = $FAQ::OMatic::Config::itemDir || '';
137
#my $inode = `ls -i $dir/$filename`;
138
0
my $rc = open(FILE, ">$dir/$filename");
139
0
close FILE;
140
0
0
0
if (not $rc or ((-s "$dir/$filename") != 0)) {
141
0
FAQ::OMatic::gripe('problem', "Bummer: failed to zero $filename\n");
142
0
return 0;
143
}
144
# TODO need to commit to RCS, get & release Item lock.
145
0
return 1;
146
}
147
148
sub loadFromFile {
149
0
0
0
my $self = shift;
150
0
my $filename = shift;
151
0
0
my $dir = shift || ''; # optional -- almost always itemDir
152
153
# untaint user input (so they can't express
154
# a file of ../../../../../../etc/passwd)
155
0
0
if (not $filename =~ m/^([\w\-.]*)$/) {
156
# if taint check fails, just return a bad item, rather
157
# than implying that there really is an item with the funny name
158
# supplied.
159
160
0
delete $self->{'Title'};
161
0
return;
162
} else {
163
0
$filename = $1;
164
}
165
166
0
0
if (not $dir) {
167
0
0
$dir = $FAQ::OMatic::Config::itemDir || '';
168
}
169
170
0
0
if (not -f "$dir/$filename") {
171
0
0
0
if ($dir eq ($FAQ::OMatic::Config::itemDir||'x')
0
172
and FAQ::OMatic::Versions::getVersion('Items')) {
173
# admin only cares much if an item turns up missing,
174
# and then only if he's actually gotten the FAQ installed.
175
0
FAQ::OMatic::gripe('note',
176
"FAQ::OMatic::Item::loadFromFile: $filename isn't a regular "
177
."file (-f test failed).");
178
}
179
0
delete $self->{'Title'};
180
0
return;
181
}
182
183
0
0
if ((-s "$dir/$filename") == 0) {
184
0
delete $self->{'Title'};
185
0
$self->{'EmptyStub'} = 'true';
186
0
return;
187
}
188
189
0
0
if (not open(FILE, "$dir/$filename")) {
190
0
FAQ::OMatic::gripe('note',
191
"FAQ::OMatic::Item::loadFromFile couldn't open $filename.");
192
0
delete $self->{'Title'};
193
0
return;
194
}
195
196
# take note of which file we came from
197
0
$self->{'filename'} = $filename;
198
199
0
$self->loadFromFileHandle(\*FILE, $filename);
200
201
0
close(FILE);
202
203
0
return $self;
204
}
205
206
sub loadFromFileHandle {
207
0
0
0
my $self = shift;
208
0
my $fh = shift;
209
0
my $debugFilename = shift;
210
211
return loadFromCodeClosure($self,
212
sub {
213
0
0
return <$fh>; # read one line
214
},
215
0
$debugFilename);
216
}
217
218
sub loadFromString {
219
0
0
0
my $self = shift;
220
0
my $string = shift;
221
0
my $debugFilename = shift;
222
223
0
my @lines = split("\n", $string);
224
0
splice(@lines, scalar(@lines)-1); # hack off last empty string
225
226
return loadFromCodeClosure($self,
227
sub {
228
# read one line
229
0
0
my $line = shift(@lines);
230
0
0
$line .= "\n" if (defined $line);
231
0
return $line;
232
},
233
0
$debugFilename);
234
}
235
236
sub loadFromCodeClosure {
237
0
0
0
my $self = shift;
238
0
my $closure = shift; # a sub that returns one line of the file
239
0
0
my $debugFilename = shift || 'an item read from a filehandle';
240
241
# process item headers
242
# THANKS to "John R. Jackson" for
243
# grepping for unprotected while constructs.
244
0
while (defined($_ = &{$closure})) {
0
245
0
chomp;
246
0
my ($key,$value) = FAQ::OMatic::keyValue($_);
247
0
0
if ($key eq 'Part') {
0
0
0
0
248
0
my $newPart = new FAQ::OMatic::Part;
249
0
$newPart->loadFromCodeClosure($closure, $self->{'filename'}, $self,
250
0
scalar @{$self->{'Parts'}}); # partnum
251
0
push @{$self->{'Parts'}}, $newPart;
0
252
} elsif ($key eq 'LastModified') {
253
# LEGACY: Transparently update older items with LastModified keys
254
# to use new LastModifiedSecs key.
255
0
my $secs = compactDateToSecs($value); # turn back into seconds
256
0
$self->{'LastModifiedSecs'} = $secs;
257
} elsif ($key eq 'PermEditItem') {
258
# Replace this old permission descriptor with the new ones
259
0
$self->{'PermEditTitle'} = $value;
260
0
$self->{'PermEditDirectory'} = $value;
261
0
$self->{'PermAddItem'} = $value;
262
} elsif ($key =~ m/-Set$/) {
263
0
0
if (not defined($self->{$key})) {
264
0
$self->{$key} = new FAQ::OMatic::Set;
265
}
266
0
$self->{$key}->insert($value);
267
} elsif ($key ne '') {
268
0
$self->setProperty($key, $value);
269
} else {
270
0
FAQ::OMatic::gripe('problem',
271
"FAQ::OMatic::Item::loadFromCodeClosure was confused by this "
272
."header in $debugFilename: \"$_\"");
273
# this marks the item "broken" so that the save routine will
274
# refuse to save this corrupted file out and lose more data.
275
0
delete $self->{'Title'};
276
0
return;
277
}
278
}
279
280
# We just loaded this item from a file; the title hasn't really
281
# changed. So we unset that property (that was set when we read
282
# the 'Title:' header), so that we can detect when an item's title
283
# actually does change.
284
0
$self->setProperty('titleChanged', '');
285
286
0
return $self;
287
}
288
289
sub numParts {
290
0
0
0
my $self = shift;
291
0
return scalar @{$self->{'Parts'}};
0
292
}
293
294
sub getPart {
295
0
0
0
my $self = shift;
296
0
my $num = shift;
297
298
0
return $self->{'Parts'}->[FAQ::OMatic::stripInt($num)];
299
}
300
301
@monthMap =( 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
302
'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec' );
303
304
# a human-readable date/time format. Currently used for the
305
# last-modified field.
306
sub compactDate {
307
0
0
0
my ($forsecs) = shift; # optional; default is now
308
0
0
$forsecs = time() if (not $forsecs);
309
0
my ($sec,$min,$hr,$day,$mo,$yr,$wday,$yday,$isdst) = localtime($forsecs);
310
311
0
0
my $df = $FAQ::OMatic::Config::dateFormat||'';
312
0
my $time;
313
0
0
if ($df eq '24') {
314
# THANKS: to Jan Ornstedt for suggesting 24-hour "European" dates
315
0
$time = sprintf("%02d:%02d%s", $hr, $min);
316
} else {
317
0
my $ampm = "am";
318
0
0
if ($hr >= 12) {
319
0
$hr -= 12;
320
0
$ampm = "pm";
321
}
322
0
0
$hr = 12 if ($hr == 0);
323
0
$time = sprintf("%2d:%02d%s", $hr, $min, $ampm);
324
}
325
326
0
return sprintf("%04d-%03s-%02d %s",
327
$yr+1900, $monthMap[$mo], $day, $time);
328
}
329
330
# undo the previous transformation
331
# TODO: this is only used (I think) for updating LastModified: fields
332
# TODO: to LastModifiedSecs: fields. It could eventually be discarded.
333
sub compactDateToSecs {
334
0
0
0
my $cd = shift;
335
0
my ($yr,$mo,$dy,$hr,$mn,$ampm) =
336
($cd =~ m/(\d+)-([a-z]+)-(\d+) +(\d+):(\d+)([ap])m/i);
337
0
0
if (not defined $ampm) {
338
0
return -1; # can't parse string
339
}
340
0
my $month_i;
341
0
for ($month_i=0; $month_i<12; $month_i++) {
342
0
0
if ($mo eq $monthMap[$month_i]) {
343
0
$mo = $month_i; # notice months run 0..11
344
0
last;
345
}
346
}
347
0
0
if ($month_i == 12) {
348
0
return -1; # can't parse month
349
}
350
0
0
$hr = 0 if ($hr == 12); # noon/midnight
351
0
0
$hr += 12 if ($ampm eq 'p'); # am/pm
352
0
$yr -= 1900; # year is biased in struct
353
354
0
require Time::Local;
355
# LastModified: keys were represented in local time, not GMT.
356
0
return Time::Local::timelocal(0, $mn, $hr, $dy, $mo, $yr);
357
}
358
359
sub saveToFile {
360
0
0
0
my $self = shift;
361
0
0
my $filename = shift || '';
362
0
0
my $dir = shift || ''; # optional -- almost always itemDir
363
0
0
my $lastModified = shift || ''; # optional -- normally today.
364
# 'noChange' is allowed; used when
365
# regenerating files (mod date hasn't
366
# really changed.).
367
0
0
my $updateAllDependencies = shift || ''; # optional. specified
368
# by maintenance when regenerating all dependencies.
369
0
0
my $noRecomputeDependencies = shift || ''; # optional, used by
370
# mirrorClient to prevent trying to follow
371
# forward references.
372
373
# TODO: I don't think maintenance.pm really needs to actually write the
374
# TODO: item files when regenerating dependencies/HTML cache files.
375
# TODO: If not, that part of saveToFile should be factored out, so we're
376
# TODO: not really writing out item/ files.
377
378
0
0
$dir = $FAQ::OMatic::Config::itemDir if (not $dir);
379
380
0
$filename =~ m/([\w\-.]*)/; # Untaint filename
381
0
$filename = $1;
382
383
0
0
if (not $filename) {
384
0
$filename = $self->{'filename'};
385
} else {
386
# change of filename (from a new, anonymous item)
387
0
$self->{'filename'} = $filename;
388
}
389
390
0
0
if ($self->isBroken()) {
391
0
0
FAQ::OMatic::gripe('error',
392
"Tried to save a broken item to ".(defined($filename)?$filename:"")."".FAQ::OMatic::stackTrace());
393
}
394
395
0
0
0
if ($dir eq $FAQ::OMatic::Config::itemDir
396
and not $noRecomputeDependencies) {
397
# compute new IDependOn-Set -- the items whose titles we depend
398
# on.
399
# copy old list first, so we have something to compare new list to
400
0
$self->{'oldIDependOn-Set'} =
401
$self->getSet('IDependOn-Set')->clone();
402
0
my $newSet = new FAQ::OMatic::Set;
403
# I depend on any item I link to, which includes any explicit
404
# (faqomatic:...) links in the text, ...
405
0
my $parti;
406
0
for ($parti=0; $parti<$self->numParts(); $parti++) {
407
0
my $part = $self->getPart($parti);
408
0
$newSet->insert($part->getLinks());
409
}
410
# ...and any implicit links to my ancestors or to siblings
411
0
my ($parentTitles,$parentNames) = $self->getParentChain();
412
0
$newSet->insert(@{$parentNames});
0
413
0
$newSet->insert(grep {defined($_)} $self->getSiblings());
0
414
# ...and any bags.
415
0
$newSet->insert(map { "bags.".$_ } $self->getBags());
0
416
417
0
$self->{'IDependOn-Set'} = $newSet;
418
}
419
420
# note last modified date in item itself
421
0
0
if ($lastModified ne 'noChange') {
422
# Time now stored in file in Unix-style seconds.
423
# (but as an ASCII integer, which isn't 31-bit limited,
424
# so I'm sure you'll be pleased to note that we're
425
# Y2.038K-compliant. :v)
426
0
0
$lastModified = time() if ($lastModified eq '');
427
0
$self->{'LastModifiedSecs'} = $lastModified;
428
# $self->{'LastModified'} = compactDate($lastModified);
429
}
430
431
0
my $lock = FAQ::OMatic::lockFile("$filename");
432
0
0
return if not $lock;
433
434
0
0
if (not open(FILE, ">$dir/$filename")) {
435
0
FAQ::OMatic::gripe('problem',
436
"saveToFile: Couldn't write to $dir/$filename because $!");
437
0
FAQ::OMatic::unlockFile($lock);
438
0
return;
439
}
440
0
my $key;
441
0
foreach $key (sort keys %{$self}) {
0
442
0
0
0
if (($key =~ m/^[a-z]/) or ($key eq 'Parts')) {
0
443
0
next;
444
# some keys don't get explicitly written out.
445
# These include lowercase keys (e.g. class, filename),
446
# and the Parts key, which we write explicitly later.
447
} elsif ($key =~ m/-Set$/) {
448
0
my $a;
449
0
foreach $a ($self->getSet($key)->getList()) {
450
0
0
if (FAQ::OMatic::I18N::language() eq 'ja_JP.EUC') {
451
# Japanese only
452
0
$a = nkf('-e', $a);
453
}
454
0
print FILE "$key: $a\n";
455
}
456
} else {
457
0
my $value = $self->{$key};
458
0
$value =~ s/[\n\r]/ /g; # don't allow CRs in a single-line field,
459
# that would corrupt the file format.
460
0
0
if (FAQ::OMatic::I18N::language() eq 'ja_JP.EUC') {
461
# Japanese only
462
0
$value = nkf('-e', $value);
463
}
464
0
print FILE "$key: $value\n";
465
}
466
}
467
# now save the parts out
468
0
my $partCount = 0;
469
0
my $part;
470
0
foreach $part (@{$self->{'Parts'}}) {
0
471
0
print FILE "Part: $partCount\n";
472
0
print FILE $part->displayAsFile();
473
0
print FILE "EndPart: $partCount\n";
474
0
++$partCount;
475
}
476
477
0
close FILE;
478
0
FAQ::OMatic::unlockFile($lock);
479
480
# For item files (not .smry files, which also use the FAQ::OMatic::Item
481
# mechanism for storage), do these things:
482
# 1. Perform RCS ci so we can always get the files back in the face
483
# of net-creeps.
484
# 2. Clear the search hint so we know to regenerate the search index
485
# 3. Rewrite the static cached HTML copy
486
#
487
# We now ci and co in separate steps so that we can specify the '-ko'
488
# flag to co (which ci doesn't accept); the '-ko' flag keeps co
489
# from performing RCS keyword substitution on the item text. This
490
# is important in general to avoid modifying users' data,
491
# but crucial in the (dollar)Log(dollar)
492
# case, where the number of lines in an item file change, and
493
# the structure of the file is corrupted. (Oh, to use XML!)
494
#
495
# THANKS to others for pointing out the -k fix, and
496
# THANKS Somnath Mitra for sending a patch
497
# upon which this fix is based.
498
0
0
if ($dir eq $FAQ::OMatic::Config::itemDir) {
499
## Tell RCS who we are
500
0
$ENV{"USER"} = $FAQ::OMatic::Config::RCSuser;
501
0
$ENV{"LOGNAME"} = $FAQ::OMatic::Config::RCSuser;
502
0
my $itemPath = "$dir/$filename";
503
0
my $rcsFilePath = $FAQ::OMatic::Config::metaDir
504
."/RCS/$filename,v";
505
0
my $cmd = "$FAQ::OMatic::Config::RCSci "
506
."$FAQ::OMatic::Config::RCSciArgs $itemPath $rcsFilePath "
507
."&& " # && => only exit with success if both operations succeed
508
."$FAQ::OMatic::Config::RCSco "
509
."$FAQ::OMatic::Config::RCScoArgs $rcsFilePath $itemPath";
510
#FAQ::OMatic::gripe('debug', $cmd);
511
0
my @result = FAQ::OMatic::mySystem($cmd);
512
0
0
if (scalar(@result)) {
513
0
FAQ::OMatic::gripe('problem',
514
"RCS \"$cmd\" failed: (".join(", ", @result).")");
515
}
516
}
517
# RCS has a habit of making item files read-only by the user -- fix that
518
# (umask might also be uptight)
519
0
0
if (not chmod(0644, "$dir/$filename")) {
520
0
FAQ::OMatic::gripe('problem', "chmod($dir/$filename) failed: $!");
521
}
522
523
# if $lastModified was specified, correct filesystem mtime
524
# (If not specified, the fs mtime is already set to 'now',
525
# which is correct.)
526
0
0
if ($lastModified) {
527
0
utime(time(),$self->{'LastModifiedSecs'},"$dir/$filename");
528
}
529
530
# As I was saying, ...
531
# 2. Clear the search hint so we know to regenerate the search index
532
# 3. Rewrite the static cached HTML copy
533
0
0
if ($dir eq $FAQ::OMatic::Config::itemDir) {
534
0
unlink("$FAQ::OMatic::Config::metaDir/freshSearchDBHint");
535
536
0
$self->writeCacheCopy();
537
0
0
if ($self->{'titleChanged'}) {
538
# this item's title has changed:
539
# update the cache for any items that refer to this one (and
540
# thus have this one's title in their cached HTML)
541
0
my $dependent;
542
0
foreach $dependent (getDependencies($self->{'filename'})) {
543
0
my $dependentItem = new FAQ::OMatic::Item($dependent);
544
0
$dependentItem->writeCacheCopy();
545
}
546
}
547
548
# rewrite .dep files (items that contain HeDependsMe-Sets)
549
0
my $oidos = $self->getSet('oldIDependOn-Set');
550
0
my $nidos = $self->getSet('IDependOn-Set');
551
0
my @removeList = ($oidos->subtract($nidos))->getList();
552
0
my @addList;
553
0
0
if ($updateAllDependencies) {
554
0
@addList = $nidos->getList();
555
} else {
556
0
@addList = ($nidos->subtract($oidos))->getList();
557
}
558
0
my $itemName;
559
0
foreach $itemName (@removeList) {
560
0
adjustDependencies('remove', $itemName, $self->{'filename'});
561
}
562
0
foreach $itemName (@addList) {
563
0
adjustDependencies('insert', $itemName, $self->{'filename'});
564
}
565
}
566
}
567
568
sub getDependencies {
569
0
0
0
my $filename = shift;
570
0
my $depItem = loadDepItem($filename);
571
0
return $depItem->getSet('HeDependsOnMe-Set')->getList();
572
}
573
574
sub loadDepItem {
575
0
0
0
my $itemName = shift;
576
577
0
my $depFile = "$itemName.dep";
578
0
my $depItem = new FAQ::OMatic::Item($depFile,
579
$FAQ::OMatic::Config::cacheDir);
580
0
$depItem->setProperty('Title', 'Dependency List');
581
# in case $depItem was new
582
0
return $depItem;
583
}
584
585
sub adjustDependencies {
586
0
0
0
my $what = shift; # 'insert' or 'remove'
587
0
my $itemName = shift;
588
0
my $targetName = shift;
589
590
0
my $depItem = loadDepItem($itemName);
591
0
my $hdos = $depItem->getSet('HeDependsOnMe-Set');
592
0
0
if ($what eq 'insert') {
593
0
$hdos->insert($targetName);
594
} else {
595
0
$hdos->remove($targetName);
596
}
597
0
$depItem->setProperty('HeDependsOnMe-Set', $hdos);
598
# in case $hdos was new
599
0
my $depFile = "$itemName.dep";
600
0
$depItem->saveToFile($depFile,
601
$FAQ::OMatic::Config::cacheDir);
602
}
603
604
# For explicit faqomatic: links, the dependency mechanism is automatic:
605
# the link can't change without the item itself changing, so when the
606
# item gets written out, the cache and dependencies for it are up-to-date.
607
#
608
# For parent links, the dependency mechanism still works -- if a parent
609
# moves or changes its name (or this item moves, which is an operation on
610
# its parent), the old parent had to get written, and this item knew it
611
# was dependent on that parent, so this item gets rewritten, too, and has
612
# its dependencies updated, at which point it detects any new parent.
613
#
614
# But for sibling links, this item has no way of discovering (via
615
# dependencies) when those links change. Whenever a category changes its
616
# directory part list, it has also changed the sibling links for some
617
# of its children. In any case like that, it's the parent's responsibility
618
# to rewrite all of its children, so their dependencies and caches
619
# can be recomputed.
620
sub updateAllChildren {
621
0
0
0
my $self = shift;
622
623
0
my $filei;
624
0
foreach $filei ($self->getChildren()) {
625
#FAQ::OMatic::gripe('debug', "Updating child $filei of ".$self->{'filename'});
626
0
my $itemi = new FAQ::OMatic::Item($filei);
627
0
0
if (not $itemi->isBroken()) {
628
# $itemi->writeCacheCopy();
629
# jonh: only writing the cache copy isn't enough -- if $itemi's set of
630
# siblings has changed, then its IDependOns have changed, too. Those
631
# are stored in the item file itself.
632
0
$itemi->saveToFile('', '', 'noChange');
633
# The contents of the item itself haven't changed.
634
# The 'noChange' prevents us from updating the LastModifiedSecs
635
# property, so that this item doesn't show up in 'recent'
636
# searches even though it hasn't actually changed.
637
}
638
}
639
}
640
641
sub getChildren {
642
0
0
0
my $self = shift;
643
644
0
my $dirPart = $self->getDirPart();
645
0
0
if (defined($dirPart)) {
646
0
return $dirPart->getChildren();
647
}
648
0
return ();
649
}
650
651
sub getBags {
652
0
0
0
my $self = shift;
653
654
# remove duplicates but keep order using a Set
655
0
my $bagset = new FAQ::OMatic::Set('keepOrdered');
656
0
my $i;
657
0
for ($i=0; $i<$self->numParts(); $i++) {
658
0
$bagset->insert($self->getPart($i)->getBags());
659
}
660
661
0
return $bagset->getList();
662
}
663
664
# Currently meaningful -Sets that can be in an Item:
665
# HeDependsOnMe-Set: list of items that depend on this item's Title property
666
# IDependOn-Set: list of items whose titles this item depends upon.
667
# it's useful so we can revoke our membership in that item's
668
# HeDependsOnMe-Set when we no longer refer to it.
669
670
sub getSet {
671
0
0
0
my $self = shift;
672
0
my $setName = shift;
673
674
0
0
return $self->{$setName} || new FAQ::OMatic::Set;
675
}
676
677
sub writeCacheCopy {
678
0
0
0
my $self = shift;
679
680
0
my $filename = $self->{'filename'};
681
682
0
0
0
if (defined($FAQ::OMatic::Config::cacheDir)
683
&& (-w $FAQ::OMatic::Config::cacheDir)) {
684
0
my $staticFilename =
685
"$FAQ::OMatic::Config::cacheDir/$filename.html";
686
0
my $params = {'file'=>$self->{'filename'},
687
'_fromCache'=>1};
688
# this link is coming from inside the cache, so we
689
# can use relative links. That's nice if we later
690
# wrap up the cache and mail it somewhere.
691
0
my $staticHtml = $self->getWholePage($params, 1);
692
0
0
if (not open(CACHEFILE, ">$staticFilename")) {
693
0
FAQ::OMatic::gripe('problem',
694
"Can't write $staticFilename: $!");
695
} else {
696
0
print CACHEFILE $staticHtml;
697
0
close CACHEFILE;
698
0
0
if (not chmod(0644, $staticFilename)) {
699
0
FAQ::OMatic::gripe('problem',
700
"chmod($staticFilename) failed: $!");
701
}
702
}
703
}
704
}
705
706
sub getWholePage {
707
0
0
0
my $self = shift;
708
0
my $params = shift;
709
0
0
my $isCached = shift || '';
710
711
0
return FAQ::OMatic::pageHeader($params,
712
FAQ::OMatic::Appearance::allLinks(), 'suppressType')
713
.$self->displayHTML($params)
714
.basicURL($params)
715
.FAQ::OMatic::pageFooter($params,
716
FAQ::OMatic::Appearance::allLinks(), $isCached);
717
}
718
719
sub display {
720
0
0
0
my $self = shift;
721
0
my @keys;
722
0
my $rt = ""; # return text
723
724
0
my $key;
725
0
foreach $key (sort keys %$self) {
726
0
0
if ($key eq 'Parts') {
727
0
$rt .= "".gettext("Parts")."\n";
728
0
my $part;
729
0
foreach $part (@{$self->{$key}}) {
0
730
0
$rt .= $part->display();
731
}
732
} else {
733
0
$rt .= "$key => $self->{$key}
734
}
735
}
736
0
return $rt;
737
}
738
739
sub getTitle {
740
0
0
0
my $self = shift;
741
0
my $undefokay = shift; # return undef instead of '(missing or broken...'
742
0
my $title = $self->{'Title'};
743
0
0
if ($title) {
744
0
$title =~ s/&/&/sg;
745
0
$title =~ s/
746
0
$title =~ s/>/>/sg;
747
0
$title =~ s/"/"/sg;
748
} else {
749
0
undef $title;
750
0
0
$title = gettext("(missing or broken file)") if (not $undefokay);
751
}
752
753
0
return $title;
754
}
755
756
sub isBroken {
757
0
0
0
my $self = shift;
758
0
return (not defined($self->{'Title'}));
759
}
760
761
sub isEmptyStub {
762
0
0
0
my $self = shift;
763
0
0
return $self->{'EmptyStub'} || '';
764
}
765
766
sub getParent {
767
0
0
0
my $self = shift;
768
769
0
return new FAQ::OMatic::Item($self->{'Parent'});
770
}
771
772
# returns two lists, the filenames and titles of this item's parent items.
773
# The list is slightly falsified in that if the topmost ancestor isn't
774
# '1' (such as 'trash' and 'help000'), we insert '1' as an ancestor.
775
# That way 'trash' and 'help000's displayed parent chains include links
776
# to the top of the FAQ, but are not moveable (since they still have no
777
# real parent, which is how moveItem.pm can tell.)
778
sub getParentChain {
779
0
0
0
my $self = shift;
780
0
my @titles = ();
781
0
my @filenames = ();
782
0
my ($nextfile, $nextitem, $thisfile);
783
784
0
$nextitem = $self;
785
0
$nextfile = $self->{'filename'};
786
0
0
do {
0
787
0
push @titles, $nextitem->getTitle();
788
0
push @filenames, $nextitem->{'filename'};
789
0
$thisfile = $nextfile;
790
0
$nextfile = $nextitem->{'Parent'};
791
0
$nextitem = $nextitem->getParent();
792
} while ((defined $nextitem) and (defined $nextfile)
793
and ($nextfile ne $thisfile));
794
795
0
0
0
if (($nextfile||'') ne '1') {
796
# insert '1' as extra 'bogus' parent
797
0
my $item1 = new FAQ::OMatic::Item('1');
798
0
push @titles, $item1->getTitle();
799
0
push @filenames, $item1->{'filename'}; # I can guess what this is :v)
800
}
801
802
# Massage undefined data; this happens when writing the HTML cache for
803
# a mirrored item that has a forward reference to another item that
804
# hasn't been mirrored yet. Once the new item arrives, dependencies
805
# will cause us to rewrite the HTML file correctly.
806
# TODO: a regression test should 'grep undefinedFilename item/*' to
807
# see if any of these stay in the item or cache directories after a
808
# mirror is complete.
809
0
0
@titles = map { $_ || 'undefinedTitle' } @titles;
0
810
0
0
@filenames = map { $_ || 'undefinedFilename' } @filenames;
0
811
0
return (\@titles, \@filenames);
812
}
813
814
# same structure as above, but only used to check for a particular parent
815
sub hasParent {
816
0
0
0
my $self = shift;
817
0
my $parentFile = shift;
818
819
0
my ($nextfile, $nextitem, $thisfile);
820
821
0
$nextitem = $self;
822
0
$nextfile = $self->{'filename'};
823
0
0
do {
0
824
0
0
0
return 1 if (defined($nextfile) && ($nextfile eq $parentFile));
825
826
0
$thisfile = $nextfile;
827
0
$nextfile = $nextitem->{'Parent'};
828
0
$nextitem = $nextitem->getParent();
829
} while ((defined $nextitem) and (defined $nextfile)
830
and ($nextfile ne $thisfile));
831
832
0
return 0;
833
}
834
835
# okay, I guess this displays the neighbors, too...
836
sub displaySiblings {
837
0
0
0
my $self = shift;
838
0
my $params = shift;
839
0
my $rt = ''; # return text
840
0
my $useTable = FAQ::OMatic::getParam($params, 'render') eq 'tables';
841
842
0
my ($prevs,$nexts) = $self->getSiblings();
843
0
0
if ($prevs) {
844
0
my $prevItem = new FAQ::OMatic::Item($prevs);
845
0
my $prevTitle = $prevItem->getTitle();
846
0
0
if ($useTable) {
847
0
$rt.=" \n";
848
} else {
849
0
$rt.="
850
}
851
0
$rt.=gettext("Previous").": ";
852
0
0
$rt.=" \n" if $useTable;
853
0
$rt.=FAQ::OMatic::makeAref('-command'=>'faq',
854
'-params'=>$params,
855
'-changedParams'=>{"file"=>$prevs})
856
.FAQ::OMatic::ImageRef::getImageRefCA('-small',
857
'border=0', $prevItem->isCategory(), $params)
858
."$prevTitle\n";
859
0
0
$rt.=" \n" if $useTable;
860
}
861
0
0
if ($nexts) {
862
0
my $nextItem = new FAQ::OMatic::Item($nexts);
863
0
my $nextTitle = $nextItem->getTitle();
864
0
0
if ($useTable) {
865
0
$rt.=" \n";
866
} else {
867
0
$rt.="
868
}
869
0
$rt.=gettext("Next").": ";
870
0
0
$rt.=" \n" if $useTable;
871
0
$rt.=FAQ::OMatic::makeAref('-command'=>'faq',
872
'-params'=>$params,
873
'-changedParams'=>{"file"=>$nexts})
874
.FAQ::OMatic::ImageRef::getImageRefCA('-small',
875
'border=0', $nextItem->isCategory(), $params)
876
."$nextTitle\n";
877
0
0
$rt.=" \n" if $useTable;
878
}
879
0
return $rt;
880
}
881
882
# sub hasParent {
883
# my $self = shift;
884
# my $parentQuery = shift;
885
# my ($titles,$filenames) = $self->getParentChain();
886
#
887
# my $i;
888
# foreach $i (@{$filenames}) {
889
# my $item = new FAQ::OMatic::Item($i);
890
# return 'true' if ($item->{'filename'} eq $parentQuery);
891
# }
892
#
893
# return '';
894
# }
895
896
sub displayCoreHTML {
897
0
0
0
my $self = shift;
898
0
my $params = shift; # ref to hash of display params
899
0
my $whatAmI = $self->whatAmI();
900
0
my $render = FAQ::OMatic::getParam($params, 'render');
901
902
# we'll pass this to makeAref to get file param right in links
903
0
my @fixfn =('file'=>$self->{'filename'});
904
0
my $title = $self->getTitle();
905
906
# accumulate the title, the parts, and the editing sections into
907
# a list @rowboxes, so that when we construct the , we know in
908
# advance how many rows it has.
909
0
my @rowboxes = ();
910
911
# create the title
912
{
913
0
my $titlebox = '';
0
914
0
0
if ($render ne 'text') {
915
0
$titlebox .= "
916
.$self->{'filename'}."\"> \n"; # link for internal refs
917
}
918
919
# prefix item title with a path back to the root, so that user
920
# can find his way back up. (This replaces the old "Up to:" line.)
921
0
my ($titles,$filenames) = $self->getParentChain();
922
0
my ($thisTitle) = shift @{$titles};
0
923
0
my ($thisFilename) = shift @{$filenames};
0
924
# my (@parentTitles) = reverse @{$titles};
925
0
my (@parentFilenames) = reverse @{$filenames};
0
926
0
$titlebox.=
927
join(" : ",
928
map {
929
0
my ($target,$label) =
930
FAQ::OMatic::faqomaticReference($params, "$_");
931
0
"$label ";
932
} @parentFilenames
933
);
934
0
0
if (@parentFilenames) {
935
0
$titlebox.=" :\n";
936
0
0
0
if ($render ne 'text'
0
937
and not ($FAQ::OMatic::Config::nolanTitles || '')) {
938
0
$titlebox.="
939
}
940
}
941
# THANKS: to Jim Adler who suggested this graphical
942
# improvement: larger type to make the titles stand out.
943
0
0
if ($render eq 'text') {
944
0
$titlebox.=$thisTitle;
945
} else {
946
0
0
0
if ($FAQ::OMatic::Config::nolanTitles || '') {
947
# John Nolan likes it better this way:
948
0
$titlebox.= FAQ::OMatic::ImageRef::getImageRefCA('-small',
949
'border=0', $self->isCategory(), $params);
950
0
$titlebox.="$thisTitle ";
951
} else {
952
0
$titlebox.="$thisTitle
953
}
954
0
$titlebox.=""; # close
955
}
956
0
push @rowboxes, { 'type'=>'wide', 'text'=>$titlebox,
957
'id'=>'title' };
958
}
959
960
0
0
if (FAQ::OMatic::getParam($params, 'showModerator') eq 'show') {
961
0
my $mod = FAQ::OMatic::Auth::getInheritedProperty($self, 'Moderator');
962
0
my $brt = '';
963
964
# highlight the "Moderator: ".
965
# THANKS submitted by Akiko Takano
966
0
0
if (FAQ::OMatic::getParam($params, 'render') ne 'text') {
967
0
$brt .= "";
968
0
$brt .= gettext("Moderator").": ".FAQ::OMatic::mailtoReference($params, $mod);
969
0
0
$brt .= " "
970
.gettext("(inherited from parent)")."" if (not $self->{'Moderator'});
971
0
$brt .= "\n";
972
} else {
973
0
$brt .= "Moderator: ".FAQ::OMatic::mailtoReference($params, $mod);
974
}
975
976
0
push @rowboxes, { 'type'=>'wide', 'text'=>$brt,
977
'id'=>'showModerator' };
978
}
979
980
## Edit commands:
981
0
0
my $aoc = $self->isCategory ? 'cat' : 'ans';
982
983
0
0
if (FAQ::OMatic::getParam($params, 'editCmds') ne 'hide') {
984
0
my $editrow = [];
985
0
my ($text_edit_title, $text_edit_perm, $text_move, $text_trash);
986
0
0
if ($self->isCategory())
0
987
{
988
0
$text_edit_title = gettext("Category Title and Options");
989
0
$text_edit_perm = gettext("Edit Category Permissions");
990
0
$text_move = gettext("Move Category");
991
0
$text_trash = gettext("Trash Category");
992
}
993
elsif ($self->isAnswer())
994
{
995
0
$text_edit_title = gettext("Answer Title and Options");
996
0
$text_edit_perm = gettext("Edit Answer Permissions");
997
0
$text_move = gettext("Move Answer");
998
0
$text_trash = gettext("Trash Answer");
999
}
1000
else
1001
{
1002
# fixup for unexpected cases
1003
0
my $s = gettext($whatAmI);
1004
0
$text_edit_title = gettexta("%0 Title and Options", $s);
1005
0
$text_edit_perm = gettexta("Edit %0 Permissions", $s);
1006
0
$text_edit_perm = gettexta("Edit %0 Permissions", $s);
1007
0
$text_move = gettexta("Move %0", $s);
1008
0
$text_trash = gettexta("Trash %0", $s);
1009
}
1010
1011
0
push @$editrow, {'text'=>FAQ::OMatic::button(
1012
FAQ::OMatic::makeAref('-command'=>'editItem',
1013
'-params'=>$params,
1014
'-changedParams'=>{@fixfn}),
1015
$text_edit_title,
1016
"$aoc-title", $params),
1017
'size'=>'edit'};
1018
# TODO: just edit title. Options is only part order; need
1019
# a new interface for that.
1020
1021
0
push @$editrow, {'text'=>FAQ::OMatic::button(
1022
FAQ::OMatic::makeAref('-command'=>'editModOptions',
1023
'-params'=>$params,
1024
'-changedParams'=>{@fixfn}),
1025
$text_edit_perm,
1026
"$aoc-opts", $params),
1027
'size'=>'edit'};
1028
1029
0
push @rowboxes, { 'type'=>'multirow', 'cells'=>$editrow,
1030
'id'=>'title, perms', 'isEdit'=>'true' };
1031
0
$editrow = [];
1032
1033
# These don't make sense if we're in a special-case item file, such
1034
# as 'trash'. We'll assume here that items whose file names end in
1035
# a digit are 'incrementable' and can thus have children.
1036
# TODO: default system should ship with help000 having moderator-only
1037
# TODO: permissions to discourage the public from modifying the
1038
# TODO: help system. This will matter more when the help system
1039
# TODO: is implemented. :v)
1040
# THANKS: to Doug Becker for
1041
# accidentally making a 'trasi' item (perl incrsemented 'trash' :v)
1042
# and discovering this problem.
1043
0
0
if ($self->ordinaryItem()) {
1044
# Duplicate it
1045
0
0
my $dupTitle = $whatAmI eq "Answer"
1046
? gettext("Duplicate Answer")
1047
: gettext("Duplicate Category as Answer");
1048
0
push @$editrow, {'text'=>FAQ::OMatic::button(
1049
FAQ::OMatic::makeAref('-command'=>'addItem',
1050
'-params'=>$params,
1051
'-changedParams'=>{'_insert'=>'answer',
1052
'_duplicate'=>$self->{'filename'},
1053
'file'=>$self->{'Parent'}}
1054
),
1055
$dupTitle,
1056
"$aoc-dup-ans", $params),
1057
'size'=>'edit'};
1058
1059
# Move it (if not at the top)
1060
0
0
if ($self->{'Parent'} ne $self->{'filename'}) {
1061
0
push @$editrow, {'text'=>FAQ::OMatic::button(
1062
FAQ::OMatic::makeAref('-command'=>'moveItem',
1063
'-params'=>$params,
1064
'-changedParams'=>{@fixfn}),
1065
$text_move),
1066
'size'=>'edit'};
1067
1068
# Trash it (same rules as for moving)
1069
0
push @$editrow, {'text'=>FAQ::OMatic::button(
1070
FAQ::OMatic::makeAref('-command'=>'submitMove',
1071
'-params'=>$params,
1072
'-changedParams'=>{@fixfn,
1073
'_newParent'=>'trash'}),
1074
$text_trash),
1075
'size'=>'edit'};
1076
}
1077
1078
# Convert category to answer / answer to category
1079
# THANKS: to Steve Herber for suggesting pulling this out of
1080
# THANKS: editPart and putting it here as a distinct command
1081
# THANKS: for clarity.
1082
0
0
0
if ($self->isCategory()
0
1083
and scalar($self->getChildren())==0) {
1084
0
push @$editrow, {'text'=>FAQ::OMatic::button(
1085
FAQ::OMatic::makeAref('-command'=>'submitCatToAns',
1086
'-params'=>$params,
1087
'-changedParams'=>{
1088
'checkSequenceNumber'=>$self->{'SequenceNumber'},
1089
@fixfn}),
1090
gettext("Convert to Answer"),
1091
'cat-to-ans', $params),
1092
'size'=>'edit'};
1093
} elsif (not $self->isCategory()) {
1094
0
push @$editrow, {'text'=>FAQ::OMatic::button(
1095
FAQ::OMatic::makeAref('-command'=>'submitAnsToCat',
1096
'-params'=>$params,
1097
'-changedParams'=>{
1098
'checkSequenceNumber'=>$self->{'SequenceNumber'},
1099
@fixfn}),
1100
gettext("Convert to Category"),
1101
"$aoc-to-cat", $params),
1102
'size'=>'edit'};
1103
}
1104
1105
# Create new children
1106
0
0
if ($self->isCategory()) {
1107
# suggestion of adding cat title to reduce confusion is from
1108
# THANKS: pauljohn@ukans.edu
1109
0
0
if (length($title) > 15) {
1110
0
$title = substrFOM($title, 12)."...";
1111
}
1112
0
push @$editrow, {'text'=>FAQ::OMatic::button(
1113
FAQ::OMatic::makeAref('-command'=>'addItem',
1114
'-params'=>$params,
1115
'-changedParams'=>{'_insert'=>'answer', @fixfn}),
1116
gettexta("New Answer in \"%0\"", $title),
1117
'cat-new-ans', $params),
1118
'size'=>'edit'};
1119
0
push @$editrow, {'text'=>FAQ::OMatic::button(
1120
FAQ::OMatic::makeAref('-command'=>'addItem',
1121
'-params'=>$params,
1122
'-changedParams'=>{'_insert'=>'category', @fixfn}),
1123
gettexta("New Subcategory of \"%0\"", $title),
1124
'cat-new-cat', $params),
1125
'size'=>'edit'};
1126
}
1127
}
1128
1129
0
push @rowboxes, { 'type'=>'multirow', 'cells'=>$editrow,
1130
'id'=>'dup, trash, etc', 'isEdit'=>'true' };
1131
0
$editrow = [];
1132
1133
# Allow user to insert a part before any other
1134
0
0
if ($self->ordinaryItem()) { # as opposed to trash, help, ...
1135
0
push @$editrow, {'text'=>''}; # empty cell --
1136
# this is a *hack* so that this 'multirow' lines up the
1137
# same as the afterbody's of the 'three'-type parts generated
1138
# by Part.pm. But it may confuse some future itemRender
1139
# routine.
1140
0
push @$editrow, {'text'=>
1141
FAQ::OMatic::button(
1142
FAQ::OMatic::makeAref('-command'=>'editPart',
1143
'-params'=>$params,
1144
'-changedParams'=>{'partnum'=>'-1',
1145
'_insertpart'=>'1',
1146
'checkSequenceNumber'=>$self->{'SequenceNumber'},
1147
@fixfn}
1148
),
1149
gettext("Insert Text Here"),
1150
"$aoc-ins-part", $params),
1151
'size'=>'edit'};
1152
0
push @$editrow, {'text'=>
1153
FAQ::OMatic::button(
1154
FAQ::OMatic::makeAref('-command'=>'editPart',
1155
'-params'=>$params,
1156
'-changedParams'=>{'partnum'=>'-1',
1157
'_insertpart'=>'1',
1158
'_upload'=>'1',
1159
'checkSequenceNumber'=>$self->{'SequenceNumber'},
1160
@fixfn}
1161
),
1162
gettext("Insert Uploaded Text Here"),
1163
"$aoc-ins-part", $params),
1164
'size'=>'edit'};
1165
0
push @rowboxes, { 'type'=>'multirow', 'cells'=>$editrow,
1166
'id'=>'insert before other parts', 'isEdit'=>'true' };
1167
}
1168
}
1169
1170
0
my $partnum = 0;
1171
0
my $authorSet = new FAQ::OMatic::Set('keepordered');
1172
# for AttributionsTogether
1173
0
my $part;
1174
0
foreach $part (@{$self->{'Parts'}}) {
0
1175
0
0
if ($render eq 'text') {
1176
0
push @rowboxes, $part->displayText($self, $partnum, $params);
1177
} else {
1178
0
push @rowboxes, $part->displayHTML($self, $partnum, $params);
1179
}
1180
0
$authorSet->insert($part->{'Author-Set'}->getList());
1181
0
++$partnum;
1182
}
1183
1184
0
0
0
if ((not $FAQ::OMatic::Config::hideEasyEdits)
1185
and ($render ne 'text')) {
1186
0
0
if ($self->isCategory()) {
1187
# Categories: offer a way to insert a new answer
1188
# TODO: does this link belong just below the directory
1189
# part, rather than at the bottom?
1190
0
my $title = $self->getTitle();
1191
0
push @rowboxes, { 'type'=>'wide',
1192
'text'=>FAQ::OMatic::button(
1193
FAQ::OMatic::makeAref('-command'=>'addItem',
1194
'-params'=>$params,
1195
'-changedParams'=>{'_insert'=>'answer', @fixfn}),
1196
gettexta("New Answer in \"%0\"", $title),
1197
'cat-new-ans', $params),
1198
'size'=>'edit',
1199
'id'=>'easy edit insert answer'};
1200
} else {
1201
# answers: offer a way to append an item
1202
0
my $partnum = scalar(@{$self->{'Parts'}})-1;
0
1203
0
push @rowboxes, { 'type'=>'wide',
1204
'text'=>FAQ::OMatic::button(
1205
FAQ::OMatic::makeAref('-command'=>'editPart',
1206
'-params'=>$params,
1207
'-changedParams'=>{'partnum'=>'9999afterLast',
1208
'_insertpart'=>'1',
1209
'checkSequenceNumber'=>$self->{'SequenceNumber'},
1210
@fixfn}
1211
),
1212
gettext("Append to This Answer"),
1213
"$aoc-ins-part", $params),
1214
'size'=>'edit',
1215
'id'=>'easy edit append to answer'};
1216
}
1217
}
1218
1219
# AttributionsTogether displays all attributions for any part in
1220
# this item together at the bottom of the item to reduce clutter.
1221
0
0
my $attributionsTogether = $self->{'AttributionsTogether'} || '';
1222
0
my $showAttributions = FAQ::OMatic::getParam($params, 'showAttributions');
1223
0
0
0
if ($attributionsTogether and
1224
($showAttributions eq 'default')) {
1225
0
my @authors = $authorSet->getList();
1226
0
my $brt = FAQ::OMatic::authorList($params, \@authors);
1227
0
push @rowboxes, { 'type'=>'wide', 'text'=>$brt,
1228
'id'=>'attributionsTogether' };
1229
}
1230
1231
# THANKS: Config::showLastModifiedAlways feature was requested by
1232
# THANKS: parker@austx.tandem.com
1233
# (but it's now handled as a standard default parameter.)
1234
0
my $showLastModified =
1235
FAQ::OMatic::getParam($params, 'showLastModified') eq 'show';
1236
0
my $lastModified = $self->{'LastModifiedSecs'};
1237
0
0
0
if ($lastModified and $showLastModified) {
1238
0
my $brt = '';
1239
0
$brt .= "".compactDate($self->{'LastModifiedSecs'})." \n";
1240
0
push @rowboxes, { 'type'=>'wide', 'text'=>$brt,
1241
'id'=>'lastModified' };
1242
}
1243
1244
0
my @items = { 'item'=>$self,
1245
'rows'=>\@rowboxes };
1246
1247
## recurse on children
1248
0
0
0
if ($params->{'recurse'} or $params->{'_recurse'}) {
1249
0
my $filei;
1250
my $itemi;
1251
0
foreach $filei ($self->getChildren()) {
1252
0
$itemi = new FAQ::OMatic::Item($filei);
1253
#$rt .= $itemi->displayCoreHTML($params);
1254
0
push @items, @{$itemi->displayCoreHTML($params)};
0
1255
}
1256
}
1257
1258
#return $rt;
1259
0
return \@items;
1260
}
1261
1262
sub ordinaryItem {
1263
0
0
0
my $self = shift;
1264
0
return ($self->{'filename'} =~ m/\d$/);
1265
}
1266
1267
sub displayHTML {
1268
0
0
0
my $self = shift;
1269
0
my $params = shift; # ref to hash of display params
1270
0
my $rt = "";
1271
1272
# signal to aref generator that some internal links are
1273
# possible. (only signal this when recursing to save effort otherwise)
1274
0
0
0
if ($params->{'recurse'} or $params->{'_recurse'}) {
1275
0
$params->{'_recurseRoot'} = $self->{'filename'};
1276
# A limit jonh puts on his machines:
1277
# FAQ::OMatic::checkLoadAverage();
1278
}
1279
1280
0
my $itemboxes = $self->displayCoreHTML($params);
1281
0
$rt = FAQ::OMatic::Appearance::itemRender($params, $itemboxes);
1282
1283
# turn #internal links off after the items are displayed.
1284
# Otherwise they mess up the bottom link bar.
1285
# (is there a general way to solve that problem?)
1286
0
delete $params->{'_recurseRoot'};
1287
1288
# Sibling links
1289
0
0
0
if ((FAQ::OMatic::getParam($params, 'render') ne 'text')
0
1290
and not ($FAQ::OMatic::Config::hideSiblings || '')) {
1291
0
my $useTable = FAQ::OMatic::getParam($params, 'render') eq 'tables';
1292
0
$rt.="\n";
1293
0
0
$rt.="" if $useTable;
1294
0
$rt.="\n";
1295
0
$rt.= $self->displaySiblings($params);
1296
0
0
$rt.="
\n" if $useTable;
1297
0
0
$rt.="\n" if not $useTable;
1298
}
1299
1300
0
$rt.=FAQ::OMatic::HelpMod::helpFor($params,
1301
'How can I contribute to this FAQ?', "
1302
1303
0
return $rt;
1304
}
1305
1306
sub basicURL {
1307
0
0
0
my $params = shift;
1308
1309
0
0
return '' if ($params->{'file'} =~ m/^help/);
1310
1311
0
my %killParams = %{$params};
0
1312
0
delete $killParams{'file'};
1313
0
0
delete $killParams{'recurse'} if ($params->{'recurse'});
1314
0
my $i; foreach $i (keys %killParams) { $killParams{$i} = ''; }
0
0
1315
1316
# TODO: We have always had the "This document is:"
1317
# TODO: refer to the CGI. I liked that because it let me fiddle
1318
# TODO: with the cache layout (after all, it changed in 2.604.)
1319
# TODO: But others have asked to totally hide the presence of the CGI,
1320
# TODO: in which case we should *only* display cache URLs here.
1321
# TODO: Or leave this line out altogether.
1322
1323
0
my $url = FAQ::OMatic::makeAref('-command'=>'faq',
1324
'-params' => $params,
1325
'-changedParams'=>\%killParams,
1326
'-thisDocIs'=>1,
1327
'-refType'=>'url');
1328
1329
0
0
if (FAQ::OMatic::getParam($params, 'render') ne 'text') {
1330
0
return gettext("This document is:") . " $url
1331
} else {
1332
0
return gettext("This document is at:") . " $url\n";
1333
}
1334
}
1335
1336
sub permissionBox {
1337
0
0
0
my $self = shift;
1338
0
my $perm = shift;
1339
1340
0
my @permNum = (7);
1341
0
push @permNum, FAQ::OMatic::Groups::getGroupCodeList();
1342
0
push @permNum, (5, 3);
1343
1344
0
my @permDesc = map { nameForPerm($_); } @permNum;
0
1345
1346
0
push @permNum, ('');
1347
0
push @permDesc, gettext('Inherit');
1348
1349
0
0
return popup($perm, \@permNum, \@permDesc, $self->{$perm}||'');
1350
}
1351
1352
sub popup {
1353
0
0
0
my $name = shift;
1354
0
my $values = shift; # ary ref
1355
0
my $descary = shift; # ary ref; 1:1 with $values
1356
0
my $curvalue = shift; # one of @{$values}
1357
1358
0
0
$curvalue = '' if (not defined $curvalue);
1359
1360
0
my $rt = '';
1361
0
$rt.="\n";
1362
0
for (my $i=0; $i<@{$values}; $i++) {
0
1363
0
$rt .= "[$i]."\"";
1364
0
0
$rt .= " SELECTED" if ($values->[$i] eq $curvalue);
1365
0
$rt .= ">".$descary->[$i]."\n";
1366
}
1367
0
$rt.="\n";
1368
0
return $rt;
1369
}
1370
1371
sub nameForPerm {
1372
# this is a lot like Auth::authError, but with more concise descriptions
1373
0
0
0
my $perm = shift;
1374
1375
0
0
if ($perm =~ m/^6 (.*)$/) {
1376
0
return gettexta("Group %0", "$1");
1377
}
1378
1379
0
my %map = (
1380
'3' => gettext("Users giving their names"),
1381
'5' => gettext("Authenticated users"),
1382
'7' => gettext("Moderator"),
1383
);
1384
1385
0
return $map{$perm};
1386
}
1387
1388
sub displayItemEditor {
1389
0
0
0
my $self = shift;
1390
0
my $params = shift;
1391
0
my $cgi = shift;
1392
0
my $rt = ""; # return text
1393
1394
0
0
my $insertHint = $params->{'_insert'} || '';
1395
0
0
if ($insertHint eq 'category') {
0
1396
0
$rt .= gettext("New Category")."\n";
1397
} elsif ($insertHint eq "answer") {
1398
0
$rt .= gettext("New Answer")."\n";
1399
} else {
1400
0
0
if ($self->isCategory())
0
1401
{
1402
0
$rt .= gettexta("Editing Category %0 ", $self->getTitle());
1403
}
1404
elsif ($self->isAnswer())
1405
{
1406
0
$rt = gettexta("Editing Answer %0 ", $self->getTitle());
1407
}
1408
else
1409
{
1410
# fixup for unexpected cases.
1411
0
$rt .= gettexta("Editing %0 %1 ",
1412
gettext($self->whatAmI()),
1413
$self->getTitle());
1414
}
1415
0
$rt .= "\n";
1416
}
1417
0
$rt .= FAQ::OMatic::makeAref('-command'=>'submitItem',
1418
'-params'=>$params,
1419
'-changedParams'=>{'_insert'=>$params->{'_insert'}},
1420
'-refType'=>'POST');
1421
1422
# SequenceNumber protects the database from race conditions --
1423
# if person A gets this form,
1424
# then person B gets this form,
1425
# then person A returns the form (incrementing the sequence number),
1426
# then person B returns the form, the sequence number won't match,
1427
# so B will be turned back, so he can't mistakenly overwrite A's changes.
1428
# (it doesn't help for race conditions involving two simultaneously-
1429
# running CGIs, only with the simultaneity of two people typing into
1430
# browser forms at once.
1431
# TODO: Lock files are supposed to help with two CGIs, but their
1432
# TODO: implementation isn't right. They only protect during the
1433
# TODO: actual write (which keeps the item files consistent). But
1434
# TODO: data can get lost in a race, since two CGIs can still
1435
# TODO: run in the classic A:read-B:read-A:modify,write-B:modify,write
1436
# TODO: race condition.
1437
0
$rt .= "
1438
.$self->{'SequenceNumber'}."\">\n";
1439
1440
# Title
1441
0
$rt .= "
1442
.$self->getTitle()."\" size=60>\n";
1443
1444
# Reorder parts
1445
0
0
if ($self->numParts() > 1) {
1446
0
$rt .= gettext("New Order for Text Parts:");
1447
0
$rt .= "
1448
0
my $i;
1449
0
for ($i=0; $i<$self->numParts(); $i++) {
1450
0
$rt .= "$i ";
1451
}
1452
0
$rt .= "\" size=60>\n";
1453
}
1454
1455
# AttributionsTogether
1456
0
$rt .= "
1457
0
0
$rt .= " CHECKED" if $self->{'AttributionsTogether'};
1458
0
$rt .= "> ".gettext("Show attributions from all parts together at bottom")."\n";
1459
1460
# TODO: delete this block. superseded by submitAnsToCat
1461
# if ((not defined $self->{'directoryHint'})
1462
# and (not $params->{'_insert'})) {
1463
# # we hide this on initial inserts, because it serves to confuse, and
1464
# # they can always come back here.
1465
# $rt .= "
1466
# ." Add a directory part to turn this answer item into "
1467
# ."a category item.\n";
1468
# }
1469
1470
# Submit
1471
0
$rt .="
1472
0
$rt .= "
1473
0
$rt .= "
1474
# this lets the submit script check that the whole POST was
1475
# received.
1476
0
$rt .= "\n";
1477
# $rt .= FAQ::OMatic::button(
1478
# FAQ::OMatic::makeAref('-command'=>'faq',
1479
# '-params'=>$params,
1480
# '-changedParams'=>{'checkSequenceNumber'=>''}),
1481
# "Cancel and return to the FAQ");
1482
1483
0
$rt .= FAQ::OMatic::HelpMod::helpFor($params, 'editItem', "
1484
1485
0
return $rt;
1486
}
1487
1488
sub permissionsInfo {
1489
0
0
0
my $permissionsInfo = {
1490
1491
'01' => { 'name'=>'PermAddPart', 'desc'=>
1492
gettext("Who can add a new text part to this item:") },
1493
'02' => { 'name'=>'PermAddItem', 'desc'=>
1494
gettext("Who can add a new answer or category to this category:") },
1495
'03' => { 'name'=>'PermEditPart', 'desc'=>
1496
gettext("Who can edit or remove existing text parts from this item:") },
1497
'04' => { 'name'=>'PermEditDirectory', 'desc'=>
1498
gettext("Who can move answers or subcategories from this category; or turn this category into an answer or vice versa:") },
1499
'05' => { 'name'=>'PermEditTitle', 'desc'=>
1500
gettext("Who can edit the title and options of this answer or category:") },
1501
'06' => { 'name'=>'PermUseHTML', 'desc'=>
1502
gettext("Who can use untranslated HTML when editing the text of this answer or category:") },
1503
'07' => { 'name'=>'PermModOptions', 'desc'=>
1504
gettext("Who can change these moderator options and permissions:") },
1505
'09' => { 'name'=>'PermNewBag', 'global'=>1, 'desc'=>
1506
gettext("Who can create new bags:") },
1507
'10' => { 'name'=>'PermReplaceBag', 'global'=>1, 'desc'=>
1508
gettext("Who can replace existing bags:") },
1509
'11' => { 'name'=>'PermInstall', 'global'=>1, 'desc'=>
1510
gettext("Who can access the installation/configuration page (use caution!):") },
1511
'12' => { 'name'=>'PermEditGroups', 'global'=>1, 'desc'=>
1512
gettext("Who can use the group membership pages:") },
1513
};
1514
# TODO: The global permissions should probably appear
1515
# TODO: on a different page. As-is, the administrator must
1516
# TODO: give away control over these permissions to give
1517
# TODO: away moderatorship of the root item.
1518
0
return $permissionsInfo;
1519
}
1520
1521
sub displayModOptionsEditor {
1522
0
0
0
my $self = shift;
1523
0
my $params = shift;
1524
0
my $cgi = shift;
1525
0
my $rt = ""; # return text
1526
1527
0
0
if ($self->isCategory())
0
1528
{
1529
0
$rt .= gettext("Moderator options for category");
1530
}
1531
elsif ($self->isAnswer())
1532
{
1533
0
$rt .= gettext("Moderator options for answer");
1534
}
1535
else
1536
{
1537
# fixup for unexpected cases.
1538
0
$rt .= gettext("Moderator options for")." "
1539
.gettext($self->whatAmI());
1540
}
1541
0
$rt .= " ".$self->getTitle()." :\n"
1542
."\n";
1543
1544
0
$rt .= FAQ::OMatic::makeAref('-command'=>'submitModOptions',
1545
'-params'=>$params,
1546
'-changedParams'=>{'_insert'=>$params->{'_insert'}},
1547
'-refType'=>'POST');
1548
1549
0
$rt .= "
1550
.$self->{'SequenceNumber'}."\">\n";
1551
1552
# Moderator
1553
# THANKS to John Nolan for suggesting a better permissions layout.
1554
0
$rt .= "\n";
1555
0
$rt .= " \n"
1556
." ".gettext("Name & Description")." \n"
1557
." ".gettext("Setting")." \n"
1558
." ".gettext("Setting if Inherited")." \n"
1559
." \n";
1560
1561
# Moderator
1562
# $rt .= " ".gettext("Moderator")." "
1563
# ." \n";
1564
0
0
my $inherited = $self->getInheritance($params, 'Moderator', '
1565
0
sub {shift;});
1566
0
$rt .= " ".gettext("Moderator")." \n"
1567
."
1568
0
0
$rt .= "
1569
."
1570
.($self->{'Moderator'}||'')."\" size=60> \n";
1571
0
$rt .= " $inherited"
1572
." \n";
1573
1574
# ModeratorMail
1575
0
$rt .= " "
1576
." MailModerator "
1577
." \n";
1578
0
$rt .= " \n";
1579
0
$rt .= popup('MailModerator', [1, 0, ''], [gettext('Yes'), gettext('No'), gettext('Inherit')],
1580
$self->{'MailModerator'});
1581
0
0
0
$inherited =
1582
$self->getInheritance($params, 'MailModerator', '
1583
0
sub {(gettext("No"), gettext("Yes"))[shift()] || gettext("undefined")});
1584
0
$rt .= " $inherited \n";
1585
0
$rt .= " \n";
1586
1587
1588
# Notifier
1589
# THANKS to John Nolan for suggesting a better permissions layout.
1590
# $rt .= "\n";
1591
# $rt .= " \n"
1592
# ." ".gettext("Name & Description")." \n"
1593
# ." ".gettext("Setting")." \n"
1594
# ." ".gettext("Setting if Inherited")." \n"
1595
# ." \n";
1596
1597
# Notifer
1598
# $rt .= " ".gettext("Moderator")." "
1599
# ." \n";
1600
0
0
$inherited = $self->getInheritance($params, 'Notifier', '
1601
0
sub {shift;});
1602
0
$rt .= " ".gettext("Notifier")." \n"
1603
."
1604
."
1605
0
0
$rt .= "
1606
."
1607
.($self->{'Notifier'}||'')."\" size=60> \n";
1608
0
$rt .= " $inherited"
1609
." \n";
1610
1611
# NotifierMail
1612
0
$rt .= " "
1613
." MailNotifier "
1614
." \n";
1615
0
$rt .= " \n";
1616
0
$rt .= popup('MailNotifier', [1, 0, ''], [gettext('Yes'), gettext('No'), gettext('Inherit')],
1617
$self->{'MailNotifier'});
1618
0
0
0
$inherited =
1619
$self->getInheritance($params, 'MailNotifier', '
1620
0
sub {(gettext("No"), gettext("Yes"))[shift()] || gettext("undefined")});
1621
0
$rt .= " $inherited \n";
1622
0
$rt .= " \n";
1623
1624
# Permission info
1625
0
$rt .= " ".gettext("Permissions")."
1626
1627
0
my $permissionsInfo = permissionsInfo();
1628
0
foreach my $key (sort keys %{$permissionsInfo}) {
0
1629
0
my $ph = $permissionsInfo->{$key}; # permission descriptor hash
1630
0
0
0
next if ($ph->{'global'} and $self->{'filename'} ne '1');
1631
# only display global permissions for item 1, where they are set
1632
0
my $pname = $ph->{'name'};
1633
0
my $inherited =
1634
$self->getInheritance($params, $pname, '
1635
0
$rt.=" \n";
1636
0
$rt.=" $pname "
1637
." \n"; # Perm description column
1638
0
$rt.=" ".$self->permissionBox($ph->{'name'})." \n";
1639
# popup choice column
1640
0
$rt.=" $inherited \n"; # inherited value column
1641
0
$rt.=" \n";
1642
}
1643
1644
# RelaxChildPerms
1645
0
$rt .= " "
1646
." "."RelaxChildPerms"." "
1647
."
1648
.gettext("by the creator of the item, allowing that person full ")
1649
.gettext("freedom to edit that new item.")
1650
."
1651
.gettext("the moderator of this item.")
1652
." \n";
1653
0
$rt .= " \n";
1654
0
$rt .= popup('RelaxChildPerms',
1655
['relax', 'norelax', ''],
1656
[gettext("Relax"), gettext("Don\'t Relax"), gettext("Inherit")],
1657
$self->{'RelaxChildPerms'});
1658
0
0
0
$inherited =
1659
$self->getInheritance($params, 'RelaxChildPerms', '
1660
sub {{'relax'=>gettext("Relax"), 'norelax'=>gettext("Don\'t Relax")}->{shift()}
1661
0
|| gettext("undefined")});
1662
0
$rt .= " $inherited \n";
1663
0
$rt .= " \n";
1664
1665
0
$rt .= "
\n";
1666
1667
0
$rt .="
1668
0
$rt .= "
1669
0
$rt .= "
1670
# this lets the submit script check that the whole POST was
1671
# received.
1672
0
$rt .= "\n";
1673
1674
0
$rt .= FAQ::OMatic::HelpMod::helpFor($params, 'editModOptions', "
1675
1676
0
return $rt;
1677
}
1678
1679
sub getInheritance {
1680
0
0
0
my $self = shift;
1681
0
my $params = shift;
1682
0
my $pname = shift;
1683
0
my $separator = shift;
1684
0
my $namecode = shift;
1685
1686
0
my $val;
1687
my $whered;
1688
0
0
if ($self->getParent() eq $self) {
1689
0
$val = FAQ::OMatic::Auth::getDefaultProperty($pname);
1690
0
$whered = gettext("(system default)");
1691
} else {
1692
0
my ($pset,$where) = FAQ::OMatic::Auth::getInheritedProperty(
1693
$self->getParent(), $pname);
1694
0
0
if (defined $where) {
1695
0
$val = $pset;
1696
0
$whered = "(".gettext("defined in")." \""
1697
.FAQ::OMatic::makeAref('-command'=>'editModOptions',
1698
'-params'=>$params,
1699
'-changedParams'=>{'file'=>$where->{'filename'}})
1700
.$where->getTitle()
1701
."\")";
1702
} else {
1703
0
$val = $pset;
1704
0
$whered = gettext("(system default)");
1705
}
1706
}
1707
0
return ("".&{$namecode}($val)." ".$separator.$whered);
0
1708
}
1709
1710
sub setProperty {
1711
0
0
0
my $self = shift;
1712
0
my $property = shift;
1713
0
my $value = shift;
1714
1715
0
0
0
if (defined($value) and ($value ne '')) {
1716
0
$self->{$property} = $value;
1717
0
0
if ($property eq 'Title') {
1718
# keep track if title changes after file is loaded;
1719
# used to update items whose cached representations
1720
# depend on this item's title (because those items have
1721
# embedded faqomatic: references to this one).
1722
0
$self->{'titleChanged'} = 1;
1723
}
1724
} else {
1725
0
delete $self->{$property};
1726
}
1727
}
1728
1729
sub getProperty {
1730
0
0
0
my $self = shift;
1731
0
my $property = shift;
1732
1733
0
return $self->{$property};
1734
}
1735
1736
sub getDirPart {
1737
0
0
0
my $self = shift;
1738
1739
0
0
if (defined $self->{'directoryHint'}) {
1740
0
return $self->{'Parts'}->[$self->{'directoryHint'}];
1741
} else {
1742
0
return undef;
1743
}
1744
}
1745
1746
sub makeDirectory {
1747
# This sub guarantees that this item contains a directory part,
1748
# creating an empty one if there wasn't already one.
1749
# It returns the dirpart.
1750
0
0
0
my $self = shift;
1751
1752
0
0
return $self->getDirPart() if $self->getDirPart();
1753
1754
0
my $dirPart = new FAQ::OMatic::Part();
1755
# should set author for $newPart to user doing this action
1756
0
$dirPart->{'Type'} = 'directory';
1757
0
$dirPart->{'Text'} = '';
1758
0
$dirPart->{'HideAttributions'} = 1; # directories prefer to have
1759
# attributions hidden.
1760
0
$self->{'directoryHint'} = scalar @{$self->{'Parts'}};
0
1761
0
push @{$self->{'Parts'}}, $dirPart;
0
1762
1763
0
return $dirPart;
1764
}
1765
1766
sub addSubItem {
1767
0
0
0
my $self = shift;
1768
0
my $subfilename = shift;
1769
0
0
my $deferUpdate = shift || '';
1770
1771
0
my $dirPart;
1772
1773
0
my $subitem = new FAQ::OMatic::Item($subfilename);
1774
0
0
if ($subitem->isBroken()) {
1775
0
FAQ::OMatic::gripe('problem', gettexta("File %0 seems broken.", $subfilename));
1776
}
1777
1778
0
$self->makeDirectory()->mergeDirectory($subfilename);
1779
1780
# all the children in the list may now have different siblings,
1781
# which means we need to recompute their dependencies and
1782
# regenerate their cached html.
1783
0
0
if (!$deferUpdate) {
1784
0
$self->updateAllChildren();
1785
}
1786
1787
0
$self->incrementSequence();
1788
}
1789
1790
sub removeSubItem {
1791
0
0
0
my $self = shift;
1792
0
my $subfilename = shift; # if omitted, this just removes an empty
1793
# directory part.
1794
0
0
my $deferUpdate = shift || '';
1795
1796
0
my $dirPart = $self->getDirPart();
1797
0
0
if (not defined $dirPart) {
1798
0
FAQ::OMatic::gripe('panic', "FAQ::OMatic::Item::removeSubItem(): I ("
1799
.$self->{'filename'}
1800
.") don't have a directoryHint! How did that happen?");
1801
}
1802
0
0
if ($subfilename) {
1803
0
$dirPart->unmergeDirectory($subfilename);
1804
1805
# all the children in the list may now have different siblings,
1806
# which means we need to recompute their dependencies and
1807
# regenerate their cached html.
1808
0
0
if (!$deferUpdate) {
1809
0
$self->updateAllChildren();
1810
}
1811
}
1812
1813
# I'm not sure why I thought automatically converting categories to answers
1814
# when their directories become empty was a good idea. When the trash is
1815
# emptied, it becomes an answer. If you empty a category, and expect
1816
# to refill it with moves, you won't see your category in the (default)
1817
# move target list anymore. That would be confusing. Hmmm.
1818
# if ($dirPart->{'Text'} =~ m/^\s*$/s) {
1819
# splice @{$self->{'Parts'}}, $self->{'directoryHint'}, 1;
1820
# delete $self->{'directoryHint'};
1821
# }
1822
1823
0
$self->incrementSequence();
1824
}
1825
1826
sub extractWordsFromString {
1827
0
0
0
my $string = shift;
1828
0
my $filename = shift;
1829
0
my $words = shift;
1830
1831
0
my @wordlist = FAQ::OMatic::Words::getWords( $string );
1832
1833
# Associate words with this file in index
1834
0
my $i;
1835
0
foreach $i (@wordlist) {
1836
# do it for every prefix, too
1837
0
my $prefix;
1838
0
foreach $prefix ( FAQ::OMatic::Words::getPrefixes( $i ) ) {
1839
0
$words->{$prefix}{$filename} = 1;
1840
}
1841
}
1842
}
1843
1844
sub extractWords {
1845
0
0
0
my $self = shift;
1846
0
my $words = shift;
1847
1848
0
extractWordsFromString($self->getTitle(), $self->{'filename'}, $words);
1849
1850
0
my $part;
1851
0
foreach $part (@{$self->{'Parts'}}) {
0
1852
0
extractWordsFromString($part->{'Text'}, $self->{'filename'}, $words);
1853
}
1854
1855
# recurse (turned off -- see buildSearchDB)
1856
# my $dirPart = $self->getDirPart();
1857
# if (defined $dirPart) {
1858
# my $filei;
1859
# my $itemi;
1860
# foreach $filei ($dirPart->getChildren()) {
1861
# $itemi = new FAQ::OMatic::Item($filei);
1862
# $itemi->extractWords($words);
1863
# }
1864
# }
1865
}
1866
1867
sub rightEnd {
1868
0
0
0
my $string = shift;
1869
0
my $amount = shift;
1870
0
my $encode_lang = FAQ::OMatic::I18N::language();
1871
#EUC-JP case
1872
0
0
return rightEndMB($string,$amount) if($encode_lang eq "ja_JP.EUC");
1873
#normal case
1874
0
return rightEndSB($string,$amount);
1875
}
1876
1877
sub rightEndSB {
1878
0
0
0
my $string = shift;
1879
0
my $amount = shift;
1880
0
0
if ($amount >= length($string)) {
1881
0
return $string;
1882
} else {
1883
0
return substr($string,length($string)-$amount,$amount);
1884
}
1885
}
1886
1887
sub rightEndMB {
1888
0
0
0
my $string = shift;
1889
0
my $amount = shift;
1890
0
my ($n, $c, $r, $mb, $width, $result);
1891
0
$width = length($string) - $amount;
1892
0
0
if ($amount >= length($string)) {
1893
0
return $string;
1894
} else {
1895
0
while (length($string)) {
1896
0
0
0
last unless ($mb = $string =~ s/^([\200-\377].)+//) ||
1897
$string =~s/[\0-\177]+//;
1898
0
$n = $width;
1899
0
0
$n -= $width % 2 if $mb;
1900
0
($c,$r) = unpack("a$n a*", $&);
1901
0
$width -= length($c);
1902
0
$result .= $c;
1903
0
0
last if length($r)
1904
}
1905
0
return ($r.$string);
1906
}
1907
}
1908
1909
sub displaySearchContext {
1910
0
0
0
my $self = shift;
1911
0
my $params = shift;
1912
0
my $rows = [];
1913
0
my $text = "";
1914
0
my @contexts = ();
1915
0
my @pieces=();
1916
0
my @parts=();
1917
0
my @hw;
1918
my $wordmatch;
1919
0
my $i;
1920
0
my $count;
1921
1922
0
my @highlightWordsFlag = ();
1923
0
0
0
if (not ($FAQ::OMatic::Config::disableSearchHighlight || '')) {
1924
0
@highlightWordsFlag = (
1925
0
'_highlightWords' => join(' ', @{$params->{'_searchArray'}})
1926
);
1927
}
1928
# start with a title that's a link
1929
0
push @$rows, { 'type'=>'wide', 'text'=>
1930
FAQ::OMatic::makeAref('-command'=>'faq',
1931
'-params'=>$params,
1932
'-changedParams'=>
1933
{ 'file' => $self->{'filename'},
1934
@highlightWordsFlag
1935
#'_highlightWords' => join(' ', @{$params->{'_searchArray'}})
1936
})
1937
.FAQ::OMatic::highlightWords($self->getTitle(),$params)."",
1938
'id'=>'displaySearchContext-title' };
1939
1940
# add some context
1941
# get all of my parts' text
1942
0
$text = join(" ",
1943
0
map { $_->{'Text'} } @{$self->{'Parts'}});
0
1944
1945
# contstruct the wordmatch regular expression that matches any
1946
# of the search words, with apostrophes interspersed.
1947
0
@hw = @{ $params->{'_searchArray'} };
0
1948
0
@hw = map { FAQ::OMatic::lotsOfApostrophes($_) } @hw;
0
1949
0
$wordmatch = '(\W'.join(')|(',@hw).')';
1950
1951
0
$text = ' '.$text; # ensure we match at beginning of text (because of \s)
1952
1953
0
@pieces = split(/$wordmatch/is, $text); # break into pieces
1954
# THANKS to John Goerzen
1955
# and THANKS to Colin Watson
1956
# for reporting the fix on the previous line for a Perl 5.8 warning
1957
# that turns into an error.
1958
# save only the defined parts, so it alternates between match and nonmatch
1959
0
foreach $i (@pieces) {
1960
0
0
if (defined $i) {
1961
0
push @parts, $i;
1962
}
1963
}
1964
1965
# now all even @parts are non-match, all odd are matches
1966
# whenever an even part is shorter than 20 characters, merge
1967
# it and its neighbors.
1968
0
for ($i=2; ($i
1969
0
0
if (length($parts[$i]) < 20) {
1970
0
splice(@parts, $i-1, 3, $parts[$i-1].$parts[$i].$parts[$i+1]);
1971
0
$i = $i - 2;
1972
}
1973
}
1974
1975
0
0
for ($i=1, $count=0; $i
1976
0
0
my $ls = ($i-1 >= 0) ? $parts[$i-1] : '';
1977
0
0
my $rs = ($i+1 < scalar(@parts)) ? $parts[$i+1] : '';
1978
0
0
my $ltrunc = (($i>1) or length($ls)>40);
1979
0
0
my $rtrunc = (($i40);
1980
0
0
push @contexts,
0
1981
FAQ::OMatic::entify(
1982
($ltrunc ? '...' : '')
1983
.rightEnd($ls,40)
1984
.' '
1985
.$parts[$i]
1986
.substrFOM($rs,40)
1987
.($rtrunc ? '...' : ''));
1988
}
1989
0
my $context = join("\n
1990
1991
# highlight the matching words
1992
0
push @$rows, { 'type'=>'wide',
1993
'text'=>FAQ::OMatic::highlightWords($context,$params),
1994
'id'=>'displaySearchContext-text' };
1995
1996
0
return { 'item'=>$self, 'rows'=>$rows };
1997
}
1998
1999
sub notifyModerator {
2000
0
0
0
my $self = shift;
2001
0
my $cgi = shift;
2002
0
my $didWhat = shift;
2003
0
my $changedPart = shift;
2004
2005
0
0
my $mail = FAQ::OMatic::Auth::getInheritedProperty($self, 'MailModerator')
2006
|| '';
2007
0
0
return if ($mail ne '1'); # didn't want mail anyway
2008
2009
0
my $moderator = FAQ::OMatic::Auth::getInheritedProperty($self, 'Moderator');
2010
0
0
return if (not $moderator =~ m/\@/); # some non-address
2011
2012
0
my $msg = '';
2013
0
my ($id,$aq) = FAQ::OMatic::Auth::getID();
2014
2015
0
0
0
if ($id eq $moderator
2016
and $didWhat =~ m/moderator options/) {
2017
0
return;
2018
# moderator doesn't need to get mail about his own edits
2019
# THANKS to Bernhard Scholz for the suggestion
2020
}
2021
2022
0
$msg .= "[This is a message about the Faq-O-Matic items you moderate.]\n\n";
2023
0
$msg .= "Who: $id\n";
2024
0
$msg .= "Item: ".$self->getTitle()."\n";
2025
0
$msg .= "File: ".$self->{'filename'}."\n";
2026
0
my $url = FAQ::OMatic::makeAref('-command'=>'faq',
2027
# sleazy hack that will bite me later -- go ahead and use
2028
# global params, because that's always "okay" here.
2029
#'-params'=>$params,
2030
'-changedParams'=>{'file'=>$self->{'filename'}},
2031
'-reftype'=>'url',
2032
'-blastAll'=>1);
2033
0
$msg .= "URL: ".$url."\n";
2034
0
$msg .= "What: ".$didWhat."\n";
2035
2036
0
0
if (defined $changedPart) {
2037
0
$msg .= "New text:\n";
2038
0
$msg .= FAQ::OMatic::quoteText($self->getPart($changedPart)->{'Text'},
2039
'> ');
2040
}
2041
2042
0
$msg .= "\nAs always, thanks for your help maintaining the FAQ.\n";
2043
2044
# make sure $moderator isn't a trick string
2045
0
$moderator = FAQ::OMatic::validEmail($moderator);
2046
0
0
if (defined($moderator)) {
2047
# send the mail to the moderator
2048
# pageHeader is added to tell which FAQ has sent the mail.
2049
# THANKS suggested by Akiko Takano
2050
0
FAQ::OMatic::sendEmail($moderator,
2051
"[" . FAQ::OMatic::fomTitle() . "] Faq-O-Matic Moderator Mail",
2052
$msg);
2053
} else {
2054
0
FAQ::OMatic::gripe('problem',
2055
"Moderator address is suspect ($moderator)");
2056
}
2057
}
2058
2059
sub notifyNotifier {
2060
0
0
0
my $self = shift;
2061
0
my $cgi = shift;
2062
0
my $didWhat = shift;
2063
0
my $changedPart = shift;
2064
2065
0
0
my $mail = FAQ::OMatic::Auth::getInheritedProperty($self, 'MailNotifier')
2066
|| '';
2067
0
0
return if ($mail ne '1'); # didn't want mail anyway
2068
2069
0
my $moderator = FAQ::OMatic::Auth::getInheritedProperty($self, 'Notifier');
2070
0
0
return if (not $moderator =~ m/\@/); # some non-address
2071
2072
0
my $msg = '';
2073
0
my ($id,$aq) = FAQ::OMatic::Auth::getID();
2074
2075
0
0
0
if ($id eq $moderator
2076
and $didWhat =~ m/moderator options/) {
2077
0
return;
2078
# moderator doesn't need to get mail about his own edits
2079
# THANKS to Bernhard Scholz for the suggestion
2080
}
2081
2082
0
$msg .= "[This is a notification about the Faq-O-Matic items you have subscribed to.]\n\n";
2083
0
$msg .= "Who: $id\n";
2084
0
$msg .= "Item: ".$self->getTitle()."\n";
2085
0
$msg .= "File: ".$self->{'filename'}."\n";
2086
0
my $url = FAQ::OMatic::makeAref('-command'=>'faq',
2087
# sleazy hack that will bite me later -- go ahead and use
2088
# global params, because that's always "okay" here.
2089
#'-params'=>$params,
2090
'-changedParams'=>{'file'=>$self->{'filename'}},
2091
'-reftype'=>'url',
2092
'-blastAll'=>1);
2093
0
$msg .= "URL: ".$url."\n";
2094
0
$msg .= "What: ".$didWhat."\n";
2095
2096
0
0
if (defined $changedPart) {
2097
0
$msg .= "New text:\n";
2098
0
$msg .= FAQ::OMatic::quoteText($self->getPart($changedPart)->{'Text'},
2099
'> ');
2100
}
2101
2102
0
$msg .= "\nAs always, thanks for your help maintaining the FAQ.\n";
2103
2104
# make sure $moderator isn't a trick string
2105
0
$moderator = FAQ::OMatic::validEmail($moderator);
2106
0
0
if (defined($moderator)) {
2107
# send the mail to the moderator
2108
# pageHeader is added to tell which FAQ has sent the mail.
2109
# THANKS suggested by Akiko Takano
2110
0
FAQ::OMatic::sendEmail($moderator,
2111
"[" . FAQ::OMatic::fomTitle() . "] " . $self->getTitle().":".$didWhat,
2112
$msg);
2113
} else {
2114
0
FAQ::OMatic::gripe('problem',
2115
"Moderator address is suspect ($moderator)");
2116
}
2117
}
2118
2119
# item in the parent's list
2120
sub getSiblings {
2121
0
0
0
my $self = shift;
2122
0
my ($prev, $next);
2123
2124
0
my $parent = $self->getParent();
2125
0
0
return (undef,undef) if (not $parent);
2126
0
my @siblings = $parent->getChildren();
2127
0
my $i;
2128
0
for ($i=0; $i<@siblings; $i++) {
2129
0
0
if ($siblings[$i] eq $self->{'filename'}) {
2130
0
0
$prev = ($i>0) ? $siblings[$i-1] : undef;
2131
0
0
$next = ($i<@siblings-1) ? $siblings[$i+1] : undef;
2132
0
return ($prev,$next);
2133
}
2134
}
2135
0
return (undef,undef);
2136
}
2137
2138
sub isCategory {
2139
0
0
0
my $self = shift;
2140
0
0
return (defined $self->{'directoryHint'}) ? 1 : 0;
2141
}
2142
2143
# added for convenient reasons
2144
sub isAnswer {
2145
0
0
0
my $self = shift;
2146
0
return !($self->isCategory());
2147
}
2148
2149
sub whatAmI {
2150
# do not translate here; translate just before output.
2151
# (There is code that tests for string equality based on the
2152
# output of this function. Maybe that's stupid.)
2153
0
0
0
my $self = shift;
2154
2155
0
0
return gettext_noop("Category") if ($self->isCategory());
2156
0
0
return gettext_noop("Answer") if ($self->isAnswer());
2157
2158
# unreachable
2159
0
gripe('problem',
2160
'Internal error #20010805-1843: unreachable code is reached',
2161
1);
2162
0
return "(Unexpected item type)";
2163
}
2164
2165
sub updateDirectoryHint {
2166
0
0
0
my $self = shift;
2167
2168
0
my $i;
2169
0
for ($i=0; $i<$self->numParts(); $i++) {
2170
0
0
if ($self->getPart($i)->{'Type'} eq 'directory') {
2171
0
$self->{'directoryHint'} = $i;
2172
0
return;
2173
}
2174
}
2175
0
delete $self->{'directoryHint'};
2176
}
2177
2178
sub clone {
2179
# return a deep-copy of myself
2180
0
0
0
my $self = shift;
2181
2182
0
my $newitem = new FAQ::OMatic::Item();
2183
2184
# copy all of prototype's attributes
2185
0
my $key;
2186
0
foreach $key (keys %{$self}) {
0
2187
0
0
next if ($key eq 'Parts');
2188
0
0
if ($key =~ m/-Set$/) {
0
2189
0
$newitem->{$key} = $self->{$key}->clone();
2190
} elsif (ref $self->{$key}) {
2191
# guarantee this is a deep copy -- if we missed
2192
# a ref, complain.
2193
0
FAQ::OMatic::gripe('error', "clone: prototype has key '$key' "
2194
."that is a reference (".$self->{$key}.").");
2195
}
2196
0
$newitem->{$key} = $self->{$key};
2197
}
2198
2199
# copy all the parts...
2200
0
my $i;
2201
0
for ($i=0; $i<$self->numParts(); $i++) {
2202
0
push(@{$newitem->{'Parts'}}, $self->getPart($i)->clone());
0
2203
}
2204
2205
0
$newitem->updateDirectoryHint();
2206
2207
0
return $newitem;
2208
}
2209
2210
sub checkSequence {
2211
0
0
0
my $self = shift;
2212
0
my $params = shift;
2213
2214
0
0
my $checkSequenceNumber =
2215
defined($params->{'checkSequenceNumber'})
2216
? $params->{'checkSequenceNumber'}
2217
: -1;
2218
0
0
if ($checkSequenceNumber ne $self->{'SequenceNumber'}) {
2219
0
my $button = FAQ::OMatic::button(
2220
FAQ::OMatic::makeAref('-command'=>'faq',
2221
'-params'=>$params,
2222
'-changedParams'=>{'partnum'=>'', 'checkSequenceNumber'=>''}
2223
),
2224
gettext("Return to the FAQ"));
2225
0
FAQ::OMatic::gripe('error',
2226
gettext("Either someone has changed the answer or category you were editing since you received the editing form, or you submitted the same form twice.")
2227
."\n"
2228
.gettexta("Please %0 and start again to make sure no changes are lost. Sorry for the inconvenience.",
2229
$button)
2230
.""
2231
.gettexta("(Sequence number in form: %0; in item: %1)",
2232
$checkSequenceNumber, $self->{'SequenceNumber'}),
2233
{'noentify'=>1}
2234
);
2235
}
2236
}
2237
2238
sub incrementSequence {
2239
0
0
0
my $self = shift;
2240
2241
0
$self->setProperty('SequenceNumber', $self->{'SequenceNumber'}+1);
2242
}
2243
2244
sub substrFOM {
2245
0
0
0
my $string = shift;
2246
0
my $width = shift;
2247
0
my $result = shift;
2248
0
my $encode_lang = FAQ::OMatic::I18N::language();
2249
#EUC-JP case
2250
0
0
return substrMB($string,$width,$result) if($encode_lang eq "ja_JP.EUC");
2251
#normal case
2252
0
return substr($string,$width,$result);
2253
2254
}
2255
2256
sub substrMB {
2257
0
0
0
my $string = shift;
2258
0
my $width = shift;
2259
0
my $result = shift;
2260
0
my ($n, $c, $r, $mb);
2261
0
while (length($string)){
2262
0
0
0
last unless ($mb = $string =~ s/^([\200-\377].)+//)
2263
|| $string =~ s/[\0-\177]+//;
2264
0
$n = $width;
2265
0
0
$n -= $width % 2 if $mb;
2266
0
($c,$r) = unpack("a$n a*", $&);
2267
0
$width -= length($c);
2268
0
$result .= $c;
2269
0
0
last if length($r);
2270
}
2271
0
return $result;
2272
} # end of sub substrJ..
2273
1;