| 31 |
## `Good' & dotted prefix name of this namespace (ex. "prefix.name", "prefix2.name") |
## `Good' & dotted prefix name of this namespace (ex. "prefix.name", "prefix2.name") |
| 32 |
$OPTION{namespace_good_prefix} = 'DEFAULT'; |
$OPTION{namespace_good_prefix} = 'DEFAULT'; |
| 33 |
|
|
| 34 |
|
## Sort fields (0 / 'alphabetic' / ref(CODE) |
| 35 |
|
$OPTION{field_sort} = 0; |
| 36 |
|
|
| 37 |
## Field body data type (specified by package name) |
## Field body data type (specified by package name) |
| 38 |
$OPTION{value_type} = { |
$OPTION{value_type} = { |
| 39 |
':default' => ['Message::Field::Unstructured'], |
':default' => ['Message::Field::Unstructured'], |
| 76 |
} |
} |
| 77 |
} |
} |
| 78 |
|
|
| 79 |
|
sub sort_good_practice ($$\@\%) { |
| 80 |
|
my ($hdr, $array, $nspack, $option) = @_; |
| 81 |
|
if ($option->{field_sort} eq 'good-practice') { |
| 82 |
|
no strict 'refs'; |
| 83 |
|
my $order = ${ $nspack.'::OPTION' }{field_sort_good_practice_order}; |
| 84 |
|
my $mynsuri = ${ $nspack.'::OPTION' }{namespace_uri}; |
| 85 |
|
my $mynsprefix = ${ $nspack.'::OPTION' }{namespace_phname}; |
| 86 |
|
return sort { |
| 87 |
|
if ($a->{ns} eq $b->{ns}) { |
| 88 |
|
if ($a->{ns} eq $mynsuri) { |
| 89 |
|
$order->{ $a->{name} } ||= 999; |
| 90 |
|
$order->{ $b->{name} } ||= 999; |
| 91 |
|
|
| 92 |
|
$order->{ $a->{name} } <=> $order->{ $b->{name} } |
| 93 |
|
|| $a->{name} cmp $b->{name}; |
| 94 |
|
} else { #($a->{ns} eq $b->{ns}) |
| 95 |
|
my $nspack = Message::Header::_NS_uri2package ($a->{ns}); |
| 96 |
|
my $sort = ${ $nspack.'::OPTION' }{field_sort}; |
| 97 |
|
if ($sort->{'good-practice'}) { |
| 98 |
|
my $order = ${ $nspack.'::OPTION' }{field_sort_good_practice_order}; |
| 99 |
|
$order->{ $a->{name} } ||= 999; |
| 100 |
|
$order->{ $b->{name} } ||= 999; |
| 101 |
|
|
| 102 |
|
$order->{ $a->{name} } <=> $order->{ $b->{name} } |
| 103 |
|
|| $a->{name} cmp $b->{name}; |
| 104 |
|
} elsif ($sort->{alphabetic}) { |
| 105 |
|
$a->{name} cmp $b->{name}; |
| 106 |
|
} else { |
| 107 |
|
1; ## Isn't supported |
| 108 |
|
} |
| 109 |
|
} |
| 110 |
|
} else { ## $a->{ns} ne $b->{ns} |
| 111 |
|
if ($a->{ns} eq $mynsuri) { |
| 112 |
|
my $bp = ($hdr->{ns}->{uri2phname}->{ $b->{ns} } || $b->{ns}).'-'; |
| 113 |
|
$bp =~ s/^\Q$mynsprefix\E-//; |
| 114 |
|
$order->{ $a->{name} } ||= 999; |
| 115 |
|
$order->{ $bp } ||= 999; |
| 116 |
|
|
| 117 |
|
$order->{ $a->{name} } <=> $order->{ $bp } |
| 118 |
|
|| $a->{name} cmp $bp; |
| 119 |
|
} elsif ($b->{ns} eq $mynsuri) { |
| 120 |
|
my $ap = ($hdr->{ns}->{uri2phname}->{ $a->{ns} } || $a->{ns}).'-'; |
| 121 |
|
$ap =~ s/^\Q$mynsprefix\E-//; |
| 122 |
|
$order->{ $ap } ||= 999; |
| 123 |
|
$order->{ $b->{name} } ||= 999; |
| 124 |
|
|
| 125 |
|
$order->{ $ap } <=> $order->{ $b->{name} } |
| 126 |
|
|| $ap cmp $b->{name}; |
| 127 |
|
} else { |
| 128 |
|
my $ap = ($hdr->{ns}->{uri2phname}->{ $a->{ns} } || $a->{ns}).'-'; |
| 129 |
|
my $bp = ($hdr->{ns}->{uri2phname}->{ $b->{ns} } || $b->{ns}).'-'; |
| 130 |
|
$ap =~ s/^\Q$mynsprefix\E-//; |
| 131 |
|
$bp =~ s/^\Q$mynsprefix\E-//; |
| 132 |
|
|
| 133 |
|
$order->{ $ap } ||= 999; |
| 134 |
|
$order->{ $bp } ||= 999; |
| 135 |
|
|
| 136 |
|
$order->{ $ap } <=> $order->{ $bp } |
| 137 |
|
|| $ap cmp $bp; |
| 138 |
|
} |
| 139 |
|
} |
| 140 |
|
} @$array; |
| 141 |
|
} |
| 142 |
|
@$array; |
| 143 |
|
} |
| 144 |
|
|
| 145 |
package Message::Header::XCGI; |
package Message::Header::XCGI; |
| 146 |
our %OPTION = %Message::Header::Default::OPTION; |
our %OPTION = %Message::Header::Default::OPTION; |
| 147 |
$OPTION{namespace_uri} = 'urn:x-suika-fam-cx:msgpm:header:http:cgi:x'; |
$OPTION{namespace_uri} = 'urn:x-suika-fam-cx:msgpm:header:http:cgi:x'; |
Parent Directory
| 
Revision Log
| 
Patch