############################################################################## # The Faq-O-Matic is Copyright 1997 by Jon Howell, all rights reserved. # # # # This program is free software; you can redistribute it and/or # # modify it under the terms of the GNU General Public License # # as published by the Free Software Foundation; either version 2 # # of the License, or (at your option) any later version. # # # # This program is distributed in the hope that it will be useful, # # but WITHOUT ANY WARRANTY; without even the implied warranty of # # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # # GNU General Public License for more details. # # # # You should have received a copy of the GNU General Public License # # along with this program; if not, write to the Free Software # # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.# # # # Jon Howell can be contacted at: # # 6211 Sudikoff Lab, Dartmouth College # # Hanover, NH 03755-3510 # # jonh@cs.dartmouth.edu # # # # An electronic copy of the GPL is available at: # # http://www.gnu.org/copyleft/gpl.html # # # ############################################################################## use strict; ### ### A FAQ::OMatic::Item is a data structure that contains an entire item ### from the FAQ. (One file.) ### package FAQ::OMatic::Item; use FAQ::OMatic::Part; use FAQ::OMatic; use FAQ::OMatic::Auth; use FAQ::OMatic::Appearance; use FAQ::OMatic::Groups; use FAQ::OMatic::Words; use FAQ::OMatic::HelpMod; use FAQ::OMatic::Versions; use FAQ::OMatic::Set; use FAQ::OMatic::I18N; BEGIN { # This code use Japanese environment only. # see http://chasen.aist-nara.ac.jp/index.html.en # if (FAQ::OMatic::I18N::language() eq 'ja_JP.EUC') { require NKF; import NKF; } } my @monthMap; # a constant array, no cache problem for mod_perl sub new { my ($class) = shift; my ($arg) = shift; # what file the item data lives in my ($dir) = shift; # what dir we should look in for the item data # (default $FAQ::OMatic::Config::itemDir) my $item = {}; bless $item; # if we have the item loaded already, use the in-core copy! my $itemCache = FAQ::OMatic::getLocal('itemCache'); if ($arg and (defined $itemCache->{$arg})) { return $itemCache->{$arg}; } $item->{'class'} = $class; $item->{'Parts'} = []; if ($arg) { $item->loadFromFile($arg,$dir); if ($item->{'filename'}) { $itemCache->{$item->{'filename'}} = $item; FAQ::OMatic::setLocal('itemCache', $itemCache); } } else { $item->setProperty('Title', gettext("New Item")); } # ensure every item has a sequence number. # sequence numbers are used to: # 1. detect conflicting edits. We discard the later submission; # no attempt is made to prevent simultaneous edits in the first place. # The assumption is that simultaneous edits are uncommon, and stale # locks would probably be less convenient than occasional conflicts. # 2. incremental transfers for mirrored faqs $item->{'SequenceNumber'} = 0 if (not defined($item->{'SequenceNumber'})); return $item; } # used for emptying trash. sub destroyItem { my $self = shift; my $deferUpdate = shift || ''; # only works for things in Config::itemDir my $filename = $self->{'filename'}; # remove item from internal cache so we don't try to re-save it out. my $itemCache = FAQ::OMatic::getLocal('itemCache'); delete $itemCache->{$filename}; # detach the item from its parent my $parent = $self->getParent(); $parent->removeSubItem($filename, $deferUpdate); # TODO note that we don't do anything about symlinks (faqomatic: refs) # to this missing item; they'll become "missing or broken item". We # should probably handle that issue during the "Move to trash" operation, # since you don't really want symlinks into the trash, anyway. # TODO note that the file simply disappears, so if we lose the # biggestFileHint, we might accidentally reallocate this file number. # That's not horrible, but perhaps worth avoiding. # TODO I don't delete the RCS file, because disk space is free. # I'm emptying the trash just to reduce the amount of cruft that piles # up in user-visible space! If someone really cares, they could delete # the RCS file, too. (On the other hand, one might worry about # disk space for bag deletion.) destroyItemRaw($self->{'filename'}); } sub destroyItemRaw { my $filename = shift; # zero file on disk # we leave a stub there so that new files won't be created with the # same file name. That keeps links by filename from changing their # destination. my $dir = $FAQ::OMatic::Config::itemDir || ''; #my $inode = `ls -i $dir/$filename`; my $rc = open(FILE, ">$dir/$filename"); close FILE; if (not $rc or ((-s "$dir/$filename") != 0)) { FAQ::OMatic::gripe('problem', "Bummer: failed to zero $filename\n"); return 0; } # TODO need to commit to RCS, get & release Item lock. return 1; } sub loadFromFile { my $self = shift; my $filename = shift; my $dir = shift || ''; # optional -- almost always itemDir # untaint user input (so they can't express # a file of ../../../../../../etc/passwd) if (not $filename =~ m/^([\w\-.]*)$/) { # if taint check fails, just return a bad item, rather # than implying that there really is an item with the funny name # supplied. delete $self->{'Title'}; return; } else { $filename = $1; } if (not $dir) { $dir = $FAQ::OMatic::Config::itemDir || ''; } if (not -f "$dir/$filename") { if ($dir eq ($FAQ::OMatic::Config::itemDir||'x') and FAQ::OMatic::Versions::getVersion('Items')) { # admin only cares much if an item turns up missing, # and then only if he's actually gotten the FAQ installed. FAQ::OMatic::gripe('note', "FAQ::OMatic::Item::loadFromFile: $filename isn't a regular " ."file (-f test failed)."); } delete $self->{'Title'}; return; } if ((-s "$dir/$filename") == 0) { delete $self->{'Title'}; $self->{'EmptyStub'} = 'true'; return; } if (not open(FILE, "$dir/$filename")) { FAQ::OMatic::gripe('note', "FAQ::OMatic::Item::loadFromFile couldn't open $filename."); delete $self->{'Title'}; return; } # take note of which file we came from $self->{'filename'} = $filename; $self->loadFromFileHandle(\*FILE, $filename); close(FILE); return $self; } sub loadFromFileHandle { my $self = shift; my $fh = shift; my $debugFilename = shift; return loadFromCodeClosure($self, sub { return <$fh>; # read one line }, $debugFilename); } sub loadFromString { my $self = shift; my $string = shift; my $debugFilename = shift; my @lines = split("\n", $string); splice(@lines, scalar(@lines)-1); # hack off last empty string return loadFromCodeClosure($self, sub { # read one line my $line = shift(@lines); $line .= "\n" if (defined $line); return $line; }, $debugFilename); } sub loadFromCodeClosure { my $self = shift; my $closure = shift; # a sub that returns one line of the file my $debugFilename = shift || 'an item read from a filehandle'; # process item headers # THANKS to "John R. Jackson" for # grepping for unprotected while constructs. while (defined($_ = &{$closure})) { chomp; my ($key,$value) = FAQ::OMatic::keyValue($_); if ($key eq 'Part') { my $newPart = new FAQ::OMatic::Part; $newPart->loadFromCodeClosure($closure, $self->{'filename'}, $self, scalar @{$self->{'Parts'}}); # partnum push @{$self->{'Parts'}}, $newPart; } elsif ($key eq 'LastModified') { # LEGACY: Transparently update older items with LastModified keys # to use new LastModifiedSecs key. my $secs = compactDateToSecs($value); # turn back into seconds $self->{'LastModifiedSecs'} = $secs; } elsif ($key eq 'PermEditItem') { # Replace this old permission descriptor with the new ones $self->{'PermEditTitle'} = $value; $self->{'PermEditDirectory'} = $value; $self->{'PermAddItem'} = $value; } elsif ($key =~ m/-Set$/) { if (not defined($self->{$key})) { $self->{$key} = new FAQ::OMatic::Set; } $self->{$key}->insert($value); } elsif ($key ne '') { $self->setProperty($key, $value); } else { FAQ::OMatic::gripe('problem', "FAQ::OMatic::Item::loadFromCodeClosure was confused by this " ."header in $debugFilename: \"$_\""); # this marks the item "broken" so that the save routine will # refuse to save this corrupted file out and lose more data. delete $self->{'Title'}; return; } } # We just loaded this item from a file; the title hasn't really # changed. So we unset that property (that was set when we read # the 'Title:' header), so that we can detect when an item's title # actually does change. $self->setProperty('titleChanged', ''); return $self; } sub numParts { my $self = shift; return scalar @{$self->{'Parts'}}; } sub getPart { my $self = shift; my $num = shift; return $self->{'Parts'}->[FAQ::OMatic::stripInt($num)]; } @monthMap =( 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec' ); # a human-readable date/time format. Currently used for the # last-modified field. sub compactDate { my ($forsecs) = shift; # optional; default is now $forsecs = time() if (not $forsecs); my ($sec,$min,$hr,$day,$mo,$yr,$wday,$yday,$isdst) = localtime($forsecs); my $df = $FAQ::OMatic::Config::dateFormat||''; my $time; if ($df eq '24') { # THANKS: to Jan Ornstedt for suggesting 24-hour "European" dates $time = sprintf("%02d:%02d%s", $hr, $min); } else { my $ampm = "am"; if ($hr >= 12) { $hr -= 12; $ampm = "pm"; } $hr = 12 if ($hr == 0); $time = sprintf("%2d:%02d%s", $hr, $min, $ampm); } return sprintf("%04d-%03s-%02d %s", $yr+1900, $monthMap[$mo], $day, $time); } # undo the previous transformation # TODO: this is only used (I think) for updating LastModified: fields # TODO: to LastModifiedSecs: fields. It could eventually be discarded. sub compactDateToSecs { my $cd = shift; my ($yr,$mo,$dy,$hr,$mn,$ampm) = ($cd =~ m/(\d+)-([a-z]+)-(\d+) +(\d+):(\d+)([ap])m/i); if (not defined $ampm) { return -1; # can't parse string } my $month_i; for ($month_i=0; $month_i<12; $month_i++) { if ($mo eq $monthMap[$month_i]) { $mo = $month_i; # notice months run 0..11 last; } } if ($month_i == 12) { return -1; # can't parse month } $hr = 0 if ($hr == 12); # noon/midnight $hr += 12 if ($ampm eq 'p'); # am/pm $yr -= 1900; # year is biased in struct require Time::Local; # LastModified: keys were represented in local time, not GMT. return Time::Local::timelocal(0, $mn, $hr, $dy, $mo, $yr); } sub saveToFile { my $self = shift; my $filename = shift || ''; my $dir = shift || ''; # optional -- almost always itemDir my $lastModified = shift || ''; # optional -- normally today. # 'noChange' is allowed; used when # regenerating files (mod date hasn't # really changed.). my $updateAllDependencies = shift || ''; # optional. specified # by maintenance when regenerating all dependencies. my $noRecomputeDependencies = shift || ''; # optional, used by # mirrorClient to prevent trying to follow # forward references. # TODO: I don't think maintenance.pm really needs to actually write the # TODO: item files when regenerating dependencies/HTML cache files. # TODO: If not, that part of saveToFile should be factored out, so we're # TODO: not really writing out item/ files. $dir = $FAQ::OMatic::Config::itemDir if (not $dir); $filename =~ m/([\w\-.]*)/; # Untaint filename $filename = $1; if (not $filename) { $filename = $self->{'filename'}; } else { # change of filename (from a new, anonymous item) $self->{'filename'} = $filename; } if ($self->isBroken()) { FAQ::OMatic::gripe('error', "Tried to save a broken item to ".(defined($filename)?$filename:"")."

