FAQ/faq_maker.pl

   1 #!/usr/local/bin/perl -w
   2
   3 use strict ;
   4 use Carp ;
   5
   6 use YAML ;
   7
   8 my @markup = (
   9
  10               {
  11                'search'  => 'M<[^<>]+>',
  12                'replace' => sub {
  13                        my ( $text ) = @_;
  14
  15                        $text =~ s|M<([^<>]+)>|<SPAN CLASS="stem">$1</SPAN>|sg;
  16
  17                        $text;
  18                },
  19
  20               },
  21
  22               {
  23                'search'  => 'QUOTE<(.*?)>',
  24                'replace' => sub {
  25                        my ( $text ) = @_;
  26
  27                        $text =~ /QUOTE<(.*?)>/gs;
  28
  29                        my $before = $`;
  30                        my $after  = $';
  31                        my $quote  = $1;
  32
  33                        $quote =~ s/\\/<BR>/sg;
  34
  35                        $before .
  36                        "<P><TABLE BORDER='0' ALIGN='CENTER' CELLPADDING='3'" .
  37                        " CELLSPACING='0' BGCOLOR='FORESTGREEN'><TR><TD>" .
  38                        "<TABLE WIDTH='100%' CELLPADDING='3' CELLSPACING='2'" .
  39                        " BORDER='0' BGCOLOR='#CFE7CF'><TR><TH> $quote" .
  40                        "</TH></TR></TABLE></TD></TR></TABLE>" .
  41                        $after;
  42                },
  43               },
  44
  45              );
  46
  47
  48 my (
  49     @sections,
  50
  51     $header_text,
  52
  53     $page_title_base
  54 );
  55
  56 set_header_text() ;
  57
  58 process_faq_text() ;
  59
  60 process_sections() ;
  61
  62 print_section_page() ;
  63
  64 exit ;
  65
  66
  67 sub process_faq_text {
  68
  69         my ( $section, $quest_text, $answer_text, $curr_faq ) ;
  70
  71         while( <> ) {
  72
  73                 next if /^\s*$/ ;
  74                 s/\n/ /;
  75
  76                 if ( /^([SQ]):\s*(.+)$/ ) {
  77
  78
  79                         if ( $curr_faq ) {
  80
  81
  82                                 $curr_faq->{'answer'} =
  83                                     markup_text( $answer_text ) ;
  84
  85                                 $answer_text = '' ;
  86
  87                                 unless ( $curr_faq->{'question'} &&
  88                                          $curr_faq->{'answer'} ) {
  89
  90
  91                                         die
  92
  93                                  "bad FAQ entry before line $. in $ARGV\n" ;
  94                                 }
  95
  96                                 push( @{$section->{'faqs'}}, $curr_faq ) ;
  97                                 $curr_faq = undef ;
  98                         }
  99
 100                         if ( $1 eq 'S' ) {
 101
 102                                 my $section_title = $2 ;
 103
 104                                 push( @sections, $section ) if $section ;
 105
 106                                 $section = {
 107
 108                                         'plain_title' => $section_title,
 109                                         'title'       => markup_text( $section_title ),
 110                                 } ;
 111
 112                                 next ;
 113                         }
 114
 115                         $quest_text = $2 ;
 116
 117                         next ;
 118                 }
 119
 120                 if ( /^A:\s*(.+)$/ ) {
 121
 122                         $answer_text = markup_text( $1 ) ;
 123
 124                         $curr_faq = {
 125                                 'question' => markup_text( $quest_text ),
 126                         } ;
 127
 128                         $quest_text = '' ;
 129                         next ;
 130                 }
 131
 132                 if ( $quest_text ) {
 133
 134                         $quest_text .= $_ ;
 135                         next ;
 136                 }
 137
 138                 $answer_text .= $_ ;
 139         }
 140
 141         push( @sections, $section ) ;
 142 }
 143
 144
 145 sub process_sections {
 146
 147
 148         my $sect_num = 1 ;
 149
 150         foreach my $sect_ref ( @sections ) {
 151
 152
 153                 my $title = $sect_ref->{'title'} ;
 154
 155                 $sect_ref->{'num'} = $sect_num ;
 156
 157                 my $link = <<LINK ;
 158 $sect_num <A HREF="faq$sect_num.html">$title</A>
 159 LINK
 160
 161                 $sect_ref->{'link'} = $link ;
 162
 163                 my $quest_num = 1 ;
 164
 165                 foreach my $faq_ref ( @{$sect_ref->{'faqs'}} ) {
 166
 167                         my $quest  = $faq_ref->{'question'} ;
 168
 169                         my $answer = $faq_ref->{'answer'} ;
 170
 171                         $faq_ref->{'num'} = $quest_num ;
 172                         $faq_ref->{'index'} = "$sect_num.$quest_num" ;
 173
 174                         $faq_ref->{'link'} = <<LINK ;
 175 $sect_num.$quest_num <A HREF="faq$sect_num.html#FAQ$quest_num">$quest</A>
 176 LINK
 177
 178                         $quest_num++ ;
 179                 }
 180
 181                 $sect_num++ ;
 182         }
 183 }
 184
 185
 186 sub print_section_page {
 187
 188         my $page_text = <<HTML ;
 189 <%attr>
 190         title => "$page_title_base"
 191 </%attr>
 192
 193 <A HREF="index.html">Home</A> &gt <B>FAQ</B>
 194
 195 <HR CLASS="sep">
 196
 197 <H1>Frequently Asked Questions</H1>
 198
 199 <UL STYLE="list-style-type:none">
 200 HTML
 201
 202         foreach my $sect_ref ( @sections ) {
 203
 204                 my $link = $sect_ref->{'link'} ;
 205
 206                 $page_text .= "<LI>$link" ;
 207
 208                 print_faq_pages( $sect_ref ) ;
 209         }
 210
 211         $page_text .= "</UL>";
 212
 213         write_file( 'faq.html', $page_text ) ;
 214
 215 }
 216
 217 sub print_faq_pages {
 218
 219         my ( $sect_ref ) = @_ ;
 220
 221         my $quest_list ;
 222
 223         my $faq_text ;
 224
 225         my $plain_title = $sect_ref->{'plain_title'} ;
 226         my $title = $sect_ref->{'title'} ;
 227         my $sect_num = $sect_ref->{'num'} ;
 228
 229         my $page_text = <<HTML ;
 230 <%attr>
 231         title => "$page_title_base &gt; $plain_title"
 232 </%attr>
 233
 234 <A HREF="index.html">Home</A> &gt <A HREF="faq.html">FAQ</A> &gt; <B>$title</B>
 235
 236 <HR CLASS="sep">
 237
 238 <H1><A NAME="top">$title</A></H1>
 239
 240 <HR CLASS="sep">
 241
 242 HTML
 243
 244
 245         $quest_list .= <<HTML ;
 246 <UL STYLE="list-style-type:none">
 247 HTML
 248
 249         foreach my $faq_ref ( @{$sect_ref->{'faqs'}} ) {
 250
 251                 my $quest = $faq_ref->{'question'} ;
 252                 my $answer = $faq_ref->{'answer'} ;
 253
 254                 my $faq_num = $faq_ref->{'num'} ;
 255                 my $faq_ind = $faq_ref->{'index'} ;
 256
 257                 $quest_list .= <<HTML ;
 258 <LI>$faq_ref->{'link'}
 259 HTML
 260
 261
 262                 $faq_text .= <<HTML ;
 263
 264 <A NAME="FAQ$faq_num"></A>
 265
 266 <H3>$quest</H3>
 267     <BLOCKQUOTE>
 268 $answer
 269     </BLOCKQUOTE>
 270
 271 <DIV CLASS="toplink"><A HREF="#top">Top</A></DIV>
 272
 273 <HR CLASS="sep">
 274
 275 HTML
 276
 277         }
 278
 279         $quest_list .= "</UL>" ;
 280
 281
 282         my $section_list = '<UL STYLE="list-style-type:none">' ;
 283
 284         foreach my $s_ref ( @sections ) {
 285
 286                 $section_list .= <<HTML ;
 287 <LI>$s_ref->{'link'}
 288 HTML
 289
 290                 if ( $s_ref == $sect_ref ) {
 291
 292                         $section_list .= $quest_list ;
 293                 }
 294
 295         }
 296
 297         $section_list .= "</UL>" ;
 298
 299         $page_text .= $section_list ;
 300
 301         $page_text .= $faq_text ;
 302
 303         write_file( "faq$sect_num.html", $page_text ) ;
 304 }
 305
 306
 307 sub set_header_text {
 308
 309         $page_title_base = 'Stem Systems, Inc. &gt; Stem &gt; FAQ'
 310 }
 311
 312
 313 sub write_file {
 314
 315         my( $file_name ) = shift ;
 316
 317         local( *FH ) ;
 318
 319         open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
 320
 321         print FH @_ ;
 322 }
 323
 324
 325
 326 sub markup_text {
 327
 328         my ( $text ) = @_;
 329
 330         map {
 331
 332                 if ($text =~ /$_->{'search'}/s) {
 333
 334                         $text = $_->{'replace'}->($text);
 335                 }
 336
 337         } @markup;
 338
 339         return $text;
 340
 341 }
 342
 343
 344 __END__
 345
 346