package Kwiki::Purple;
use Kwiki::Plugin '-Base';
use Kwiki::Installer '-base';

const class_id             => 'purple';
const class_title          => 'Purple';
const css_file             => 'purple.css';
const hook_classes         => [qw(heading p li td)];
const cgi_class            => 'Kwiki::Purple::CGI';
const config_file          => 'purple.yaml';
const default_retrieval_format => 'raw';
const timeout              => 60;

field hooked => 0;

# XXX some of these don't work, such a titlehyper
 my %formatter_text_flags = (
     tr          => ['|', "\n"],
     td          => ['', '|'],
     hr          => ['----', "\n\n"],
);
# actually, we don't want to to_text on the Phrases, just the blocks
#my %formatter_text_flags = ();

our $VERSION = '0.04';

sub init {
    super;
    return unless $self->is_in_cgi;
    $self->establish_formatter_overrides;
}

sub register {
    my $registry = shift;
    $registry->add(hook => 'page:store', pre => 'update_nids');
    $registry->add(wafl => nid => 'Kwiki::Purple::Nid::Wafl');
    $registry->add(wafl => t => 'Kwiki::Purple::Transclusion::Wafl');
    $registry->add(action => 'get_node');
    $registry->add(prerequisite => 'purple_sequence');
}

sub establish_formatter_overrides {
    $self->start_nid;
    $self->invade_formatter;
}

sub invade_formatter {
    my $formatter = $self->hub->formatter;
    my $table = $formatter->table;
    $table->{li} = 'Kwiki::Formatter::Purple::Item';
    $table->{heading} = 'Kwiki::Formatter::Purple::Heading';
    $table->{wiki} = 'Kwiki::Formatter::Purple::WikiLink';
    no strict 'refs';
    no warnings 'redefine'; # XXX for sake of tests
    foreach my $key (keys(%formatter_text_flags)) {
        my $class = $table->{$key};
        my $ts = 'text_start';
        my $te = 'text_end';
        my $start = "$class\::$ts";
        my $end = "$class\::$te";
        my $info = $formatter_text_flags{$key};
        my $open = $info->[0];
        my $close = $info->[1];
        $open ||= '';
        $close ||= '';
        *{"$start"} = sub {$open};
        *{"$end"} = sub {$close};
    }
}

sub Spoon::Formatter::Unit::to_text {
    my $self = shift;
    $self->get_text;
}

sub Spoon::Formatter::Unit::get_text {
    my $self = shift;
    my $inner;
    if (@{$self->units}) {
        $inner = join '', map {
            ref($_)
              ? $_->to_text
                ? $_->to_text
                : $_->matched
              : $_;
        } @{$self->units};
    } else {
        $inner = $self->matched;
    }
    $self->text_start . $inner . $self->text_end;
}

# XXX should be a way to determine these rather than beat on it like this
sub Spoon::Formatter::Unit::text_start {''}
sub Spoon::Formatter::Unit::text_end {''}
sub Spoon::Formatter::Block::text_end {"\n\n"}
sub Spoon::Formatter::WaflBlock::text_start {'.' . shift->method . "\n"}
sub Spoon::Formatter::WaflBlock::text_end {'.' . shift->method . "\n"}


# XXX presumably much or all of this can be moved into 
# the ::Formatter::Purple:: classes? 
sub start_nid {
    my $formatter = $self->hub->formatter;
    my $table = $formatter->table;
    my $start = 'html_start';
    my $end = 'html_end';
    no strict 'refs';
    no warnings 'redefine';
    for my $type (@{$self->hook_classes}) {
        my $class = $table->{$type};
        my $start = "$class\::$start";
        my $end = "$class\::$end";
        *{"$start"} = 
         sub {
             my $self = shift;
             my $nid = $self->units->[-1];
             my $level = '';
             my $element = $type;
             if ($type eq 'heading') {
                 $level = $self->level;
                 $element = 'h';
             }
             my $nid_value =
               (ref($nid) and $nid->isa('Kwiki::Purple::Nid::Wafl'))
               ? ' id="nid' . $nid->nid . '"'
               : '';
             qq(<${element}${level}${nid_value}>);
         };
    }
}

sub update_nids {
    my $hook = pop;
    my $page = $self;
    $self = $self->hub->purple;
    $self->update($page);
}

sub update {
    my $page = shift;
    my $formatter = $self->hub->formatter;
    my %hooks;
    unless ($self->hooked) {
        $self->hooked(1);
        my $table = $formatter->table;
        for my $class (@$table{@{$self->hook_classes}}) {
            $hooks{$class} = $self->hub->add_hook(
                $class . '::unit_match', post => 'purple:check_nid'
            );
        }
    }
    my $units = $self->hub->formatter->text_to_parsed($page->content);
    $page->content($units->to_text);
    for my $class (keys(%hooks)) {
        $hooks{$class}->unhook;
    }
}

