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