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.3 $=~/\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->{Type}) {
    $pack = $SuikaWiki::Format::Definition::Class{$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{'/'.$opt->{Name}
                                               .'/'.$opt->{Version}.'//'}
    || $SuikaWiki::Format::Definition::Class{'/'.$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->{Type} and substr ($opt->{Type}, 0, 5) eq 'text/')
    or $opt->{Name}) {
    $pack = $SuikaWiki::Format::Definition::Class{'text/plain//'};
  } else {
    $pack = $SuikaWiki::Format::Definition::Class{'application/octet-stream//'};
  }
  return $pack if $pack;
  
  return undef
}

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 ___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->{Type}) {
        $p->{-result} .= $opt->{Type}.SuikaWiki::Format::Definition->__get_param_string ($opt->{Type_param});
      } else {
        $p->{-result} .= $opt->{Name}.'/'.$opt->{Version};
      }
    },
  },
  type_to => {
    after => sub {
      my ($f, $name, $p, $o) = @_;
      my $opt = $o->{type_to};
      if ($opt->{Type}) {
        $p->{-result} .= $opt->{Type}.SuikaWiki::Format::Definition->__get_param_string ($opt->{Type_param});
      } else {
        $p->{-result} .= $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/01/16 08:04:14 $
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.4	our $VERSION = do{my @r=(q$Revision: 1.3 $=~/\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			if ($opt->{Type}) {
48			$pack = $SuikaWiki::Format::Definition::Class{$opt->{Type}
49			.$self->__get_param_string
50			($opt->{Type_param}\|\|{})
51			.'//'};
52			return $pack if $pack;
53			}
54
55			if (not ($opt->{Name}) and $opt->{magic}) {
56			if ($opt->{magic} =~ m#^([\w.-]+)/([\w.-]+)#) {
57			$opt->{Name} = $1;
58			$opt->{Version} = $2;
59			}
60			}
61
62			$pack = $SuikaWiki::Format::Definition::Class{'/'.$opt->{Name}
63			.'/'.$opt->{Version}.'//'}
64			\|\| $SuikaWiki::Format::Definition::Class{'/'.$opt->{Name}.'///'};
65			return $pack if $pack;
66
67	wakaba	1.3	report SuikaWiki::Format::Definition::error
68			-type => 'WARN_DEFAULT_CLASS',
69			type => $opt,
70			-object => $self, method => '___get_class_name';
71	wakaba	1.2	if (($opt->{Type} and substr ($opt->{Type}, 0, 5) eq 'text/')
72			or $opt->{Name}) {
73	wakaba	1.1	$pack = $SuikaWiki::Format::Definition::Class{'text/plain//'};
74			} else {
75			$pack = $SuikaWiki::Format::Definition::Class{'application/octet-stream//'};
76			}
77			return $pack if $pack;
78
79			return undef
80			}
81
82	wakaba	1.3	sub ___report_error ($$) {
83			my ($self, $err) = @_;
84			$self->{-error}->($err) if $self->{-error};
85			if ($err->{-def}->{level} ne 'warn') {
86			$err->throw;
87			}
88			}
89
90	wakaba	1.1	package SuikaWiki::Format::Definition::template;
91
92			sub new ($;%) {
93			my $class = shift;
94			bless {@_}, $class;
95			}
96
97			sub convert ($$;%) {
98			my ($self, $source, %opt) = @_;
99	wakaba	1.4	report SuikaWiki::Format::Definition::error
100			-type => 'CONVERTER_NOT_FOUND',
101			-object => $self, method => 'converter',
102			type => $self->{type},
103			type_to => \%opt;
104	wakaba	1.1	}
105
106	wakaba	1.3	sub wikiform ($$;%) {
107			my ($self, $source, %opt) = @_;
108	wakaba	1.4	report SuikaWiki::Format::Definition::error
109			-type => 'WIKIFORM_NOT_FOUND',
110			-object => $self, method => 'wikiform',
111			type => $self->{type};
112	wakaba	1.3	}
113
114			sub next_index_for_anchor ($$;%) {
115			my ($self, $source, %opt) = @_;
116			1;
117	wakaba	1.4	# report SuikaWiki::Format::Definition::error
118			# -type => 'NEXT_INDEX_NOT_FOUND',
119			# -object => $self, method => 'next_index_for_anchor',
120			# type => $self->{type},
121			# next_index_type => 'anchor';
122			}
123
124			sub headsummary ($$;%) {
125			my ($self, $source, %opt) = @_;
126			# report SuikaWiki::Format::Definition::error
127			# -type => '',
128			# -object => $self, method => 'wikiform',
129			# type => $self->{type};
130			undef;
131			}
132
133			sub ___report_error ($$) {
134			my ($view, $err) = @_;
135			$err->throw;
136	wakaba	1.3	}
137
138	wakaba	1.1	package SuikaWiki::Format::Definition::error;
139			require Message::Util::Error;
140			our @ISA = 'Message::Util::Error';
141
142	wakaba	1.2	sub ___error_def () {+{
143	wakaba	1.1	CLASS_NOT_FOUND => {
144			description => q(%type;: Format handler class not found),
145			},
146			CONVERTER_NOT_FOUND => {
147			description => q(%type; => %type-to;: Converter not found),
148			},
149	wakaba	1.3	NEXT_INDEX_NOT_FOUND => {
150			description => q(%type;: Next %t (name => next_index_type); index is unknown),
151			},
152			WARN_DEFAULT_CLASS => {
153			description => q(%type;: Default type is selected),
154			level => 'warn',
155			},
156			WIKIFORM_NOT_FOUND => {
157			description => q(%type;: WikiForm handler not defined),
158			},
159	wakaba	1.1	}}
160
161			sub _FORMATTER_PACKAGE_ () {'SuikaWiki::Formatter::Definition::error::formatter'}
162
163			package SuikaWiki::Formatter::Definition::error::formatter;
164			our @ISA = 'Message::Util::Error::formatter';
165
166	wakaba	1.2	sub ___rule_def ($) {+{
167			type => {
168	wakaba	1.1	after => sub {
169			my ($f, $name, $p, $o) = @_;
170	wakaba	1.2	my $opt = $o->{type};
171	wakaba	1.1	if ($opt->{Type}) {
172			$p->{-result} .= $opt->{Type}.SuikaWiki::Format::Definition->__get_param_string ($opt->{Type_param});
173			} else {
174			$p->{-result} .= $opt->{Name}.'/'.$opt->{Version};
175			}
176			},
177	wakaba	1.2	},
178			type_to => {
179	wakaba	1.1	after => sub {
180			my ($f, $name, $p, $o) = @_;
181	wakaba	1.2	my $opt = $o->{type_to};
182	wakaba	1.1	if ($opt->{Type}) {
183			$p->{-result} .= $opt->{Type}.SuikaWiki::Format::Definition->__get_param_string ($opt->{Type_param});
184			} else {
185			$p->{-result} .= $opt->{Name}.'/'.$opt->{Version};
186			}
187			},
188	wakaba	1.2	},
189			}}
190	wakaba	1.1
191			=head1 LICENSE
192
193	wakaba	1.3	Copyright 2003-2004 Wakaba <[email protected]>
194	wakaba	1.1
195			This program is free software; you can redistribute it and/or
196			modify it under the same terms as Perl itself.
197
198			=cut
199
200	wakaba	1.4	1; # $Date: 2004/01/16 08:04:14 $