SuikaWiki/View/Implementation.pm


=head1 NAME

SuikaWiki::View::Implementation --- SuikaWiki: WikiView implementation

=cut

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

=head1 METHODS

=over 4

=item $v = SuikaWiki::View->new

Constructs new instance of WikiView implementation

=cut

sub new ($%) {
  my $class = shift;
  my $self = bless {@_, definition => {}}, $class;
  
  $self;
}

sub select ($$$) {
  my ($self, $mode, $opt) = @_;
  $mode =~ s/(?<=.)-/_/g;
  my $views = $self->{definition}->{$mode} || [];
  my @views;
  VIEW: for my $view (@$views) {
    my $point = 0;
    COND: for (keys %{$view->{condition}}) {
      next if $_ eq 'mode';
      if (ref ($view->{condition}->{$_}) eq 'ARRAY') {
        for my $item (@{$view->{condition}->{$_}}) {
          if ($item eq $opt->{condition}->{$_}) {
            $point++;
            next COND;
          }
        }
        next VIEW; # no match
      } elsif ($opt->{condition}->{$_} eq $view->{condition}->{$_}) {
        $point++;
      } else {
        next VIEW; # no match
      }
    }
    $views[$point] ||= [];
    push @{$views[$point]}, $view;
  }
  
  for (reverse 0..$#views) {
    for my $view (@{$views[$_]||[]}) {
      return $view if !$view->{check} || &{$view->{check}} ($self, $opt);
    }
  }
  
  if ($mode ne '#default') { 
    return $self->select ('#default', $opt);
  } else {
    return undef;
  }
}

sub instantiate ($$$) {
  my ($self, $mode, $opt) = @_;
  my $view = $self->select ($mode, $opt) or return undef;
  unless (ref $view->{object}) {
    if ($view->{object_class}) {
      $view->{object} = $view->{object_class}->new (view => $self, 
                                                    viewdef => $view, 
                                                    opt => $opt);
    } else {
      $view->{object} = &{$view->{object_init}} ($self, $opt, $view);
    }
  }
  $view->{object}->{viewdef} = $view;
  return $view->{object};
}

                 
sub register_mode ($$$) {
  my ($self, $mode, $view) = @_;
  $view->{condition}->{mode} ||= $mode;
  $self->{definition}->{$mode} ||= [];
  push @{$self->{definition}->{$mode}}, $view;
}

                   
sub init_db ($$) {
  my ($self, $opt) = @_;
  $self->{wiki}->init_db;
}

sub register_common_modes ($) {
  my ($self) = @_;
  for (@CommonViewDefs) {
    $self->register_mode ($_->{condition}->{mode} => $_);
  }
}

our %TemplateFragment;
sub assemble_template ($$) {
  my ($self, $name) = @_;
  $name =~ tr/-/_/;
  my $template = join '',
    map {$_->{Main}}
    sort {$a->{Order} <=> $b->{Order}}
    @{$TemplateFragment{$name}||[]};
  $template;
}

sub ___report_error ($$) {
  my ($view, $err) = @_;
  $view->{wiki}->___raise_event (name => 'view_error',
                                 argv => $err, argv_name => 'error')
    and $err->throw;;
}

sub exit ($) {
  my $self = shift;
  delete $self->{wiki};
  delete $self->{definition};
  $self->{exited} = 1;
  1;
}

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

=item $v->{definition}->{ $mode } = [{ condition => {mode => $mode,...}, ... },...]

=item $v->{wiki}

Instance of wiki implementation

=back

=cut

package SuikaWiki::View::template;

sub new ($%) {
  my $class = shift;
  bless {@_}, $class;
}

sub main ($$) {
  my ($self, $opt) = @_;
  my $opt2 = {};
  $self->main_pre ($opt, $opt2)
    &&
  1
    &&
  $self->main_post ($opt, $opt2);
}

sub main_pre ($$$) {
  1;
}

sub main_post ($$$) {
  1;
}

package SuikaWiki::View::Implementation::error;
require Message::Util::Error;
our @ISA = 'Message::Util::Error';