sub check_nid {
    my $hook = pop;
    my $unit = $self;
    my $text = $unit->text;
    my $nid;
    $nid = $1 if ($text =~ /{nid ([A-Z0-9]+)}\s*/);

    $self = $self->hub->purple;

    my $page = $self->hub->pages->current;

    unless ($nid) {
        $nid = $self->next_nid($page);
        $text =~ s/(?: |=)*(\n{0,2})\n*$/ {nid $nid}$1/;
        $unit->text($text);
    }

    $self->write_node($nid, $unit->text);
}

sub write_node {
    # we just went to the trouble of adding the nid, but let's
    # go ahead and remove it before storing
    my $nid = shift;
    my $text = shift;
    my $page_id = $self->hub->pages->current->id;
    $text =~ s/\s*{nid [A-Z0-9]+}\s*$//;
    io($self->plugin_directory . '/' . $nid)->print($text);
    io($self->plugin_directory . '/' . $nid . '.name')->print($page_id);
}

sub get_node {
    my $nid = $self->cgi->nid;
    my $format = $self->cgi->format || $self->default_retrieval_format;
    $self->retrieve_node($nid, $format);
}
sub retrieve_node {
    my $nid = shift;
    my $format = shift;
    my $method = 'retrieve_node_' . $format;
    $self->$method($nid);
}

sub retrieve_node_raw {
    my $nid = shift;
    $self->hub->headers->content_type('text/plain');
    $self->read_node($nid);
}

# Track recursion loops, at least in this process...
my $semaphore = [];

sub retrieve_node_html {
    my $nid = shift;

    my ($text, $name, $href, $html);

    my $url = $self->hub->purple_sequence->query_index($nid);
    my $local = $self->is_local($url);

    # yuck
    if ($local) {
        $text = $self->read_node($nid);
        $name = $self->read_node_name($nid);
        my $script = $self->hub->config->script_name;
        $href = "$script?$name#nid$nid";
    } else {
        if ($self->is_kwiki($url)) {
            if ($url =~ /^([^\?]+)\?.*page_uri=([^;]+);?/) {
                $href = $1;
                $name = $2;
            }
            $href = $href . "?$name#nid$nid";
            $text = $self->retrieve_remote_kwiki_text($url);
        } else {
            $html = $self->retrieve_remote_html($url);
        }
    }

    return $html if $html;

    # XXX Loop detection needs to be more effective
    unless ((grep {$nid} @$semaphore)) {
        push @$semaphore, $nid if $local;
        my $unit = Spoon::Formatter::Block->new;
        $unit->text($text);
        my $html = $unit->parse->to_html;
        pop(@$semaphore) if $local;
        return qq(<span class="transclusion">$html) .
          qq(&nbsp;<a class="nid" href="$href">T</a></span>);
    } else {
        return qq(<a class="transclusion_loop" href="$href">) .
          qq(TLE</a>);
    }
}

sub is_kwiki {
    my $url = shift;
    return ($url =~ /action=get_node/ &&
            $url =~ /page_uri=/ &&
            $url =~ /nid=/);
}

# XXX always fail for now
sub retrieve_remote_html {
    return 'remote html retrieval non enabled, get Kwiki::Transclude'
      unless $self->hub->have_plugin('transclude') or 1;
}

# XXX refactor to Kwiki-RemoteFetch, with proxy settings
# and the like, for use by this, FetchRSS, whatever else
sub retrieve_remote_kwiki_text {
    my $url = shift;
    my $content = $self->web_request(
        method => 'GET',
        request_url => $url,
    );
}

# XXX pull out to own module
sub web_request {
    my %param = @_;
    my $content;
    my $post_input;

    require LWP::UserAgent;
    require HTTP::Request::Common;

    my $ua  = LWP::UserAgent->new();
    $ua->timeout($self->timeout);

    my $method = $param{method};
    my $request;
    $request = HTTP::Request::Common::GET
      ($param{request_url})
      if $method eq 'GET';
    $request = HTTP::Request::Common::POST
      ($param{request_url}, $param{post_data})
      if $method eq 'POST';
    die "unsupported method $method" unless defined $method;

    if ($param{username} && $param{password}) {
        $request->authorization_basic($param{username}, $param{password});
    }

    my $response = $ua->request($request);
    if ($response->is_success()) {
        $content  = $response->content();
        if (!length($content)) {
            $content = 'zero length response';
        }
    } else {
        $content = $response->status_line;
    }
    return $content;
}

sub is_local {
    my $url = shift;
    my $full_url = $self->full_url;
    return ($url =~ /^$full_url/);
}

