SuikaWiki/Format/Definition.pm


=head1 NAME

SuikaWiki::Format::Definition - SuikaWiki: Format definition manager

=head1 DESCRIPTION

This module provides "format" definitions management functionality.

This module is part of SuikaWiki.

=cut

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

sub new_handler ($;%) {
  my ($class, %opt) = @_;
  my $self = bless {%opt}, $class;
  my $pack = $self->__get_class_name (\%opt);
  report SuikaWiki::Format::Definition::error
    -type => 'CLASS_NOT_FOUND',
    type => \%opt,
    -object => $self, method => 'new_handler',
    unless $pack;
  
  $pack->new (type => \%opt);
}

sub __get_param_string ($$) {
  join '', map {
              ';'. $_ .'='. __quote ($_[1]->{$_})
            } sort {
              $a cmp $b
            } keys %{$_[1]||{}}
}
sub __quote ($) {
  my $s = shift;
  $s =~ s/([\\"])/\\$1/g;
  '"'.$s.'"';
}
sub __get_class_name ($$) {
  local $Error::Depth = $Error::Depth + 1;
  my ($self, $opt) = @_;
  my $pack;
  if ($opt->{serialized_media_type}) {
    $pack = $SuikaWiki::Format::Definition::Class{$opt->{serialized_media_type}};
    return $pack if $pack;
  }
  if ($opt->{Type}) {
    $pack = $SuikaWiki::Format::Definition::Class{'IMT:'.$opt->{Type}
                                                 .$self->__get_param_string
                                                    ($opt->{Type_param}||{})
                                                 .'##'};
    return $pack if $pack;
  }
  
  if (not ($opt->{Name}) and $opt->{magic}) {
    if ($opt->{magic} =~ m#^([\w.+-]+)(?:/([\w.+-]+))?#) {
      $opt->{Name} = $1;
      $opt->{Version} = $2;
    }
  }
  
  $pack = $SuikaWiki::Format::Definition::Class{'MAGIC:'.$opt->{Name}
                                               .'/'.$opt->{Version}.'##'}
    || $SuikaWiki::Format::Definition::Class{'MAGIC:'.$opt->{Name}.'/##'};
  return $pack if $pack;
  
  report SuikaWiki::Format::Definition::error
    -type => 'WARN_DEFAULT_CLASS',
    type => $opt,
    -object => $self, method => '___get_class_name';
  if ( ($opt->{serialized_media_type} and
        $opt->{serialized_media_type} =~ m#^IMT:text/#)
    or ($opt->{Type} and substr ($opt->{Type}, 0, 5) eq 'text/') or
    ($opt->{serialized_media_type} and
     $opt->{serialized_media_type} =~ m#^MAGIC:#)
    or $opt->{Name}) {
    $pack = $SuikaWiki::Format::Definition::Class{'IMT:text/plain##'};
  } elsif (
    ($opt->{serialized_media_type} and
     $opt->{serialized_media_type} =~ m#^IMT:multipart/#) or
    ($opt->{Type} and $opt->{Type} =~ m#^multipart/#)
  ) {
    $pack = $SuikaWiki::Format::Definition::Class{'IMT:multipart/mixed##'};
  } else {
    $pack = $SuikaWiki::Format::Definition::Class{'IMT:application/octet-stream##'};
  }
  return $pack if $pack;
  
  return undef
}

sub serialize_media_type ($%) {
  my (undef, %opt) = @_;
  my %return;
  if ($opt{Type}) {
    $return{Type} = 'IMT:'.$opt{Type};
    if ($opt{Type_param}) {
      $return{Type} .= join '', map {my $s;
                         ';'. $_ .'="'
                       . (($s = $opt{Type_param}->{$_}) =~ s/([\\"])/\\$1/g, $s)
                       . '"' 
                       } sort {
                         $a cmp $b
                       } keys %{$opt{Type_param}};
    }
  }
  if ($opt{Magic}) {
    $return{Magic} = 'MAGIC:'.$opt{Magic};
  } elsif ($opt{Name}) {
    $return{Name} = 'MAGIC:'.$opt{Name}.'/*';
    $return{Magic} = 'MAGIC:'.$opt{Name}.'/'.$opt{Version} if $opt{Version};
  }
  if ($opt{URIReference}) {
    $return{URIReference} = $opt{URIReference};
  }
  my $flag = '##';
  $flag .= 'f' if $opt{IsFragment};
  $flag .= 'p' if $opt{IsPlaceholder};
  for (qw/URIReference Type Magic Name/) {
    $return{$_} .= $flag if $return{$_};
  }
  $return{_} = $return{URIReference} || $return{Type}
            || $return{Magic} || $return{Name};
  \%return;
}

sub ___report_error ($$) {
  my ($self, $err) = @_;
  $self->{-error}->($err) if $self->{-error};
  if ($err->{-def}->{level} ne 'warn') {
    $err->throw;
  }
}

package SuikaWiki::Format::Definition::template;

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

sub convert ($$;%) {
  my ($self, $source, %opt) = @_;
  report SuikaWiki::Format::Definition::error
    -type => 'CONVERTER_NOT_FOUND',
    -object => $self, method => 'converter',
    type => $self->{type},
    type_to => \%opt;
}

sub wikiform ($$;%) {
  my ($self, $source, %opt) = @_;
  report SuikaWiki::Format::Definition::error
    -type => 'WIKIFORM_NOT_FOUND',
    -object => $self, method => 'wikiform',
    type => $self->{type};
}

sub next_index_for_anchor ($$;%) {
  my ($self, $source, %opt) = @_;
  1;
#  report SuikaWiki::Format::Definition::error
#    -type => 'NEXT_INDEX_NOT_FOUND',
#    -object => $self, method => 'next_index_for_anchor',
#    type => $self->{type},
#    next_index_type => 'anchor';
}

sub headsummary ($$;%) {
  my ($self, $source, %opt) = @_;
#  report SuikaWiki::Format::Definition::error
#    -type => '',
#    -object => $self, method => 'wikiform',
#    type => $self->{type};
  undef;
}

sub content_written ($%) {

}

sub content_removed ($%) {

}

sub content_type_changed_from ($%) {
  
}

=item $format->content_prop_modified (%param)

When WikiPage content property other than media-type:media-type modified.

=cut

sub content_prop_modified ($%) {

}

=item $val = $format->prop ($uri, %option)

Get format property.

=cut

sub prop ($$;%) {
  my ($self, $name, %opt) = @_;
  return $opt{default};
}

sub ___report_error ($$) {
  my ($view, $err) = @_;
  $err->throw;
}

package SuikaWiki::Format::Definition::error;
require Message::Util::Error;
our @ISA = 'Message::Util::Error';

sub ___error_def () {+{
  CLASS_NOT_FOUND => {
    description => q(%type;: Format handler class not found),
  },
  CONVERTER_NOT_FOUND => {
    description => q(%type; => %type-to;: Converter not found),
  },
  NEXT_INDEX_NOT_FOUND => {
    description => q(%type;: Next %t (name => next_index_type); index is unknown),
  },
  WARN_DEFAULT_CLASS => {
    description => q(%type;: Default type is selected),
    level => 'warn',
  },
  WIKIFORM_NOT_FOUND => {
    description => q(%type;: WikiForm handler not defined),
  },
}}

sub _FORMATTER_PACKAGE_ () {'SuikaWiki::Formatter::Definition::error::formatter'}

package SuikaWiki::Formatter::Definition::error::formatter;
our @ISA = 'Message::Util::Error::formatter';

sub ___rule_def ($) {+{
  type => {
    after => sub {
      my ($f, $name, $p, $o) = @_;
      my $opt = $o->{type};
      if ($opt->{serialized_media_type}) {
        $p->{-result} .= '(Serialized:) '.$opt->{serialized_media_type};
      } elsif ($opt->{Type}) {
        $p->{-result} .= 'IMT:'.$opt->{Type}.SuikaWiki::Format::Definition->__get_param_string ($opt->{Type_param});
      } else {
        $p->{-result} .= 'MAGIC:'.$opt->{Name}.'/'.$opt->{Version};
      }
    },
  },
  type_to => {
    after => sub {
      my ($f, $name, $p, $o) = @_;
      my $opt = $o->{type_to};
      if ($opt->{serialized_media_type}) {
        $p->{-result} .= '(Serialized:) '.$opt->{serialized_media_type};
      } elsif ($opt->{Type}) {
        $p->{-result} .= 'IMT:'.$opt->{Type}.SuikaWiki::Format::Definition->__get_param_string ($opt->{Type_param});
      } else {
        $p->{-result} .= 'MAGIC:'.$opt->{Name}.'/'.$opt->{Version};
      }
    },
  },
}}

=head1 LICENSE

Copyright 2003-2004 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/06/03 06:38:48 $
1	wakaba	1.1
2			=head1 NAME
3
4			SuikaWiki::Format::Definition - SuikaWiki: Format definition manager
5
6			=head1 DESCRIPTION
7
8			This module provides "format" definitions management functionality.
9
10			This module is part of SuikaWiki.
11
12			=cut
13
14			package SuikaWiki::Format::Definition;
15			use strict;
16	wakaba	1.8	our $VERSION = do{my @r=(q$Revision: 1.7 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
17	wakaba	1.1
18			sub new_handler ($;%) {
19			my ($class, %opt) = @_;
20	wakaba	1.3	my $self = bless {%opt}, $class;
21			my $pack = $self->__get_class_name (\%opt);
22	wakaba	1.2	report SuikaWiki::Format::Definition::error
23			-type => 'CLASS_NOT_FOUND',
24	wakaba	1.3	type => \%opt,
25			-object => $self, method => 'new_handler',
26	wakaba	1.1	unless $pack;
27
28			$pack->new (type => \%opt);
29			}
30
31			sub __get_param_string ($$) {
32			join '', map {
33			';'. $_ .'='. __quote ($_[1]->{$_})
34			} sort {
35			$a cmp $b
36			} keys %{$_[1]\|\|{}}
37			}
38			sub __quote ($) {
39			my $s = shift;
40			$s =~ s/([\\"])/\\$1/g;
41			'"'.$s.'"';
42			}
43			sub __get_class_name ($$) {
44	wakaba	1.3	local $Error::Depth = $Error::Depth + 1;
45	wakaba	1.1	my ($self, $opt) = @_;
46			my $pack;
47	wakaba	1.6	if ($opt->{serialized_media_type}) {
48			$pack = $SuikaWiki::Format::Definition::Class{$opt->{serialized_media_type}};
49			return $pack if $pack;
50			}
51	wakaba	1.1	if ($opt->{Type}) {
52	wakaba	1.6	$pack = $SuikaWiki::Format::Definition::Class{'IMT:'.$opt->{Type}
53	wakaba	1.1	.$self->__get_param_string
54			($opt->{Type_param}\|\|{})
55	wakaba	1.6	.'##'};
56	wakaba	1.1	return $pack if $pack;
57			}
58
59			if (not ($opt->{Name}) and $opt->{magic}) {
60	wakaba	1.5	if ($opt->{magic} =~ m#^([\w.+-]+)(?:/([\w.+-]+))?#) {
61	wakaba	1.1	$opt->{Name} = $1;
62			$opt->{Version} = $2;
63			}
64			}
65
66	wakaba	1.6	$pack = $SuikaWiki::Format::Definition::Class{'MAGIC:'.$opt->{Name}
67			.'/'.$opt->{Version}.'##'}
68			\|\| $SuikaWiki::Format::Definition::Class{'MAGIC:'.$opt->{Name}.'/##'};
69	wakaba	1.1	return $pack if $pack;
70
71	wakaba	1.3	report SuikaWiki::Format::Definition::error
72			-type => 'WARN_DEFAULT_CLASS',
73			type => $opt,
74			-object => $self, method => '___get_class_name';
75	wakaba	1.8	if ( ($opt->{serialized_media_type} and
76			$opt->{serialized_media_type} =~ m#^IMT:text/#)
77			or ($opt->{Type} and substr ($opt->{Type}, 0, 5) eq 'text/') or
78			($opt->{serialized_media_type} and
79			$opt->{serialized_media_type} =~ m#^MAGIC:#)
80	wakaba	1.2	or $opt->{Name}) {
81	wakaba	1.6	$pack = $SuikaWiki::Format::Definition::Class{'IMT:text/plain##'};
82	wakaba	1.8	} elsif (
83			($opt->{serialized_media_type} and
84			$opt->{serialized_media_type} =~ m#^IMT:multipart/#) or
85			($opt->{Type} and $opt->{Type} =~ m#^multipart/#)
86			) {
87			$pack = $SuikaWiki::Format::Definition::Class{'IMT:multipart/mixed##'};
88	wakaba	1.1	} else {
89	wakaba	1.6	$pack = $SuikaWiki::Format::Definition::Class{'IMT:application/octet-stream##'};
90	wakaba	1.1	}
91			return $pack if $pack;
92
93			return undef
94			}
95
96	wakaba	1.6	sub serialize_media_type ($%) {
97			my (undef, %opt) = @_;
98			my %return;
99			if ($opt{Type}) {
100			$return{Type} = 'IMT:'.$opt{Type};
101			if ($opt{Type_param}) {
102			$return{Type} .= join '', map {my $s;
103			';'. $_ .'="'
104			. (($s = $opt{Type_param}->{$_}) =~ s/([\\"])/\\$1/g, $s)
105			. '"'
106			} sort {
107			$a cmp $b
108			} keys %{$opt{Type_param}};
109			}
110			}
111			if ($opt{Magic}) {
112			$return{Magic} = 'MAGIC:'.$opt{Magic};
113			} elsif ($opt{Name}) {
114			$return{Name} = 'MAGIC:'.$opt{Name}.'/*';
115			$return{Magic} = 'MAGIC:'.$opt{Name}.'/'.$opt{Version} if $opt{Version};
116			}
117			if ($opt{URIReference}) {
118			$return{URIReference} = $opt{URIReference};
119			}
120			my $flag = '##';
121			$flag .= 'f' if $opt{IsFragment};
122			$flag .= 'p' if $opt{IsPlaceholder};
123			for (qw/URIReference Type Magic Name/) {
124			$return{$_} .= $flag if $return{$_};
125			}
126			$return{_} = $return{URIReference} \|\| $return{Type}
127			\|\| $return{Magic} \|\| $return{Name};
128			\%return;
129			}
130
131	wakaba	1.3	sub ___report_error ($$) {
132			my ($self, $err) = @_;
133			$self->{-error}->($err) if $self->{-error};
134			if ($err->{-def}->{level} ne 'warn') {
135			$err->throw;
136			}
137			}
138
139	wakaba	1.1	package SuikaWiki::Format::Definition::template;
140
141			sub new ($;%) {
142			my $class = shift;
143			bless {@_}, $class;
144			}
145
146			sub convert ($$;%) {
147			my ($self, $source, %opt) = @_;
148	wakaba	1.4	report SuikaWiki::Format::Definition::error
149			-type => 'CONVERTER_NOT_FOUND',
150			-object => $self, method => 'converter',
151			type => $self->{type},
152			type_to => \%opt;
153	wakaba	1.1	}
154
155	wakaba	1.3	sub wikiform ($$;%) {
156			my ($self, $source, %opt) = @_;
157	wakaba	1.4	report SuikaWiki::Format::Definition::error
158			-type => 'WIKIFORM_NOT_FOUND',
159			-object => $self, method => 'wikiform',
160			type => $self->{type};
161	wakaba	1.3	}
162
163			sub next_index_for_anchor ($$;%) {
164			my ($self, $source, %opt) = @_;
165			1;
166	wakaba	1.4	# report SuikaWiki::Format::Definition::error
167			# -type => 'NEXT_INDEX_NOT_FOUND',
168			# -object => $self, method => 'next_index_for_anchor',
169			# type => $self->{type},
170			# next_index_type => 'anchor';
171			}
172
173			sub headsummary ($$;%) {
174			my ($self, $source, %opt) = @_;
175			# report SuikaWiki::Format::Definition::error
176			# -type => '',
177			# -object => $self, method => 'wikiform',
178			# type => $self->{type};
179			undef;
180			}
181
182	wakaba	1.7	sub content_written ($%) {
183
184			}
185
186			sub content_removed ($%) {
187
188			}
189
190			sub content_type_changed_from ($%) {
191
192			}
193
194	wakaba	1.8	=item $format->content_prop_modified (%param)
195
196			When WikiPage content property other than media-type:media-type modified.
197
198			=cut
199
200			sub content_prop_modified ($%) {
201
202			}
203
204			=item $val = $format->prop ($uri, %option)
205
206			Get format property.
207
208			=cut
209
210			sub prop ($$;%) {
211			my ($self, $name, %opt) = @_;
212			return $opt{default};
213			}
214
215	wakaba	1.4	sub ___report_error ($$) {
216			my ($view, $err) = @_;
217			$err->throw;
218	wakaba	1.3	}
219
220	wakaba	1.1	package SuikaWiki::Format::Definition::error;
221			require Message::Util::Error;
222			our @ISA = 'Message::Util::Error';
223
224	wakaba	1.2	sub ___error_def () {+{
225	wakaba	1.1	CLASS_NOT_FOUND => {
226			description => q(%type;: Format handler class not found),
227			},
228			CONVERTER_NOT_FOUND => {
229			description => q(%type; => %type-to;: Converter not found),
230			},
231	wakaba	1.3	NEXT_INDEX_NOT_FOUND => {
232			description => q(%type;: Next %t (name => next_index_type); index is unknown),
233			},
234			WARN_DEFAULT_CLASS => {
235			description => q(%type;: Default type is selected),
236			level => 'warn',
237			},
238			WIKIFORM_NOT_FOUND => {
239			description => q(%type;: WikiForm handler not defined),
240			},
241	wakaba	1.1	}}
242
243			sub _FORMATTER_PACKAGE_ () {'SuikaWiki::Formatter::Definition::error::formatter'}
244
245			package SuikaWiki::Formatter::Definition::error::formatter;
246			our @ISA = 'Message::Util::Error::formatter';
247
248	wakaba	1.2	sub ___rule_def ($) {+{
249			type => {
250	wakaba	1.1	after => sub {
251			my ($f, $name, $p, $o) = @_;
252	wakaba	1.2	my $opt = $o->{type};
253	wakaba	1.8	if ($opt->{serialized_media_type}) {
254			$p->{-result} .= '(Serialized:) '.$opt->{serialized_media_type};
255			} elsif ($opt->{Type}) {
256			$p->{-result} .= 'IMT:'.$opt->{Type}.SuikaWiki::Format::Definition->__get_param_string ($opt->{Type_param});
257	wakaba	1.1	} else {
258	wakaba	1.8	$p->{-result} .= 'MAGIC:'.$opt->{Name}.'/'.$opt->{Version};
259	wakaba	1.1	}
260			},
261	wakaba	1.2	},
262			type_to => {
263	wakaba	1.1	after => sub {
264			my ($f, $name, $p, $o) = @_;
265	wakaba	1.2	my $opt = $o->{type_to};
266	wakaba	1.8	if ($opt->{serialized_media_type}) {
267			$p->{-result} .= '(Serialized:) '.$opt->{serialized_media_type};
268			} elsif ($opt->{Type}) {
269			$p->{-result} .= 'IMT:'.$opt->{Type}.SuikaWiki::Format::Definition->__get_param_string ($opt->{Type_param});
270	wakaba	1.1	} else {
271	wakaba	1.8	$p->{-result} .= 'MAGIC:'.$opt->{Name}.'/'.$opt->{Version};
272	wakaba	1.1	}
273			},
274	wakaba	1.2	},
275			}}
276	wakaba	1.1
277			=head1 LICENSE
278
279	wakaba	1.3	Copyright 2003-2004 Wakaba <[email protected]>
280	wakaba	1.1
281			This program is free software; you can redistribute it and/or
282			modify it under the same terms as Perl itself.
283
284			=cut
285
286	wakaba	1.8	1; # $Date: 2004/06/03 06:38:48 $