sub ___error_def () {+{
  VIEW_NOT_DEFINED => {
    description => q(View (%condition (separator => ", ");): View not defined),
    level => 'fatal',
  },
  WARN_VIEW_NOT_DEFINED => {
    description => q(View (%condition (separator => ", ");): View not defined),
  },
  ERROR_REPORTED => {
    level => 'fatal',
  },
}}

sub _FORMATTER_PACKAGE_ () { 'SuikaWiki::View::Implementation::error::formatter' }

package SuikaWiki::View::Implementation::error::formatter;
push our @ISA, 'Message::Util::Error::formatter';

sub ___rule_def () {+{
  condition => {
    after => sub {
      my ($f, $name, $p, $o) = @_;
      if ($p->{name}) {
        $p->{-result} .= $o->{condition}->{$p->{name}};
      } else {
        $p->{-result} .= join $p->{separator} || '; ',
                                map {$_.($p->{vi}||'=').$o->{condition}->{$_}}
                                keys %{$o->{condition}};
      }
    },
  },
}}

=head1 LICENSE

Copyright 2003 Wakaba <[email protected]>

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

=cut

1; # $Date: 2004/01/16 08:02:05 $
1	wakaba	1.1
2			=head1 NAME
3
4			SuikaWiki::View::Implementation --- SuikaWiki: WikiView implementation
5
6			=cut
7
8			package SuikaWiki::View::Implementation;
9			use strict;
10	wakaba	1.9	our $VERSION = do{my @r=(q$Revision: 1.8 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
11	wakaba	1.1	our @CommonViewDefs;
12
13			=head1 METHODS
14
15			=over 4
16
17			=item $v = SuikaWiki::View->new
18
19			Constructs new instance of WikiView implementation
20
21			=cut
22
23			sub new ($%) {
24			my $class = shift;
25			my $self = bless {@_, definition => {}}, $class;
26
27			$self;
28			}
29
30			sub select ($$$) {
31			my ($self, $mode, $opt) = @_;
32	wakaba	1.8	$mode =~ s/(?<=.)-/_/g;
33	wakaba	1.1	my $views = $self->{definition}->{$mode} \|\| [];
34			my @views;
35			VIEW: for my $view (@$views) {
36			my $point = 0;
37	wakaba	1.2	COND: for (keys %{$view->{condition}}) {
38	wakaba	1.1	next if $_ eq 'mode';
39	wakaba	1.2	if (ref ($view->{condition}->{$_}) eq 'ARRAY') {
40			for my $item (@{$view->{condition}->{$_}}) {
41			if ($item eq $opt->{condition}->{$_}) {
42			$point++;
43			next COND;
44			}
45			}
46			next VIEW; # no match
47			} elsif ($opt->{condition}->{$_} eq $view->{condition}->{$_}) {
48	wakaba	1.1	$point++;
49			} else {
50	wakaba	1.2	next VIEW; # no match
51	wakaba	1.1	}
52			}
53			$views[$point] \|\|= [];
54			push @{$views[$point]}, $view;
55			}
56
57			for (reverse 0..$#views) {
58			for my $view (@{$views[$_]\|\|[]}) {
59			return $view if !$view->{check} \|\| &{$view->{check}} ($self, $opt);
60			}
61			}
62
63			if ($mode ne '#default') {
64			return $self->select ('#default', $opt);
65			} else {
66			return undef;
67			}
68			}
69
70			sub instantiate ($$$) {
71			my ($self, $mode, $opt) = @_;
72			my $view = $self->select ($mode, $opt) or return undef;
73			unless (ref $view->{object}) {
74			if ($view->{object_class}) {
75			$view->{object} = $view->{object_class}->new (view => $self,
76			viewdef => $view,
77			opt => $opt);
78			} else {
79			$view->{object} = &{$view->{object_init}} ($self, $opt, $view);
80			}
81			}
82			$view->{object}->{viewdef} = $view;
83			return $view->{object};
84			}
85
86
87			sub register_mode ($$$) {
88			my ($self, $mode, $view) = @_;
89			$view->{condition}->{mode} \|\|= $mode;
90			$self->{definition}->{$mode} \|\|= [];
91			push @{$self->{definition}->{$mode}}, $view;
92			}
93
94
95			sub init_db ($$) {
96			my ($self, $opt) = @_;
97			$self->{wiki}->init_db;
98			}
99
100			sub register_common_modes ($) {
101			my ($self) = @_;
102			for (@CommonViewDefs) {
103			$self->register_mode ($_->{condition}->{mode} => $_);
104			}
105			}
106
107	wakaba	1.2	our %TemplateFragment;
108			sub assemble_template ($$) {
109			my ($self, $name) = @_;
110	wakaba	1.4	$name =~ tr/-/_/;
111	wakaba	1.5	my $template = join '',
112	wakaba	1.2	map {$_->{Main}}
113			sort {$a->{Order} <=> $b->{Order}}
114	wakaba	1.3	@{$TemplateFragment{$name}\|\|[]};
115	wakaba	1.5	$template;
116	wakaba	1.2	}
117
118	wakaba	1.8	sub ___report_error ($$) {
119			my ($view, $err) = @_;
120	wakaba	1.9	$view->{wiki}->___raise_event (name => 'view_error',
121			argv => $err, argv_name => 'error')
122	wakaba	1.8	and $err->throw;;
123			}
124
125	wakaba	1.7	sub exit ($) {
126			my $self = shift;
127			delete $self->{wiki};
128			delete $self->{definition};
129			$self->{exited} = 1;
130			1;
131			}
132
133			sub DESTROY ($) {
134			my $self = shift;
135			$self->exit unless $self->{exited};
136			}
137
138	wakaba	1.1	=item $v->{definition}->{ $mode } = [{ condition => {mode => $mode,...}, ... },...]
139
140			=item $v->{wiki}
141
142			Instance of wiki implementation
143
144			=back
145
146			=cut
147
148			package SuikaWiki::View::template;
149
150			sub new ($%) {
151			my $class = shift;
152			bless {@_}, $class;
153			}
154
155			sub main ($$) {
156			my ($self, $opt) = @_;
157	wakaba	1.2	my $opt2 = {};
158			$self->main_pre ($opt, $opt2)
159			&&
160			1
161			&&
162			$self->main_post ($opt, $opt2);
163			}
164
165			sub main_pre ($$$) {
166			1;
167			}
168
169			sub main_post ($$$) {
170			1;
171	wakaba	1.1	}
172
173	wakaba	1.6	package SuikaWiki::View::Implementation::error;
174			require Message::Util::Error;
175			our @ISA = 'Message::Util::Error';
176
177	wakaba	1.8	sub ___error_def () {+{
178			VIEW_NOT_DEFINED => {
179			description => q(View (%condition (separator => ", ");): View not defined),
180			level => 'fatal',
181			},
182			WARN_VIEW_NOT_DEFINED => {
183			description => q(View (%condition (separator => ", ");): View not defined),
184			},
185	wakaba	1.6	ERROR_REPORTED => {
186	wakaba	1.8	level => 'fatal',
187			},
188			}}
189
190			sub _FORMATTER_PACKAGE_ () { 'SuikaWiki::View::Implementation::error::formatter' }
191
192			package SuikaWiki::View::Implementation::error::formatter;
193			push our @ISA, 'Message::Util::Error::formatter';
194
195			sub ___rule_def () {+{
196			condition => {
197			after => sub {
198			my ($f, $name, $p, $o) = @_;
199			if ($p->{name}) {
200			$p->{-result} .= $o->{condition}->{$p->{name}};
201			} else {
202			$p->{-result} .= join $p->{separator} \|\| '; ',
203			map {$_.($p->{vi}\|\|'=').$o->{condition}->{$_}}
204			keys %{$o->{condition}};
205			}
206			},
207	wakaba	1.6	},
208			}}
209
210	wakaba	1.1	=head1 LICENSE
211
212			Copyright 2003 Wakaba <[email protected]>
213
214			This program is free software; you can redistribute it and/or
215			modify it under the same terms as Perl itself.
216
217			=cut
218
219	wakaba	1.9	1; # $Date: 2004/01/16 08:02:05 $