=pod

=head1 NAME

Wala.pm - easy minimalist wiki

=head1 SYNOPSIS

As a standalone wiki app:

    #!/usr/bin/perl
    use Wala;
    my $w = Wala->new;
    $w->run;

Pulling content into other scripts:

    $text = $w->print_page('SandBox');

=head1 DESCRIPTION

This is a Wala, which is a derivation of a wiki that incorporates appending
text directly to pages, turning a wiki into something more like a forum while
retaining all the wonderful full-page editing features of a wiki.

=head1 INSTALLATION

This script is a self-contained package, which makes the code easy to test.
To actually use it as a wala, create a script named "wala.pl" in the same
directory, containing the following three lines:

    #!/usr/bin/perl
    use Wala;
    my $w = Wala->new();
    $w->run;

You can experiment with the wala by use'ing it and calling its functions
without calling "run".  By default, required directories and files should
be created as needed, but you can visit wala.pl?setup in your browser,
or call C<setup()> from a script at any time.

=head2 CONFIGURATION

You can set options directly from the calling script, like so:

    #!/usr/bin/perl
    use Wala;

    my $w = Wala->new(
        RecentChangesMaxLines => 50,  # Max lines to display in RecentChanges
        DefaultUserName       => 'Anonymous',  # Default user name
        StyleSheet            => 'wala.css',  # URL of style sheet
        DefaultPageText       => "Write something.\n",
        CookieSurvivalDays    => 90,  # Number of days for cookies to remain
        RootDir               => '.', # No trailing slash, please
        HomePage              => 'HomePage', # Name of default page
        TimeZone              => 'UTC', # Currently just a string to display
        TitleString           => 'wala::', # Display before page names in titles
        ScriptName            => 'wala.pl',
        ShowSearchlinks       => 1, # Display "see also" box on pages
        LogRelatedLinks       => 1, # Log related links for a given change.
        CheckSetup            => 1, # Check for setup files every time
        UseCache              => 0, # Don't use caching behavior
        NoCache               => qr/^([A-Z]|PageIndex|RecentChanges|HomePage|PageChangeTimes)$/x,
    );

    $w->run;

=head2 FEEDS

Feeds are practically a requirement these days. While it wouldn't be the
hardest thing in the world to roll my own Atom or RSS within Wala.pm, it was
much less painful to look to CPAN, which offers XML::Atom::SimpleFeed.

I've included a simple wala_feed.pl, which relies on the aforementioned
module.  It shouldn't be too hard to customize.

If you do something along the lines of:

    FeedURL => 'http://p1k3.com/wala/wala_feed.pl',

in your configuration, Wala.pm will link to your feed in page headers so that
browsers like Firefox will auto-discover it.

=head1 LICENSE

No warranty of any kind is made regarding this software's fitness or
suitability for any purpose. The authors explicitly disclaim any liability or
responsibility for the results of its use.

This software is dedicated to the public domain.  In any jurisdiction where a
dedication to the public domain is not permitted by law, the authors grant you
a perpetual, non-exclusive license to modify and/or redistribute the software
in any medium, world-wide, forever and ever.

Though there is no legal requirement, credit would be appreciated.

=head1 AUTHORS

Wala was originally written by Brent P. Newhall. This version contains
substantial modifications by Brennen Bearnes; following Brent's lead, all
changes are placed in the public domain. Egregious bugs are probably Brennen's
fault.

=head1 REVISION

 Brennen's version, branched from Brent's at 1.1.4

 $Id$

=cut

package Wala;

use strict;
use warnings;
no  warnings 'uninitialized';

use Fcntl qw(:flock);
use POSIX qw(strftime);

use base 'MethodSpit';
use Wala::Markup;
use Wala::Editor;

# Default configuration:
my %WalaConf = (
    RecentChangesMaxLines => 50,  # Max lines to display in RecentChanges
    DefaultUserName       => 'Anonymous',  # Default user name
    StyleSheet            => 'wala.css',  # URL of style sheet
    DefaultPageText       => "Write something.\n",
    CookieSurvivalDays    => 90,  # Number of days for cookies to remain
    RootDir               => '.', # No trailing slash, please
    HomePage              => 'HomePage', # Name of default page
    TimeZone              => 'UTC', # Currently just a string to display
    TitleString           => 'wala::', # Display before page names in titles
    ScriptName            => 'wala.pl', # substr( $0, rindex( $0, "/" ) + 1 );
    ShowSearchlinks       => 1, # Display "see also" box on pages
    CheckSetup            => 1, # Check for setup files every time
    UseCache              => 0, # Don't use caching behavior
    NoCache               => qr/^([A-Z]|PageIndex|RecentChanges|HomePage
                                  |PageChangeTimes)$/x,
    LogRelatedLinks       => 1, # Log related links for a given change.
    DisplayRootDir        => undef,
    DisplayURL            => undef,
    TestMode              => undef,
    FeedURL               => undef,
    cookies               => undef,
    parameters            => undef,
);

# (Relatively) cheap custom method generation.

# Simple accessors:
__PACKAGE__->methodspit(keys %WalaConf);

# Accessors which depend on RootDir unless explicitly set:
__PACKAGE__->methodspit_depend(
  'RootDir',
  {
    LogFile     => '/log',
    SpamLogFile => '/spam.log',
    PagesDir    => '/pages',
    CacheDir    => '/cache',
    DiffDir     => '/diffs',
  }
);

=head1 METHODS

=over

=item new()

=cut

sub new {
  my ($class) = shift;
  my (@params) = @_;

  my $self = \%WalaConf;
  bless $self, $class;

  $self->conf(@params);

  return $self;
}

sub conf {
  my $self = shift;
  my %params = @_;

  for my $p (keys %params) {
    $self->{$p} = $params{$p};
  }

  return;
}

=item run()

=cut

