lib/SuikaWiki/Implementation.pm


=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.9 $=~/\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.3',
    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     => 20,
       -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'};
    \%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 ';', @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 ';', @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 ->{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_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_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/02/08 08:56:45 $
1	wakaba	1.1
2			=head1 NAME
3
4	wakaba	1.8	SuikaWiki::Implementation - SuikaWiki: WikiEngine Core
5
6			=head1 DESCRIPTION
7
8			This module implements core part of the SuikaWiki WikiEngine.
9			All implemented features of WikiEngine can be called directly
10			or indirectly from instance of this module (with some exception
11			such as functions provided by WikiPlugin modules).
12
13			This module is part of SuikaWiki.
14
15			=head1 SYNOPSIS
16
17			require SuikaWiki::Implementation;
18			my $WIKI = new SuikaWiki::Implementation;
19			...
20			$WIKI->exit;
21
22			C<lib/suikawiki.pl> might be a good example for instanciating WikiEngine.
23	wakaba	1.1
24			=cut
25
26			package SuikaWiki::Implementation;
27			use strict;
28	wakaba	1.10	our $VERSION = do{my @r=(q$Revision: 1.9 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
29	wakaba	1.1
30			=head1 METHODS
31
32			=over 4
33
34			=item $wiki = SuikaWiki::Implementation->new ()
35
36			Constructs new instance of wiki implementation
37
38			=cut
39
40			sub new ($;%) {
41	wakaba	1.2	my $self = bless {
42	wakaba	1.8	driver_name => 'WikiImplementation',
43			driver_version => '0.0',
44			driver_uri_reference => q<about:>,
45			engine_name => 'SuikaWiki',
46	wakaba	1.10	engine_version => '2.9.3',
47	wakaba	1.8	engine_uri_reference => q<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SuikaWiki>,
48	wakaba	1.2	}, shift;
49	wakaba	1.1
50			$self;
51			}
52
53	wakaba	1.2	=item $wiki->init_variables
54
55			Initialize per-access variables. This method should be called
56			before other init_* methods are to be called.
57
58			=cut
59
60			sub init_variables ($) {
61			my $self = shift;
62	wakaba	1.7	$self->close_input;
63	wakaba	1.2	$self->{var} = {};
64	wakaba	1.10	$self->___raise_event (name => 'setting_initial_variables');
65	wakaba	1.2	}
66
67	wakaba	1.1	=item $wiki->init_plugin
68
69			Prepares to use wiki plugins
70
71			=cut
72
73			sub init_plugin ($) {
74			my $self = shift;
75			require SuikaWiki::Plugin;
76	wakaba	1.5	$self->{plugin} = SuikaWiki::Plugin->new (wiki => $self);
77	wakaba	1.1
78	wakaba	1.10	$self->___raise_event (name => 'plugin_manager_loaded');
79	wakaba	1.1	}
80
81			=item $wiki->init_view
82
83			Prepares to use wikiview
84
85			=cut
86
87			sub init_view ($) {
88			my $self = shift;
89			require SuikaWiki::View::Implementation;
90			$self->{view} = SuikaWiki::View::Implementation->new (wiki => $self);
91
92	wakaba	1.10	$self->___raise_event (name => 'view_implementation_loaded');
93	wakaba	1.1	}
94
95			=item $wiki->init_db
96
97			Prepares to use wiki database
98
99			=cut
100
101			sub init_db ($) {
102	wakaba	1.10	my $wiki = shift;
103			return if ref $wiki->{db}; ## Already initialized
104			$wiki->{config}->{lock}
105			= {-directory => $wiki->{config}->{path_to}->{db__lock__dir},
106	wakaba	1.1	-retry => 20,
107			-error_handler => sub {
108	wakaba	1.10	my ($self, %o) = @_;
109			if ($o{level} eq 'fatal' or $wiki->{config}->{debug}->{db}) {
110			if ($wiki->{config}->{path_to}->{db__lock__log_file}) {
111			open LOG, '>>', $wiki->{config}->{path_to}
112			->{db__lock__log_file};
113			print LOG scalar (gmtime),
114	wakaba	1.1	"\@@{[time]} @{[$$]} {$o{level}}: LOCK: ",
115	wakaba	1.10	$o{msg}, Carp::longmess,"\n";
116			close LOG;
117			}
118			}
119			if ($o{level} eq 'fatal') {
120			die $o{msg};
121			}
122	wakaba	1.1	},
123			};
124	wakaba	1.10	$wiki->{var}->{db}->{lock_prop} = sub {
125	wakaba	1.1	my $prop = shift;
126	wakaba	1.10	my %lock = %{$wiki->{config}->{lock}};
127	wakaba	1.1	$lock{-name} = $prop;
128	wakaba	1.10	$lock{-share} = defined $wiki->{var}->{db}->{read_only}->{$prop}
129			? $wiki->{var}->{db}->{read_only}->{$prop}
130			: $wiki->{var}->{db}->{read_only}->{'#default'};
131	wakaba	1.1	\%lock;
132			};
133
134			require SuikaWiki::DB::Logical;
135	wakaba	1.10	$wiki->{db} = new SuikaWiki::DB::Logical;
136	wakaba	1.1
137	wakaba	1.10	$wiki->___raise_event (name => 'database_loaded');
138	wakaba	1.1	}
139
140	wakaba	1.3	=item $wiki->view_in_mode (%opt)
141
142			Doing main process in accordance to the mode.
143
144			Actually, this method only raises an event of 'view_in_mode'.
145			So that "doing main process" code should be registered as an event procedure
146			of 'view_in_mode'.
147
148			=cut
149
150			sub view_in_mode ($%) {
151			my ($self, %opt) = @_;
152	wakaba	1.10	$self->___raise_event (name => 'view_in_mode', argv => \%opt);
153	wakaba	1.1	}
154
155	wakaba	1.5
156	wakaba	1.8	=item $uri = $wiki->uri_reference (%option)
157
158			Returning URI reference that refers the wiki or a WikiPage.
159
160			Load {input} before calling this method or specify appropriate C<wiki_uri>
161			option to get proper result.
162
163			One or two URI reference(s) is returned as C<URI> object.
164			See C<base> option.
165
166			Available options:
167
168			=over 4
169
170			=item anchor_no => positive-integer (default: none)
171
172			Numeral anchor index. With this option, C<fragment> option
173			is ignored.
174
175			=item base => URI reference (default: none)
176
177			Base URI reference. C<wantarray ? (relative, absolute) : relative> is
178			returned when C<base> is specified. Otherwise, C<(absolute, absolute)>
179			is returned.
180
181			=item fragment => URI reference fragment (default: none)
182
183			URI refernece fragment. This option value MUST be encoded
184			by URI escape encoding.
185
186			=item mode => mode-name (default: "default")
187
188			WikiView mode in which referred.
189	wakaba	1.2
190	wakaba	1.8	=item page => [WikiName] (default: none)
191
192			WikiName to that WikiPage URI reference is referring.
193
194			=item param => {name1 => value1, name2 => value2,...} (default: none)
195
196			Additional query parameters. Names and values are automatically
197			encoded by URI escape encoding if necessary.
198
199			=item up_to_date => 1/0 (default: 0)
200
201			"Up-to-date" URI query parameter for cheating cache.
202
203			=item wiki_uri => URI reference (default: auto)
204
205			A base URI reference referring the wiki itself.
206
207			=item with_lm => 1/0 (default: 0)
208
209			"Last modified" URI query parameter for chating WWW browser history.
210
211			=back
212	wakaba	1.2
213			=cut
214
215	wakaba	1.6	sub uri_reference ($;%) {
216	wakaba	1.8	my ($self, %opt) = @_; ## Note: $opt{wiki_uri} must be a URI(.pm) if any.
217			my $uri = $opt{wiki_uri} \|\| $self->___get_wiki_uri;
218	wakaba	1.6
219			## SuikaWiki 3.0 format
220			my $query_param = qr/[^0-9A-Za-z_.-]/;
221	wakaba	1.7	my @param = map {my $n = $_; $n =~ tr/_/-/;
222			$self->___uri_escape_encode ($n, $query_param).'='.
223	wakaba	1.6	$self->___uri_escape_encode ($opt{param}->{$_}, $query_param)}
224			keys %{$opt{param}};
225			push @param, 'mode='.$self->___uri_escape_encode ($opt{mode}, $query_param)
226			if $opt{mode};
227			push @param, 'x-d='.time if $opt{up_to_date};
228			if ($opt{page}) {
229			if ($opt{with_lm} and ref $self->{db}) {
230			push @param, 'x-lm='
231			. $self->___uri_escape_encode
232			($self->{db}->get (lastmodified => $opt{page}),
233			$query_param);
234			}
235	wakaba	1.9	my $page = $opt{page}->stringify (wiki => $self);
236	wakaba	1.6	if (@param) {
237			## TODO: Encode by $wiki->{config}->{charset}->{uri_param_encode}
238			unshift @param, 'mypage='.$self->___uri_escape_encode
239			($page, $query_param);
240			push @param, '_charset_='.$self->{config}->{charset}->{uri_param_encode};
241			## TODO: downgrade to &
242			$uri->query (join ';', @param);
243			} else {
244			## TODO: Encode by $wiki->{config}->{charset}->{uri_query_encode}
245			$uri->query ($self->___uri_escape_encode ($page, $query_param));
246			}
247			} elsif (@param) {
248			push @param, '_charset_='.$self->{config}->{charset}->{uri_param_encode};
249			$uri->query (join ';', @param);
250			}
251
252			if ($opt{anchor_no}) {
253			$uri->fragment ('anchor-'.$opt{anchor_no});
254			} elsif ($opt{fragment}) {
255			$uri->fragment ($opt{fragment});
256			}
257
258			if (defined $opt{base}) {
259			$opt{base} = $self->{input}->request_uri
260			if ref $self->{input} and not ref $opt{base} and $opt{base} eq '1';
261			return wantarray ? ($uri->rel ($opt{base}), $uri) : $uri->rel ($opt{base});
262			} else {
263			return ($uri, $uri);
264			}
265			}
266
267	wakaba	1.8	=item 1/0 = $wiki->uri_is_part_of_wiki ($uri-reference)
268
269			Check whether given URI reference is "part of" the wiki.
270
271			=cut
272
273	wakaba	1.6	sub uri_is_part_of_wiki ($$) {
274			my ($self, $uri) = @_;
275			my $wiki_uri = ''.$self->___get_wiki_uri;
276	wakaba	1.8	$uri = URI->new (substr ($uri, 0, length ($wiki_uri)));
277			$uri eq $wiki_uri ? 1 : 0;
278	wakaba	1.6	}
279
280			sub ___get_wiki_uri ($) {
281			my ($self) = shift;
282			my $uri;
283			if (ref $self->{___uri}) {
284			$uri = $self->{___uri}->clone;
285			} elsif (ref $self->{input}) {
286			$uri = $self->{input}->request_uri (no_path_info => 1, no_query => 1);
287			$self->{___uri} = $uri->clone;
288			} else {
289			$uri = URI->new;
290			}
291			$uri;
292			}
293
294			sub ___uri_escape_encode ($$;$) {
295			my ($self, $s, $char) = @_;
296			$char \|\|= qr([^0-9A-Za-z_.!~*'();/?:\@&=+\$,-]);
297	wakaba	1.10	## TODO: Some fix required when utf8'ized
298	wakaba	1.6	# require Encode;
299			# $s = Encode::decode ('utf8', $s);
300			$s =~ s/($char)/sprintf '%%%02X', ord $1/ge;
301			$s;
302			}
303
304	wakaba	1.9	sub name ($$%) {
305			require SuikaWiki::Name;
306			my ($wiki, $name, %opt) = @_;
307			SuikaWiki::Name->new ($name, wiki => $wiki, %opt);
308			}
309
310	wakaba	1.10	=item $wiki->close_input
311	wakaba	1.8
312	wakaba	1.10	Closing input manager (C<< $wiki->{input} >>).
313	wakaba	1.8
314			=cut
315
316	wakaba	1.10	sub close_input ($) {
317	wakaba	1.5	my $self = shift;
318	wakaba	1.10	if (ref $self->{input}) {
319			$self->___raise_event (name => 'input_close');
320			$self->{input}->exit;
321			}
322			delete $self->{input};
323	wakaba	1.5	}
324
325	wakaba	1.8	=item $wiki->close_view
326
327			Closing WikiView manager (C<< $wiki->close_view >>).
328
329			=cut
330
331	wakaba	1.5	sub close_view ($) {
332			my $self = shift;
333			$self->{view}->exit if ref $self->{view};
334			delete $self->{view};
335			}
336
337	wakaba	1.10	=item $wiki->close_db
338
339			Closing WikiDB (C<$wiki->{db}>).
340
341			Although this method is automatically called by C<< $wiki->exit >>,
342			it is good practice to explicitly close something opened explicitly.
343
344			This method make C<database_close> event called before database is
345			actually closed. Future version of this module might make event handler
346			being able to cancel closing.
347
348			Calling this method when database is not opened makes no sense,
349			nor being C<database_close> event raisen.
350
351			=cut
352
353			sub close_db ($) {
354			my $self = shift;
355			if (ref $self->{db}) {
356			$self->___raise_event (name => 'database_close');
357			$self->{db}->close;
358			}
359			delete $self->{db};
360			}
361
362	wakaba	1.8	=item $wiki->close_plugin
363
364			Closing WikiPlugin manager (C<< $wiki->{plugin} >>).
365			Note that this method does not unload WikiPlugin modules.
366			(They are "merged" to script namespace so that unloading them
367			is almost impossible.)
368
369			=cut
370
371	wakaba	1.5	sub close_plugin ($) {
372			my $self = shift;
373			$self->{plugin}->exit if ref $self->{plugin};
374			delete $self->{plugin};
375			}
376
377	wakaba	1.8	=item 1/0 = $wiki->exit
378	wakaba	1.1
379	wakaba	1.8	Exitign the wiki. This method closes input manager, WikiDB manager,
380			WikiView manager and WikiPlugin manager after C<close> event is raised.
381			Note that C<close> event handler can "cancel" exiting,
382			it makes this method return C<0>.
383
384			This method is automatically called before C<$wiki> is destoroyed.
385	wakaba	1.1
386			=cut
387
388			sub exit ($) {
389			my $self = shift;
390	wakaba	1.5	return 0 unless $self->___raise_event (name => 'close');
391	wakaba	1.7	$self->close_input;
392	wakaba	1.5	$self->close_db;
393			$self->close_view;
394			$self->close_plugin;
395			$self->{exited} = 1;
396			1;
397	wakaba	1.1	}
398
399	wakaba	1.8	## TODO: Provides "cancelable" to close event.
400
401	wakaba	1.1	sub DESTROY ($) {
402			my $self = shift;
403	wakaba	1.5	$self->exit unless $self->{exited};
404	wakaba	1.1	}
405
406			=back
407
408			=head1 PUBLIC PROPERTIES
409
410			=over 4
411
412	wakaba	1.2	=item $wiki->{config}
413
414			Persistent wiki configureation parameters
415			(that is not changed with the situation when is who accessing in what way)
416
417			=over 4
418
419			=item ->{charset}->{internal} = <IANA charset name (in lower case)>
420
421			Character encoding scheme used in wiki implementation
422
423			=item ->{charset}->{output} = <IANA charset name (in lower case)>
424
425			Default character encoding scheme used to output content
426
427	wakaba	1.5	=item ->{debug}->{$category} = 1/0 (Default 0)
428
429			Debug mode
430
431			Categories:
432
433			=over 4
434
435			=item db
436
437			WikiDatabase related features
438
439	wakaba	1.7	=item general
440
441			Generic.
442
443			=item view
444
445			WikiView related.
446
447	wakaba	1.5	=back
448
449	wakaba	1.2	=item ->{entity}->{expires}->{$rulename} = {delta => $seconds}
450
451			How long outputed entity will be fresh.
452
453			=item ->{lock}
454	wakaba	1.1
455			Default (prototype) properties to give SuikaWiki::DB::Util::Lock
456
457	wakaba	1.2	=item ->{page}->{ $name }
458
459			WikiPage which has feature of $name
460
461			=item ->{path_to}->{ $name }
462	wakaba	1.1
463			Filesystem path (or path fragment) to $name
464
465	wakaba	1.2	=back
466
467	wakaba	1.1	=item $wiki->{db}
468
469			Wiki main database
470
471	wakaba	1.8	=item $wiki->{driver_name}
472
473			Product name of the WikiDriver.
474
475			For interoperability, only alphanumeric characters and limited symbols
476			(those allowed in RFC 2616 token) should be used as parts of product name.
477
478			=item $wiki->{driver_version}
479
480			WikiDriver version in string.
481
482			For interoperability, only alphanumeric characters and limited symbols
483			(those allowed in RFC 2616 token) should be used as parts of product name.
484
485			=item $wiki->{engine_name} (Read only)
486
487			SuikaWiki WikiEngine name
488
489			=item $wiki->{engine_version} (Read only)
490
491			SuikaWiki WikiEngine version
492
493	wakaba	1.1	=item @{$wiki->{event}->{ $event_name }}
494
495	wakaba	1.10	Event handling procedures. See also EVENT MODEL section.
496	wakaba	1.2
497			=item $wiki->{var}
498
499			Non-persistent wiki variable options
500			(that might vary with context such as caller's argument values)
501
502			=over 4
503
504	wakaba	1.6	=item ->{client}->{downgrade}->{ $feature } = $parameter
505
506			Whether downgrade is required. See C<Downgrade> plugin module.
507
508	wakaba	1.2	=item ->{client}->{used_for_negotiation} = [<HTTP field name>s]
509
510			HTTP (request) header field names used to select variable content.
511			This value will be used to generate HTTP Vary header field.
512
513			=item ->{client}->{user_agent_name} = <HTTP User-Agent field body value>
514
515			User agent name provided by such ways as User-Agent field (in HTTP)
516			or HTTP_USER_AGENT meta variable (in HTTP-CGI).
517
518			=item ->{db}->{lock_prop} = sub ($prop)
519
520			Function returning hash reference of lock options
521			(that will be passed to SuikaWiki::DB::Util::Lock->new).
522
523			$prop, an argument to the function, is a database property name.
524
525			=item ->{db}->{read_only}->{ $prop } = 1/0
526
527			Whether the database property named as $prop is opened in read only
528			mode or not. Special property name of '#default' is used to set
529			the default value referred when {read_only}->{$prop} is not specified
530			explicily.
531
532			Note that this value must be set before the instance of database property
533			is loaded.
534
535	wakaba	1.5	=item ->{error} = [{description => Error 1}, {description => Error 2},...]
536
537			Trapped errors.
538
539	wakaba	1.2	=item ->{input}
540
541			Instance of input parameter interface (such as SuikaWiki::Input::HTTP)
542
543			=item ->{mode} = mode name
544
545			Wiki mode name
546
547			=item ->{page} = [page]
548
549			WikiPage being referred
550
551			=back
552
553			=item $wiki->{view}
554
555			WikiView implementation (an instance of SuikaWiki::View::Implementation)
556
557	wakaba	1.10	=back
558
559			=head1 INTERNAL METHODS
560
561			This section describes some internal methods which only intend to be
562			used by this module. These methods MUST NOT be used out of this
563			module.
564
565			=over 4
566
567			=item 1/0 = $wiki->___raise_event (%option)
568
569			Raise an event. C<0> is returned if "cancel"ed, otherwise C<1>
570			returned.
571
572			Options:
573
574			=over 4
575
576			=item name => event-name (required)
577
578			Event name.
579
580			=item argv => some-value (default: none)
581
582			Some argument value, which is to be passed to event handlers
583			as C<< $event->{ I<argv_name> } >>.
584
585			=item argv_name => string (default: same as C<name>)
586
587			Name of argument. C<argv> (or C<name> if missing) is passed to event
588			handlers with this name.
589
590			=back
591
592	wakaba	1.1	=cut
593
594	wakaba	1.10	sub ___raise_event ($%) {
595			my ($self, %opt) = @_;
596			my $event = {cancel => 0, name => $opt{name},
597			($opt{argv_name}\|\|$opt{name}) => $opt{argv}};
598			for (@{$self->{event}->{$opt{name}}}) {
599			$_->($self, $event);
600			return 0 if $event->{cancel};
601			}
602			return 1;
603			}
604
605			=back
606
607			=head1 EVENT MODEL
608
609			Wiki implementation object (C<$wiki>) "raise"s some event.
610
611			WARNING: Event model of SuikaWiki 3 is not completed yet.
612			Future revision of SuikaWiki might introduce incompatible modification
613			to the interface.
614
615			@@TBD
616
617			=head2 Events
618
619			=over 4
620
621			=item close
622
623			When the wiki implementation is to be closed.
624
625			This event is uncancelabel in current implementation.
626
627			=item database_close
628
629			When the WikiDatabase is to be closed.
630
631			This event is uncancelable in current implementation.
632
633			=item database_loaded
634
635			When WikiDatabase manager is loaded. This event handler is typically
636			used to set database property module for SuikaWiki::DB::Logical.
637
638			This event is uncancelable.
639
640			=item plugin_manager_loaded
641
642			When WikiPlugin manager is loaded. Note that plugins themselves are not
643			loaded yet.
644
645			This event is uncancelable.
646
647			=item setting_initial_variables
648
649			On the process to set per-access variables.
650			This event is raised before other core modules such as WikiDatabase
651			or WikiPlugin are loaded.
652
653			This event is uncancelable.
654
655			=item view_error
656
657			Something wrong with or something useful message is available from WikiView
658			manager.
659
660			This event is uncancelable.
661
662			=item view_in_mode
663
664			C<view_in_mode> method is called.
665
666			This event is uncancelable in current implementation.
667
668			=back
669
670			=head2 Example
671
672			## Installing a new event handler
673			push @{$wiki->{event}->{ $some_event_name }}, sub {
674			my ($wiki, $event) = @_;
675
676			# something
677
678			$event->{cancel} = 1 if $some_condition;
679			};
680
681	wakaba	1.1	=head1 LICENSE
682
683	wakaba	1.8	Copyright 2003-2004 Wakaba <w@suika.fam.cx>. All rights reserved.
684	wakaba	1.1
685			This program is free software; you can redistribute it and/or
686			modify it under the same terms as Perl itself.
687
688			=cut
689
690	wakaba	1.10	1; # $Date: 2004/02/08 08:56:45 $