| 1 |
wakaba |
1.1 |
package SWE::DB::SuikaWiki3Props; |
| 2 |
|
|
use strict; |
| 3 |
|
|
require SWE::DB::SuikaWiki3; |
| 4 |
|
|
push our @ISA, 'SWE::DB::SuikaWiki3'; |
| 5 |
|
|
|
| 6 |
|
|
require Encode::EUCJPSW; |
| 7 |
|
|
|
| 8 |
|
|
sub new ($) { |
| 9 |
|
|
my $self = shift->SUPER::new (@_); |
| 10 |
|
|
$self->{leaf_suffix} = '.prop'; |
| 11 |
|
|
return $self; |
| 12 |
|
|
} # new |
| 13 |
|
|
|
| 14 |
|
|
sub get_data ($$) { |
| 15 |
|
|
my $self = shift; |
| 16 |
|
|
my $data = $self->SUPER::get_data (@_); |
| 17 |
|
|
|
| 18 |
|
|
return {} unless defined $data; |
| 19 |
|
|
|
| 20 |
|
|
my $prop_name = { |
| 21 |
|
|
q<http://suika.fam.cx/~wakaba/-temp/2004/04/24/mt#media-type> => 'content-type', |
| 22 |
|
|
q<http://suika.fam.cx/~wakaba/archive/2004/8/11/sw-bt#creation-date> => 'created', |
| 23 |
|
|
q<http://suika.fam.cx/~wakaba/archive/2004/7/25/html-relrev#up> => '%rel-up', |
| 24 |
|
|
q<http://suika.fam.cx/~wakaba/archive/2004/7/25/html-relrev#down> => '%rev-up', |
| 25 |
|
|
q<http://suika.fam.cx/~wakaba/archive/2004/7/25/html-relrev#next> => '%rel-next', |
| 26 |
|
|
q<http://suika.fam.cx/~wakaba/archive/2004/7/25/html-relrev#prev> => '%rel-prev', |
| 27 |
|
|
q<http://suika.fam.cx/~wakaba/archive/2004/8/11/sw-bt#category> => '%rel-tag', |
| 28 |
|
|
q<http://suika.fam.cx/~wakaba/archive/2004/7/20/sw-propedit#inCategory> => '%rev-tag', |
| 29 |
|
|
q<http://suika.fam.cx/~wakaba/archive/2004/7/20/sw#category> => '%rel-tag', |
| 30 |
|
|
q<http://suika.fam.cx/~wakaba/archive/2004/7/20/sw#keyword> => '%rel-tag', |
| 31 |
|
|
q<http://suika.fam.cx/~wakaba/archive/2004/7/25/html-relrev#index> => '%rel-index', |
| 32 |
|
|
q<http://suika.fam.cx/~wakaba/archive/2004/7/25/html-relrev#contents> => '%rel-index', |
| 33 |
|
|
q<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SuikaWiki%2F0.9#page-icon> => '%rel-icon', |
| 34 |
|
|
q<http://suika.fam.cx/~wakaba/archive/2004/7/20/sw#obsolete> => '%obsoleted-by', |
| 35 |
|
|
q<http://suika.fam.cx/~wakaba/archive/2004/7/20/sw#license> => 'rights', |
| 36 |
|
|
q<http://suika.fam.cx/~wakaba/archive/2004/7/20/sw#license--type> => 'rights-type', |
| 37 |
|
|
q<http://suika.fam.cx/~wakaba/archive/2004/8/11/sw-bt#subject> => 'title', |
| 38 |
|
|
q<http://suika.fam.cx/~wakaba/archive/2004/7/20/sw#abstract> => 'summary', |
| 39 |
|
|
q<http://suika.fam.cx/~wakaba/archive/2004/7/20/sw#abstract--type> => 'summary-type', |
| 40 |
|
|
q<http://suika.fam.cx/~wakaba/archive/2004/8/11/sw-bt#status> => 'bug-status', |
| 41 |
|
|
q<http://suika.fam.cx/~wakaba/archive/2004/8/11/sw-bt#priority> => 'bug-priority', |
| 42 |
|
|
q<http://suika.fam.cx/~wakaba/archive/2004/7/20/sw-propedit#seq> => 'prop-revision', |
| 43 |
|
|
}; |
| 44 |
|
|
my $last_prop = ''; |
| 45 |
wakaba |
1.2 |
my $last_prop_name = ''; |
| 46 |
wakaba |
1.1 |
my $r = {}; |
| 47 |
|
|
for (split /\x0D\x0A?|\x0A/, $data) { |
| 48 |
|
|
if (s/^\s+//) { |
| 49 |
|
|
s/^\\//; |
| 50 |
|
|
if ($last_prop =~ /^%/) { |
| 51 |
wakaba |
1.2 |
$r->{$last_prop_name}->{$_} = 1; |
| 52 |
|
|
} elsif (defined $r->{$last_prop_name}) { |
| 53 |
|
|
$r->{$last_prop_name} = "\x0A" . $_; |
| 54 |
wakaba |
1.1 |
} else { |
| 55 |
wakaba |
1.2 |
$r->{$last_prop_name} = $_; |
| 56 |
wakaba |
1.1 |
} |
| 57 |
|
|
} else { |
| 58 |
|
|
my $prop = $_; |
| 59 |
|
|
my $value; |
| 60 |
|
|
if ($prop =~ s/:([^:]*)\z//) { |
| 61 |
|
|
$value = $1; |
| 62 |
|
|
$value =~ s/^\s+//; |
| 63 |
|
|
undef $value unless length $value; |
| 64 |
|
|
} else { |
| 65 |
|
|
$prop =~ s/:\s*\z//; |
| 66 |
|
|
} |
| 67 |
|
|
$prop =~ s/\[list\]$//; |
| 68 |
|
|
|
| 69 |
|
|
my $pn = $prop_name->{$prop} // $prop; |
| 70 |
|
|
$last_prop = $pn; |
| 71 |
|
|
|
| 72 |
|
|
if (defined $value) { |
| 73 |
wakaba |
1.2 |
if ($pn =~ s/^%//) { |
| 74 |
wakaba |
1.1 |
$r->{$pn}->{$value} = 1; |
| 75 |
|
|
} elsif (defined $r->{$pn}) { |
| 76 |
|
|
$r->{$pn} .= "\x0A" . $value; |
| 77 |
|
|
} else { |
| 78 |
|
|
$r->{$pn} = $value; |
| 79 |
|
|
} |
| 80 |
wakaba |
1.2 |
} else { |
| 81 |
|
|
$pn =~ s/^%//; |
| 82 |
wakaba |
1.1 |
} |
| 83 |
wakaba |
1.2 |
$last_prop_name = $pn; |
| 84 |
wakaba |
1.1 |
} |
| 85 |
|
|
} |
| 86 |
|
|
|
| 87 |
|
|
for my $prop (qw/content-type summary-type rights-type/) { |
| 88 |
|
|
if (defined $r->{$prop}) { |
| 89 |
|
|
$r->{$prop} = { |
| 90 |
|
|
'IMT:text/x.suikawiki.image;version="0.9"##' => 'text/x.suikawiki.image', |
| 91 |
|
|
'IMT:text/x-suikawiki;version="0.10"##' => 'text/x-suikawiki', |
| 92 |
|
|
'IMT:text/x-suikawiki;version="0.9"##' => 'text/x-suikawiki', |
| 93 |
|
|
'IMT:application/x.suikawiki.config;version="2.0"##' => 'application/x.suikawiki.config', |
| 94 |
|
|
'IMT:text/plain##' => 'text/plain', |
| 95 |
|
|
'IMT:text/css##' => 'text/css', |
| 96 |
|
|
}->{$r->{$prop}} // $r->{$prop}; |
| 97 |
|
|
} |
| 98 |
|
|
} |
| 99 |
|
|
|
| 100 |
|
|
return $r; |
| 101 |
|
|
} # get_data |
| 102 |
|
|
|
| 103 |
|
|
1; |