sub run {
    my $self = shift;
    my ($result);

    my $page = $self->HomePage;
    $self->setup() if $self->CheckSetup;
    $self->parse_cookies($ENV{'HTTP_COOKIE'});

    my $querystring = $ENV{'QUERY_STRING'};
    my $content_len = $ENV{'CONTENT_LENGTH'};

    if (length($querystring) > 0 and index($querystring, '=') < 0) {
        # We got a plain WikiWord as the only parameter, so that's the page
        $page = $querystring;
    } elsif (length($querystring) > 0 or $content_len > 0) {
        # We have one or more parameters; read and parse them:

        my $query;
        if ($content_len > 0) {
            read STDIN, $query, $content_len;
        } else {
            $query = $querystring;
        }

        $result = $self->parse_parameters($query, $page);
    }

    # Cut off access to other directories.
    if ($page =~ m/^[.]/) {
        $page = $self->HomePage;
    }

    my $pagefile = $self->PagesDir  . "/$page";
    my $cachefile = $self->CacheDir . "/$page";

    print $self->get_header($page);

    # We're faking a stupid global here:
    my $parameters = $self->parameters;

    if ($result) {
        # take care of the results from various parameters
        print $result . "\n</body>\n</html>\n";
        return 1; # done
    } elsif ($parameters->{'action'} eq 'links') {
        # A bit of a special case - show all backlinks:
        print $self->print_page($page) . $self->get_footer($page);
        return 1; # done
    }

    # Half of caching behavior is implemented starting here:
    if ($self->skip_cache($page)) {
      print $self->print_page($page) . $self->get_footer($page);
      return 1; # done
    }

    # We'll only fall through to this stuff if UseCache is turned on:

    my ($page_mtime, $cachetime);
    if (-e $cachefile) {
        ($page_mtime, $cachetime) = get_mtime($pagefile, $cachefile);
    }

    # Has the page been touched since it was cached?
    if ($page_mtime < $cachetime) {
        # no - use cache
        $result = get_file_text($cachefile);
    } else {
        # yes - store a fresh copy in the cache
        $result = $self->print_page($page); 
        write_file($cachefile, $result);
    }

    print $result . $self->get_footer($page);
}

# Skip cache for this page?
sub skip_cache {
  my $self = shift;
  my ($page) = @_;

  return 1 unless $self->UseCache;
  return 1 if $page =~ $self->NoCache();

  return;
}


#######################
# Markup Processing   #
#######################

# Pass the page out to a markup plugin, then pull it back in
# and handle links.

sub wikify {
    my $self = shift;
    my ($page) = @_;

    # Get our markup.
    # So far just the default Wala module.
    $page = Wala::Markup::wiki_page_to_html($page);

    # this to use Textile
    #my $textile = new Text::Textile;
    #$page = $textile->process($page);

    $page = $self->convert_links($page);
    $page = $self->convert_wikiwords($page);
    $page = $self->handle_macros($page);

    return $page;

}


# Right now this just handles {pageindex} and {recentchanges}
# for &wikify
sub handle_macros {
    my $self = shift;
    my ($page) = @_;

    # This is stupid. Note particularly the <p> tags.

    $page =~ s/<p>
              {recentchanges\ +(\d+)}
              <\/p>
             /$self->print_recent_changes($1)/geosix;

    $page =~ s/<p>
              {pageindex}
              <\/p>
             /$self->get_list_of_pages()/geosix;
   
    return $page;

}


#######################
#   Link Processing   #
#######################

# Return link markup.
sub a {
    my ($url, $linktext, $class) = @_;
    $class ||= 'exists';
    return qq{<a href="$url" class="$class">$linktext</a>}; 
}


