Added libraries needed for lintian-style output.

[maemian] / lib / Text_utils.pm

diff --git a/lib/Text_utils.pm b/lib/Text_utils.pm
new file mode 100644 (file)
index 0000000..96e745a
--- /dev/null
+++ b/lib/Text_utils.pm
@@ -0,0 +1,214 @@
+# Hey emacs! This is a -*- Perl -*- script!
+# Text_utils -- Perl utility functions for lintian
+
+# Copyright (C) 1998 Christian Schwarz and Richard Braakman
+#
+# 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, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Text_utils;
+
+use Exporter;
+our @ISA    = qw(Exporter);
+our @EXPORT = qw(split_paragraphs wrap_paragraphs dtml_to_html dtml_to_text);
+
+use strict;
+
+# requires wrap() function
+use Text::Wrap;
+# requires fail() function
+use Util;
+
+# html_wrap -- word-wrap a paragaph.  The wrap() function from Text::Wrap
+# is not suitable, because it chops words that are longer than the line
+# length.
+sub html_wrap {
+    my ($lead, @text) = @_;
+    my @words = split(' ', join(' ', @text));
+    # subtract 1 to compensate for the lack of a space before the first word.
+    my $ll = length($lead) - 1;
+    my $cnt = 0;
+    my $r = "";
+
+    while ($cnt <= $#words) {
+       if ($ll + 1 + length($words[$cnt]) > 76) {
+           if ($cnt == 0) {
+               # We're at the start of a line, and word still does not
+               # fit.  Don't wrap it.
+               $r .= $lead . shift(@words) . "\n";
+           } else {
+               # start new line
+               $r .= $lead . join(' ', splice(@words, 0, $cnt)) . "\n";
+               $ll = length($lead) - 1;
+               $cnt = 0;
+           }
+       } else {
+           $ll += 1 + length($words[$cnt]);
+           $cnt++;
+       }
+    }
+
+    if ($#words >= 0) {
+       # finish last line
+       $r .= $lead . join(' ', @words) . "\n";
+    }
+
+    return $r;
+}
+
+# split_paragraphs -- splits a bunch of text lines into paragraphs.
+# This function returns a list of paragraphs.
+# Paragraphs are separated by empty lines. Each empty line is a
+# paragraph. Furthermore, indented lines are considered a paragraph.
+sub split_paragraphs {
+    return "" unless (@_);
+
+    my $t = join("\n",@_);
+
+    my ($l,@o);
+    while ($t) {
+       $t =~ s/^\.\n/\n/o;
+       # starts with space or empty line?
+       if (($t =~ s/^([ \t][^\n]*)\n?//o) or ($t =~ s/^()\n//o)) {
+           #FLUSH;
+           if ($l) {
+               $l =~ s/\s+/ /go;
+               $l =~ s/^\s+//o;
+               $l =~ s/\s+$//o;
+               push(@o,$l);
+               undef $l;
+           }
+           #
+           push(@o,$1);
+       }
+       # normal line?
+       elsif ($t =~ s/^([^\n]*)\n?//o) {
+           $l .= "$1 ";
+       }
+       # what else can happen?
+       else {
+           fail("internal error in wrap");
+       }
+    }
+    #FLUSH;
+    if ($l) {
+       $l =~ s/\s+/ /go;
+       $l =~ s/^\s+//o;
+       $l =~ s/\s+$//o;
+       push(@o,$l);
+       undef $l;
+    }
+    #
+
+    return @o;
+}
+
+sub dtml_to_html {
+    my @o;
+
+    my $pre=0;
+    for $_ (@_) {
+       s,\&maint\;,<a href=\"mailto:lintian-maint\@debian.org\">Lintian maintainer</a>,o; # "
+       s,\&debdev\;,<a href=\"mailto:debian-devel\@lists.debian.org\">debian-devel</a>,o; # "
+
+       # empty line?
+       if (/^\s*$/o) {
+           if ($pre) {
+               push(@o,"\n");
+           }
+       }
+       # preformatted line?
+       elsif (/^\s/o) {
+           if (not $pre) {
+               push(@o,"<pre>");
+               $pre=1;
+           }
+           push(@o,"$_");
+       }
+       # normal line
+       else {
+           if ($pre) {
+               push(@o,"</pre>");
+               $pre=0;
+           }
+           push(@o,"<p>$_\n");
+       }
+    }
+    if ($pre) {
+       push(@o,"</pre>");
+       $pre=0;
+    }
+
+    return @o;
+}
+
+sub dtml_to_text {
+    for $_ (@_) {
+       # substitute Lintian &tags;
+       s,&maint;,lintian-maint\@debian.org,go;
+       s,&debdev;,debian-devel\@lists.debian.org,go;
+
+       # substitute HTML <tags>
+       s,<i>,&lt;,go;
+       s,</i>,&gt;,go;
+       s,<[^>]+>,,go;
+
+       # substitute HTML &tags;
+       s,&lt;,<,go;
+       s,&gt;,>,go;
+       s,&amp;,\&,go;
+
+       # preformatted?
+       if (not /^\s/o) {
+           # no.
+
+           s,\s\s+, ,go;
+           s,^ ,,o;
+           s, $,,o;
+       }
+    }
+
+    return @_;
+}
+
+# wrap_paragraphs -- wrap paragraphs in dpkg/dselect style.
+# indented lines are not wrapped but displayed "as is"
+sub wrap_paragraphs {
+    my $lead = shift;
+    my $html = 0;
+
+    if ($lead eq 'HTML') {
+       $html = 1;
+       $lead = shift;
+    }
+
+    my $o;
+    for my $t (split_paragraphs(@_)) {
+       # empty or indented line?
+       if ($t =~ /^$/ or $t =~ /^\s/) {
+           $o .= "$lead$t\n";
+       } else {
+           if ($html) {
+               $o .= html_wrap($lead, "$t\n");
+           } else {
+               $o .= wrap($lead, $lead, "$t\n");
+           }
+       }
+    }
+    return $o;
+}
+
+1;