File Coverage

blib/lib/FAQ/OMatic/Part.pm
Criterion Covered Total %
statement 21 361 5.8
branch 0 118 0.0
condition 0 43 0.0
subroutine 7 31 22.5
pod 0 24 0.0
total 28 577 4.8


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   7 use strict;
  1         2  
  1         53  
29              
30             ###
31             ### A FAQ::OMatic::Part is a member of a FAQ::OMatic::Item, and contains one chunk of
32             ### text, plus its attributions, modification date, and other
33             ### characteristics.
34             ###
35              
36             package FAQ::OMatic::Part;
37              
38 1     1   6 use FAQ::OMatic;
  1         3  
  1         38  
39 1     1   5 use FAQ::OMatic::Item;
  1         2  
  1         23  
40 1     1   721 use FAQ::OMatic::Appearance;
  1         4  
  1         43  
41 1     1   836 use FAQ::OMatic::Set;
  1         2  
  1         39  
42 1     1   10 use FAQ::OMatic::I18N;
  1         2  
  1         185  
43 1     1   1157 use Text::Tabs;
  1         894  
  1         5633  
44              
45             sub new {
46 0     0 0   my ($class) = shift;
47              
48 0           my $part = {};
49 0           bless $part;
50 0           $part->{'Type'} = ''; # type is always defined, since '' is a
51             # valid type.
52 0           $part->{'Text'} = ''; # might as well define the text, since
53             # that's the point of a part.
54 0           $part->{'Author-Set'} = new FAQ::OMatic::Set('keepOrdered');
55              
56 0           return $part;
57             }
58              
59             sub loadFromCodeClosure {
60 0     0 0   my $self = shift;
61 0           my $closure = shift; # a sub that returns one line for each call
62 0           my $filename = shift;
63 0           my $item = shift;
64 0           my $partnum = shift;
65              
66 0           my ($lines) = 0;
67 0           my ($text) = "";
68              
69             # THANKS to "John R. Jackson" for
70             # grepping for unprotected while constructs.
71 0           while (defined($_ = &{$closure})) {
  0            
72 0           chomp;
73 0           my ($key,$value) = FAQ::OMatic::keyValue($_);
74 0 0         if ($key eq 'Author') {
75             # convert old-style 'Author' keys to 'Author-Set' keys
76             # transparently. Eventually all such items will get written
77             # out with updated header keys.
78 0           $key = 'Author-Set';
79             }
80 0 0         if ($key eq 'DateOfPart') {
81             # convert old-style 'DateOfPart' keys to 'LastModifiedSecs' keys
82             # transparently.
83 0           $value = FAQ::OMatic::Item::compactDateToSecs($value);
84             # turn back into seconds
85 0           $key = 'LastModifiedSecs';
86             }
87 0 0         if ($key eq 'Lines') {
    0          
    0          
88             # Lines header is always last before the text content of a Part
89 0           $lines = $value;
90 0           last;
91             } elsif ($key =~ m/-Set$/) {
92             # header key ends in '-Set' -- that means it may appear multiple
93             # times.
94 0 0         if (not defined($self->{$key})) {
95 0           $self->{$key} = new FAQ::OMatic::Set;
96             }
97 0           $self->{$key}->insert($value);
98             } elsif ($key ne '') {
99 0           $self->{$key} = $value;
100 0 0 0       if (($key eq 'Type') and ($value eq 'directory')) {
101             # keep a quick way for the item object to find the part that
102             # holds the directory
103 0           $item->{'directoryHint'} = $partnum;
104             }
105             } else {
106 0           FAQ::OMatic::gripe('problem',
107             "FAQ::OMatic::Part::loadFromCodeClosure was confused by this header in file $filename: \"$_\"");
108             }
109             }
110             # THANKS to "John R. Jackson" for
111             # grepping for unprotected while constructs.
112 0   0       while (($lines>0) and defined($_ = &{$closure})) {
  0            
113 0           $text .= $_;
114 0           $lines--;
115             }
116             # verify that EndPart shows up in the right place
117 0           $_ = &{$closure};
  0            
118 0 0         if (not defined $_) {
119 0           FAQ::OMatic::gripe('problem',
120             "FAQ::OMatic::Part::loadFromCodeClosure file $filename part $partnum didn't end right.");
121             }
122 0           my ($key,$value) = FAQ::OMatic::keyValue($_);
123 0 0 0       if (($key ne 'EndPart') or ($value != $partnum)) {
124 0           FAQ::OMatic::gripe('problem', "FAQ::OMatic::Part::loadFromCodeClosure file $filename part $partnum didn't end with EndPart.");
125             }
126 0           $self->{'Text'} = $text;
127             }
128              
129             sub displayAsFile {
130 0     0 0   my $self = shift;
131 0           my $rt = "";
132              
133 0           my $key;
134 0           foreach $key (sort keys %{$self}) {
  0            
135 0 0 0       if (($key =~ m/^[a-z]/)
    0          
136             or ($key eq 'Text')) {
137 0           next;
138             # these keys get ignored or written out later (Text)
139             } elsif ($key =~ m/-Set$/) {
140 0           my $a;
141 0           foreach $a ($self->getSet($key)->getList()) {
142 0           $rt .= "$key: $a\n";
143             }
144             } else {
145 0           $rt .= "$key: ".$self->{$key}."\n";
146             }
147             }
148 0           my $text = $self->{'Text'};
149 0           $text =~ s/([^\n])\r([^\n])/$1\n$2/gs; # standalone LF's become \n's.
150 0           $text =~ s/\r//gs; # Remove any bogus extra \r's
151 0 0         $text .= "\n" if (not ($text =~ m/\n$/)); # ensure final \n
152 0           $self->{'Text'} = $text; # make sure in-memory copy
153             # reflects the one we're saving
154              
155 0           $rt .= "Lines: ".countLines($text)."\n".$text;
156              
157 0           return $rt;
158             }
159              
160             sub countLines {
161 0     0 0   my $data = shift;
162 0           my $datacopy = $data;
163 0           $datacopy =~ s/[^\n]//gs; # count \n's
164 0           return length($datacopy);
165             }
166              
167             sub display {
168 0     0 0   my $self = shift;
169 0           my @keys;
170 0           my $rt = ""; # return text
171              
172 0           $rt .= "
    \n";
173 0           my $key;
174 0           foreach $key (sort keys %$self) {
175 0           $rt .= "
  • $key => $self->{$key}
    \n";
    • 176             }
    177 0           $rt .= "\n";
    178              
    179 0           return $rt;
    180             }
    181              
    182             sub displayHTML {
    183 0     0 0   my $self = shift;
    184 0           my $item = shift;
    185 0           my $partnum = shift;
    186 0           my $params = shift;
    187 0           my $showAttributions = FAQ::OMatic::getParam($params, 'showAttributions');
    188 0           my @boxes = (); # return one table row per @boxes element
    189              
    190 0           my $rt = '';
    191              
    192 0   0       my $type = $self->{'Type'} || '';
    193 0           my $tmp = FAQ::OMatic::insertLinks($params, $self->{'Text'},
    194             $type eq 'html',
    195             $type eq 'directory');
    196 0           $tmp = FAQ::OMatic::highlightWords($tmp, $params);
    197 0 0         if ($type eq 'monospaced'){
        0          
    198             ## monospaced text
    199 0           $tmp =~ s/\n$//;
    200 0           $tmp = "
    \n".$tmp."
    ";
    201             } elsif ($type eq 'html') {
    202             ## HTML text. Just add a
    at the end, and a comment that
    203             ## it's untranslated.
    204 0           $tmp = "\n" . $tmp .
    206             "\n
    \n";
    207             } else {
    208             ## standard format: double-CRs become

    's (whitespace between

    209             ## paragraphs), and lines that start with whitespace get a
    210             ## tag. Note that directories are standard format too, we just
    211             ## enforce a rule when editing to keep the structure consistent.
    212 0           $tmp .= "
    "; # keep attributions below part
    213             # These are Andreas Klußmann 's
    214             # cool rules: triple-space for a paragraph, double for a break,
    215             # indent for 
    formatted text.
    216 0           $tmp =~ s/\n\n\n/\n

    \n/gs;

    217 0           $tmp =~ s/\n\n/
    \n/gs;
    218 0           $tmp =~ s/\n( +[^\n]*)(?=\n)/\n
    $1<\/pre>/gs;
    219 0           $tmp =~ s/<\/pre>\n
    /\n/gs;
    220             }
    221 0           $rt .= $tmp;
    222              
    223             # turn off attributions if this part has the HideAttributions property,
    224             # or if the item has the AttributionsTogether property.
    225 0 0         if ($showAttributions eq 'default') {
    226 0 0 0       if ($self->{'HideAttributions'} or $item->{'AttributionsTogether'}) {
    227 0           $showAttributions = 'hide';
    228             } else {
    229 0           $showAttributions = 'all';
    230             }
    231             }
    232 0 0         if ($showAttributions eq 'all') {
    233             #$rt .= "".join(", ",
    234             # THANKS: DateOfPart courtesy Scott Hardin
    235 0           my ($date_string) = '';
    236 0 0 0       if ($self->{'LastModifiedSecs'} and
    237             FAQ::OMatic::getParam($params, 'showLastModified') eq 'show') {
    238 0           $date_string = FAQ::OMatic::Item::compactDate(
    239             $self->{'LastModifiedSecs'}) . " ";
    240             }
    241 0           $rt .= ""
    242             .$date_string
    243             .join(", ",
    244 0           map { FAQ::OMatic::mailtoReference($params, $_) }
    245             $self->{'Author-Set'}->getList()
    246             )."";
    247             }
    248              
    249 0 0         my $color = ($type eq 'directory')
    250             ? $FAQ::OMatic::Config::directoryPartColor
    251             : $FAQ::OMatic::Config::regularPartColor;
    252 0           my $partBox = { 'type'=>'three',
    253             'text'=>$rt,
    254             'color'=>$color };
    255             # that's the end of the main part content
    256              
    257 0 0 0       if (FAQ::OMatic::getParam($params, 'editCmds') ne 'hide'
    258             and $item->ordinaryItem()) {
    259 0 0         my $aoc = $item->isCategory ? 'cat' : 'ans';
    260 0           my $filename = $item->{'filename'};
    261 0           my @rightEdits = ();
    262 0           my @belowEdits = ();
    263              
    264 0           push @rightEdits, {'text'=>FAQ::OMatic::button(
    265             FAQ::OMatic::makeAref('-command'=>'editPart',
    266             '-params'=>$params,
    267             '-changedParams'=>{'file'=>$filename,
    268             'partnum'=>$partnum,
    269             'checkSequenceNumber'=>$item->{'SequenceNumber'}}),
    270             gettext("Edit This Text"),
    271             "$aoc-edit-part", $params),
    272             'size'=>'edit'};
    273 0           push @rightEdits, {'text'=>FAQ::OMatic::button(
    274             FAQ::OMatic::makeAref('-command'=>'editPart',
    275             '-params'=>$params,
    276             '-changedParams'=>{'file'=>$filename,
    277             'partnum'=>$partnum,
    278             '_insertpart'=>1,
    279             '_duplicate'=>1,
    280             'checkSequenceNumber'=>$item->{'SequenceNumber'}}),
    281             gettext("Duplicate This Text"),
    282             "$aoc-dup-part", $params),
    283             'size'=>'edit'};
    284 0 0         if ($type ne 'directory') {
        0          
    285 0           push @rightEdits, {'text'=>FAQ::OMatic::button(
    286             FAQ::OMatic::makeAref('-command'=>'delPart',
    287             '-params'=>$params,
    288             '-changedParams'=>{"file"=>$filename,
    289             'partnum'=>$partnum,
    290             'checkSequenceNumber'=>$item->{'SequenceNumber'}}
    291             ),
    292             gettext("Remove This Text"),
    293             "$aoc-del-part", $params),
    294             'size'=>'edit'};
    295             } elsif (scalar($self->getChildren())==0) {
    296             # directory, but has no children -- can just delete directory.
    297             # this is a minor variation on Item's Convert to Answer.
    298 0           push @rightEdits, {'text'=>FAQ::OMatic::button(
    299             FAQ::OMatic::makeAref('-command'=>'submitCatToAns',
    300             '-params'=>$params,
    301             '-changedParams'=>{"file"=>$filename,
    302             '_removePart'=>1,
    303             'checkSequenceNumber'=>$item->{'SequenceNumber'}}
    304             ),
    305             gettext("Remove This Text"),
    306             "$aoc-del-part", $params),
    307             'size'=>'edit'};
    308             }
    309              
    310 0           my @baglist = $self->getBags();
    311 0 0         if (scalar(@baglist)==1) {
        0          
    312 0           push @rightEdits, {'text'=>FAQ::OMatic::button(
    313             FAQ::OMatic::makeAref('-command'=>'editBag',
    314             '-params'=>$params,
    315             '-changedParams'=>{'file'=>$filename,
    316             '_target'=>$baglist[0]}),
    317             gettexta("Replace %0 with new upload", $baglist[0])),
    318             'size'=>'edit'};
    319             } elsif (scalar(@baglist)>1) {
    320 0           push @rightEdits, {'text'=>FAQ::OMatic::button(
    321             FAQ::OMatic::makeAref('-command'=>'selectBag',
    322             '-params'=>$params,
    323             '-changedParams'=>{'file'=>$filename}),
    324             gettext("Select bag to replace with new upload")),
    325             'size'=>'edit'};
    326             }
    327              
    328 0           push @rightEdits, {'text'=>FAQ::OMatic::button(
    329             FAQ::OMatic::makeAref('-command'=>'editBag',
    330             '-params'=>$params,
    331             '-changedParams'=>{'file'=>$filename,
    332             'partnum'=>$partnum}),
    333             gettext("Upload New Bag Here")),
    334             'size'=>'edit'};
    335              
    336             # separate block of editing commands that don't apply to a specific
    337             # part, but their position between parts is relevant
    338 0           push @belowEdits, {'text'=>''};
    339 0           push @belowEdits, {'text'=>FAQ::OMatic::button(
    340             FAQ::OMatic::makeAref('-command'=>'editPart',
    341             '-params'=>$params,
    342             '-changedParams'=>{'file'=>$filename,
    343             'partnum'=>$partnum,
    344             '_insertpart'=>1,
    345             'checkSequenceNumber'=>$item->{'SequenceNumber'}}),
    346             gettext("Insert Text Here"),
    347             "$aoc-ins-part", $params),
    348             'size'=>'edit'};
    349 0           push @belowEdits, {'text'=>FAQ::OMatic::button(
    350             FAQ::OMatic::makeAref('-command'=>'editPart',
    351             '-params'=>$params,
    352             '-changedParams'=>{'file'=>$filename,
    353             'partnum'=>$partnum,
    354             '_insertpart'=>1,
    355             '_upload'=>1,
    356             'checkSequenceNumber'=>$item->{'SequenceNumber'}}),
    357             gettext("Insert Uploaded Text Here"),
    358             "$aoc-ins-part", $params),
    359             'size'=>'edit'};
    360              
    361 0           return { 'type'=>'three',
    362             'part'=>$self,
    363             'body'=>$partBox,
    364             'editbody'=>\@rightEdits,
    365             'afterbody'=>\@belowEdits,
    366             'id'=>'generated by Part::displayHTML'};
    367             }
    368              
    369             # no editing boxes
    370 0           return { 'type'=>'wide',
    371             'text'=>$partBox->{'text'},
    372             'color'=>$partBox->{'color'},
    373             'part'=>$self,
    374             };
    375             }
    376              
    377             sub displayText {
    378 0     0 0   my $self = shift;
    379 0           my $item = shift;
    380 0           my $partnum = shift;
    381 0           my $params = shift;
    382 0           my $showAttributions = FAQ::OMatic::getParam($params, 'showAttributions');
    383 0           my @boxes = (); # return one table row per @boxes element
    384              
    385 0           my $rt = '';
    386              
    387 0   0       my $type = $self->{'Type'} || '';
    388 0           my $tmp = FAQ::OMatic::insertLinksText($params, $self->{'Text'},
    389             $type eq 'html',
    390             $type eq 'directory');
    391 0 0         if ($type eq 'monospaced'){
        0          
    392             ## monospaced text -- display it as-is
    393             } elsif ($type eq 'html') {
    394             ## HTML text. Eliminate all tags.
    395 0           $tmp =~ s#<([^>]("[^"]*")?)*>##sg;
    396             } else {
    397             ## standard format: double-CRs are line breaks, triple-crs are
    398             ## white-space, indented lines shouldn't be touched.
    399 0           my @whitespaces = split("\n\n\n", $tmp);
    400 0           my $out = '';
    401 0           $Text::Wrap::columns = 70;
    402 0           for (my $i=0; $i<@whitespaces; $i++) {
    403 0           my @lb = split("\n\n", $whitespaces[$i]);
    404 0           my @paragraph = map { wrapLeftLines($_) } @lb;
      0            
    405 0           $out .= join("\n", @paragraph);
    406 0           $out =~ s/\n?\n?$/\n\n/s; # ensure text ends in a blank line
    407             }
    408             # TODO: already-indented lines are not to be wrapped.
    409 0           $tmp = $out;
    410             }
    411 0           $rt .= $tmp;
    412              
    413             # turn off attributions if this part has the HideAttributions property,
    414             # or if the item has the AttributionsTogether property.
    415 0 0         if ($showAttributions eq 'default') {
    416 0 0 0       if ($self->{'HideAttributions'} or $item->{'AttributionsTogether'}) {
    417 0           $showAttributions = 'hide';
    418             } else {
    419 0           $showAttributions = 'all';
    420             }
    421             }
    422 0 0         if ($showAttributions eq 'all') {
    423 0           my @authors = $self->{'Author-Set'}->getList();
    424 0           my $brt = FAQ::OMatic::authorList($params, \@authors);
    425 0 0 0       if ($self->{'LastModifiedSecs'} and
    426             FAQ::OMatic::getParam($params, 'showLastModified') eq 'show') {
    427 0           $brt = FAQ::OMatic::Item::compactDate(
    428             $self->{'LastModifiedSecs'})
    429             ." ".$brt;
    430             }
    431 0           $rt.=$brt;
    432             }
    433              
    434             # no editing boxes
    435 0           return { 'type'=>'wide',
    436             'text'=>$rt,
    437             'part'=>$self,
    438             };
    439             }
    440              
    441             sub displayPartEditor {
    442 0     0 0   my $self = shift;
    443 0           my $item = shift;
    444 0           my $partnum = shift;
    445 0           my $params = shift;
    446 0           my $rt = ''; # return text
    447              
    448             # default number of rows is room for text plus a little new text.
    449 0           my $rows = countLines($self->{'Text'})+4;
    450 0 0         $rows = 15 if ($rows < 15); # make sure it's never too teeny
    451 0 0         $rows = 30 if ($rows > 30); # and never way big
    452              
    453 0 0         $rt .= FAQ::OMatic::makeAref('-command'=>'submitPart',
    454             '-params'=>$params,
    455             '-changedParams'=>{'partnum'=>$partnum},
    456             '-refType'=>'POST',
    457             '-multipart'=>($params->{'_upload'} ? 1 : ''),
    458             '-saveTransients'=>1);
    459              
    460 0           $rt.="\n"; \n"; \n"; \n"; \n";
    461 0           $rt.="\n";
    462 0           $rt .= "
    463             .$item->{'SequenceNumber'}."\">\n";
    464              
    465 0 0         if (not $params->{'_upload'}) {
    466             # Regular input screen -- provide a \n";
    490            
    491 0           $rt.="
    492 0           $rt.="
    493 0           $rt.="\n";
    494             } else {
    495             # Upload file instead of typing in textarea
    496             # THANKS: to John Goerzen
    497 0           $rt .= "

    \n"

    498             .gettext("Upload file:")." ";
    499 0           $rt .= "
    ";
    500 0 0         if ($self->{'Text'} ne '') {
    501 0           my @count = ($self->{'Text'} =~ m/\n/gs);
    502 0           my $count = scalar(@count);
    503 0           $rt .= gettext("Warning: file contents will replace previous text")." ($count lines).\n";
    504             }
    505             }
    506              
    507             # HideAttributions
    508 0           $rt .= "

    509 0 0         $rt .= " CHECKED" if $self->{'HideAttributions'};
    510 0           $rt .= "> ".gettext("Hide Attributions")."\n";
    511              
    512             # Type
    513 0           $rt .= "

    ".gettext("Format text as:")."
    \n\n";
    514              
    515 0 0         if ($self->{'Type'} eq 'directory') {
    516             # TODO: delete this commented block. superseded by submitCatToAns.
    517             # if (scalar($self->getChildren()) == 0) {
    518             # $rt .= "
    519             # ."value=\"1\"> Remove directory (turning this category "
    520             # ."item into an answer item) if text box above is empty.\n";
    521             # }
    522 0           $rt .= "
    523             ." CHECKED> ".gettext("Directory")."\n";
    524             } else {
    525             # THANKS: Jim Spath (jes) got rid of
    s to format more tightly
    526             # in Lynx; jonh put one back in, plus some pairs to keep
    527             # layout from sucking in netscape/ie.
    528 0           $rt .= "
    529 0 0         $rt .= " CHECKED" if ($self->{'Type'} eq '');
    530 0           $rt .= "> ".gettext("Natural text")."\n";
    531              
    532 0           $rt .= "
    533 0 0         $rt .= " CHECKED" if ($self->{'Type'} eq 'monospaced');
    534 0           $rt .= "> ".gettext("Monospaced text (code, tables)")."\n";
    535              
    536             # THANKS: John Goerzen supplied the patches to introduce
    537             # THANKS: 'html'-type parts.
    538 0           my $url = FAQ::OMatic::Auth::ensurePerm($item, 'PermUseHTML',
    539             FAQ::OMatic::commandName(),
    540             FAQ::OMatic::dispatch::cgi(), 0, 'useHTML');
    541 0 0         if ($url) {
    542             # $rt .= "

    Untranslated HTML\n";

    543             # THANKS: Jim Adler says: why even admit that it exists?
    544             # problem: how can a user authenticate if he should be able
    545             # to use HTML?
    546             } else {
    547 0           $rt .= "
    548 0 0         $rt .= " CHECKED" if ($self->{'Type'} eq 'html');
    549 0           $rt .= "> ".gettext("Untranslated HTML")."\n";
    550             }
    551             }
    552 0           $rt .= "\n";
    553 0           $rt.="
    554              
    555             # Submit
    556             # THANKS: to Jim Adler for suggesting using a
    557             # table to bring the Submit button up higher so users don't have
    558             # to scroll just to get past the rest of the form.
    559 0           $rt.="\n";
    560 0           $rt .= "
    \n";
    561 0           $rt .= "\n";
    562 0           $rt .= "\n";
    563             # this lets the submit script check that the whole POST was
    564             # received.
    565 0           $rt .= "\n";
    566             # $rt .= FAQ::OMatic::button(
    567             # FAQ::OMatic::makeAref('-command'=>'faq',
    568             # '-params'=>$params,
    569             # '-changedParams'=>{'partnum'=>'',
    570             # 'checkSequenceNumber'=>''}
    571             # ),
    572             # 'Cancel and return to FAQ');
    573 0           $rt.="
    574 0           $rt.="
    \n";
    575              
    576 0           return $rt;
    577             }
    578              
    579             # insert [item title] into faqomatic:XX references
    580             sub addTitleToFaqomaticReferences {
    581 0     0 0   my $text = shift;
    582 0           my @splitty = splitLinksFromText($text);
    583 0           for (my $i=1; $i
    584 0           $splitty[$i] =~ m/^faqomatic:(.*)$/;
    585 0           my $filename = $1;
    586 0           my $item = new FAQ::OMatic::Item($filename);
    587 0           my $title = $item->getTitle();
    588 0           $title =~ tr/\[\]/\(\)/; # eliminate []'s
    589 0           $splitty[$i] = "faqomatic[$title]:$filename";
    590             }
    591 0           return join('', @splitty);
    592             }
    593              
    594             sub setText {
    595 0     0 0   my $self = shift;
    596 0           my $newText = shift;
    597              
    598             # eliminate tabs
    599 0 0         if ($newText =~ m/\t/) {
    600             # use Text::Tabs expand function to eliminate tabs
    601 0           $Text::Tabs::tabstop = 8;
    602 0           $newText = join("\n", Text::Tabs::expand(split(/\n/, $newText)));
    603             }
    604 0           $self->{'Text'} = $newText;
    605             }
    606              
    607             sub setProperty {
    608 0     0 0   my $self = shift;
    609 0           my $property = shift;
    610 0           my $value = shift;
    611              
    612 0 0         if ($value) {
    613 0           $self->{$property} = $value;
    614             } else {
    615 0           delete $self->{$property};
    616             }
    617             }
    618              
    619             sub getChildren {
    620 0     0 0   my $self = shift;
    621              
    622 0 0         if ($self->{'Type'} ne 'directory') {
    623 0           return ();
    624             }
    625              
    626 0           return $self->getLinks();
    627             }
    628              
    629             # returns a list of all faqomatic: links in this part
    630             sub getLinks {
    631 0     0 0   my $self = shift;
    632 0           return getLinksFromText($self->{'Text'});
    633             }
    634              
    635             sub getLinksFromText {
    636 0     0 0   my $text = shift;
    637 0           my @splitty = splitLinksFromText($text);
    638 0           my @dirlist = ();
    639 0           for (my $i=1; $i
    640             # strip off faqomatic: prefixes to leave item names
    641 0           $splitty[$i] =~ s/^faqomatic://;
    642 0           push @dirlist, $splitty[$i];
    643             }
    644 0           return @dirlist;
    645             }
    646              
    647             sub splitLinksFromText {
    648             # this function determines what is or isn't a faqomatic: link
    649             # it returns a split-style alternating array; even indices are
    650             # other stuff and odd indices are the faqomatic: links with
    651             # the "faqomatic:" still attached.
    652 0     0 0   my $text = shift;
    653 0           my @splitty = split(/(faqomatic:[^>\s.,\?!)]+)/, $text);
    654             #TODO debug delete
    655             #my @splitty = split(/(faqomatic:[^\>]*)/, $text);
    656 0           return @splitty;
    657             }
    658              
    659             # returns list of names of all bags this part references,
    660             # either as inlines or as baglinks.
    661             sub getBags() {
    662 0     0 0   my $self = shift;
    663              
    664 0           my $text = $self->{'Text'};
    665 0           my @regexlist = ($text =~
    666             m/(baginline:(\S*[^\s.,>)\?!]))|(baglink:(\S*[^\s.,>)\?!]))/gs);
    667             # the above regexp will return 4*number of matches, one entry for
    668             # each left parethesis.
    669             # We actually want either the second or fourth item from each 4-tuple.
    670 0           my $i;
    671 0           my @baglist = ();
    672 0           for ($i=0; $i
    673 0   0       push @baglist, $regexlist[$i+1] || $regexlist[$i+3];
    674             # Thanks to John Nolan for finding another
    675             # Use of Uninitialized Value -w bug that was here.
    676             }
    677             # remove duplicates but keep order using a Set
    678 0           my $bagset = new FAQ::OMatic::Set('keepOrdered');
    679 0           $bagset->insert(@baglist);
    680 0           return $bagset->getList();
    681             }
    682              
    683             sub mergeDirectory {
    684 0     0 0   my $self = shift;
    685 0           my $filename = shift;
    686              
    687 0 0         if ($self->{'Type'} ne 'directory') {
    688 0           FAQ::OMatic::gripe('panic', "mergeDirectory: self is not a directory");
    689             }
    690 0 0         if (not -f "$FAQ::OMatic::Config::itemDir/$filename") {
    691 0           FAQ::OMatic::gripe('panic', "mergeDirectory: $filename isn't a file");
    692             }
    693              
    694 0           my @dirlist = $self->getChildren();
    695 0           my %dirhash = map { ($_,1) } @dirlist;
      0            
    696 0 0         return if ($dirhash{$filename}); # already done
    697              
    698 0           my $item = new FAQ::OMatic::Item($filename);
    699 0           my $headerpattern = gettext("Answers in this category:");
    700 0 0 0       if ((defined $item->{'directoryHint'})
    701             and ($self->{'Text'} =~ m/\n\n$headerpattern/)) {
    702             # Insert subcategories above "Answers in this category" header, if
    703             # one exists.
    704 0           $self->{'Text'} =~ s/(\n?\n\n$headerpattern)/\n\n$&/s;
    705             } else {
    706             # just tack on the end with all the other answers
    707 0           $self->{'Text'} .= "\n\n";
    708             }
    709 0           my ($id,$aq) = FAQ::OMatic::Auth::getID(); # user is now a coauthor of
    710 0 0         $self->addAuthor($id) if ($id); # the directory part
    711             }
    712              
    713             sub unmergeDirectory {
    714 0     0 0   my $self = shift;
    715 0           my $filename = shift;
    716              
    717 0 0         if ($self->{'Type'} ne 'directory') {
    718 0           FAQ::OMatic::gripe('panic',
    719             "unmergeDirectory: self is not a directory");
    720             }
    721              
    722             # since directories can now contain textual content, we
    723             # unmerge by simply "substituting out" the faqomatic link:
    724             # THANKS: to erinker@beasys.com for helping me get the whitespace
    725             # removal right (or at least better)
    726             # THANKS: to "Mark D. Nagel" for finding
    727             # structure-corrputing bug where removing 'faqomatic:21' would also
    728             # change 'faqomatic:218' into 'faqomatic:21'. The fix was to add
    729             # a pattern at the end that forces the match to be complete.
    730             # Bad software engineering note: this regex needs to be kept in
    731             # agreement with the one in Part::getLinks(), because they both define
    732             # the boundaries of a faqomatic: link.
    733 0           my @splitty = splitLinksFromText($self->{'Text'});
    734 0           for (my $i=1; $i
    735 0 0         if ($splitty[$i] eq 'faqomatic:'.$filename) {
    736             # found our target
    737             # try to remove any surrounding boilerplate
    738 0           $splitty[$i-1] =~ s/\n?\n? ?
    739 0           $splitty[$i] = ''; # delete the faqomatic: ref
    740 0           $splitty[$i+1] =~ s/^>//s;
    741             # return happy
    742 0           $self->{'Text'} = join('', @splitty);
    743 0           return;
    744             }
    745             }
    746             # Uh oh, never found the link!
    747 0           die "failed to unmerge $filename from directory of "
    748             .$self->{'filename'}
    749             .".";
    750             }
    751              
    752             sub addAuthor {
    753 0     0 0   my $self = shift;
    754 0           my $author = shift;
    755              
    756 0           $self->{'Author-Set'}->insert($author);
    757             }
    758              
    759             sub clone {
    760             # return a deep-copy of myself
    761 0     0 0   my $self = shift;
    762              
    763 0           my $newpart = new FAQ::OMatic::Part();
    764              
    765             # copy all of prototype's attributes
    766 0           my $key;
    767 0           foreach $key (keys %{$self}) {
      0            
    768 0 0         if ($key =~ m/-Set$/) {
        0          
    769 0           $newpart->{$key} = $self->{$key}->clone();
    770             } elsif (ref $self->{$key}) {
    771             # guarantee this is a deep copy -- if we missed
    772             # a ref, complain.
    773 0           FAQ::OMatic::gripe('error', "FAQ::OMatic::Part::clone: prototype has "
    774             ."key '$key' that is a reference (".$self->{$key}.").");
    775             }
    776 0           $newpart->{$key} = $self->{$key};
    777             }
    778              
    779             # don't let rogue directories escape and mess up the item structure
    780 0 0         $newpart->{'Type'} = '' if ($newpart->{'Type'} eq 'directory');
    781              
    782 0           return $newpart;
    783             }
    784              
    785             sub getSet {
    786 0     0 0   my $self = shift;
    787 0           my $setName = shift;
    788              
    789 0   0       return $self->{$setName} || new FAQ::OMatic::Set;
    790             }
    791              
    792             sub wrapLeftLines {
    793             # wrap lines that are left-justified; preserve the others
    794 0     0 0   my $text = shift;
    795              
    796 0           my @lines = split(/\n/, $text);
    797 0           my @buffer = ();
    798 0           my $rt = '';
    799 0           my $line;
    800 0           while (defined($line = shift @lines)) {
    801 0 0         if ($line =~ m/^\s/) {
    802             # a concrete line -- wrap prior buffer, pass concrete line
    803 0 0         if (@buffer) {
    804 0           $rt .= faqwrap(@buffer);
    805 0           @buffer = ();
    806             }
    807 0           $rt.=$line."\n";
    808             } else {
    809             # a wrappable line -- group into buffer
    810 0           push @buffer, $line;
    811             }
    812             }
    813             # wrap remaining buffer
    814 0 0         if (@buffer) {
    815 0           $rt .= faqwrap(@buffer);
    816 0           @buffer = ();
    817             }
    818 0           return $rt;
    819             }
    820              
    821             sub faqwrap {
    822 0     0 0   my @lines = @_;
    823              
    824             # Text::Wrap() is pretty broken. The docs say it doesn't die
    825             # when given a word longer than $columns, but it still does.
    826              
    827 0           my $rt="Text::Wrap() failed\n";
    828 0           eval {
    829 0           require Text::Wrap;
    830 0           import Text::Wrap qw(wrap $columns);
    831              
    832 0           $rt=wrap('','',@lines);
    833             };
    834 0           return $rt;
    835             }
    836              
    837             sub touch {
    838 0     0 0   my $self = shift;
    839 0   0       my $time = shift || time();
    840              
    841 0           $self->setProperty('LastModifiedSecs', $time);
    842             }
    843              
    844             1;