".FAQ::OMatic::stackTrace()); } if ($dir eq $FAQ::OMatic::Config::itemDir and not $noRecomputeDependencies) { # compute new IDependOn-Set -- the items whose titles we depend # on. # copy old list first, so we have something to compare new list to $self->{'oldIDependOn-Set'} = $self->getSet('IDependOn-Set')->clone(); my $newSet = new FAQ::OMatic::Set; # I depend on any item I link to, which includes any explicit # (faqomatic:...) links in the text, ... my $parti; for ($parti=0; $parti<$self->numParts(); $parti++) { my $part = $self->getPart($parti); $newSet->insert($part->getLinks()); } # ...and any implicit links to my ancestors or to siblings my ($parentTitles,$parentNames) = $self->getParentChain(); $newSet->insert(@{$parentNames}); $newSet->insert(grep {defined($_)} $self->getSiblings()); # ...and any bags. $newSet->insert(map { "bags.".$_ } $self->getBags()); $self->{'IDependOn-Set'} = $newSet; } # note last modified date in item itself if ($lastModified ne 'noChange') { # Time now stored in file in Unix-style seconds. # (but as an ASCII integer, which isn't 31-bit limited, # so I'm sure you'll be pleased to note that we're # Y2.038K-compliant. :v) $lastModified = time() if ($lastModified eq ''); $self->{'LastModifiedSecs'} = $lastModified; # $self->{'LastModified'} = compactDate($lastModified); } my $lock = FAQ::OMatic::lockFile("$filename"); return if not $lock; if (not open(FILE, ">$dir/$filename")) { FAQ::OMatic::gripe('problem', "saveToFile: Couldn't write to $dir/$filename because $!"); FAQ::OMatic::unlockFile($lock); return; } my $key; foreach $key (sort keys %{$self}) { if (($key =~ m/^[a-z]/) or ($key eq 'Parts')) { next; # some keys don't get explicitly written out. # These include lowercase keys (e.g. class, filename), # and the Parts key, which we write explicitly later. } elsif ($key =~ m/-Set$/) { my $a; foreach $a ($self->getSet($key)->getList()) { if (FAQ::OMatic::I18N::language() eq 'ja_JP.EUC') { # Japanese only $a = nkf('-e', $a); } print FILE "$key: $a\n"; } } else { my $value = $self->{$key}; $value =~ s/[\n\r]/ /g; # don't allow CRs in a single-line field, # that would corrupt the file format. if (FAQ::OMatic::I18N::language() eq 'ja_JP.EUC') { # Japanese only $value = nkf('-e', $value); } print FILE "$key: $value\n"; } } # now save the parts out my $partCount = 0; my $part; foreach $part (@{$self->{'Parts'}}) { print FILE "Part: $partCount\n"; print FILE $part->displayAsFile(); print FILE "EndPart: $partCount\n"; ++$partCount; } close FILE; FAQ::OMatic::unlockFile($lock); # For item files (not .smry files, which also use the FAQ::OMatic::Item # mechanism for storage), do these things: # 1. Perform RCS ci so we can always get the files back in the face # of net-creeps. # 2. Clear the search hint so we know to regenerate the search index # 3. Rewrite the static cached HTML copy # # We now ci and co in separate steps so that we can specify the '-ko' # flag to co (which ci doesn't accept); the '-ko' flag keeps co # from performing RCS keyword substitution on the item text. This # is important in general to avoid modifying users' data, # but crucial in the (dollar)Log(dollar) # case, where the number of lines in an item file change, and # the structure of the file is corrupted. (Oh, to use XML!) # # THANKS to others for pointing out the -k fix, and # THANKS Somnath Mitra for sending a patch # upon which this fix is based. if ($dir eq $FAQ::OMatic::Config::itemDir) { ## Tell RCS who we are $ENV{"USER"} = $FAQ::OMatic::Config::RCSuser; $ENV{"LOGNAME"} = $FAQ::OMatic::Config::RCSuser; my $itemPath = "$dir/$filename"; my $rcsFilePath = $FAQ::OMatic::Config::metaDir ."/RCS/$filename,v"; my $cmd = "$FAQ::OMatic::Config::RCSci " ."$FAQ::OMatic::Config::RCSciArgs $itemPath $rcsFilePath " ."&& " # && => only exit with success if both operations succeed ."$FAQ::OMatic::Config::RCSco " ."$FAQ::OMatic::Config::RCScoArgs $rcsFilePath $itemPath"; #FAQ::OMatic::gripe('debug', $cmd); my @result = FAQ::OMatic::mySystem($cmd); if (scalar(@result)) { FAQ::OMatic::gripe('problem', "RCS \"$cmd\" failed: (".join(", ", @result).")"); } } # RCS has a habit of making item files read-only by the user -- fix that # (umask might also be uptight) if (not chmod(0644, "$dir/$filename")) { FAQ::OMatic::gripe('problem', "chmod($dir/$filename) failed: $!"); } # if $lastModified was specified, correct filesystem mtime # (If not specified, the fs mtime is already set to 'now', # which is correct.) if ($lastModified) { utime(time(),$self->{'LastModifiedSecs'},"$dir/$filename"); } # As I was saying, ... # 2. Clear the search hint so we know to regenerate the search index # 3. Rewrite the static cached HTML copy if ($dir eq $FAQ::OMatic::Config::itemDir) { unlink("$FAQ::OMatic::Config::metaDir/freshSearchDBHint"); $self->writeCacheCopy(); if ($self->{'titleChanged'}) { # this item's title has changed: # update the cache for any items that refer to this one (and # thus have this one's title in their cached HTML) my $dependent; foreach $dependent (getDependencies($self->{'filename'})) { my $dependentItem = new FAQ::OMatic::Item($dependent); $dependentItem->writeCacheCopy(); } } # rewrite .dep files (items that contain HeDependsMe-Sets) my $oidos = $self->getSet('oldIDependOn-Set'); my $nidos = $self->getSet('IDependOn-Set'); my @removeList = ($oidos->subtract($nidos))->getList(); my @addList; if ($updateAllDependencies) { @addList = $nidos->getList(); } else { @addList = ($nidos->subtract($oidos))->getList(); } my $itemName; foreach $itemName (@removeList) { adjustDependencies('remove', $itemName, $self->{'filename'}); } foreach $itemName (@addList) { adjustDependencies('insert', $itemName, $self->{'filename'}); } } } sub getDependencies { my $filename = shift; my $depItem = loadDepItem($filename); return $depItem->getSet('HeDependsOnMe-Set')->getList(); } sub loadDepItem { my $itemName = shift; my $depFile = "$itemName.dep"; my $depItem = new FAQ::OMatic::Item($depFile, $FAQ::OMatic::Config::cacheDir); $depItem->setProperty('Title', 'Dependency List'); # in case $depItem was new return $depItem; } sub adjustDependencies { my $what = shift; # 'insert' or 'remove' my $itemName = shift; my $targetName = shift; my $depItem = loadDepItem($itemName); my $hdos = $depItem->getSet('HeDependsOnMe-Set'); if ($what eq 'insert') { $hdos->insert($targetName); } else { $hdos->remove($targetName); } $depItem->setProperty('HeDependsOnMe-Set', $hdos); # in case $hdos was new my $depFile = "$itemName.dep"; $depItem->saveToFile($depFile, $FAQ::OMatic::Config::cacheDir); } # For explicit faqomatic: links, the dependency mechanism is automatic: # the link can't change without the item itself changing, so when the # item gets written out, the cache and dependencies for it are up-to-date. # # For parent links, the dependency mechanism still works -- if a parent # moves or changes its name (or this item moves, which is an operation on # its parent), the old parent had to get written, and this item knew it # was dependent on that parent, so this item gets rewritten, too, and has # its dependencies updated, at which point it detects any new parent. # # But for sibling links, this item has no way of discovering (via # dependencies) when those links change. Whenever a category changes its # directory part list, it has also changed the sibling links for some # of its children. In any case like that, it's the parent's responsibility # to rewrite all of its children, so their dependencies and caches # can be recomputed. sub updateAllChildren { my $self = shift; my $filei; foreach $filei ($self->getChildren()) { #FAQ::OMatic::gripe('debug', "Updating child $filei of ".$self->{'filename'}); my $itemi = new FAQ::OMatic::Item($filei); if (not $itemi->isBroken()) { # $itemi->writeCacheCopy(); # jonh: only writing the cache copy isn't enough -- if $itemi's set of # siblings has changed, then its IDependOns have changed, too. Those # are stored in the item file itself. $itemi->saveToFile('', '', 'noChange'); # The contents of the item itself haven't changed. # The 'noChange' prevents us from updating the LastModifiedSecs # property, so that this item doesn't show up in 'recent' # searches even though it hasn't actually changed. } } } sub getChildren { my $self = shift; my $dirPart = $self->getDirPart(); if (defined($dirPart)) { return $dirPart->getChildren(); } return (); } sub getBags { my $self = shift; # remove duplicates but keep order using a Set my $bagset = new FAQ::OMatic::Set('keepOrdered'); my $i; for ($i=0; $i<$self->numParts(); $i++) { $bagset->insert($self->getPart($i)->getBags()); } return $bagset->getList(); } # Currently meaningful -Sets that can be in an Item: # HeDependsOnMe-Set: list of items that depend on this item's Title property # IDependOn-Set: list of items whose titles this item depends upon. # it's useful so we can revoke our membership in that item's # HeDependsOnMe-Set when we no longer refer to it. sub getSet { my $self = shift; my $setName = shift; return $self->{$setName} || new FAQ::OMatic::Set; } sub writeCacheCopy { my $self = shift; my $filename = $self->{'filename'}; if (defined($FAQ::OMatic::Config::cacheDir) && (-w $FAQ::OMatic::Config::cacheDir)) { my $staticFilename = "$FAQ::OMatic::Config::cacheDir/$filename.html"; my $params = {'file'=>$self->{'filename'}, '_fromCache'=>1}; # this link is coming from inside the cache, so we # can use relative links. That's nice if we later # wrap up the cache and mail it somewhere. my $staticHtml = $self->getWholePage($params, 1); if (not open(CACHEFILE, ">$staticFilename")) { FAQ::OMatic::gripe('problem', "Can't write $staticFilename: $!"); } else { print CACHEFILE $staticHtml; close CACHEFILE; if (not chmod(0644, $staticFilename)) { FAQ::OMatic::gripe('problem', "chmod($staticFilename) failed: $!"); } } } } sub getWholePage { my $self = shift; my $params = shift; my $isCached = shift || ''; return FAQ::OMatic::pageHeader($params, FAQ::OMatic::Appearance::allLinks(), 'suppressType') .$self->displayHTML($params) .basicURL($params) .FAQ::OMatic::pageFooter($params, FAQ::OMatic::Appearance::allLinks(), $isCached); } sub display { my $self = shift; my @keys; my $rt = ""; # return text my $key; foreach $key (sort keys %$self) { if ($key eq 'Parts') { $rt .= "

  • ".gettext("Parts")."\n"; my $part; foreach $part (@{$self->{$key}}) { $rt .= $part->display(); } } else { $rt .= "
  • $key => $self->{$key}
    \n"; } } return $rt; } sub getTitle { my $self = shift; my $undefokay = shift; # return undef instead of '(missing or broken...' my $title = $self->{'Title'}; if ($title) { $title =~ s/&/&/sg; $title =~ s//>/sg; $title =~ s/"/"/sg; } else { undef $title; $title = gettext("(missing or broken file)") if (not $undefokay); } return $title; } sub isBroken { my $self = shift; return (not defined($self->{'Title'})); } sub isEmptyStub { my $self = shift; return $self->{'EmptyStub'} || ''; } sub getParent { my $self = shift; return new FAQ::OMatic::Item($self->{'Parent'}); } # returns two lists, the filenames and titles of this item's parent items. # The list is slightly falsified in that if the topmost ancestor isn't # '1' (such as 'trash' and 'help000'), we insert '1' as an ancestor. # That way 'trash' and 'help000's displayed parent chains include links # to the top of the FAQ, but are not moveable (since they still have no # real parent, which is how moveItem.pm can tell.) sub getParentChain { my $self = shift; my @titles = (); my @filenames = (); my ($nextfile, $nextitem, $thisfile); $nextitem = $self; $nextfile = $self->{'filename'}; do { push @titles, $nextitem->getTitle(); push @filenames, $nextitem->{'filename'}; $thisfile = $nextfile; $nextfile = $nextitem->{'Parent'}; $nextitem = $nextitem->getParent(); } while ((defined $nextitem) and (defined $nextfile) and ($nextfile ne $thisfile)); if (($nextfile||'') ne '1') { # insert '1' as extra 'bogus' parent my $item1 = new FAQ::OMatic::Item('1'); push @titles, $item1->getTitle(); push @filenames, $item1->{'filename'}; # I can guess what this is :v) } # Massage undefined data; this happens when writing the HTML cache for # a mirrored item that has a forward reference to another item that # hasn't been mirrored yet. Once the new item arrives, dependencies # will cause us to rewrite the HTML file correctly. # TODO: a regression test should 'grep undefinedFilename item/*' to # see if any of these stay in the item or cache directories after a # mirror is complete. @titles = map { $_ || 'undefinedTitle' } @titles; @filenames = map { $_ || 'undefinedFilename' } @filenames; return (\@titles, \@filenames); } # same structure as above, but only used to check for a particular parent sub hasParent { my $self = shift; my $parentFile = shift; my ($nextfile, $nextitem, $thisfile); $nextitem = $self; $nextfile = $self->{'filename'}; do { return 1 if (defined($nextfile) && ($nextfile eq $parentFile)); $thisfile = $nextfile; $nextfile = $nextitem->{'Parent'}; $nextitem = $nextitem->getParent(); } while ((defined $nextitem) and (defined $nextfile) and ($nextfile ne $thisfile)); return 0; } # okay, I guess this displays the neighbors, too... sub displaySiblings { my $self = shift; my $params = shift; my $rt = ''; # return text my $useTable = FAQ::OMatic::getParam($params, 'render') eq 'tables'; my ($prevs,$nexts) = $self->getSiblings(); if ($prevs) { my $prevItem = new FAQ::OMatic::Item($prevs); my $prevTitle = $prevItem->getTitle(); if ($useTable) { $rt.="\n"; } else { $rt.="
    \n"; } $rt.=gettext("Previous").": "; $rt.="\n" if $useTable; $rt.=FAQ::OMatic::makeAref('-command'=>'faq', '-params'=>$params, '-changedParams'=>{"file"=>$prevs}) .FAQ::OMatic::ImageRef::getImageRefCA('-small', 'border=0', $prevItem->isCategory(), $params) ."$prevTitle\n"; $rt.="\n" if $useTable; } if ($nexts) { my $nextItem = new FAQ::OMatic::Item($nexts); my $nextTitle = $nextItem->getTitle(); if ($useTable) { $rt.="\n"; } else { $rt.="
    \n"; } $rt.=gettext("Next").": "; $rt.="\n" if $useTable; $rt.=FAQ::OMatic::makeAref('-command'=>'faq', '-params'=>$params, '-changedParams'=>{"file"=>$nexts}) .FAQ::OMatic::ImageRef::getImageRefCA('-small', 'border=0', $nextItem->isCategory(), $params) ."$nextTitle\n"; $rt.="\n" if $useTable; } return $rt; } # sub hasParent { # my $self = shift; # my $parentQuery = shift; # my ($titles,$filenames) = $self->getParentChain(); # # my $i; # foreach $i (@{$filenames}) { # my $item = new FAQ::OMatic::Item($i); # return 'true' if ($item->{'filename'} eq $parentQuery); # } # # return ''; # } sub displayCoreHTML { my $self = shift; my $params = shift; # ref to hash of display params my $whatAmI = $self->whatAmI(); my $render = FAQ::OMatic::getParam($params, 'render'); # we'll pass this to makeAref to get file param right in links my @fixfn =('file'=>$self->{'filename'}); my $title = $self->getTitle(); # accumulate the title, the parts, and the editing sections into # a list @rowboxes, so that when we construct the , we know in # advance how many rows it has. my @rowboxes = (); # create the title { my $titlebox = ''; if ($render ne 'text') { $titlebox .= "{'filename'}."\"> \n"; # link for internal refs } # prefix item title with a path back to the root, so that user # can find his way back up. (This replaces the old "Up to:" line.) my ($titles,$filenames) = $self->getParentChain(); my ($thisTitle) = shift @{$titles}; my ($thisFilename) = shift @{$filenames}; # my (@parentTitles) = reverse @{$titles}; my (@parentFilenames) = reverse @{$filenames}; $titlebox.= join(" : ", map { my ($target,$label) = FAQ::OMatic::faqomaticReference($params, "$_"); "$label"; } @parentFilenames ); if (@parentFilenames) { $titlebox.=" :\n"; if ($render ne 'text' and not ($FAQ::OMatic::Config::nolanTitles || '')) { $titlebox.="
    "; } } # THANKS: to Jim Adler who suggested this graphical # improvement: larger type to make the titles stand out. if ($render eq 'text') { $titlebox.=$thisTitle; } else { if ($FAQ::OMatic::Config::nolanTitles || '') { # John Nolan likes it better this way: $titlebox.= FAQ::OMatic::ImageRef::getImageRefCA('-small', 'border=0', $self->isCategory(), $params); $titlebox.="$thisTitle"; } else { $titlebox.="$thisTitle"; } $titlebox.=""; # close 'wide', 'text'=>$titlebox, 'id'=>'title' }; } if (FAQ::OMatic::getParam($params, 'showModerator') eq 'show') { my $mod = FAQ::OMatic::Auth::getInheritedProperty($self, 'Moderator'); my $brt = ''; # highlight the "Moderator: ". # THANKS submitted by Akiko Takano if (FAQ::OMatic::getParam($params, 'render') ne 'text') { $brt .= ""; $brt .= gettext("Moderator").": ".FAQ::OMatic::mailtoReference($params, $mod); $brt .= " " .gettext("(inherited from parent)")."" if (not $self->{'Moderator'}); $brt .= "\n"; } else { $brt .= "Moderator: ".FAQ::OMatic::mailtoReference($params, $mod); } push @rowboxes, { 'type'=>'wide', 'text'=>$brt, 'id'=>'showModerator' }; } ## Edit commands: my $aoc = $self->isCategory ? 'cat' : 'ans'; if (FAQ::OMatic::getParam($params, 'editCmds') ne 'hide') { my $editrow = []; my ($text_edit_title, $text_edit_perm, $text_move, $text_trash); if ($self->isCategory()) { $text_edit_title = gettext("Category Title and Options"); $text_edit_perm = gettext("Edit Category Permissions"); $text_move = gettext("Move Category"); $text_trash = gettext("Trash Category"); } elsif ($self->isAnswer()) { $text_edit_title = gettext("Answer Title and Options"); $text_edit_perm = gettext("Edit Answer Permissions"); $text_move = gettext("Move Answer"); $text_trash = gettext("Trash Answer"); } else { # fixup for unexpected cases my $s = gettext($whatAmI); $text_edit_title = gettexta("%0 Title and Options", $s); $text_edit_perm = gettexta("Edit %0 Permissions", $s); $text_edit_perm = gettexta("Edit %0 Permissions", $s); $text_move = gettexta("Move %0", $s); $text_trash = gettexta("Trash %0", $s); } push @$editrow, {'text'=>FAQ::OMatic::button( FAQ::OMatic::makeAref('-command'=>'editItem', '-params'=>$params, '-changedParams'=>{@fixfn}), $text_edit_title, "$aoc-title", $params), 'size'=>'edit'}; # TODO: just edit title. Options is only part order; need # a new interface for that. push @$editrow, {'text'=>FAQ::OMatic::button( FAQ::OMatic::makeAref('-command'=>'editModOptions', '-params'=>$params, '-changedParams'=>{@fixfn}), $text_edit_perm, "$aoc-opts", $params), 'size'=>'edit'}; push @rowboxes, { 'type'=>'multirow', 'cells'=>$editrow, 'id'=>'title, perms', 'isEdit'=>'true' }; $editrow = []; # These don't make sense if we're in a special-case item file, such # as 'trash'. We'll assume here that items whose file names end in # a digit are 'incrementable' and can thus have children. # TODO: default system should ship with help000 having moderator-only # TODO: permissions to discourage the public from modifying the # TODO: help system. This will matter more when the help system # TODO: is implemented. :v) # THANKS: to Doug Becker for # accidentally making a 'trasi' item (perl incrsemented 'trash' :v) # and discovering this problem. if ($self->ordinaryItem()) { # Duplicate it my $dupTitle = $whatAmI eq "Answer" ? gettext("Duplicate Answer") : gettext("Duplicate Category as Answer"); push @$editrow, {'text'=>FAQ::OMatic::button( FAQ::OMatic::makeAref('-command'=>'addItem', '-params'=>$params, '-changedParams'=>{'_insert'=>'answer', '_duplicate'=>$self->{'filename'}, 'file'=>$self->{'Parent'}} ), $dupTitle, "$aoc-dup-ans", $params), 'size'=>'edit'}; # Move it (if not at the top) if ($self->{'Parent'} ne $self->{'filename'}) { push @$editrow, {'text'=>FAQ::OMatic::button( FAQ::OMatic::makeAref('-command'=>'moveItem', '-params'=>$params, '-changedParams'=>{@fixfn}), $text_move), 'size'=>'edit'}; # Trash it (same rules as for moving) push @$editrow, {'text'=>FAQ::OMatic::button( FAQ::OMatic::makeAref('-command'=>'submitMove', '-params'=>$params, '-changedParams'=>{@fixfn, '_newParent'=>'trash'}), $text_trash), 'size'=>'edit'}; } # Convert category to answer / answer to category # THANKS: to Steve Herber for suggesting pulling this out of # THANKS: editPart and putting it here as a distinct command # THANKS: for clarity. if ($self->isCategory() and scalar($self->getChildren())==0) { push @$editrow, {'text'=>FAQ::OMatic::button( FAQ::OMatic::makeAref('-command'=>'submitCatToAns', '-params'=>$params, '-changedParams'=>{ 'checkSequenceNumber'=>$self->{'SequenceNumber'}, @fixfn}), gettext("Convert to Answer"), 'cat-to-ans', $params), 'size'=>'edit'}; } elsif (not $self->isCategory()) { push @$editrow, {'text'=>FAQ::OMatic::button( FAQ::OMatic::makeAref('-command'=>'submitAnsToCat', '-params'=>$params, '-changedParams'=>{ 'checkSequenceNumber'=>$self->{'SequenceNumber'}, @fixfn}), gettext("Convert to Category"), "$aoc-to-cat", $params), 'size'=>'edit'}; } # Create new children if ($self->isCategory()) { # suggestion of adding cat title to reduce confusion is from # THANKS: pauljohn@ukans.edu if (length($title) > 15) { $title = substrFOM($title, 12)."..."; } push @$editrow, {'text'=>FAQ::OMatic::button( FAQ::OMatic::makeAref('-command'=>'addItem', '-params'=>$params, '-changedParams'=>{'_insert'=>'answer', @fixfn}), gettexta("New Answer in \"%0\"", $title), 'cat-new-ans', $params), 'size'=>'edit'}; push @$editrow, {'text'=>FAQ::OMatic::button( FAQ::OMatic::makeAref('-command'=>'addItem', '-params'=>$params, '-changedParams'=>{'_insert'=>'category', @fixfn}), gettexta("New Subcategory of \"%0\"", $title), 'cat-new-cat', $params), 'size'=>'edit'}; } } push @rowboxes, { 'type'=>'multirow', 'cells'=>$editrow, 'id'=>'dup, trash, etc', 'isEdit'=>'true' }; $editrow = []; # Allow user to insert a part before any other if ($self->ordinaryItem()) { # as opposed to trash, help, ... push @$editrow, {'text'=>''}; # empty cell -- # this is a *hack* so that this 'multirow' lines up the # same as the afterbody's of the 'three'-type parts generated # by Part.pm. But it may confuse some future itemRender # routine. push @$editrow, {'text'=> FAQ::OMatic::button( FAQ::OMatic::makeAref('-command'=>'editPart', '-params'=>$params, '-changedParams'=>{'partnum'=>'-1', '_insertpart'=>'1', 'checkSequenceNumber'=>$self->{'SequenceNumber'}, @fixfn} ), gettext("Insert Text Here"), "$aoc-ins-part", $params), 'size'=>'edit'}; push @$editrow, {'text'=> FAQ::OMatic::button( FAQ::OMatic::makeAref('-command'=>'editPart', '-params'=>$params, '-changedParams'=>{'partnum'=>'-1', '_insertpart'=>'1', '_upload'=>'1', 'checkSequenceNumber'=>$self->{'SequenceNumber'}, @fixfn} ), gettext("Insert Uploaded Text Here"), "$aoc-ins-part", $params), 'size'=>'edit'}; push @rowboxes, { 'type'=>'multirow', 'cells'=>$editrow, 'id'=>'insert before other parts', 'isEdit'=>'true' }; } } my $partnum = 0; my $authorSet = new FAQ::OMatic::Set('keepordered'); # for AttributionsTogether my $part; foreach $part (@{$self->{'Parts'}}) { if ($render eq 'text') { push @rowboxes, $part->displayText($self, $partnum, $params); } else { push @rowboxes, $part->displayHTML($self, $partnum, $params); } $authorSet->insert($part->{'Author-Set'}->getList()); ++$partnum; } if ((not $FAQ::OMatic::Config::hideEasyEdits) and ($render ne 'text')) { if ($self->isCategory()) { # Categories: offer a way to insert a new answer # TODO: does this link belong just below the directory # part, rather than at the bottom? my $title = $self->getTitle(); push @rowboxes, { 'type'=>'wide', 'text'=>FAQ::OMatic::button( FAQ::OMatic::makeAref('-command'=>'addItem', '-params'=>$params, '-changedParams'=>{'_insert'=>'answer', @fixfn}), gettexta("New Answer in \"%0\"", $title), 'cat-new-ans', $params), 'size'=>'edit', 'id'=>'easy edit insert answer'}; } else { # answers: offer a way to append an item my $partnum = scalar(@{$self->{'Parts'}})-1; push @rowboxes, { 'type'=>'wide', 'text'=>FAQ::OMatic::button( FAQ::OMatic::makeAref('-command'=>'editPart', '-params'=>$params, '-changedParams'=>{'partnum'=>'9999afterLast', '_insertpart'=>'1', 'checkSequenceNumber'=>$self->{'SequenceNumber'}, @fixfn} ), gettext("Append to This Answer"), "$aoc-ins-part", $params), 'size'=>'edit', 'id'=>'easy edit append to answer'}; } } # AttributionsTogether displays all attributions for any part in # this item together at the bottom of the item to reduce clutter. my $attributionsTogether = $self->{'AttributionsTogether'} || ''; my $showAttributions = FAQ::OMatic::getParam($params, 'showAttributions'); if ($attributionsTogether and ($showAttributions eq 'default')) { my @authors = $authorSet->getList(); my $brt = FAQ::OMatic::authorList($params, \@authors); push @rowboxes, { 'type'=>'wide', 'text'=>$brt, 'id'=>'attributionsTogether' }; } # THANKS: Config::showLastModifiedAlways feature was requested by # THANKS: parker@austx.tandem.com # (but it's now handled as a standard default parameter.) my $showLastModified = FAQ::OMatic::getParam($params, 'showLastModified') eq 'show'; my $lastModified = $self->{'LastModifiedSecs'}; if ($lastModified and $showLastModified) { my $brt = ''; $brt .= "".compactDate($self->{'LastModifiedSecs'})."\n"; push @rowboxes, { 'type'=>'wide', 'text'=>$brt, 'id'=>'lastModified' }; } my @items = { 'item'=>$self, 'rows'=>\@rowboxes }; ## recurse on children if ($params->{'recurse'} or $params->{'_recurse'}) { my $filei; my $itemi; foreach $filei ($self->getChildren()) { $itemi = new FAQ::OMatic::Item($filei); #$rt .= $itemi->displayCoreHTML($params); push @items, @{$itemi->displayCoreHTML($params)}; } } #return $rt; return \@items; } sub ordinaryItem { my $self = shift; return ($self->{'filename'} =~ m/\d$/); } sub displayHTML { my $self = shift; my $params = shift; # ref to hash of display params my $rt = ""; # signal to aref generator that some internal links are # possible. (only signal this when recursing to save effort otherwise) if ($params->{'recurse'} or $params->{'_recurse'}) { $params->{'_recurseRoot'} = $self->{'filename'}; # A limit jonh puts on his machines: # FAQ::OMatic::checkLoadAverage(); } my $itemboxes = $self->displayCoreHTML($params); $rt = FAQ::OMatic::Appearance::itemRender($params, $itemboxes); # turn #internal links off after the items are displayed. # Otherwise they mess up the bottom link bar. # (is there a general way to solve that problem?) delete $params->{'_recurseRoot'}; # Sibling links if ((FAQ::OMatic::getParam($params, 'render') ne 'text') and not ($FAQ::OMatic::Config::hideSiblings || '')) { my $useTable = FAQ::OMatic::getParam($params, 'render') eq 'tables'; $rt.="\n"; $rt.="
    " if $useTable; $rt.="\n"; $rt.= $self->displaySiblings($params); $rt.="
    \n" if $useTable; $rt.="

    \n" if not $useTable; } $rt.=FAQ::OMatic::HelpMod::helpFor($params, 'How can I contribute to this FAQ?', "
    "); return $rt; } sub basicURL { my $params = shift; return '' if ($params->{'file'} =~ m/^help/); my %killParams = %{$params}; delete $killParams{'file'}; delete $killParams{'recurse'} if ($params->{'recurse'}); my $i; foreach $i (keys %killParams) { $killParams{$i} = ''; } # TODO: We have always had the "This document is:" # TODO: refer to the CGI. I liked that because it let me fiddle # TODO: with the cache layout (after all, it changed in 2.604.) # TODO: But others have asked to totally hide the presence of the CGI, # TODO: in which case we should *only* display cache URLs here. # TODO: Or leave this line out altogether. my $url = FAQ::OMatic::makeAref('-command'=>'faq', '-params' => $params, '-changedParams'=>\%killParams, '-thisDocIs'=>1, '-refType'=>'url'); if (FAQ::OMatic::getParam($params, 'render') ne 'text') { return gettext("This document is:") . "
    $url
    \n"; } else { return gettext("This document is at:") . " $url\n"; } } sub permissionBox { my $self = shift; my $perm = shift; my @permNum = (7); push @permNum, FAQ::OMatic::Groups::getGroupCodeList(); push @permNum, (5, 3); my @permDesc = map { nameForPerm($_); } @permNum; push @permNum, (''); push @permDesc, gettext('Inherit'); return popup($perm, \@permNum, \@permDesc, $self->{$perm}||''); } sub popup { my $name = shift; my $values = shift; # ary ref my $descary = shift; # ary ref; 1:1 with $values my $curvalue = shift; # one of @{$values} $curvalue = '' if (not defined $curvalue); my $rt = ''; $rt.="\n"; return $rt; } sub nameForPerm { # this is a lot like Auth::authError, but with more concise descriptions my $perm = shift; if ($perm =~ m/^6 (.*)$/) { return gettexta("Group %0", "$1"); } my %map = ( '3' => gettext("Users giving their names"), '5' => gettext("Authenticated users"), '7' => gettext("Moderator"), ); return $map{$perm}; } sub displayItemEditor { my $self = shift; my $params = shift; my $cgi = shift; my $rt = ""; # return text my $insertHint = $params->{'_insert'} || ''; if ($insertHint eq 'category') { $rt .= gettext("New Category")."\n"; } elsif ($insertHint eq "answer") { $rt .= gettext("New Answer")."\n"; } else { if ($self->isCategory()) { $rt .= gettexta("Editing Category %0", $self->getTitle()); } elsif ($self->isAnswer()) { $rt = gettexta("Editing Answer %0", $self->getTitle()); } else { # fixup for unexpected cases. $rt .= gettexta("Editing %0 %1", gettext($self->whatAmI()), $self->getTitle()); } $rt .= "\n"; } $rt .= FAQ::OMatic::makeAref('-command'=>'submitItem', '-params'=>$params, '-changedParams'=>{'_insert'=>$params->{'_insert'}}, '-refType'=>'POST'); # SequenceNumber protects the database from race conditions -- # if person A gets this form, # then person B gets this form, # then person A returns the form (incrementing the sequence number), # then person B returns the form, the sequence number won't match, # so B will be turned back, so he can't mistakenly overwrite A's changes. # (it doesn't help for race conditions involving two simultaneously- # running CGIs, only with the simultaneity of two people typing into # browser forms at once. # TODO: Lock files are supposed to help with two CGIs, but their # TODO: implementation isn't right. They only protect during the # TODO: actual write (which keeps the item files consistent). But # TODO: data can get lost in a race, since two CGIs can still # TODO: run in the classic A:read-B:read-A:modify,write-B:modify,write # TODO: race condition. $rt .= "{'SequenceNumber'}."\">\n"; # Title $rt .= "
    ".gettext("Title:")."
    getTitle()."\" size=60>\n"; # Reorder parts if ($self->numParts() > 1) { $rt .= gettext("

    New Order for Text Parts:"); $rt .= "
    numParts(); $i++) { $rt .= "$i "; } $rt .= "\" size=60>\n"; } # AttributionsTogether $rt .= "

    {'AttributionsTogether'}; $rt .= "> ".gettext("Show attributions from all parts together at bottom")."\n"; # TODO: delete this block. superseded by submitAnsToCat # if ((not defined $self->{'directoryHint'}) # and (not $params->{'_insert'})) { # # we hide this on initial inserts, because it serves to confuse, and # # they can always come back here. # $rt .= "

    " # ." Add a directory part to turn this answer item into " # ."a category item.\n"; # } # Submit $rt .="
    \n"; $rt .= "\n"; $rt .= "\n"; # this lets the submit script check that the whole POST was # received. $rt .= "\n"; # $rt .= FAQ::OMatic::button( # FAQ::OMatic::makeAref('-command'=>'faq', # '-params'=>$params, # '-changedParams'=>{'checkSequenceNumber'=>''}), # "Cancel and return to the FAQ"); $rt .= FAQ::OMatic::HelpMod::helpFor($params, 'editItem', "
    \n"); return $rt; } sub permissionsInfo { my $permissionsInfo = { '01' => { 'name'=>'PermAddPart', 'desc'=> gettext("Who can add a new text part to this item:") }, '02' => { 'name'=>'PermAddItem', 'desc'=> gettext("Who can add a new answer or category to this category:") }, '03' => { 'name'=>'PermEditPart', 'desc'=> gettext("Who can edit or remove existing text parts from this item:") }, '04' => { 'name'=>'PermEditDirectory', 'desc'=> gettext("Who can move answers or subcategories from this category; or turn this category into an answer or vice versa:") }, '05' => { 'name'=>'PermEditTitle', 'desc'=> gettext("Who can edit the title and options of this answer or category:") }, '06' => { 'name'=>'PermUseHTML', 'desc'=> gettext("Who can use untranslated HTML when editing the text of this answer or category:") }, '07' => { 'name'=>'PermModOptions', 'desc'=> gettext("Who can change these moderator options and permissions:") }, '09' => { 'name'=>'PermNewBag', 'global'=>1, 'desc'=> gettext("Who can create new bags:") }, '10' => { 'name'=>'PermReplaceBag', 'global'=>1, 'desc'=> gettext("Who can replace existing bags:") }, '11' => { 'name'=>'PermInstall', 'global'=>1, 'desc'=> gettext("Who can access the installation/configuration page (use caution!):") }, '12' => { 'name'=>'PermEditGroups', 'global'=>1, 'desc'=> gettext("Who can use the group membership pages:") }, }; # TODO: The global permissions should probably appear # TODO: on a different page. As-is, the administrator must # TODO: give away control over these permissions to give # TODO: away moderatorship of the root item. return $permissionsInfo; } sub displayModOptionsEditor { my $self = shift; my $params = shift; my $cgi = shift; my $rt = ""; # return text if ($self->isCategory()) { $rt .= gettext("Moderator options for category"); } elsif ($self->isAnswer()) { $rt .= gettext("Moderator options for answer"); } else { # fixup for unexpected cases. $rt .= gettext("Moderator options for")." " .gettext($self->whatAmI()); } $rt .= " ".$self->getTitle().":\n" ."

    \n"; $rt .= FAQ::OMatic::makeAref('-command'=>'submitModOptions', '-params'=>$params, '-changedParams'=>{'_insert'=>$params->{'_insert'}}, '-refType'=>'POST'); $rt .= "{'SequenceNumber'}."\">\n"; # Moderator # THANKS to John Nolan for suggesting a better permissions layout. $rt .= "\n"; $rt .= "\n" ." \n" ." \n" ." \n" ."\n"; # Moderator # $rt .= "\n"; my $inherited = $self->getInheritance($params, 'Moderator', '
    ', sub {shift;}); $rt .= "\n"; $rt .= "\n"; # ModeratorMail $rt .= "" ."\n"; $rt .= "\n"; $rt .= "\n"; # Notifier # THANKS to John Nolan for suggesting a better permissions layout. # $rt .= "
    ".gettext("Name & Description")."".gettext("Setting")."".gettext("Setting if Inherited")."
    ".gettext("Moderator")."" # ."
    ".gettext("Moderator")."\n" ."
    ".gettext("(will inherit if empty)")."\n"; $rt .= "
    " ."{'Moderator'}||'')."\" size=60>
    $inherited" ."
    MailModerator" ."
    ".gettext("Send mail to the moderator when someone other than the moderator edits this item:")."
    \n"; $rt .= popup('MailModerator', [1, 0, ''], [gettext('Yes'), gettext('No'), gettext('Inherit')], $self->{'MailModerator'}); $inherited = $self->getInheritance($params, 'MailModerator', '
    ', sub {(gettext("No"), gettext("Yes"))[shift()] || gettext("undefined")}); $rt .= "
    $inherited
    \n"; # $rt .= "\n" # ." \n" # ." \n" # ." \n" # ."\n"; # Notifer # $rt .= "\n"; $inherited = $self->getInheritance($params, 'Notifier', '
    ', sub {shift;}); $rt .= "\n"; $rt .= "\n"; # NotifierMail $rt .= "" ."\n"; $rt .= "\n"; $rt .= "\n"; # Permission info $rt .= "\n"; my $permissionsInfo = permissionsInfo(); foreach my $key (sort keys %{$permissionsInfo}) { my $ph = $permissionsInfo->{$key}; # permission descriptor hash next if ($ph->{'global'} and $self->{'filename'} ne '1'); # only display global permissions for item 1, where they are set my $pname = $ph->{'name'}; my $inherited = $self->getInheritance($params, $pname, '
    ', \&nameForPerm); $rt.="\n"; $rt.=" \n"; # Perm description column $rt.=" \n"; # popup choice column $rt.=" \n"; # inherited value column $rt.="\n"; } # RelaxChildPerms $rt .= "" ."\n"; $rt .= "\n"; $rt .= "\n"; $rt .= "
    ".gettext("Name & Description")."".gettext("Setting")."".gettext("Setting if Inherited")."
    ".gettext("Moderator")."" # ."
    ".gettext("Notifier")."\n" ."
    ".gettext("Send mail to the Notifier when item is created or modified")."\n" ."
    ".gettext("(will inherit if empty)")."\n"; $rt .= "
    " ."{'Notifier'}||'')."\" size=60>
    $inherited" ."
    MailNotifier" ."
    ".gettext("Send mail to the Notifier when someone other than the moderator edits this item:")."
    \n"; $rt .= popup('MailNotifier', [1, 0, ''], [gettext('Yes'), gettext('No'), gettext('Inherit')], $self->{'MailNotifier'}); $inherited = $self->getInheritance($params, 'MailNotifier', '
    ', sub {(gettext("No"), gettext("Yes"))[shift()] || gettext("undefined")}); $rt .= "
    $inherited
    ".gettext("Permissions")."
    $pname" ."
    ".$ph->{'desc'}."
    ".$self->permissionBox($ph->{'name'})."$inherited
    "."RelaxChildPerms"."" ."
    ".gettext("Relax: New answers and subcategories will be moderated ") .gettext("by the creator of the item, allowing that person full ") .gettext("freedom to edit that new item.") ."
    ".gettext("Don't Relax: new items will be moderated by ") .gettext("the moderator of this item.") ."
    \n"; $rt .= popup('RelaxChildPerms', ['relax', 'norelax', ''], [gettext("Relax"), gettext("Don\'t Relax"), gettext("Inherit")], $self->{'RelaxChildPerms'}); $inherited = $self->getInheritance($params, 'RelaxChildPerms', '
    ', sub {{'relax'=>gettext("Relax"), 'norelax'=>gettext("Don\'t Relax")}->{shift()} || gettext("undefined")}); $rt .= "
    $inherited
    \n"; $rt .="

    \n"; $rt .= "\n"; $rt .= "\n"; # this lets the submit script check that the whole POST was # received. $rt .= "\n"; $rt .= FAQ::OMatic::HelpMod::helpFor($params, 'editModOptions', "
    \n"); return $rt; } sub getInheritance { my $self = shift; my $params = shift; my $pname = shift; my $separator = shift; my $namecode = shift; my $val; my $whered; if ($self->getParent() eq $self) { $val = FAQ::OMatic::Auth::getDefaultProperty($pname); $whered = gettext("(system default)"); } else { my ($pset,$where) = FAQ::OMatic::Auth::getInheritedProperty( $self->getParent(), $pname); if (defined $where) { $val = $pset; $whered = "(".gettext("defined in")." \"" .FAQ::OMatic::makeAref('-command'=>'editModOptions', '-params'=>$params, '-changedParams'=>{'file'=>$where->{'filename'}}) .$where->getTitle() ."\")"; } else { $val = $pset; $whered = gettext("(system default)"); } } return ("".&{$namecode}($val)."".$separator.$whered); } sub setProperty { my $self = shift; my $property = shift; my $value = shift; if (defined($value) and ($value ne '')) { $self->{$property} = $value; if ($property eq 'Title') { # keep track if title changes after file is loaded; # used to update items whose cached representations # depend on this item's title (because those items have # embedded faqomatic: references to this one). $self->{'titleChanged'} = 1; } } else { delete $self->{$property}; } } sub getProperty { my $self = shift; my $property = shift; return $self->{$property}; } sub getDirPart { my $self = shift; if (defined $self->{'directoryHint'}) { return $self->{'Parts'}->[$self->{'directoryHint'}]; } else { return undef; } } sub makeDirectory { # This sub guarantees that this item contains a directory part, # creating an empty one if there wasn't already one. # It returns the dirpart. my $self = shift; return $self->getDirPart() if $self->getDirPart(); my $dirPart = new FAQ::OMatic::Part(); # should set author for $newPart to user doing this action $dirPart->{'Type'} = 'directory'; $dirPart->{'Text'} = ''; $dirPart->{'HideAttributions'} = 1; # directories prefer to have # attributions hidden. $self->{'directoryHint'} = scalar @{$self->{'Parts'}}; push @{$self->{'Parts'}}, $dirPart; return $dirPart; } sub addSubItem { my $self = shift; my $subfilename = shift; my $deferUpdate = shift || ''; my $dirPart; my $subitem = new FAQ::OMatic::Item($subfilename); if ($subitem->isBroken()) { FAQ::OMatic::gripe('problem', gettexta("File %0 seems broken.", $subfilename)); } $self->makeDirectory()->mergeDirectory($subfilename); # all the children in the list may now have different siblings, # which means we need to recompute their dependencies and # regenerate their cached html. if (!$deferUpdate) { $self->updateAllChildren(); } $self->incrementSequence(); } sub removeSubItem { my $self = shift; my $subfilename = shift; # if omitted, this just removes an empty # directory part. my $deferUpdate = shift || ''; my $dirPart = $self->getDirPart(); if (not defined $dirPart) { FAQ::OMatic::gripe('panic', "FAQ::OMatic::Item::removeSubItem(): I (" .$self->{'filename'} .") don't have a directoryHint! How did that happen?"); } if ($subfilename) { $dirPart->unmergeDirectory($subfilename); # all the children in the list may now have different siblings, # which means we need to recompute their dependencies and # regenerate their cached html. if (!$deferUpdate) { $self->updateAllChildren(); } } # I'm not sure why I thought automatically converting categories to answers # when their directories become empty was a good idea. When the trash is # emptied, it becomes an answer. If you empty a category, and expect # to refill it with moves, you won't see your category in the (default) # move target list anymore. That would be confusing. Hmmm. # if ($dirPart->{'Text'} =~ m/^\s*$/s) { # splice @{$self->{'Parts'}}, $self->{'directoryHint'}, 1; # delete $self->{'directoryHint'}; # } $self->incrementSequence(); } sub extractWordsFromString { my $string = shift; my $filename = shift; my $words = shift; my @wordlist = FAQ::OMatic::Words::getWords( $string ); # Associate words with this file in index my $i; foreach $i (@wordlist) { # do it for every prefix, too my $prefix; foreach $prefix ( FAQ::OMatic::Words::getPrefixes( $i ) ) { $words->{$prefix}{$filename} = 1; } } } sub extractWords { my $self = shift; my $words = shift; extractWordsFromString($self->getTitle(), $self->{'filename'}, $words); my $part; foreach $part (@{$self->{'Parts'}}) { extractWordsFromString($part->{'Text'}, $self->{'filename'}, $words); } # recurse (turned off -- see buildSearchDB) # my $dirPart = $self->getDirPart(); # if (defined $dirPart) { # my $filei; # my $itemi; # foreach $filei ($dirPart->getChildren()) { # $itemi = new FAQ::OMatic::Item($filei); # $itemi->extractWords($words); # } # } } sub rightEnd { my $string = shift; my $amount = shift; my $encode_lang = FAQ::OMatic::I18N::language(); #EUC-JP case return rightEndMB($string,$amount) if($encode_lang eq "ja_JP.EUC"); #normal case return rightEndSB($string,$amount); } sub rightEndSB { my $string = shift; my $amount = shift; if ($amount >= length($string)) { return $string; } else { return substr($string,length($string)-$amount,$amount); } } sub rightEndMB { my $string = shift; my $amount = shift; my ($n, $c, $r, $mb, $width, $result); $width = length($string) - $amount; if ($amount >= length($string)) { return $string; } else { while (length($string)) { last unless ($mb = $string =~ s/^([\200-\377].)+//) || $string =~s/[\0-\177]+//; $n = $width; $n -= $width % 2 if $mb; ($c,$r) = unpack("a$n a*", $&); $width -= length($c); $result .= $c; last if length($r) } return ($r.$string); } } sub displaySearchContext { my $self = shift; my $params = shift; my $rows = []; my $text = ""; my @contexts = (); my @pieces=(); my @parts=(); my @hw; my $wordmatch; my $i; my $count; my @highlightWordsFlag = (); if (not ($FAQ::OMatic::Config::disableSearchHighlight || '')) { @highlightWordsFlag = ( '_highlightWords' => join(' ', @{$params->{'_searchArray'}}) ); } # start with a title that's a link push @$rows, { 'type'=>'wide', 'text'=> FAQ::OMatic::makeAref('-command'=>'faq', '-params'=>$params, '-changedParams'=> { 'file' => $self->{'filename'}, @highlightWordsFlag #'_highlightWords' => join(' ', @{$params->{'_searchArray'}}) }) .FAQ::OMatic::highlightWords($self->getTitle(),$params)."", 'id'=>'displaySearchContext-title' }; # add some context # get all of my parts' text $text = join(" ", map { $_->{'Text'} } @{$self->{'Parts'}}); # contstruct the wordmatch regular expression that matches any # of the search words, with apostrophes interspersed. @hw = @{ $params->{'_searchArray'} }; @hw = map { FAQ::OMatic::lotsOfApostrophes($_) } @hw; $wordmatch = '(\W'.join(')|(',@hw).')'; $text = ' '.$text; # ensure we match at beginning of text (because of \s) @pieces = split(/$wordmatch/is, $text); # break into pieces # THANKS to John Goerzen # and THANKS to Colin Watson # for reporting the fix on the previous line for a Perl 5.8 warning # that turns into an error. # save only the defined parts, so it alternates between match and nonmatch foreach $i (@pieces) { if (defined $i) { push @parts, $i; } } # now all even @parts are non-match, all odd are matches # whenever an even part is shorter than 20 characters, merge # it and its neighbors. for ($i=2; ($i= 0) ? $parts[$i-1] : ''; my $rs = ($i+1 < scalar(@parts)) ? $parts[$i+1] : ''; my $ltrunc = (($i>1) or length($ls)>40); my $rtrunc = (($i40); push @contexts, FAQ::OMatic::entify( ($ltrunc ? '...' : '') .rightEnd($ls,40) .' ' .$parts[$i] .substrFOM($rs,40) .($rtrunc ? '...' : '')); } my $context = join("\n
    ", @contexts); # highlight the matching words push @$rows, { 'type'=>'wide', 'text'=>FAQ::OMatic::highlightWords($context,$params), 'id'=>'displaySearchContext-text' }; return { 'item'=>$self, 'rows'=>$rows }; } sub notifyModerator { my $self = shift; my $cgi = shift; my $didWhat = shift; my $changedPart = shift; my $mail = FAQ::OMatic::Auth::getInheritedProperty($self, 'MailModerator') || ''; return if ($mail ne '1'); # didn't want mail anyway my $moderator = FAQ::OMatic::Auth::getInheritedProperty($self, 'Moderator'); return if (not $moderator =~ m/\@/); # some non-address my $msg = ''; my ($id,$aq) = FAQ::OMatic::Auth::getID(); if ($id eq $moderator and $didWhat =~ m/moderator options/) { return; # moderator doesn't need to get mail about his own edits # THANKS to Bernhard Scholz for the suggestion } $msg .= "[This is a message about the Faq-O-Matic items you moderate.]\n\n"; $msg .= "Who: $id\n"; $msg .= "Item: ".$self->getTitle()."\n"; $msg .= "File: ".$self->{'filename'}."\n"; my $url = FAQ::OMatic::makeAref('-command'=>'faq', # sleazy hack that will bite me later -- go ahead and use # global params, because that's always "okay" here. #'-params'=>$params, '-changedParams'=>{'file'=>$self->{'filename'}}, '-reftype'=>'url', '-blastAll'=>1); $msg .= "URL: ".$url."\n"; $msg .= "What: ".$didWhat."\n"; if (defined $changedPart) { $msg .= "New text:\n"; $msg .= FAQ::OMatic::quoteText($self->getPart($changedPart)->{'Text'}, '> '); } $msg .= "\nAs always, thanks for your help maintaining the FAQ.\n"; # make sure $moderator isn't a trick string $moderator = FAQ::OMatic::validEmail($moderator); if (defined($moderator)) { # send the mail to the moderator # pageHeader is added to tell which FAQ has sent the mail. # THANKS suggested by Akiko Takano FAQ::OMatic::sendEmail($moderator, "[" . FAQ::OMatic::fomTitle() . "] Faq-O-Matic Moderator Mail", $msg); } else { FAQ::OMatic::gripe('problem', "Moderator address is suspect ($moderator)"); } } sub notifyNotifier { my $self = shift; my $cgi = shift; my $didWhat = shift; my $changedPart = shift; my $mail = FAQ::OMatic::Auth::getInheritedProperty($self, 'MailNotifier') || ''; return if ($mail ne '1'); # didn't want mail anyway my $moderator = FAQ::OMatic::Auth::getInheritedProperty($self, 'Notifier'); return if (not $moderator =~ m/\@/); # some non-address my $msg = ''; my ($id,$aq) = FAQ::OMatic::Auth::getID(); if ($id eq $moderator and $didWhat =~ m/moderator options/) { return; # moderator doesn't need to get mail about his own edits # THANKS to Bernhard Scholz for the suggestion } $msg .= "[This is a notification about the Faq-O-Matic items you have subscribed to.]\n\n"; $msg .= "Who: $id\n"; $msg .= "Item: ".$self->getTitle()."\n"; $msg .= "File: ".$self->{'filename'}."\n"; my $url = FAQ::OMatic::makeAref('-command'=>'faq', # sleazy hack that will bite me later -- go ahead and use # global params, because that's always "okay" here. #'-params'=>$params, '-changedParams'=>{'file'=>$self->{'filename'}}, '-reftype'=>'url', '-blastAll'=>1); $msg .= "URL: ".$url."\n"; $msg .= "What: ".$didWhat."\n"; if (defined $changedPart) { $msg .= "New text:\n"; $msg .= FAQ::OMatic::quoteText($self->getPart($changedPart)->{'Text'}, '> '); } $msg .= "\nAs always, thanks for your help maintaining the FAQ.\n"; # make sure $moderator isn't a trick string $moderator = FAQ::OMatic::validEmail($moderator); if (defined($moderator)) { # send the mail to the moderator # pageHeader is added to tell which FAQ has sent the mail. # THANKS suggested by Akiko Takano FAQ::OMatic::sendEmail($moderator, "[" . FAQ::OMatic::fomTitle() . "] " . $self->getTitle().":".$didWhat, $msg); } else { FAQ::OMatic::gripe('problem', "Moderator address is suspect ($moderator)"); } } # item in the parent's list sub getSiblings { my $self = shift; my ($prev, $next); my $parent = $self->getParent(); return (undef,undef) if (not $parent); my @siblings = $parent->getChildren(); my $i; for ($i=0; $i<@siblings; $i++) { if ($siblings[$i] eq $self->{'filename'}) { $prev = ($i>0) ? $siblings[$i-1] : undef; $next = ($i<@siblings-1) ? $siblings[$i+1] : undef; return ($prev,$next); } } return (undef,undef); } sub isCategory { my $self = shift; return (defined $self->{'directoryHint'}) ? 1 : 0; } # added for convenient reasons sub isAnswer { my $self = shift; return !($self->isCategory()); } sub whatAmI { # do not translate here; translate just before output. # (There is code that tests for string equality based on the # output of this function. Maybe that's stupid.) my $self = shift; return gettext_noop("Category") if ($self->isCategory()); return gettext_noop("Answer") if ($self->isAnswer()); # unreachable gripe('problem', 'Internal error #20010805-1843: unreachable code is reached', 1); return "(Unexpected item type)"; } sub updateDirectoryHint { my $self = shift; my $i; for ($i=0; $i<$self->numParts(); $i++) { if ($self->getPart($i)->{'Type'} eq 'directory') { $self->{'directoryHint'} = $i; return; } } delete $self->{'directoryHint'}; } sub clone { # return a deep-copy of myself my $self = shift; my $newitem = new FAQ::OMatic::Item(); # copy all of prototype's attributes my $key; foreach $key (keys %{$self}) { next if ($key eq 'Parts'); if ($key =~ m/-Set$/) { $newitem->{$key} = $self->{$key}->clone(); } elsif (ref $self->{$key}) { # guarantee this is a deep copy -- if we missed # a ref, complain. FAQ::OMatic::gripe('error', "clone: prototype has key '$key' " ."that is a reference (".$self->{$key}.")."); } $newitem->{$key} = $self->{$key}; } # copy all the parts... my $i; for ($i=0; $i<$self->numParts(); $i++) { push(@{$newitem->{'Parts'}}, $self->getPart($i)->clone()); } $newitem->updateDirectoryHint(); return $newitem; } sub checkSequence { my $self = shift; my $params = shift; my $checkSequenceNumber = defined($params->{'checkSequenceNumber'}) ? $params->{'checkSequenceNumber'} : -1; if ($checkSequenceNumber ne $self->{'SequenceNumber'}) { my $button = FAQ::OMatic::button( FAQ::OMatic::makeAref('-command'=>'faq', '-params'=>$params, '-changedParams'=>{'partnum'=>'', 'checkSequenceNumber'=>''} ), gettext("Return to the FAQ")); FAQ::OMatic::gripe('error', 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.") ."\n

    " .gettexta("Please %0 and start again to make sure no changes are lost. Sorry for the inconvenience.", $button) ."

    " .gettexta("(Sequence number in form: %0; in item: %1)", $checkSequenceNumber, $self->{'SequenceNumber'}), {'noentify'=>1} ); } } sub incrementSequence { my $self = shift; $self->setProperty('SequenceNumber', $self->{'SequenceNumber'}+1); } sub substrFOM { my $string = shift; my $width = shift; my $result = shift; my $encode_lang = FAQ::OMatic::I18N::language(); #EUC-JP case return substrMB($string,$width,$result) if($encode_lang eq "ja_JP.EUC"); #normal case return substr($string,$width,$result); } sub substrMB { my $string = shift; my $width = shift; my $result = shift; my ($n, $c, $r, $mb); while (length($string)){ last unless ($mb = $string =~ s/^([\200-\377].)+//) || $string =~ s/[\0-\177]+//; $n = $width; $n -= $width % 2 if $mb; ($c,$r) = unpack("a$n a*", $&); $width -= length($c); $result .= $c; last if length($r); } return $result; } # end of sub substrJ.. 1;