sub convert_links {
    my $self = shift;
    my ($text) = @_;

    # Bare links.
    $text =~ s/(?<![\[<])                                   # not preceded by
               (http|https|ftp|gopher|news|telnet|ssh):\/\/ # protocol
               [A-Za-z0-9\/\.\-=?&%~_+#]*            # text
              /get_link($&)/geosx;


    # Bracketed links.  This one could perhaps use some work.
    $text =~ s/\[                                           # start bracket
               (http|https|ftp|gopher|news|telnet|ssh):\/\/ # protocol
               [\s\S]*?                                     # whitespace?
               \]                                           # end bracket
              /get_bracketed_link($&)/geosx;


    $text =~ s/mailto:*\S+/get_email_link($&)/geos;

    return $text;
}


# Bracketed URLs, with or without link text following.
sub get_bracketed_link {
    my ($text) = @_;

    $text = substr($text, 1, length($text) - 2);
    my $posit = index($text, ' ');

    if ($posit >= 0) {
        return a(
          substr($text, 0, $posit),
          substr($text, $posit + 1),
          'external'
        );
    } else {
        return a($text, $text, 'external');
    }
}


sub get_link {
    my ($url) = @_;

    if ( is_image($url) ) {
        return qq{<img src="$url" alt="(image)" />};
    } else {
        # Chop down the URL for display - no protocol:
        my $url_stub = $url;
        $url_stub =~ s{^.*?://(.*)$}{$1};
        return a($url, $url_stub, 'external');
    }
}

# For now, this just tests on file extension.
sub is_image {
    my ($url) = @_;

    if ($url =~ m{^(http:|https:|ftp:)  # protocol
                  [A-Za-z0-9/.\-=?&%~_+]+
                  \.(gif|jpg|jpeg|png$) # extensions
                 }ix
    ) {
        return 1;
    } else {
        return 0;
    }
}


# This could be smarter.
sub get_email_link {
    my ($mailto) = @_;
    return a($mailto, $mailto, 'external');
}

############################
#   Wiki Word Processing   #
############################

sub convert_wikiwords {
    my $self = shift;
    my ($text) = @_;

    # CamelCase
    $text =~ s/(?<!
                [\w\[=?:] # Not preceeded by a word character, bracket, etc.
               )           
               (
                [A-Z][a-z0-9]+        # One uppercase + lowercase
                (?:[A-Z][a-z0-9]+)+   # + one uppercase + lowercase...
               )
               (\W|$)               # Non-word or EOF
              /$self->wikiword_linkify($1) . $2/geosx;

    # Bracketed links
    $text =~ s{(?<! \\)                       # Not an escape.
               \[{1,2}                        # one or two brackets
               ([A-Za-z0-9|.%,_'!\;\&?\= ]*)  # everything we take in the link
               \]{1,2}                        # one or two brackets
              }{$self->wikiword_linkify($1)}geosx;

    return $text;
}


sub wikiword_linkify {
    my $self = shift;
    my ($wikiword) = @_;

    my $label = $wikiword;
    if ($wikiword =~ m/^(.*)\|(.*)$/) {
      ($wikiword, $label) = ($1, $2);
    }

    # take care of spaces by turning them into underscores
    $wikiword =~ s/ /_/g;

    my $scriptname = $self->ScriptName;

    if( $self->is_page($wikiword) ) {
        return a($scriptname . "?$wikiword", $label);
    } else {
        return a($scriptname . "?action=edit&amp;id=$wikiword",
                 $label, 'new');
    }
}


##########################
#   Webpage Processing   #
##########################

sub write_page {
    my $self = shift;
    my ($pagename, $file_text, $summary, $old_timestamp) = @_;

    # Test for anonymous users attempting to use URLs
    if ( $self->spamcheck($file_text, $pagename, $summary) ) {
        # Do nothing further.
        return 0;
    }

    # Check for edit collisions:
    my $new_timestamp = get_mtime($self->PagesDir . "/$pagename");
    if ( $old_timestamp and ($new_timestamp > $old_timestamp) ) {
        return "<h1>Probable edit collision.</h1>\n\n<p>This page has changed
                since you started editing it. You'll find your text below the
                edit box - please incorporate your changes here and save the
                new version."
                . $self->edit_form($pagename)
                .  "<h1>your text</h1>\n\n$file_text";
    }

    # Write the diff, and return a one-line summary.
    my $diff_line = $self->write_diff($pagename, $file_text);
    $summary ||= $diff_line;

    # Write the new page and log it.
    write_file($self->PagesDir . "/$pagename", $file_text);
    $self->log_page_edit($pagename, $summary, $self->get_username);

    # Bail out unless caching is turned on:
    return 0 unless ($self->UseCache);

    my @to_touch;

    # For new pages we want to update anything that links here:
    #if ($diff_line eq 'New page or unchanged.') {
        @to_touch = $self->get_linked_pages($pagename);
    #}

    # Update everything this page links to:
    push @to_touch, pagelinks($file_text);

    my $touch_time = time;

    # touch appropriate files,
    # first mapping directory prefix to the list.
    my $pagesdir = $self->PagesDir;
    utime $touch_time, $touch_time,
          map { "${pagesdir}/$_" } @to_touch;

    return (0);
}


# Is there a good chance this is spam?
# This is a very, very naive mechanism, but it mostly seems to work.
sub spamcheck {
    my $self = shift;
    my ($text, $pagename, $summary) = @_;

    # Does the file contain a URL or an attempt at a URL, and is the user
    # anonymous?
    if ( ($text =~ m{http://|a href}i)
         and $self->get_username eq $self->DefaultUserName )
    {
        # Quickie spamlogging.
        my $time = localtime(time);
        append_file($self->SpamLogFile,
                    "$time $ENV{'REMOTE_ADDR'} $pagename $summary\n");

        # Looks like spam.
        return 1;
    }

    # Didn't look like spam.
    return 0;

}


# Return a list of the pages linked to within a given chunk of text.
sub pagelinks {
    my ($text) = shift;

    # CamelCase
    my (@camels) = $text =~ m/((?:[A-Z][a-z0-9]+)  # One uppercase + lowercase
                               (?:[A-Z][a-z0-9]+)+) # + one uppercase + lower
                             /gsx;

    # Bracketed links
    my (@brackets) = $text =~ m!\[{1,2}                # one or two brackets
                                ([A-Za-z0-9.%,_'\ ]*)  # everything we take 
                                (?:\|.*)?              # optional pipe
                                \]{1,2}                # one or two brackets
                               !gsx;

    for (@brackets) { s/ /_/g; }

    return (@camels, @brackets);
}


sub add_to_page {
    my $self = shift;
    my ($pagename, $new_text) = @_;

    # Bail out unless we got some text to add.
    unless ($new_text) {
        return $self->print_page($pagename) . $self->get_footer($pagename);
    }

    my ($summary) = $new_text =~ m/(.*?)(\n|$)/;
    
    my $file_text = $self->get_page_text($pagename);
    $file_text .= "\n\n<[" . $self->get_username() . "]> $new_text\n";

    # We don't simply use append_file here, 'cause we want to
    # log the change and write a diff:
    return $self->write_page($pagename, $file_text, $summary);
}

sub get_page_text {
  my $self = shift;
  my ($pagename) = @_;

  return get_file_text($self->PagesDir . "/$pagename");
}

sub is_page {
  my $self = shift;
  my ($page) = @_;

  if (-e $self->PagesDir . "/$page") {
    return 1;
  } else {
    return 0;
  }
}


sub get_header {
    my $self = shift;
    my ($pagename) = @_;
    my ($searchlink, $result, @searchlinks);

    # format a pagetitle with spaces
    my $pagetitle = $pagename;

    if ($pagetitle =~ m/_/) {
        $pagetitle =~ tr/_/ /;
    } else {
        $pagetitle =~ s/([a-z])([A-Z])/$1 $2/g;
    }

    $result = '';
    
    unless ($self->TestMode) {
        $result = "Content-type: text/html;\n\n";
    }

    my $titlestring = $self->TitleString;
    $result .= <<"END_HTML";
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">

<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
<head>
    <meta http-equiv="Content-type" content="text/html;charset=UTF-8" />
    <title>${titlestring}${pagename}</title>
END_HTML

    if ($self->StyleSheet ne '') {
        $result .= qq{    <link rel="stylesheet" href="} . $self->StyleSheet . qq{" }
                 . qq{type="text/css" media="screen" />\n};
    }

    if ($self->FeedURL) {
        $result .= qq{    <link rel="alternate" href="} . $self->FeedURL . qq{" }
                 . qq{type="application/atom+xml" title="RecentChanges" />\n};
    }

    my $scriptname = $self->ScriptName;
    my $homepage = $self->HomePage;

    $result .= <<"HTML";
</head>

<body>

<p class="right">
  <a href="$scriptname?$homepage" class="exists">home</a> |
  <a href="$scriptname?RecentChanges" class="exists">changes</a> |
  <a href="$scriptname?PageIndex" class="exists" accesskey="i"><strong>i</strong>ndex</a> |
  <a rel="nofollow" accesskey="e" class="exists"
     href="$scriptname?action=edit&amp;id=$pagename"><strong>e</strong>dit</a>
</p>

<h1>$pagetitle</h1>

HTML

    return $result;
}


# produces a little toolbar for doing some searches, etc.
sub searchlinks {
    my $self = shift;
    my ($pagename) = @_;
    my (@result);

    # perform a few substitutions to make wikiwords
    # more palatable to search engines
    my $searchtext = $pagename;
    if ($searchtext =~ m/_/) {
        $searchtext =~ s/_/ /g;
    } else {
        $searchtext =~ s/([a-z])([A-Z])/$1 $2/g;
    }

    # prettier text for the wikipedia link
    my $wikipedia_linktext = $searchtext;
    # turn camelcase into underscores for wikipedia
    my $wikipedia = $searchtext;
       $wikipedia =~ s/ /_/g;

    $searchtext = lc $searchtext;

    my $googletext = $searchtext;
       $googletext =~ s/ /+/g;

    my $e2text = $searchtext;
       $e2text =~ s/ /%20/g;

    my $tagtext = $searchtext;
       $tagtext =~ s/[ _]//g;

    my (@matchpages, $filename, $page);

    # find p1k3 entries corresponding to pages
    if ( $self->DisplayRootDir and
         ($pagename =~ m/(January|February|March|April|May|June|
                          July|August|September|October|November|December)
                          _([0-9]{1,2})_([0-9]{4})
                        /x ) ) {

       my %month_num = ( January => 1, February => 2, March => 3, April => 4,
                        May => 5, June => 6, July => 7, August => 8,
                        September => 9, October => 10, November => 11,
                        December => 12 );

       my $pp = "$3/$month_num{$1}/$2";

       if (-e $self->DisplayRootDir . "/$pp") {
           push @matchpages,
                a($self->DisplayURL . $pp, "p1k3::$pp", 'external');
       }
    }

    my $parameters = $self->parameters;

    # Include the list of pages that link to this one.
    if ( $parameters->{'action'} ne 'links' ) {
        push @matchpages, map { "[$_]" }
                          $self->get_linked_pages($pagename, 15);
        @matchpages = sort @matchpages;

        # provide "more..." link if we got a full list.
        if (@matchpages >= 15) {
          push @matchpages,
               a($self->ScriptName . "?action=links&amp;id=$pagename",
                 '<em>more...</em>');
        }
    } else {
        push @matchpages, map { "[$_]" } $self->get_linked_pages($pagename);
        @matchpages = sort(@matchpages);
    }

    for (@matchpages) { $_ = $self->convert_wikiwords($_); }

    # if any pages matched, push a blank line, a "see also:", and
    # the matching page names.
    if (@matchpages) {
        push @result, '<strong>see also:</strong>', @matchpages, '&nbsp;';
    }

    push @result,
         '<strong>search:</strong>',
         a("http://en.wikipedia.org/wiki/Special:Search/$wikipedia",
           'wikipedia'),
         a("http://www.google.com/search?q=$googletext", 'google'),
         '&nbsp; ' . a("http://scholar.google.com/scholar?q=$googletext",
                       'scholar'),
         '&nbsp; ' . a("http://books.google.com/books?q=$googletext", 'books'),
         '&nbsp; ' . a("http://images.google.com/images?q=$googletext",
                       'images'),
         a("http://reddit.com/search?q=$googletext", 'reddit'),
         a("http://del.icio.us/tag/$tagtext", 'del.icio.us'),
         a("http://www.everything2.com/?node=$e2text", 'everything2');
   
    return @result;
}

sub format_matchpages {
  my ($link) = @_;
  my $new_link = $link;
  if (length($link) > 20) {
    $new_link = $link . '|' . substr($link, 0, 20) . '...';
  }
  return "[$new_link]";
}


# Return a list of the pages that link to a given page
# essentially a big dumb grep:

sub get_linked_pages {
    my $self = shift;
    my ($pagename, $quantity) = @_;

    # We'll search for these.
    my $quoted = quotemeta($pagename);
    my $with_spaces = $quoted;
       $with_spaces =~ s/_/ /g;
    my $spaces_on_caps = $quoted;
       $spaces_on_caps =~ s/([a-z])([A-Z])/$1 $2/g;

    # Useful idiom: Map a list to a hash where each value is 1.
    # Stopwords:
    my %stop = map { $_ => 1 } ('temp', '..', '.', '', $pagename);

    opendir my $dh, $self->PagesDir;

    my $filename = readdir $dh;

    my @matchpages;
    until ($filename eq '') {
        # Bail out if we've got a desired quantity:
        last if (defined $quantity) and (@matchpages >= $quantity);

        $filename = readdir $dh;

        # check stoplist
        next if $stop{$filename};

        open my $page, '<', $self->PagesDir . "/$filename";

        while (<$page>) {
            if ( m/$quoted|$with_spaces|$spaces_on_caps/io ) {
                push @matchpages, $filename;
                last;
            }
        }

        close $page;

    }

    closedir DIR;

    return @matchpages;
}


# This HTML really needs cleaned up.
sub get_footer {
    my $self = shift;
    my ($pagename) = @_;

    my $username = $self->get_username;
    my $scriptname = $self->ScriptName;

    my $text = <<HTML;

<form action="$scriptname" method="post">
<table class="addbox">
  <tr>
    <td>
      <input type="hidden" name="action" value="addtext" />
      <input type="hidden" name="id" value="$pagename" />
      &lt;$username&gt;<br />
HTML

    $text .= a("$scriptname?action=editprefs&amp;originalpage=$pagename",
               'change name');

    $text .= <<"END_HTML";

    </td>
    <td colspan="2">
      <textarea name="text" cols="80" rows="7" style="width: 100%"></textarea>
    </td>
  </tr>
  <tr>
    <td></td>
END_HTML

    # Is the user "logged in"?
    if ( $username eq $self->DefaultUserName ) {
        $text .= "    <td>You can't post URLs until you choose a name</td>\n";
    } else {
        $text .= "    <td></td>\n";
    }

    # Button.
    $text .= <<END_HTML;
    <td style="text-align: right;">
      <input type="submit" value="add your response" />
    </td>
  </tr>
</table>
</form>

<p>
END_HTML

    my $cookies = $self->cookies;

    if (defined $cookies->{'username'}) {
        #$text .= "logged in as <a href=\"$scriptname?action=editprefs&amp;" .
        #         "originalpage=$page\">$cookies{'username'}</a>";
    }
    else {
        $text .= a(
          "$scriptname?action=editprefs&amp;originalpage=$pagename",
          'choose a name'
        );
    }

    $text .= "<br />\n" . a("$scriptname?action=edit&amp;id=$pagename",
                            'edit this page');

    my ($diff_date, $datestamp) = $self->latest_diff($pagename);
    if ($diff_date ne '') {
        $text .= qq{<br />\nlast edited <a rel="nofollow" href="$scriptname?action=diff&amp;}
               . qq{id=$pagename&amp;datestamp=$datestamp">$diff_date</a>};
    }

    $text .= '</p>';

    $text .= "\n\n</body>\n</html>\n";

    return $text;
}


# The enormous cascading if statement here does what it should,
# but needs serious disentanglement
sub print_page {
    my $self = shift;
    my ($pagename) = @_;

    my ($linklist, $result);

    my $pagetext = get_file_text($self->PagesDir . "/$pagename");

    # This needs to be specific because we might encounter "0":
    if ($pagetext eq '') {
        $pagetext = $self->DefaultPageText;
    }

    # make HTML out of our markup:
    $pagetext = $self->wikify($pagetext);

    # this takes care of several special pages.  it also grabs links to search
    # engines and backreferences to other pages.
    if ($pagename eq 'RecentChanges') {
        $pagetext .= $self->print_recent_changes;
    }
    elsif ($pagename eq 'PageIndex'      ) { $pagetext .= $self->get_list_of_pages();        }
    elsif ($pagename eq 'PageChangeTimes') { $pagetext .= $self->get_change_times();         }
    elsif ($pagename =~ m/^([A-Za-z])$/  ) { $pagetext .= $self->get_list_of_pages("^$1.*"); }
    elsif ($pagename eq 'setup'          ) { $pagetext .= $self->setup();                    }
    elsif (! $self->ShowSearchlinks      ) { $linklist = '';                                 }
    elsif ($pagename eq $self->HomePage  ) { $linklist = '';                                 }
    else {
        $linklist .= qq{<p class="searchlinks" >\n};
        for my $link ($self->searchlinks($pagename)) {
            $linklist .=  "$link <br />\n";
        }
        $linklist .= "</p>\n\n";
    }

    $pagetext = "$linklist\n\n$pagetext" if $linklist;

    return $pagetext;
}


# This is all a touch ridiculous.
sub edit_form {
    my $self = shift;
    my ($pagename) = @_;

    my $file_text = $self->get_page_text($pagename);
    $file_text ||= $self->DefaultPageText;

    my $url_notice = "Feel free to post URLs.";
    my $username = $self->get_username;

    if ($username eq $self->DefaultUserName) {
        $url_notice = "You can't add URLs <em>or edit pages containing them</em> until you choose a name.";
        $username = undef;
    }

    my $editor = Wala::Editor->new(
                   page       => $pagename, 
                   message    => $url_notice,
                   file_text  => $file_text,
                   scriptname => $self->ScriptName,
                   username   => $username,
                   );

    return $editor->render();                   
   
}


sub log_page_edit {
    my $self = shift;
    my ($pagename, $summary, $username) = @_;
    my $currenttime = time;
    append_file($self->LogFile,
                "$currenttime $pagename $username $summary\n");

    return;
}



# Default returns a CSS based graph with links to pages for each
# letter. Takes $pattern as a regex for filenames of pages to index.
sub get_list_of_pages {
    my $self = shift;
    my ($pattern) = @_;

    # If no pattern was specified, just do a graph:
    my $graph_only = 1 unless $pattern;

    $pattern ||= ".*";


    # files to ignore:
    my %stop = map { $_ => 1 } ('temp', '..', '.');

    my ($filename, @pages);
    opendir DIR, $self->PagesDir;
    while ($filename = readdir DIR) {
        next if (defined $stop{$filename});
        if ($filename =~ m/$pattern/) {
            push @pages, $filename;
        }
    }
    closedir DIR;

    @pages = sort @pages;

    my (%first_letters, $letter, $text);

    foreach $filename (@pages) {

        my $filename_top;
        # this conditional is an optimization, but the whole loop
        # is stupid and needs a rewrite
        unless ($graph_only) {
            $filename_top = $self->get_firstline($filename);
            # clear special characters that would otherwise go unrendered
            $filename_top =~ s/^[\*:#]//;
        }

        $filename =~ s/_/ /g;

        # for first letters in index.
        $letter = substr $filename, 0, 1;
        unless (exists $first_letters{$letter}) {
            $text .= "\n\n= [$letter] =\n\n";
        }

        # add 'em up.
        $first_letters{$letter}++;
        $text .= "* [$filename] :: $filename_top\n";
    }

    my (@letters) = sort (keys %first_letters);
    my ($biggest_letter, $graph);

    my $scriptname = $self->ScriptName;
    for (@letters) {
        $graph .= qq{<a style="border-top: $first_letters{$_}px solid black"}
                . qq{ href="$scriptname?$_">$_</a>\n};
        if ($first_letters{$_} > $biggest_letter) {
          $biggest_letter = $first_letters{$_};
        }
    }

    my $pagecount = @pages;

    $biggest_letter += 10;

    # If $graph_only is set, we won't return the whole list.
    my ($result) = qq{<p style="margin-top: ${biggest_letter}px; text-align:}
                 . qq{ center;">$graph<br />\n$pagecount pages</p>\n\n};

    unless ($graph_only) {
        $result .= qq{<div style="font-size: .7em;">\n}
                . $self->wikify($text) . "\n</div>";
    }

    return $result;
}


# Return the first (real) line of a file.
sub get_firstline {
  my $self = shift;
  my ($filename) = @_;
  my ($filename_top);

  open (my $fh, '<', $self->PagesDir . "/$filename") or return '';

  while ($filename_top = <$fh>) {
    # make sure it has real content
    if (length($filename_top) > 1 ) {
      chomp($filename_top);
      last;
    }
  }                

  close $fh;

  return $filename_top;
}


# little wrapper to
# just return an mtime for a file.
sub get_mtime
{
    my (@filenames) = @_;

    my @mtimes; 
    for my $filename (@filenames) {
      #my( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
      #    $atime, $mtime, $ctime, $blksize, $blocks )
      #   = stat( $filename );

      push @mtimes, (stat $filename)[9];
    }
    
    # return a list if we've got more than one, a scalar
    # otherwise.  is this evil? or even necessary?
    if (@mtimes > 1) {
      return @mtimes;
    } else {
      return $mtimes[0];
    }
}


# List all files with their mtimes.
sub get_change_times
{
    my $self = shift;
    my ($pattern) = @_;
    $pattern ||= ".*";
    my ($text, %mtimes);

    my (@months) = qw(January February March April May June
                    July August September October November
                    December);

    # files to ignore:
    my %stop = map { $_ => 1 } ('temp', '..', '.');

    opendir DIR, $self->PagesDir;
    while (my $filename = readdir DIR) {
        next if (exists $stop{$filename});
        if ($filename =~ m/$pattern/) {
            $mtimes{$filename} = get_mtime($self->PagesDir . "/$filename");
        }
    }
    closedir DIR;
    
    my @pages = keys %mtimes;
    @pages = sort { $mtimes{$a} <=> $mtimes{$b}; } @pages;

    my $last_modtime;
    foreach my $filename (@pages)
    {
        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
            localtime $mtimes{$filename};

        my $modtime = "$months[$mon] $mday " . ($year + 1900);

        if ($last_modtime eq $modtime) {
            $text .= " [$filename] ";
        } else {
            $text .= "\n* '''[$modtime]''' :: [$filename] ";
        }

        $last_modtime = $modtime;
    }

    $text = "\n" . $self->wikify($text) . "\n";

    return $text;
}


######################
#   Recent Changes   #
######################


sub print_recent_changes {
    my $self = shift;
    my ($max_lines) = @_;
    $max_lines ||= $self->RecentChangesMaxLines;

    my @lines = $self->recent_changes($max_lines);

    my ($result, $last_date);

    foreach my $line (@lines) {
      chop $line;
      my ($addline, $datestamp) = $self->format_changeline($line);

      if ($datestamp ne $last_date) {
        unless ($last_date eq '') {
          $result .= "\n\n";
        }
        $result .= "''$datestamp''\n\n";
        $last_date = $datestamp;
      }

      $result .= $addline;
    }

    # format_changeline returns lines in wiki markup:
    return $self->wikify($result);
}

# Return recent changes lines from log file.
# Should be cleaned up. The logic is a bit tortured.
sub recent_changes {
    my $self = shift;
    my ($max_lines) = @_;

    # Going to use this as an array index.
    $max_lines--;

    # Open the logfile or return a null result.
    open (my $logfile, '<', $self->LogFile) or return '';
      my @lines = <$logfile>;
    close $logfile;

    # only return up to the end of @lines
    if (@lines < $max_lines) {
        $max_lines = (@lines - 1);
    }

    @lines = reverse(@lines); # Missy Elliot.

    return @lines[0..$max_lines];
}


# Format a line from the logfile.
# This whole thing should be rewritten.
sub format_changeline
{
    my $self = shift;
    my ($line) = @_;

    my @months = qw( January February March April May June
                  July August September October November December );

    my ($timestamp, $pagename, $author, $description)
      = $line =~ m/(\d+) (\S+) (\w+) (.*)$/;

    my @t = localtime($timestamp);
    my $year = $t[5] + 1900;

    my $datestamp = $months[$t[4]] . " $t[3], $year";

    my ($ampm);
    my $hour = $t[2];
    if    ($hour == 0)  { $ampm = 'am'; $hour = 12; }
    elsif ($hour < 12)  { $ampm = 'am'; }
    elsif ($hour == 12) { $ampm = 'pm'; }
    else                { $ampm = 'pm'; $hour -= 12; }

    my $min = $t[1];
    if (length($min) == 1) { $min = '0' . $min; }
    my $thetime = "$hour:$min $ampm";

    my $result = qq{* [$pagename] $description ''$author, $thetime }
               . $self->TimeZone
               . qq{''\n};

    return $result, $datestamp;
}


###############################
#   Preferences and Cookies   #
###############################


# So far this just handles the username.
sub get_preferences_form {
    my $self = shift;
    my ($originalpage) = @_;

    my $scriptname = $self->ScriptName;
    my $username = $self->get_username;

    my $text = <<"END_HTML";
<form action="$scriptname" method="post">
  <table>
    <tr>
      <td>
        <input type="hidden" name="action" value="setprefs" />
        <input type="hidden" name="id" value="$originalpage" />
        Your login name:
      </td>
      <td>
        <input type="text" name="username" value="$username"
               size="20" />
      </td>
    </tr>
    <tr>
      <td></td>
      <td>(Letters and/or numbers only, no spaces)</td>
    </tr>
    <tr>
      <td><input type="submit" value="Save" /></td>
    </tr>
  </table>
</form>
END_HTML

    return $text;
}




# I think we need to address $cookies
# which is probably persisting across
# sessions due to mod_perl.
sub parse_cookies {
    my $self = shift;
    my ($cookie_string) = @_;
    
    # see if this works
    my %cookies; 
    my @values = split /;/, $cookie_string;
    foreach my $query (@values) {
        my ($name, $value) = split(/=/, $query);
        $value =~ tr/+/ /;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        $cookies{$name} = $value;
    }

    $self->cookies(\%cookies);
}



# formerly write_cookies_to_browser
sub set_cookies
{
    my $self = shift;
    my ($username, $newpage) = @_;
    my $expiration_time = mygmtime(time + 86400 * $self->CookieSurvivalDays);
    if( $username =~ /^[A-Za-z0-9]+$/ ) {
        print "Set-Cookie: username=$username; expires=$expiration_time\n";
    }
    $self->location($newpage);
}




#############
#   Setup   #
#############


sub setup {
    my $self = shift;

    my $pagesdir = $self->PagesDir;
    my $homepage = $self->HomePage;
    
    my $result = '<p>';

    if (! -d $self->RootDir) {
        if ( mkdir $self->RootDir, 0777 ) {
            $result .= 'Made root directory.<br />';
        } else {
            return;
        }
    }

    if (! -d $pagesdir)
    {
        if ( mkdir $pagesdir, 0777 ) {
            $result .= 'Made pages directory.<br />';
        }

        if ( mkdir( $self->DiffDir, 0777 ) ) {
            $result .= 'Made diffs directory.<br />';
        }
    }
    else
    {
        $result .= 'Root directory exists.<br />';
    }

    if( ! -d $self->CacheDir )
    {
        mkdir( $self->CacheDir, 0777 );
        $result .= 'Made cache directory.<br />';
    }
    else
    {
        $result .= 'Cache directory exists.<br />';
    }

    if( ! -e "$pagesdir/" . $self->HomePage )
    {
        write_file("$pagesdir/$homepage",
                   "Welcome to the Wala.\n\n"
                   . "See TextFormattingRules\n");
        $result .= "Created $homepage.<br />";
    }
    else
    {
        $result .= 'HomePage exists.<br />';
    }

    if( ! -e "$pagesdir/TextFormattingRules" )
    {
        my $markup = <<"MARKUP";
Wala has the following '''text formatting rules''':
* Start a line with * to create a ''bulleted list''.
# Start a line with # to create a ''numbered list''.
:Start a line with a : to indent it.
 Start a line with a space to display it like source code.
Start a line with a | to create a table:
|This is|a table|
|specified with|formatting rules.|
SmashWordsTogetherLikeSo to create a link to a new page, or use brackets around a [word].  Click on the link to create the page.

For links, just type the URL:

http://walawiki.org/

Alternatively, surround the URL with brackets and put a description after it, separated by a space:
[http://walawiki.org WalaWiki]
To include an image, just type the URL of the image.
MARKUP
        write_file("$pagesdir/TextFormattingRules", $markup);
        $result .= "Created TextFormattingRules.<br />";
    }
    else
    {
        $result .= "TextFormattingRules exists.<br />";
    }

    $result .= "</p>\n\n";
    return( $result );
}




sub parse_parameters
{
    my $self = shift;
    my ($query_string) = shift;

    my %parameters;

    foreach my $query ( split( /&/, $query_string ) ) {
        my ($name, $value) = split(/=/, $query);
        $value =~ tr/+/ /;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        $parameters{$name} = $value;
    }

    $self->parameters(\%parameters);

    my $action = $parameters{'action'};

    # Cut off access to ../ etc.
    if (substr($parameters{'id'}, 0, 1) eq '.') {
        $parameters{'id'} = $self->HomePage;
    }

    $_[0] = $parameters{'id'};

    if ( $action eq 'edit' ) {
        return $self->edit_form($parameters{'id'});
    }
    elsif ( $action eq 'post' ) {
        my $w_result = $self->write_page($parameters{'id'},
                                         $parameters{'filetext'},
                                         $parameters{'summary'},
                                         $parameters{'timestamp'});

        if ($w_result) {
            # If write_page returned anything, pass that along for display.
            return $w_result;
        } else {
            # Otherwise redirect the browser to the current version of the page.
            $self->location($parameters{'id'});
        }
    }
    elsif ( $action eq 'addtext' ) {
        $self->add_to_page($parameters{'id'}, $parameters{'text'});
        $self->location($parameters{'id'}); # redirect to current version of page
    }
    elsif ( $action eq 'diff' ) {
        $_[0] .= ' Diff';
        return $self->get_diff($parameters{'id'}, $parameters{'datestamp'})
               . "<hr />\n"
               . $self->print_page($parameters{'id'});
    }
    elsif ( $action eq 'setprefs' ) {
        $self->set_cookies($parameters{'username'}, $parameters{'id'});
    }
    elsif ( $action eq 'editprefs' ) {
        $_[0] = 'Preferences';
        return $self->get_preferences_form($parameters{'originalpage'});
    }
}




############
#   Diff   #
############


sub get_diff
{
    my $self = shift;
    my ($pagename, $datestamp) = @_;

    my $text = get_file_text($self->DiffDir . "/$pagename/$datestamp");

    my (@lines) = split /\n/, $text;

    my $added_text = "<strong>Added:</strong><br />\n" .
        qq{<div style="background-color: #AAFFAA">\n};

    my $removed_text = "<strong>Removed:</strong><br />\n" .
        qq{<div style="background-color: #FFffAA">\n};

    $text = '';

    # some regexes here might be more legible.
    foreach my $line (@lines) {
        #if( substr( $line, 0, 1 ) eq '<'  ||  substr( $line, 0, 1 ) eq '>' )
        if ($line =~ m/^[<>]/)
        {
            $text .= substr($line, 1) . "<br />\n";
        }
        elsif (substr( $line, 0, 3) eq '---' )
        {
            $text .= "</div>\n$removed_text";
        }
        elsif (index($line, 'a') >= 0  && substr($line, 0, 1) ne '\\' )
        {
            $text .= "</div>\n$removed_text";
        }
        elsif (index($line, 'c') >= 0 && substr($line, 0, 1) ne '\\' )
        {
            $text .= "</div>\n$added_text";
        }
    }

    return $text . "</div>\n";
}




# Now returns a summary of the edit.
# to-fix: locking on files?
# any weird vulnerabilities?
sub write_diff
{
    my $self = shift;
    my ($pagename, $new_text) = @_;

    my $currtime = time;
    my $tempfile = $self->DiffDir . "/$pagename.$currtime.temp";
    my $pagefile = $self->PagesDir . "/$pagename";

    my $diffdir = $self->DiffDir . "/$pagename";

    my $from_scratch;
    unless (-d $diffdir) {
        mkdir $diffdir, 0777;
        $from_scratch = $new_text;
    }

    write_file($tempfile, $new_text);
    my $the_diff = `diff '$tempfile' '$pagefile'`;
    unlink $tempfile; # get rid of tempfile

    my $change_count;
    $change_count++ while $the_diff =~ /[0-9,]+[acd][0-9,]+/sg;

    # Get a list of wikiwords from the diff and new text, for "Related: "
    my (@link_list) = pagelinks($the_diff . $from_scratch);

    my $summary;
    if ($change_count == 1) {
        $summary = "One change.";
    } elsif ($change_count == 0) {
        $summary = "New page or unchanged.";
    } else {
        $summary = "$change_count changes.";
    }

    if ($self->LogRelatedLinks) {

      # Make sure the links in our related list are unique:
      my %seen = ();
      @link_list = map { "[$_]" }
                   grep { ! $seen{$_} ++ }
                   @link_list;

      $summary .= ' (Related: ' . (join q{, }, @link_list) . ')'
        if @link_list; 
    }

    write_file($diffdir . "/$currtime", $the_diff);

    return $summary;
}


sub latest_diff {
    my $self = shift;
    my ($pagename) = shift;

    my @months = qw(January Febuary March April May June
                    July August September October November
                    December);

    opendir (DIR, $self->DiffDir . "/$pagename")
        or return '';

    my @filenames;
    while (my $filename = readdir DIR) {
        if ($filename =~ /^\d+$/) {
            push @filenames, $filename;
        }
    }

    closedir DIR;

    @filenames = reverse sort @filenames;
    my @t = localtime($filenames[0]);
    my $datestamp = $filenames[0];

    return $months[$t[4]] . ' ' . $t[3] . ', ' . ($t[5] + 1900),
           $datestamp;
}




#################
#   Utilities   #
#################


sub get_username {
    my $self = shift;
    
    my $cookies = $self->cookies;

    if ($cookies->{'username'}) {
        return $cookies->{'username'};
    } else {
        return $self->DefaultUserName;
    }
}

sub mygmtime {
    my ($etime) = @_;
    my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
    my @days = qw(Sun Mon Tue Wed Thu Fri Sat);
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($etime);
    my $timestr = sprintf( "%3s, %02d-%3s-%4d %02d:%02d:%02d GMT",
        $days[$wday], $mday, $months[$mon], $year+1900, $hour, $min, $sec);

    return $timestr;
}

# Return an ISO 8601 date string for the given epoch.
sub iso_date {
  my ($time) = @_;
  return strftime("%Y-%m-%dT%H:%M:%S%z", localtime($time));
}

# These next three are pretty much as advertised.
sub get_file_text {
    my ($filename) = @_;

    open (my $fh, $filename)
      or return '';

    local $/ = undef;
    my $filetext = <$fh>;
    close $fh;

    return $filetext;
}

sub write_file {
    my ($filename, $text) = @_;

    open (my $fh, '>', $filename) or return 0;
      flock($fh, LOCK_EX);
      print $fh $text;
    close $fh;

    return 1;
}

# This may not be that useful.
sub append_file {
    my ($filename, $text) = @_;

    open (my $fh, '>>', $filename) or return 0;
      flock($fh, LOCK_EX);
      print $fh $text;
    close $fh;

    return 1;
}

# Redirect to a given page and exit.
sub location {
    my $self = shift;
    my ($newpage) = @_;
    print "Location: " . $self->ScriptName . "?$newpage\n\n";
    exit 0;
}

1;