#!/usr/bin/perl # TmNetWiki version 0.4 (September 11, 2002) # Copyright (C) 2002 Adam Brate # # Based on the GPLed UseModWiki 0.92 # Copyright (C) 2000-2001 Clifford A. Adams # or # Based on the GPLed AtisWiki 0.3 (C) 1998 Markus Denker # # ...which was based on # the LGPLed CVWiki CVS-patches (C) 1997 Peter Merel # and The Original WikiWikiWeb (C) Ward Cunningham # (code reused with permission) # Email and ThinLine options by Jim Mahoney # # 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 package Wiki::wiki; use strict; # needs subs Wiki::file: ReadFile # Wiki::template: GetPageOrEditLink, GetPagelink # Wiki::index: AllPagesList # Wiki::utility: QuoteHtml # needs consts $RawHtml # needs vars %SaveUrl, %SaveNumUrl, $SaveUrlIndex, $SaveNumUrlIndex, # %InterSite use base 'Exporter'; use Wiki::consts; use Wiki::file; use Wiki::template; use Wiki::translate; use Wiki::utility; # the following are for the SpecialMarkup use Wiki::index; use Wiki::log; use Wiki::rc; #if ($^V and $^V gt v5.6.0) { # our @EXPORT; #else { use vars qw(@EXPORT); #} @EXPORT = qw( WikiToHTML UrlLink InterPageLink StripUrlPunct CommonMarkup StoreRaw ); sub WikiToHTML; # StoreRaw, QuoteHtml, CommonMarkup, WikiLinesToHtml, # %SaveUrl, $SaveNumUrl, $SaveUrlIndex, # $SaveNumUrlIndex sub WikiLinesToHtml; # CommonMarkup sub CommonMarkup; # SpecialMarkup sub SpecialMarkup; # sub StoreBracketInterPage; # StoreRaw, GetSiteUrl, GetBracketUrlIndex sub StoreInterPage; # StoreRaw, InterPageLink sub StoreUrl; # StoreRaw, UrlLink sub StoreBracketUrl; # StoreRaw, GetBracketUrlIndex sub StoreBracketLink; # StoreRaw, GetPageLinkText sub StorePageOrEditLink; # StoreRaw, GetPageOrEditLink sub StoreRFC; # StoreRaw, RFCLink sub StoreISBN; # StoreRaw, ISBNLink sub StorePre; # StoreRaw sub StoreHref; # StoreRaw sub StoreRaw; # # %SaveUrl, $SaveUrlIndex sub GetBracketUrlIndex; # # %SaveNumUrl, $SaveNumUrlIndex sub GetSiteUrl; # # $InterSiteInit, $InterFile, %InterSite sub InterPageLink; # SplitUrlPunct, GetSiteUrl sub UrlLink; # SplitUrlPunct sub StripUrlPunct; # SplitUrlPunct sub SplitUrlPunct; # sub RFCLink; # sub ISBNLink; # sub WikiHeading; # # ==== Common wiki markup ==== sub WikiToHTML { my ($pageText,$doSpecial) = @_; %SaveUrl = (); %SaveNumUrl = (); $SaveUrlIndex = 0; $SaveNumUrlIndex = 0; $pageText =~ s/$Consts->{FS}//g; # Remove separators (paranoia) $pageText = &DoIncludes($pageText,$doSpecial); if ($RawHtml) { $pageText =~ s/((.|\n)*?)<\/html>/&StoreRaw($1)/ige; } $pageText = &QuoteHtml($pageText); $pageText =~ s/\\ *\r?\n/ /g; # Join lines with backslash at end $pageText = &CommonMarkup($pageText, 1, 0,$doSpecial); # Multi-line markup $pageText = &WikiLinesToHtml($pageText,$doSpecial); # Line-oriented markup $pageText =~ s/$Consts->{FS}(\d+)$Consts->{FS}/$SaveUrl{$1}/ge; # Restore saved text $pageText =~ s/$Consts->{FS}(\d+)$Consts->{FS}/$SaveUrl{$1}/ge; # Restore nested saved text return $pageText; } sub DoIncludes { my ($text,$doSpecial) = @_; if ($doSpecial) { $text =~ s/(?:^|\n)\s*\{INCLUDE ([A-Z]+)(\s+[^}]+)?\}/&DoSpecialMarkup($1,$2)/ge; } else { $text =~ s/(?:^|\n)\s*\{INCLUDE ([A-Z]+)(\s+[^}]+)?\}//g; } return $text; } sub CommonMarkup { my ($text, $useImage, $doLines, $doSpecial) = @_; local $_ = $text; if ($doLines < 2) { # 2 = do line-oriented only # The tag stores text with no markup (except quoting HTML) s/\<nowiki\>((.|\n)*?)\<\/nowiki\>/&StoreRaw($1)/ige; # The 
 tag wraps the stored text with the HTML 
 tag
    s/\<pre\>((.|\n)*?)\<\/pre\>/&StorePre($1, "pre")/ige;
    s/\<code\>((.|\n)*?)\<\/code\>/&StorePre($1, "code")/ige;
    if ($Consts->{HtmlTags}) {
      my ($t);
      foreach $t (@{$Consts->{HtmlPairs}}) {
        s/\<$t(\s[^<>]+?)?\>(.*?)\<\/$t\>/<$t$1>$2<\/$t>/gis;
      }
      foreach $t (@{$Consts->{HtmlSingle}}) {
        s/\<$t(\s[^<>]+?)?\>/<$t$1>/gi;
      }
    } else {
      # Note that these tags are restricted to a single line
      s/\<b\>(.*?)\<\/b\>/$1<\/b>/gi;
      s/\<i\>(.*?)\<\/i\>/$1<\/i>/gi;
      s/\<strong\>(.*?)\<\/strong\>/$1<\/strong>/gi;
      s/\<em\>(.*?)\<\/em\>/$1<\/em>/gi;
    }
    s/\<tt\>(.*?)\<\/tt\>/$1<\/tt>/gis;  #  (MeatBall)
    if ($Consts->{HtmlLinks}) {
      s/\<A(\s[^<>]+?)\>(.*?)\<\/a\>/&StoreHref($1, $2)/gise;
    }
    if ($Consts->{FreeLinks}) {
      # Consider: should local free-link descriptions be conditional?
      # Also, consider that one could write [[Bad Page|Good Page]]?
      s/\[\[$Consts->{FreeLinkPattern}\|([^\]]+)\]\]/&StorePageOrEditLink($1, $2)/geo;
      s/\[\[$Consts->{FreeLinkPattern}\]\]/&StorePageOrEditLink($1, "")/geo;
    }
    if ($Consts->{BracketText}) {  # Links like [URL text of link]
      s/\[$Consts->{UrlPattern}\s+([^\]]+?)\]/&StoreBracketUrl($1, $2)/geos;
      s/\[$Consts->{InterLinkPattern}\s+([^\]]+?)\]/&StoreBracketInterPage($1, $2)/geos;
      if ($Consts->{WikiLinks} && $Consts->{BracketWiki}) {  # Local bracket-links
        s/\[$Consts->{LinkPattern}\s+([^\]]+?)\]/&StoreBracketLink($1, $2)/geos;
      }
    }
    s/\[$Consts->{UrlPattern}\]/&StoreBracketUrl($1, "")/geo;
    s/\[$Consts->{InterLinkPattern}\]/&StoreBracketInterPage($1, "")/geo;
    s/$Consts->{UrlPattern}/&StoreUrl($1, $useImage)/geo;
    s/$Consts->{InterLinkPattern}/&StoreInterPage($1)/geo;
    if ($Consts->{WikiLinks}) {
      s/$Consts->{LinkPattern}/&GetPageOrEditLink($1, "")/geo;
    }
    s/$Consts->{RFCPattern}/&StoreRFC($1)/geo;
    s/$Consts->{ISBNPattern}/&StoreISBN($1,$2)/geo;
    if ($Consts->{ThinLine}) {
      s/----+/
/g;
      s/====+/
/g;
    } else {
      s/----+/
/g;
    }
  }
  if ($doLines) { # 0 = no line-oriented, 1 or 2 = do line-oriented
    # The quote markup patterns avoid overlapping tags (with 5 quotes)
    # by matching the inner quotes for the strong pattern.
    s/('*)'''(.*?)'''/$1$2<\/strong>/g;
    s/''(.*?)''/$1<\/em>/g;
    if ($Consts->{UseHeadings}) {
      s/(^|\n)\s*(\=+)\s+([^\n]+)\s+\=+/&WikiHeading($1, $2, $3)/geo;
    }
    if ($doSpecial) {
    # Special Markup - right now INDEX, LOGGER, SEARCH implemented
      s/(?:^|\n)\s*\{([A-Z]+)(\s+[^}]+)?\}/&DoSpecialMarkup($1,$2)/gei;
    } else {
      s/(?:^|\n)\s*\{([A-Z]+)(\s+[^}]+)?\}//gi;
    }
  }
  return $_;
}

=head1 sub DoSpecialMarkup

takes $command, $opt, where $command is INDEX, SEARCH, LOGGER, RC
and $opt is of the form "opt1 opt2=x opt3" etc.

{INDEX [nodates] [nosubpages] [noredirect]}
returns list of page links

{SEARCH}
returns a search box

{LOGGER [id=#]}
returns the output of logger

{RC [lastnum=#] [noheader] [nodaysheader] [style=min|normal]}
returns Recent Changes display

=cut

sub DoSpecialMarkup {
    my ($command,$opt) = @_;
    my %options;
    for (split(/\s+/,$opt)) {
        if (/(\w+)=(\w+)/) {
            $options{lc($1)} = $2;
        } elsif (/^(\w+)$/) {
            $options{lc($1)} = 1;
        }
    }
    
    # {INDEX [nodates] [nosubpages] [noredirect]}
    # returns list of page links
    if ($command eq 'INDEX') {
        my @list = &AllPagesList(\%options);
#	my @r = @list;
#	my @testlist;
#	for my $i (0..$#r) {
#	    for my $j (0..length $r[$i]) {
#		my $a = substr $r[$i-1],0,$j;
#		my $b = substr $r[$i],0,$j;
#		my $c = substr $r[$i+1],0,$j;
#		if ((($b ne $a) && ($b ne $c)) || ($j == length $r[$i])) {
#		    push @testlist, $b;
#		    last;
#		}
#	    }
#	}

#	my @final;
#	for my $i (0..$#testlist) {
#	    push @final,join " - ",($testlist[$i],$testlist[++$i]);
#	}
#	return join " | ",@final;
#	my $divno = 26;
#	my $div = $#list / $divno;
#	my ($start, $end,@sortlist);
#	for my $i (0..$divno) {
#	    $start = &GetPageLink($list[$i*$div]);
#	    $end = &GetPageLink($list[($i+1)*$div -1]);
#	    push @sortlist, "$start - $end";
#	}
        @list = map(&GetPageLink($_), @list);
        return join ("
",@list); #@sortlist);
    }
    if ($command eq 'LOGGER') {
	return &DoLog(\%options);
    }
    if ($command eq 'SEARCH') {
	return &GetFormStart() . &GetSearchForm(\%options) . $q->endform();
    }
# {RC [lastnum=#] [noheader] [nodaysheader] [style=min|normal]}
    if ($command eq 'RC') {
	return &GetRc(\%options);
    }
}

sub WikiLinesToHtml {
  my ($pageText,$doSpecial) = @_;
  my ($pageHtml, @htmlStack, $code, $depth, $oldCode);

  @htmlStack = ();
  $depth = 0;
  $pageHtml = "";
  foreach (split(/\n/, $pageText)) {  # Process lines one-at-a-time
    $_ .= "\n";
    if (s/^(\;+)([^:]+\:?)\:/
$2
/) {
      $code = "DL";
      $depth = length $1;
    } elsif (s/^(\:+)/
/) {
      $code = "DL";
      $depth = length $1;
    } elsif (s/^(\*+)/
  • /) {
      $code = "UL";
      $depth = length $1;
    } elsif (s/^(\#+)/
  • /) {
      $code = "OL";
      $depth = length $1;
    } elsif (/^[ \t].*\S/) {
      $code = "PRE";
      $depth = 1;
    } else {
      $depth = 0;
    }
    while (@htmlStack > $depth) {   # Close tags as needed
      $pageHtml .=  "\n";
    }
    if ($depth > 0) {
      $depth = $Consts->{IndentLimit}  if ($depth > $Consts->{IndentLimit});
      if (@htmlStack) {  # Non-empty stack
        $oldCode = pop(@htmlStack);
        if ($oldCode ne $code) {
          $pageHtml .= "<$code>\n";
        }
        push(@htmlStack, $code);
      }
      while (@htmlStack < $depth) {
        push(@htmlStack, $code);
        $pageHtml .= "<$code>\n";
      }
    }
    s/^\s*$/
    \n/;                        # Blank lines become 
     tags
    $pageHtml .= &CommonMarkup($_, 1, 2,$doSpecial);  # Line-oriented common markup
  }
  while (@htmlStack > 0) {       # Clear stack
    $pageHtml .=  "\n";
  }
  return $pageHtml;
}

sub QuoteHtml {
  my ($html) = @_;

  $html =~ s/&/&/g;
  $html =~ s//>/g;
  if (1) {   # Make an official option?
    $html =~ s/&([#a-zA-Z0-9]+);/&$1;/g;  # Allow character references
  }
  return $html;
}

sub StoreInterPage {
  my ($id) = @_;
  my ($link, $extra);

  ($link, $extra) = &InterPageLink($id);
  # Next line ensures no empty links are stored
  $link = &StoreRaw($link)  if ($link ne "");
  return $link . $extra;
}

sub InterPageLink {
  my ($id) = @_;
  my ($name, $site, $remotePage, $url, $punct);

  ($id, $punct) = &SplitUrlPunct($id);

  ($name = $id) =~ s/_|\+/ /g; # replace underscores and spaces with spaces
  $name =~ s/\:/: /; # add a space after the colon
  ($site, $remotePage) = split(/:/, $id, 2);
  $url = &GetSiteUrl($site);
  return ("", $id . $punct)  if ($url eq "");
  $remotePage =~ s/&/&/g;  # Unquote common URL HTML
  $url .= $remotePage;
  return ("$name", $punct);
}

# I don't really like the bracket.
sub StoreBracketInterPage {
  my ($id, $text) = @_;
  my ($site, $remotePage, $url, $index);

  ($site, $remotePage) = split(/:/, $id, 2);
  $remotePage =~ s/&/&/g;  # Unquote common URL HTML
  $url = &GetSiteUrl($site);
  if ($text ne "") {
    return "[$id $text]"  if ($url eq "");
  } else {
    return "[$id]"  if ($url eq "");
    $text = &GetBracketUrlIndex($id);
  }
  $url .= $remotePage;
  return &StoreRaw("$text");
}

sub GetBracketUrlIndex {
  my ($id) = @_;
  my ($index, $key);

  # Consider plain array?
  if ($SaveNumUrl{$id} > 0) {
    return $SaveNumUrl{$id};
  }
  $SaveNumUrlIndex++;  # Start with 1
  $SaveNumUrl{$id} = $SaveNumUrlIndex;
  return $SaveNumUrlIndex;
}

sub GetSiteUrl {
  my ($site) = @_;
  my ($data, $url, $status);

  if (!$InterSiteInit) {
    $InterSiteInit = 1;
    ($status, $data) = &ReadFile($InterFile);
    return ""  if (!$status);
    %InterSite = split(/\s+/, $data);  # Later consider defensive code
  }
  $url = $InterSite{$site}  if (defined($InterSite{$site}));
  return $url;
}

sub StoreRaw {
  my ($html) = @_;

  $SaveUrl{$SaveUrlIndex} = $html;
  return $Consts->{FS} . $SaveUrlIndex++ . $Consts->{FS};
}

sub StorePre {
  my ($html, $tag) = @_;

  return &StoreRaw("<$tag>" . $html . "");
}

sub StoreHref {
  my ($anchor, $text) = @_;

  return "$text";
}

sub StoreUrl {
  my ($name, $useImage) = @_;
  my ($link, $extra);

  ($link, $extra) = &UrlLink($name, $useImage);
  # Next line ensures no empty links are stored
  $link = &StoreRaw($link)  if ($link ne "");
  return $link . $extra;
}

sub UrlLink {
  my ($rawname, $useImage) = @_;
  my ($name, $printname, $punct);
  ($name, $punct) = &SplitUrlPunct($rawname);
  # Hide the protocol.
  ($printname = $name) =~ s!^(?:$Consts->{UrlProtocols})\:\/?\/?!!;
  if ($Consts->{NetworkFile} && $name =~ m|^file:|) {
    # Only do remote file:// links. No file:///c|/windows.
    if ($name =~ m|^file://[^/]|) {
      return ("$printname", $punct);
    }
    return $rawname;
  }
  # Restricted image URLs so that mailto:foo@bar.gif is not an image
  if ($useImage && ($name =~ /^(http:|https:|ftp:).+\.$Consts->{ImageExtensions}$/i)) {
    return ("", $punct);
  }
  return ("$printname", $punct);
}

# I don't really like the bracket, so no bracket if $text is given
sub StoreBracketUrl {
  my ($url, $text) = @_;

  if ($text eq "") {
      $text = &GetBracketUrlIndex($url);
  } else {
      $text = &CommonMarkup($text,1,2);
  }
  return &StoreRaw("$text");
}

sub StoreBracketLink {
  my ($name, $text) = @_;

  return &StoreRaw(&GetPageLinkText($name, "[$text]"));
}

sub StorePageOrEditLink {
  my ($page, $name) = @_;

  if ($Consts->{FreeLinks}) {
    $page =~ s/^\s+//;      # Trim extra spaces
    $page =~ s/\s+$//;
    $page =~ s|\s*/\s*|/|;  # ...also before/after subpages
  }
  $name =~ s/^\s+//;
  $name =~ s/\s+$//;
  return &StoreRaw(&GetPageOrEditLink($page, $name));
}

sub StoreRFC {
  my ($num) = @_;

  return &StoreRaw(&RFCLink($num));
}

sub RFCLink {
  my ($num) = @_;

  return "RFC $num";
}

sub StoreISBN {
  my ($type,$num) = @_;

  return &StoreRaw(&ISBNLink($type,$num));
}

sub ISBNLink {
  my ($type,$rawnum) = @_;
  my ($rawprint, $html, $num, $first, $second, $third,$amznaccount); 

  $num = $rawnum;
  $rawprint = $rawnum;
  $rawprint =~ s/ +$//;
  $num =~ s/[- ]//g;
  if (length($num) != 10) {
    return "$type $rawnum";
  }
  $amznaccount = $Consts->{AmznAccount} ? "/$Consts->{AmznAccount}" : "";
  $second  = "" . T('B&N'). "";
  $first = "" ;
  $third  = "" . T('Pricescan') . "";
  my $image = ''.$type.' '.$num.'';
 $html  = $first . "$type " . $rawprint . " $image";
  $html .= "($second, $third)";
  $html = $first . $image .'';
  $html .= " "  if ($rawnum =~ / $/);  # Add space if old ISBN had space.
  return $html;
}

# Makes sure Url doesn't have any trailing punctuation
sub SplitUrlPunct {
  my ($url) = @_;
  my ($punct);

  if ($url =~ s/\"\"$//) {
    return ($url, "");   # Delete double-quote delimiters here
  }
  ($punct) = ($url =~ /((?:[^a-zA-Z0-9\/\xc0-\xff]|\>)+)$/);
  $url =~ s/((?:[^a-zA-Z0-9\/\xc0-\xff]|\>)+)$//;
  return ($url, $punct);
}

sub StripUrlPunct {
  my ($url) = @_;
  my ($junk);

  ($url, $junk) = &SplitUrlPunct($url);
  return $url;
}

sub WikiHeading {
  my ($pre, $depth, $text) = @_;

  $depth = length($depth);
  $depth = 6  if ($depth > 6);
  return $pre . "$text\n";
}

1;