sub read_node {
    my $nid = shift;
    my $file = io($self->plugin_directory . '/' . $nid);
    $file->exists 
      ? $file->all
      : '';
}

sub read_node_name {
    my $nid = shift;
    my $file = io($self->plugin_directory . '/' . $nid . '.name');
    $file->exists
      ? $file->all
      : '';
}

sub next_nid {
    my $page = shift;
    my $uri = $page->uri;

    my $nid = $self->hub->purple_sequence->get_next;
    my $url = $self->generate_retrieval_url($uri, $nid,
        $self->default_retrieval_format);
    $self->hub->purple_sequence->update_index($url, $nid);
    return $nid;
}

sub generate_retrieval_url {
    my $uri = shift;
    my $nid = shift;
    my $format = shift;

    my $url = $self->retrieval_url_base .
      "?action=get_node;nid=$nid;page_uri=$uri";

    return $url;
}

# so when we have views we don't run into permissions problems with
# retrieval
sub retrieval_url_base {
    return ($self->config->can('purple_retrieval_url') &&
      $self->config->purple_retrieval_url)
      ? $self->config->purple_retrieval_url
      : $self->full_url;
}

sub full_url {
    return CGI::url(-full => 1);
}

##########################################################################
package Kwiki::Purple::CGI;
use Kwiki::CGI -base;

cgi 'nid';
cgi 'format';

##########################################################################
package Kwiki::Purple::Nid::Wafl;
use Spoon::Formatter;
use base 'Spoon::Formatter::WaflPhrase';
const formatter_id => 'nid_wafl';

sub nid {
    my $value = shift;
    $self->{nid} = $value if $value;
    return $self->{nid};
}

sub parse_phrases {
    my ($nid, @else) = split(' ', $self->arguments);
    $self->nid($nid) if ($nid and not @else);
    super;
}
 
sub to_html { 
    qq(&nbsp;<a class="nid" href="#nid) .
       $self->nid . qq(">) . $self->nid .  '</a>';
}

sub text {''}

sub to_text {
    '{nid ' . $self->nid . '}';
}


######################################################################
package Kwiki::Formatter::Purple::WikiLink;
use Kwiki::Formatter;
use base 'Kwiki::Formatter::WikiLink';
use Kwiki ':char_classes';
our $pattern =
  qr/[$UPPER](?=[$WORD]*[$UPPER])(?=[$WORD]*[$LOWER])[$WORD]+(?:\#[0-9A-Z]+){0,1}/;
const pattern_start => qr/$pattern|!$pattern/;

sub html {
    my $page_name = $self->escape_html($self->matched);
    return $page_name
      if $page_name =~ s/^!//;
    my $nid;
    ($page_name, $nid) = split('#', $page_name);
    # XXX hack!
    my $link = $self->hub->pages->new_from_name($page_name)->kwiki_link;
    if ($nid) {
        $link =~ s/$page_name"/$page_name#nid$nid"/;
        $link =~ s{(\w+)(<\/a>)}{$1#$nid$2};
    }
    return $link;
}


######################################################################
package Kwiki::Formatter::Purple::Heading;
use Kwiki::Formatter;
use base 'Kwiki::Formatter::Heading';

sub text_start {
    return '=' x $self->level . ' ';
}


######################################################################
package Kwiki::Formatter::Purple::Item;
use Kwiki::Formatter;
use base 'Kwiki::Formatter::Item';

field buttons => '';

sub text_start { $self->buttons }
sub text_end { "\n" }

sub match {
    my $bullet = $self->bullet;
    return unless 
      $self->text =~ /^($bullet)(.*)\n/m;
    $self->buttons($1);
    $self->set_match($2);
}

##########################################################################
package Kwiki::Purple::Transclusion::Wafl;
use Spoon::Formatter;
use base 'Spoon::Formatter::WaflPhrase';

# XXX this has some issues with looping
sub to_html {
    my ($nid, @else) = split(' ', $self->arguments);
    return $self->wafl_error unless ($nid and not @else);
    $self->hub->purple->retrieve_node_html($nid);
}

package Kwiki::Purple;

__DATA__

__config/purple.yaml__
purple_retrieval_url:
__css/purple.css__
a.nid {
    font-family: Verdana, Trebuchet, Arial, Helvetica;
    font-style: normal;
    font-weight: bold;
    font-size: x-small;
    text-decoration: none;
    color: #C8A8FF;  /* light purple */
}

.transclusion {
    border-bottom: thin solid #c8a8FF;
} 

.transclusion_loop {
    font-family: Verdana, Trebuchet, Arial, Helvetica;
    font-style: normal;
    font-weight: bold;
    font-size: x-small;
    text-decoration: none;
    color: #ff08c8;
}

body {
    padding-bottom: 25em;
}
