=head1 NAME

SuikaWiki::Implementation - SuikaWiki: WikiEngine Core

=head1 DESCRIPTION

This module implements core part of the SuikaWiki WikiEngine.
All implemented features of WikiEngine can be called directly
or indirectly from instance of this module (with some exception
such as functions provided by WikiPlugin modules).

This module is part of SuikaWiki.

=head1 SYNOPSIS

  require SuikaWiki::Implementation;
  my $WIKI = new SuikaWiki::Implementation;
  ...
  $WIKI->exit;

C<lib/suikawiki.pl> might be a good example for instanciating WikiEngine.

=cut

package SuikaWiki::Implementation;
use strict;
our $VERSION = do{my @r=(q$Revision: 1.15 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};

=head1 METHODS

=over 4

=item $wiki = SuikaWiki::Implementation->new ()

Constructs new instance of wiki implementation

=cut

sub new ($;%) {
  my $self = bless {
    driver_name => 'WikiImplementation',
    driver_version => '0.0',
    driver_uri_reference => q<about:>,
    engine_name => 'SuikaWiki',
    engine_version => '2.9.5',
    engine_uri_reference => q<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SuikaWiki>,
  }, shift;
  
  $self;
}

=item $wiki->init_variables

Initialize per-access variables.  This method should be called
before other init_* methods are to be called.

=cut

sub init_variables ($) {
  my $self = shift;
  $self->close_input;
  $self->{var} = {};
  $self->___raise_event (name => 'setting_initial_variables');
}

=item $wiki->init_plugin

Prepares to use wiki plugins

=cut

sub init_plugin ($) {
  my $self = shift;
  require SuikaWiki::Plugin;
  $self->{plugin} = SuikaWiki::Plugin->new (wiki => $self);
  
  $self->___raise_event (name => 'plugin_manager_loaded');
}

=item $wiki->init_view

Prepares to use wikiview

=cut

sub init_view ($) {
  my $self = shift;
  require SuikaWiki::View::Implementation;
  $self->{view} = SuikaWiki::View::Implementation->new (wiki => $self);

  $self->___raise_event (name => 'view_implementation_loaded');
}

=item $wiki->init_db

Prepares to use wiki database

=cut

sub init_db ($) {
  my $wiki = shift;
  return if ref $wiki->{db};  ## Already initialized
  $wiki->{config}->{lock}
    ||= {-directory => $wiki->{config}->{path_to}->{db__lock__dir},
       -retry     => 40,
       -error_handler => sub {
         my ($self, %o) = @_;
         if ($o{level} eq 'fatal' or $wiki->{config}->{debug}->{db}) {
           if ($wiki->{config}->{path_to}->{db__lock__log_file}) {
             open LOG, '>>', $wiki->{config}->{path_to}
                                            ->{db__lock__log_file};
               print LOG scalar (gmtime),
                                  "\@@{[time]} @{[$$]} {$o{level}}: LOCK: ",
                                  $o{msg}, Carp::longmess,"\n";
             close LOG;
           }
         }
         if ($o{level} eq 'fatal') {
           die $o{msg};
         }
       },
      };
  $wiki->{var}->{db}->{lock_prop} = sub {
    my $prop = shift;
    my %lock = %{$wiki->{config}->{lock}};
    $lock{-name} = $prop;
    $lock{-share} = defined $wiki->{var}->{db}->{read_only}->{$prop}
                  ? $wiki->{var}->{db}->{read_only}->{$prop}
                  : $wiki->{var}->{db}->{read_only}->{'#default'};
    if ($lock{-share}) {
      $lock{-module} = (defined $wiki->{var}->{db}->{read_lock_module}->{$prop}
                    ? $wiki->{var}->{db}->{read_lock_module}->{$prop}
                    : $wiki->{var}->{db}->{read_lock_module}->{'#default'});
    } else {
      $lock{-module} = (defined $wiki->{var}->{db}->{lock_module}->{$prop}
                    ? $wiki->{var}->{db}->{lock_module}->{$prop}
                    : $wiki->{var}->{db}->{lock_module}->{'#default'});
    }
    \%lock;
  };
  
  require SuikaWiki::DB::Logical;
  $wiki->{db} = new SuikaWiki::DB::Logical;
  
  $wiki->___raise_event (name => 'database_loaded');
}

=item $wiki->view_in_mode (%opt)

Doing main process in accordance to the mode.

Actually, this method only raises an event of 'view_in_mode'.
So that "doing main process" code should be registered as an event procedure
of 'view_in_mode'.

=cut

sub view_in_mode ($%) {
  my ($self, %opt) = @_;
  $self->___raise_event (name => 'view_in_mode', argv => \%opt);
}


=item $uri = $wiki->uri_reference (%option)

Returning URI reference that refers the wiki or a WikiPage.

Load {input} before calling this method or specify appropriate C<wiki_uri> 
option to get proper result.

One or two URI reference(s) is returned as C<URI> object.
See C<base> option.

Available options:

=over 4

=item anchor_no => positive-integer (default: none)

Numeral anchor index.  With this option, C<fragment> option
is ignored.

=item base => URI reference (default: none)

Base URI reference.  C<wantarray ? (relative, absolute) : relative> is
returned when C<base> is specified.  Otherwise, C<(absolute, absolute)>
is returned.

=item fragment => URI reference fragment (default: none)

URI refernece fragment.  This option value MUST be encoded
by URI escape encoding.

=item mode => mode-name (default: "default")

WikiView mode in which referred.

=item page => [WikiName] (default: none)

WikiName to that WikiPage URI reference is referring.

=item param => {name1 => value1, name2 => value2,...} (default: none)

Additional query parameters.  Names and values are automatically
encoded by URI escape encoding if necessary.

=item up_to_date => 1/0 (default: 0)

"Up-to-date" URI query parameter for cheating cache.

=item wiki_uri => URI reference (default: auto)

A base URI reference referring the wiki itself.

=item with_lm => 1/0 (default: 0)

"Last modified" URI query parameter for chating WWW browser history.

=back

=cut

sub uri_reference ($;%) {
  my ($self, %opt) = @_; ## Note: $opt{wiki_uri} must be a URI(.pm) if any.
  my $uri = $opt{wiki_uri} || $self->___get_wiki_uri;
  
  ## SuikaWiki 3.0 format
  my $query_param = qr/[^0-9A-Za-z_.-]/;
  my @param = map {my $n = $_; $n =~ tr/_/-/;
                   $self->___uri_escape_encode ($n, $query_param).'='.
                   $self->___uri_escape_encode ($opt{param}->{$_}, $query_param)}
              keys %{$opt{param}};
  push @param, 'mode='.$self->___uri_escape_encode ($opt{mode}, $query_param)
    if $opt{mode};
  push @param, 'x-d='.time if $opt{up_to_date};
  if ($opt{page}) {
    if ($opt{with_lm} and ref $self->{db}) {
      push @param, 'x-lm='
                 . $self->___uri_escape_encode
                            ($self->{db}->get (lastmodified => $opt{page}),
                             $query_param);
    }
    my $page = $opt{page}->stringify (wiki => $self);
    if (@param) {
      ## TODO: Encode by $wiki->{config}->{charset}->{uri_param_encode}
      unshift @param, 'mypage='.$self->___uri_escape_encode 
                                         ($page, $query_param);
      push @param, '_charset_='.$self->{config}->{charset}->{uri_param_encode};
      ## TODO: downgrade to &
      $uri->query (join ';', sort @param);
    } else {
      ## TODO: Encode by $wiki->{config}->{charset}->{uri_query_encode}
      $uri->query ($self->___uri_escape_encode ($page, $query_param));
    }
  } elsif (@param) {
    push @param, '_charset_='.$self->{config}->{charset}->{uri_param_encode};
    $uri->query (join ';', sort @param);
  }
    
  if ($opt{anchor_no}) {
    $uri->fragment ('anchor-'.$opt{anchor_no});
  } elsif ($opt{fragment}) {
    $uri->fragment ($opt{fragment});
  }
  
  if (defined $opt{base}) {
    $opt{base} = $self->{input}->request_uri
      if ref $self->{input} and not ref $opt{base} and $opt{base} eq '1';
    return wantarray ? ($uri->rel ($opt{base}), $uri) : $uri->rel ($opt{base});
  } else {
    return ($uri, $uri);
  }
}

=item 1/0 = $wiki->uri_is_part_of_wiki ($uri-reference)

Check whether given URI reference is "part of" the wiki.

=cut

sub uri_is_part_of_wiki ($$) {
  my ($self, $uri) = @_;
  my $wiki_uri = ''.$self->___get_wiki_uri;
  $uri = URI->new (substr ($uri, 0, length ($wiki_uri)));
  $uri eq $wiki_uri ? 1 : 0;
}

sub ___get_wiki_uri ($) {
  my ($self) = shift;
  my $uri;
  if (ref $self->{___uri}) {
    $uri = $self->{___uri}->clone;
  } elsif (ref $self->{input}) {
    $uri = $self->{input}->request_uri (no_path_info => 1, no_query => 1);
    $self->{___uri} = $uri->clone;
  } else {
    $uri = URI->new;
  }
  $uri;
}

sub ___uri_escape_encode ($$;$) {
  my ($self, $s, $char) = @_;
  $char ||= qr([^0-9A-Za-z_.!~*'();/?:\@&=+\$,-]);
## TODO: Some fix required when utf8'ized
#  require Encode;
#  $s = Encode::decode ('utf8', $s);
  $s =~ s/($char)/sprintf '%%%02X', ord $1/ge;
  $s;
}

sub name ($$%) {
  require SuikaWiki::Name;
  my ($wiki, $name, %opt) = @_;
  SuikaWiki::Name->new ($name, wiki => $wiki, %opt);
}

=item $wiki->close_input

Closing input manager (C<< $wiki->{input} >>).

=cut

sub close_input ($) {
  my $self = shift;
  if (ref $self->{input}) {
    $self->___raise_event (name => 'input_close');
    $self->{input}->exit;
  }
  delete $self->{input};
}

=item $wiki->close_view

Closing WikiView manager (C<< $wiki->close_view >>).

=cut

sub close_view ($) {
  my $self = shift;
  $self->{view}->exit if ref $self->{view};
  delete $self->{view};
}

=item $wiki->close_db

Closing WikiDB (C<$wiki->{db}>).

Although this method is automatically called by C<< $wiki->exit >>,
it is good practice to explicitly close something opened explicitly.

This method make C<database_close> event called before database is
actually closed.  Future version of this module might make event handler
being able to cancel closing.

Calling this method when database is not opened makes no sense,
nor being C<database_close> event raisen.

=cut

sub close_db ($) {
  my $self = shift;
  if (ref $self->{db}) {
    $self->___raise_event (name => 'database_close');
    $self->{db}->close;
  }
  delete $self->{db};
}

=item $wiki->close_plugin

Closing WikiPlugin manager (C<< $wiki->{plugin} >>).
Note that this method does not unload WikiPlugin modules.
(They are "merged" to script namespace so that unloading them
is almost impossible.)

=cut

sub close_plugin ($) {
  my $self = shift;
  $self->{plugin}->exit if ref $self->{plugin};
  delete $self->{plugin};
}

=item 1/0 = $wiki->exit

Exitign the wiki.  This method closes input manager, WikiDB manager,
WikiView manager and WikiPlugin manager after C<close> event is raised.
Note that C<close> event handler can "cancel" exiting,
it makes this method return C<0>.

This method is automatically called before C<$wiki> is destoroyed.

=cut

sub exit ($) {
  my $self = shift;
  return 0 unless $self->___raise_event (name => 'close');
  $self->close_input;
  $self->close_db;
  $self->close_view;
  $self->close_plugin;
  $self->{exited} = 1;
  1;
}

## TODO: Provides "cancelable" to close event.

sub DESTROY ($) {
  my $self = shift;
  $self->exit unless $self->{exited};
}

=back

=head1 PUBLIC PROPERTIES

=over 4

=item $wiki->{config}

Persistent wiki configureation parameters
(that is not changed with the situation when is who accessing in what way)

=over 4

=item ->{charset}->{internal} = <IANA charset name (in lower case)>

Character encoding scheme used in wiki implementation

=item ->{charset}->{output} = <IANA charset name (in lower case)>

Default character encoding scheme used to output content

=item ->{debug}->{$category} = 1/0 (Default 0)

Debug mode

Categories:

=over 4

=item db

WikiDatabase related features

=item general

Generic.

=item view

WikiView related.

=back

=item ->{entity}->{expires}->{$rulename} = {delta => $seconds}

How long outputed entity will be fresh.

=item ->{lock}

Default (prototype) properties to give SuikaWiki::DB::Util::Lock

=item ->{nmz__uri_to_uri} = I<CODE>

A function that converts URI reference in Namazu index into global
URI reference.  Example:

  $wiki->{config}->{nmz__uri_to_uri} = sub {
    my ($uri, %opt) = @_;
    $uri =~ m!\w+$!;
    return $opt{o}->{wiki}->uri_reference (page => $1);
  };

=item ->{page}->{ $name }

WikiPage which has feature of $name

=item ->{path_to}->{ $name }

Filesystem path (or path fragment) to $name

=back

=item $wiki->{db}

Wiki main database

=item $wiki->{driver_name}

Product name of the WikiDriver.

For interoperability, only alphanumeric characters and limited symbols
(those allowed in RFC 2616 token) should be used as parts of product name.

=item $wiki->{driver_version}

WikiDriver version in string.

For interoperability, only alphanumeric characters and limited symbols
(those allowed in RFC 2616 token) should be used as parts of product name.

=item $wiki->{engine_name} (Read only)

SuikaWiki WikiEngine name

=item $wiki->{engine_version} (Read only)

SuikaWiki WikiEngine version

=item @{$wiki->{event}->{ $event_name }}

Event handling procedures.  See also EVENT MODEL section.

=item $wiki->{var}

Non-persistent wiki variable options
(that might vary with context such as caller's argument values)

=over 4

=item ->{client}->{downgrade}->{ $feature } = $parameter

Whether downgrade is required.  See C<Downgrade> plugin module.

=item ->{client}->{used_for_negotiation} = [<HTTP field name>s]

HTTP (request) header field names used to select variable content.
This value will be used to generate HTTP Vary header field.

=item ->{client}->{user_agent_name} = <HTTP User-Agent field body value>

User agent name provided by such ways as User-Agent field (in HTTP) 
or HTTP_USER_AGENT meta variable (in HTTP-CGI).

=item ->{db}->{lock_module}->{ $prop } = I<module-name>

Name for Perl module associated with C<$prop> (read and write mode),
implementing WikiDB Locking interface.  Special C<$prop> C<#default>
provides fallback module name.

=item ->{db}->{lock_prop} = sub ($prop)

Function returning hash reference of lock options
(that will be passed to SuikaWiki::DB::Util::Lock->new).

$prop, an argument to the function, is a database property name.

=item ->{db}->{read_lock_module}->{ $prop } = I<module-name>

Name for Perl module associated with C<$prop> (read-only mode),
implementing WikiDB Locking interface.  Special C<$prop> C<#default>
provides fallback module name.

=item ->{db}->{read_only}->{ $prop } = 1/0

Whether the database property named as $prop is opened in read only
mode or not.  Special property name of '#default' is used to set
the default value referred when {read_only}->{$prop} is not specified
explicily.

Note that this value must be set before the instance of database property
is loaded.

=item ->{error} = [{description => Error 1}, {description => Error 2},...]

Trapped errors.

=item ->{input}

Instance of input parameter interface (such as SuikaWiki::Input::HTTP)

=item ->{mode} = mode name

Wiki mode name

=item ->{page} = [page]

WikiPage being referred

=back

=item $wiki->{view}

WikiView implementation (an instance of SuikaWiki::View::Implementation)

=back

=head1 INTERNAL METHODS

This section describes some internal methods which only intend to be
used by this module.  These methods MUST NOT be used out of this
module.

=over 4

=item 1/0 = $wiki->___raise_event (%option)

Raise an event.  C<0> is returned if "cancel"ed, otherwise C<1>
returned.

Options:

=over 4

=item name => event-name (required)

Event name.

=item argv => some-value (default: none)

Some argument value, which is to be passed to event handlers
as C<< $event->{ I<argv_name> } >>.

=item argv_name => string (default: same as C<name>)

Name of argument.  C<argv> (or C<name> if missing) is passed to event
handlers with this name.

=back

=cut

sub ___raise_event ($%) {
  my ($self, %opt) = @_;
  my $event = {cancel => 0, name => $opt{name},
               ($opt{argv_name}||$opt{name}) => $opt{argv}};
  for (@{$self->{event}->{$opt{name}}}) {
    $_->($self, $event);
    return 0 if $event->{cancel};
  }
  return 1;
}

=back

=head1 EVENT MODEL

Wiki implementation object (C<$wiki>) "raise"s some event.

WARNING: Event model of SuikaWiki 3 is not completed yet.
Future revision of SuikaWiki might introduce incompatible modification
to the interface.

@@TBD

=head2 Events

=over 4

=item close

When the wiki implementation is to be closed.

This event is uncancelabel in current implementation.

=item database_close

When the WikiDatabase is to be closed.

This event is uncancelable in current implementation.

=item database_loaded

When WikiDatabase manager is loaded.  This event handler is typically
used to set database property module for SuikaWiki::DB::Logical.

This event is uncancelable.

=item plugin_manager_loaded

When WikiPlugin manager is loaded.  Note that plugins themselves are not
loaded yet.

This event is uncancelable.

=item setting_initial_variables

On the process to set per-access variables.
This event is raised before other core modules such as WikiDatabase
or WikiPlugin are loaded.

This event is uncancelable.

=item view_error

Something wrong with or something useful message is available from WikiView
manager.

This event is uncancelable.

=item view_in_mode

C<view_in_mode> method is called.

This event is uncancelable in current implementation.

=back

=head2 Example

  ## Installing a new event handler
  push @{$wiki->{event}->{ $some_event_name }}, sub {
    my ($wiki, $event) = @_;
    
    # something
    
    $event->{cancel} = 1 if $some_condition;
  };

=head1 LICENSE

Copyright 2003-2004 Wakaba <w@suika.fam.cx>.  All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

1; # $Date: 2004/04/01 04:45:50 $