Parent Directory
| 
Revision Log
(__report_error, wikiform, next_index_for_anchor): New functions
| 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.3 | our $VERSION = do{my @r=(q$Revision: 1.2 $=~/\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 |