diff options
Diffstat (limited to 'lib/Text')
-rw-r--r-- | lib/Text/MarkdownBook/Book.pm | 264 | ||||
-rw-r--r-- | lib/Text/MarkdownBook/Document.pm | 245 | ||||
-rw-r--r-- | lib/Text/MarkdownBook/Document/html.pm | 154 | ||||
-rw-r--r-- | lib/Text/MarkdownBook/Document/txt.pm | 46 | ||||
-rw-r--r-- | lib/Text/MarkdownBook/HTMLTree.pm | 44 | ||||
-rw-r--r-- | lib/Text/MarkdownBook/Section.pm | 67 |
6 files changed, 820 insertions, 0 deletions
diff --git a/lib/Text/MarkdownBook/Book.pm b/lib/Text/MarkdownBook/Book.pm new file mode 100644 index 0000000..4c49d1d --- /dev/null +++ b/lib/Text/MarkdownBook/Book.pm @@ -0,0 +1,264 @@ +# Copyright (C) 2012 Patrick "P. J." McDermott +# +# 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 3 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, see <http://www.gnu.org/licenses/>. + +use strict; +use warnings; + +use Carp; + +package Text::MarkdownBook::Book; + +sub new +{ + my ($class, $format, $dir) = @_; + my $self; + my $control_fh; + + $class = ref($class) || $class; + $self = {}; + bless($self, $class); + + unless ($format =~ m/^[a-z]+/) { + Carp::croak('Invalid format "' . $format . '"'); + } + eval { + require 'Text/MarkdownBook/Document/' . $format . '.pm'; + 1; + } or Carp::croak('Unsupported format "' . $format . '"'); + $self->{'format'} = $format; + + $self->{'dir'} = $dir; + $self->{'docs'} = []; + $self->{'sections'} = []; + $self->{'sections_by_id'} = {}; + + open($control_fh, '<', $dir . '/control'); + while (<$control_fh>) { + chomp($_); + if (m/^Title: /) { + s/^Title: (.*)$/$1/; + $self->{'title'} = $_; + } + } + close($control_fh); + + $self->create_documents(); + + return $self; +} + +sub dir +{ + my ($self, $dir) = @_; + my $old = $self->{'dir'}; + + $self->{'dir'} = $dir if defined($dir); + + return $old; +} + +sub title +{ + my ($self, $title) = @_; + my $old = $self->{'title'}; + + $self->{'title'} = $title if defined($title); + + return $old; +} + +sub documents +{ + my ($self, $documents) = @_; + my $old = $self->{'docs'}; + + $self->{'docs'} = $documents if defined($documents); + + return $old; +} + +sub _get_document_module +{ + my ($self) = @_; + + return 'Text::MarkdownBook::Document::' . $self->{'format'}; +} + +sub create_documents +{ + my ($self) = @_; + my $series_fh; + my $file; + my $title; + my $i; + my $doc; + my $doc_prev; + my @letters; + + # Create index document. + $doc = $self->_get_document_module()->new($self, 'index', 'index', + undef, $self->{'title'}); + $doc_prev = $doc; + push(@{$self->{'docs'}}, $doc); + + # Create chapter documents. + $i = 0; + open($series_fh, '<', $self->{'dir'} . '/chapters') + or Carp::croak('Cannot open chapters file'); + while (<$series_fh>) { + chomp($_); + ($file, $title) = split(/[ \t]+/, $_, 2); + $doc = $self->_get_document_module()->new($self, 'chapter', $file, + ++$i, $title); + $doc->prev($doc_prev); + $doc_prev->next($doc) if defined $doc_prev; + $doc_prev = $doc; + push(@{$self->{'docs'}}, $doc); + } + close($series_fh); + + # Create appendix documents. + $i = -1; + @letters = ('A' .. 'Z'); + if (-e $self->{'dir'} . '/appendices') { + open($series_fh, '<', $self->{'dir'} . '/apendices') + or Carp::croak('Cannot open appendices file'); + while (<$series_fh>) { + chomp($_); + ($file, $title) = split(/[ \t]+/, $_, 2); + $doc = $self->_get_document_module()->new($self, 'appendix', $file, + $letters[++$i], $title); + $doc->prev($doc_prev); + $doc_prev->next($doc) if defined $doc_prev; + $doc_prev = $doc; + push(@{$self->{'docs'}}, $doc); + } + close($series_fh); + } +} + +sub add_section +{ + my ($self, $section) = @_; + + push(@{$self->{'sections'}}, $section); + + # Index sections (not documents) by ID. + if (ref($section) eq 'Text::MarkdownBook::Section') { + $self->{'sections_by_id'}->{$section->id()} = $section; + } +} + +sub subst_macros +{ + my ($self, $text) = @_; + + # Substitute macros with arguments. + $text =~ s/ + \$ # Dollar sign + \[ # Left square bracket + ([^\]]+) # Macro + \] # Right square bracket + ( + \[ # Left square bracket + ([^\]]+) # Macro arguments + \] # Right square bracket + ) + /$self->_do_subst_macro($1, split(m@[ \t]+@, $3))/exg; + + # Substitute macros without arguments. + $text =~ s/ + \$ # Dollar sign + \[ # Left square bracket + ([^\]]+) # Macro + \] # Right square bracket + /$self->_do_subst_macro($1)/exg; + + return $text; +} + +sub _do_subst_macro +{ + my ($self, $macro, @args) = @_; + my $sec; + + if ($macro eq 'toc') { + return $self->_do_gen_toc(); + } elsif ($macro eq 'sectlink') { + if (@args != 1) { + Carp::carp('Invalid arguments to "sectlink" macro'); + } else { + $sec = $self->{'sections_by_id'}->{$args[0]}; + return '[ยง ' . $sec->number() . '][' . $sec->id() . ']'; + } + } else { + Carp::carp("Unrecognized macro \"$macro\""); + } +} + +sub _do_gen_toc +{ + my ($self) = @_; + my $section; + my $toc = ''; + + foreach $section (@{$self->{'sections'}}) { + $toc .= "\n" if $toc ne ''; + if (ref($section) =~ m/^Text::MarkdownBook::Document/) { + next if $section->type() eq 'index'; + $toc .= ' * ['; + $toc .= $section->id(); + $toc .= ' '; + $toc .= $section->title(); + $toc .= ']['; + $toc .= $section->file(); + $toc .= ']'; + } elsif (ref($section) eq 'Text::MarkdownBook::Section') { + $toc .= ' ' x $section->level(); + $toc .= ($section->level() == 1 ? ' - [' : ' * ['); + $toc .= $section->number(); + $toc .= ' '; + $toc .= $section->title(); + $toc .= ']['; + $toc .= $section->id(); + $toc .= ']'; + } + } + + return $toc; +} + +sub parse +{ + my ($self) = @_; + my $doc; + + foreach $doc (@{$self->{'docs'}}) { + $self->add_section($doc); + $doc->parse(); + } +} + +sub output +{ + my ($self) = @_; + my $doc; + + foreach $doc (@{$self->{'docs'}}) { + $doc->output(); + } +} + +1; diff --git a/lib/Text/MarkdownBook/Document.pm b/lib/Text/MarkdownBook/Document.pm new file mode 100644 index 0000000..af16be4 --- /dev/null +++ b/lib/Text/MarkdownBook/Document.pm @@ -0,0 +1,245 @@ +# Copyright (C) 2012 Patrick "P. J." McDermott +# +# 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 3 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, see <http://www.gnu.org/licenses/>. + +use strict; +use warnings; + +use Text::MarkdownBook::Section; +use Carp; + +package Text::MarkdownBook::Document; + +sub new +{ + my ($class, $book, $type, $file, $id, $title) = @_; + my $self; + + $class = ref($class) || $class; + $self = {}; + bless($self, $class); + + $self->{'book'} = $book; + $self->{'type'} = $type; + $self->{'file'} = $file; + $self->{'id'} = $id; + $self->{'title'} = $title; + + return $self; +} + +sub book +{ + my ($self, $book) = @_; + my $old = $self->{'book'}; + + $self->{'book'} = $book if defined($book); + + return $old; +} + +sub type +{ + my ($self, $type) = @_; + my $old = $self->{'type'}; + + $self->{'type'} = $type if defined($type); + + return $old; +} + +sub file +{ + my ($self, $file) = @_; + my $old = $self->{'file'}; + + $self->{'file'} = $file if defined($file); + + return $old; +} + +sub file_path +{ + my ($self) = @_; + + return $self->{'book'}->dir() . '/' . $self->{'file'}; +} + +sub id +{ + my ($self) = @_; + + return $self->{'id'}; +} + +sub title +{ + my ($self, $title) = @_; + my $old = $self->{'title'}; + + $self->{'title'} = $title if defined($title); + + return $old; +} + +sub full_title +{ + my ($self) = @_; + + if ($self->{'type'} eq 'chapter') { + return sprintf('Chapter %d - %s', $self->{'id'}, $self->{'title'}); + } elsif ($self->{'type'} eq 'appendix') { + return sprintf('Appendix %s - %s', $self->{'id'}, $self->{'title'}); + } else { + return undef; + } +} + +sub prev +{ + my ($self, $other) = @_; + my $old = $self->{'prev'}; + + $self->{'prev'} = $other if defined($other); + + return $old; +} + +sub next +{ + my ($self, $other) = @_; + my $old = $self->{'next'}; + + $self->{'next'} = $other if defined($other); + + return $old; +} + +sub sections +{ + my ($self) = @_; + + # FIXME: Why is this necessary?! + foreach my $sec (@{$self->{'sections'}}) { + } + + return $self->{'sections'}; +} + +sub parse +{ + my ($self) = @_; + my $source_fh; + my $source_text; + + open($source_fh, '<', + $self->{'book'}->dir() . '/' . $self->{'file'} . '.mdwn') + or Carp::croak('Cannot open "' . $self->{'file'} . '" source document'); + $source_text = join('', <$source_fh>); + close($source_fh); + + # Parse headings of non-index documents. + if ($self->{'type'} ne 'index') { + $self->{'section_level_numbers'} = [0, 0]; + $self->{'section_level'} = -1; + $source_text =~ s/ + ^ + (.+) # Heading text + [ \t]* # Optional trailing whitespace + \n # Line break + (=+|-+) # Underline + [ \t]* # Optional trailing whitespace + $ + /$self->_do_heading($1, $2)/mexg; + } + + # Store parsed text. + $self->{'source_text'} = $source_text; +} + +sub _do_heading +{ + my ($self, $text, $underline) = @_; + my $level; + my $levels; + my $section_number; + my $section_title; + my $section_id; + my $section; + + # Shorten underline to one character. + $underline =~ s/^([=-]).*$/$1/; + + # Detect heading level. + if ($underline eq '=') { + $level = 1; + } else { + $level = 2; + } + + # Calculate section number. + $levels = $#{$self->{'section_level_numbers'}}; + if ($level != $self->{'section_level'}) { + foreach (@{$self->{'section_level_numbers'}}[$level .. $levels]) { + $_ = 0; + } + } + $self->{'section_level'} = $level; + ++${$self->{'section_level_numbers'}}[$level - 1]; + $section_number = join('.', @{$self->{'section_level_numbers'}}); + + # Add document ID to section number. + $section_number = $self->{'id'} . '.' . $section_number; + + # Trim off unused subsection parts. + $section_number =~ s/(?:\.0)*$//; + + # Parse out section title. + $section_title = $text; + $section_title =~ s/ + ^ + ([^\[]+) # Section title + [ \t]+ # Whitespace + \[ # Left square bracket + [^\]]+ # Section ID + \] # Right square bracket + $ + /$1/x; + + # Parse out section ID. + $section_id = $text; + $section_id =~ s/ + ^ + [^\[\]]+ # Section title + [ \t]+ # Whitespace + \[ # Left square bracket + ([^\]]+) # Section ID + \] # Right square bracket + $ + /$1/x; + + # Create and store section object. + $section = Text::MarkdownBook::Section->new($self, + $level, $section_number, $section_id, $section_title); + push(@{$self->{'sections'}}, $section); + $self->{'book'}->add_section($section); + + # Prepend number to section title. + $text = $section_number . ' ' . $section_title; + + # Return underlined section title. + return $text . "\n" . $underline x length($text); +} + +1; diff --git a/lib/Text/MarkdownBook/Document/html.pm b/lib/Text/MarkdownBook/Document/html.pm new file mode 100644 index 0000000..e074de0 --- /dev/null +++ b/lib/Text/MarkdownBook/Document/html.pm @@ -0,0 +1,154 @@ +# Copyright (C) 2012 Patrick "P. J." McDermott +# +# 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 3 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, see <http://www.gnu.org/licenses/>. + +use strict; +use warnings; + +use Text::MarkdownBook::Document; +use Text::MarkdownBook::HTMLTree; +use Carp; +use Text::Markdown; +use HTML::TreeBuilder; +use HTML::Template; + +package Text::MarkdownBook::Document::html; + +our @ISA = qw(Text::MarkdownBook::Document); + +sub output +{ + my ($self) = @_; + my $text; + my $doc; + my $sec; + + # Substitute macros. + $text = $self->{'book'}->subst_macros( + $self->{'source_text'}); + + # Append link definitions. + $text .= "\n"; + foreach $doc (@{$self->{'book'}->documents()}) { + $text .= "\n"; + $text .= '['; + $text .= $doc->file(); + $text .= ']: '; + $text .= $doc->file(); + $text .= '.html'; + foreach $sec (@{$doc->sections()}) { + $text .= "\n"; + $text .= '['; + $text .= $sec->id(); + $text .= ']: '; + $text .= $doc->file(); + $text .= '.html#'; + $text .= $sec->id(); + } + } + + # Convert to HTML. + $text = Text::Markdown::Markdown($text); + + # Set "id" attributes of headings. + $self->_do_set_heading_id_attrs($text); + + # Output the templated HTML. + $self->_do_output_template(); + + # Clean up. + $self->{'tree'}->delete(); +} + +sub _do_set_heading_id_attrs +{ + my ($self, $text) = @_; + my @headings; + my $heading; + my $i = -1; + + # Parse HTML. + $self->{'tree'} = HTML::TreeBuilder->new(); + $self->{'tree'}->parse($text); + $self->{'tree'}->eof($text); + + # Find the "body" element. + @{$self->{'tree_body'}} = + Text::MarkdownBook::HTMLTree::find_elements_by_tag_names( + $self->{'tree'}, ('body')); + + # Don't modify headings of index documents. + return if $self->{'type'} eq 'index'; + + # Find all headings. + @headings = Text::MarkdownBook::HTMLTree::find_elements_by_tag_names( + @{$self->{'tree_body'}}[0], ('h1', 'h2')); + + # Set "id" attributes. + foreach $heading (@headings) { + $heading->attr('id', ${$self->{'sections'}}[++$i]->id()); + } +} + +sub _do_output_template +{ + my ($self) = @_; + + my $doc_tmpl; + my %opt_end_tags; + my $elem; + my $body; + my $doc_fh; + + $doc_tmpl = HTML::Template->new(filename => 'include/document.tmpl'); + + # Don't omit any end tags. + %opt_end_tags = map([$_ => 0], %HTML::Element::optionalEndTag); + + # Get HTML text of all children of the "body" element. + foreach $elem (@{$self->{'tree_body'}}[0]->content_list()) { + # It's safe to assume (ref($elem) eq 'HTML::Element'). + $body .= $elem->as_HTML('<>&', '', \%opt_end_tags) . "\n"; + } + + $doc_tmpl->param(IS_INDEX => ($self->{'type'} eq 'index')); + + $doc_tmpl->param(BOOK_TITLE => $self->{'book'}->title()); + $doc_tmpl->param(TITLE => $self->{'title'}); + $doc_tmpl->param(CHAPT_TITLE => $self->full_title()); + + if (defined($self->{'prev'})) { + $doc_tmpl->param(PREV_LINK => $self->{'prev'}->file() . '.html'); + $doc_tmpl->param(PREV_TITLE => $self->{'prev'}->title()); + } else { + $doc_tmpl->param(PREV_LINK => undef); + $doc_tmpl->param(PREV_TITLE => undef); + } + if (defined($self->{'next'})) { + $doc_tmpl->param(NEXT_LINK => $self->{'next'}->file() . '.html'); + $doc_tmpl->param(NEXT_TITLE => $self->{'next'}->title()); + } else { + $doc_tmpl->param(NEXT_LINK => undef); + $doc_tmpl->param(NEXT_TITLE => undef); + } + + $doc_tmpl->param(BODY => $body); + + open($doc_fh, '>', $self->file_path() . '.html') + or Carp::croak('Cannot open "' . $self->{'file'} . '" destination document'); + $doc_tmpl->output(print_to => $doc_fh); + close($doc_fh); +} + +1; diff --git a/lib/Text/MarkdownBook/Document/txt.pm b/lib/Text/MarkdownBook/Document/txt.pm new file mode 100644 index 0000000..f2a8a77 --- /dev/null +++ b/lib/Text/MarkdownBook/Document/txt.pm @@ -0,0 +1,46 @@ +# Copyright (C) 2012 Patrick "P. J." McDermott +# +# 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 3 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, see <http://www.gnu.org/licenses/>. + +use strict; +use warnings; + +use Text::MarkdownBook::Document; +use Carp; + +package Text::MarkdownBook::Document::txt; + +our @ISA = qw(Text::MarkdownBook::Document); + +sub output +{ + my ($self) = @_; + my $out_fh; + + open($out_fh, '>', + $self->{'book'}->dir() . '/' . $self->{'file'} . '.txt') + or Carp::croak('Cannot open "' . $self->{'file'} . + '" destination document'); + + # Print document title. + print($out_fh $self->{'title'} . "\n" . + '*' x length($self->{'title'}) . "\n\n\n"); + + # Print document text with macro substitutions. + print($out_fh $self->{'book'}->subst_macros($self->{'source_text'})); + + close($out_fh); +} + +1; diff --git a/lib/Text/MarkdownBook/HTMLTree.pm b/lib/Text/MarkdownBook/HTMLTree.pm new file mode 100644 index 0000000..6080475 --- /dev/null +++ b/lib/Text/MarkdownBook/HTMLTree.pm @@ -0,0 +1,44 @@ +# Copyright (C) 2012 Patrick "P. J." McDermott +# +# 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 3 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, see <http://www.gnu.org/licenses/>. + +use strict; +use warnings; + +use HTML::Element; + +package Text::MarkdownBook::HTMLTree; + +sub find_elements_by_tag_names +{ + my ($elem, @tagnames) = @_; + + my @list = $elem->content_list(); + my $tag; + my @retlist = (); + + foreach (@list) { + if (ref($_) ne 'HTML::Element') { + next; + } + $tag = $_->tag(); + if (grep($_ eq $tag, @tagnames)) { + push(@retlist, $_); + } + } + + return @retlist; +} + +1; diff --git a/lib/Text/MarkdownBook/Section.pm b/lib/Text/MarkdownBook/Section.pm new file mode 100644 index 0000000..75e13b8 --- /dev/null +++ b/lib/Text/MarkdownBook/Section.pm @@ -0,0 +1,67 @@ +# Copyright (C) 2012 Patrick "P. J." McDermott +# +# 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 3 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, see <http://www.gnu.org/licenses/>. + +use strict; +use warnings; + +package Text::MarkdownBook::Section; + +sub new +{ + my ($class, $doc, $lev, $num, $id, $title) = @_; + my $self; + + $class = ref($class) || $class; + $self = {}; + bless($self, $class); + + $self->{'document'} = $doc; + $self->{'level'} = $lev; + $self->{'number'} = $num; + $self->{'id'} = $id; + $self->{'title'} = $title; + + return $self; +} + +sub level +{ + my ($self) = @_; + + return $self->{'level'}; +} + +sub number +{ + my ($self) = @_; + + return $self->{'number'}; +} + +sub id +{ + my ($self) = @_; + + return $self->{'id'}; +} + +sub title +{ + my ($self) = @_; + + return $self->{'title'}; +} + +1; |