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.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};

sub new_handler ($;%) {
  my ($class, %opt) = @_;
  my $pack = $class->__get_class_name (\%opt);
  throw SuikaWiki::Format::Definition::error
    type => 'CLASS_NOT_FOUND',
    -type => \%opt
    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 ($$) {
  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;
  
  if ($opt->{Type} and substr ($opt->{Type}, 0, 5) eq 'text/') {
    $pack = $SuikaWiki::Format::Definition::Class{'text/plain//'};
  } else {
    $pack = $SuikaWiki::Format::Definition::Class{'application/octet-stream//'};
  }
  return $pack if $pack;
  
  return undef
}

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

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

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

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

sub ___errors () {+{
  CLASS_NOT_FOUND => {
    description => q(%type;: Format handler class not found),
  },
  CONVERTER_NOT_FOUND => {
    description => q(%type; => %type-to;: Converter not found),
  },
}}

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

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

sub rule_def ($) {
  my $err = {%{shift->SUPER::rule_def}};
  $err->{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};
      }
    },
  };
  $err->{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};
      }
    },
  };
  $err;
}

=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: 2003/07/19 04:45:55 $
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			our $VERSION = do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
17
18			sub new_handler ($;%) {
19			my ($class, %opt) = @_;
20			my $pack = $class->__get_class_name (\%opt);
21			throw SuikaWiki::Format::Definition::error
22			type => 'CLASS_NOT_FOUND',
23			-type => \%opt
24			unless $pack;
25
26			$pack->new (type => \%opt);
27			}
28
29			sub __get_param_string ($$) {
30			join '', map {
31			';'. $_ .'='. __quote ($_[1]->{$_})
32			} sort {
33			$a cmp $b
34			} keys %{$_[1]\|\|{}}
35			}
36			sub __quote ($) {
37			my $s = shift;
38			$s =~ s/([\\"])/\\$1/g;
39			'"'.$s.'"';
40			}
41			sub __get_class_name ($$) {
42			my ($self, $opt) = @_;
43			my $pack;
44			if ($opt->{Type}) {
45			$pack = $SuikaWiki::Format::Definition::Class{$opt->{Type}
46			.$self->__get_param_string
47			($opt->{Type_param}\|\|{})
48			.'//'};
49			return $pack if $pack;
50			}
51
52			if (not ($opt->{Name}) and $opt->{magic}) {
53			if ($opt->{magic} =~ m#^([\w.-]+)/([\w.-]+)#) {
54			$opt->{Name} = $1;
55			$opt->{Version} = $2;
56			}
57			}
58
59			$pack = $SuikaWiki::Format::Definition::Class{'/'.$opt->{Name}
60			.'/'.$opt->{Version}.'//'}
61			\|\| $SuikaWiki::Format::Definition::Class{'/'.$opt->{Name}.'///'};
62			return $pack if $pack;
63
64			if ($opt->{Type} and substr ($opt->{Type}, 0, 5) eq 'text/') {
65			$pack = $SuikaWiki::Format::Definition::Class{'text/plain//'};
66			} else {
67			$pack = $SuikaWiki::Format::Definition::Class{'application/octet-stream//'};
68			}
69			return $pack if $pack;
70
71			return undef
72			}
73
74			package SuikaWiki::Format::Definition::template;
75
76			sub new ($;%) {
77			my $class = shift;
78			bless {@_}, $class;
79			}
80
81			sub convert ($$;%) {
82			my ($self, $source, %opt) = @_;
83			throw SuikaWiki::Format::Definition::error
84			type => 'CONVERTER_NOT_FOUND',
85			-type => $self->{type},
86			-type_to => \%opt;
87			}
88
89			package SuikaWiki::Format::Definition::error;
90			require Message::Util::Error;
91			our @ISA = 'Message::Util::Error';
92
93			sub ___errors () {+{
94			CLASS_NOT_FOUND => {
95			description => q(%type;: Format handler class not found),
96			},
97			CONVERTER_NOT_FOUND => {
98			description => q(%type; => %type-to;: Converter not found),
99			},
100			}}
101
102			sub _FORMATTER_PACKAGE_ () {'SuikaWiki::Formatter::Definition::error::formatter'}
103
104			package SuikaWiki::Formatter::Definition::error::formatter;
105			our @ISA = 'Message::Util::Error::formatter';
106
107			sub rule_def ($) {
108			my $err = {%{shift->SUPER::rule_def}};
109			$err->{type} = {
110			after => sub {
111			my ($f, $name, $p, $o) = @_;
112			my $opt = $o->{-type};
113			if ($opt->{Type}) {
114			$p->{-result} .= $opt->{Type}.SuikaWiki::Format::Definition->__get_param_string ($opt->{Type_param});
115			} else {
116			$p->{-result} .= $opt->{Name}.'/'.$opt->{Version};
117			}
118			},
119			};
120			$err->{type_to} = {
121			after => sub {
122			my ($f, $name, $p, $o) = @_;
123			my $opt = $o->{-type_to};
124			if ($opt->{Type}) {
125			$p->{-result} .= $opt->{Type}.SuikaWiki::Format::Definition->__get_param_string ($opt->{Type_param});
126			} else {
127			$p->{-result} .= $opt->{Name}.'/'.$opt->{Version};
128			}
129			},
130			};
131			$err;
132			}
133
134			=head1 LICENSE
135
136			Copyright 2003 Wakaba <[email protected]>
137
138			This program is free software; you can redistribute it and/or
139			modify it under the same terms as Perl itself.
140
141			=cut
142
143			1; # $Date: 2003/07/19 04:45:55 $