| 1 |
package SWE::DB::SuikaWiki3; |
package SWE::DB::SuikaWiki3; |
| 2 |
use strict; |
use strict; |
| 3 |
|
|
| 4 |
require Encode::EUCJP1997; |
require Encode::EUCJPSW; |
| 5 |
|
|
| 6 |
sub new ($) { |
sub new ($) { |
| 7 |
my $self = bless { |
my $self = bless { |
|
ns_suffix => '.ns', |
|
| 8 |
leaf_suffix => '.txt', |
leaf_suffix => '.txt', |
|
root_key => ['HomePage'], |
|
| 9 |
root_directory_name => ',/', |
root_directory_name => ',/', |
| 10 |
}, shift; |
}, shift; |
|
|
|
| 11 |
return $self; |
return $self; |
| 12 |
} # new |
} # new |
| 13 |
|
|
| 14 |
my $get_file_name = sub { |
sub _get_file_name ($$) { |
| 15 |
my $self = shift; |
my ($self, $key) = @_; |
|
my $key = shift; |
|
|
$key = $self->{root_key} if @$key == 0; |
|
|
|
|
|
my $file_name = $self->{root_directory_name}; |
|
|
$file_name .= join '/', |
|
|
map { s/(.)/sprintf '%02X', ord $1/sge; $_ . $self->{ns_suffix} } |
|
|
map { Encode::encode ('euc-jp-1997', $_) } @$key; |
|
|
$file_name =~ s/\Q$self->{ns_suffix}\E$/$self->{leaf_suffix}/; |
|
| 16 |
|
|
| 17 |
return $file_name; |
return $self->{root_directory_name} . $key . $self->{leaf_suffix}; |
| 18 |
}; # $get_file_name |
} # _get_file_name |
| 19 |
|
|
| 20 |
sub get_data ($$) { |
sub get_data ($$) { |
| 21 |
my $self = shift; |
my $self = $_[0]; |
| 22 |
my $file_name = $get_file_name->($self, $_[0]); |
my $file_name = $self->_get_file_name ($_[1]); |
| 23 |
|
|
| 24 |
return undef unless -f $file_name; |
return undef unless -f $file_name; |
| 25 |
|
|
| 26 |
open my $file, '<:encoding(euc-jp-1997)', $file_name |
open my $file, '<:encoding(euc-jp-sw)', $file_name |
| 27 |
or die "$0: $file_name: $!"; |
or die "$0: $file_name: $!"; |
| 28 |
local $/ = undef; |
local $/ = undef; |
| 29 |
return scalar <$file>; |
return scalar <$file>; |
| 30 |
} # get_data |
} # get_data |
| 31 |
|
|
|
sub set_data ($$$) { |
|
|
|
|
|
## not implemented yet. |
|
|
|
|
|
} # set_data |
|
|
|
|
| 32 |
1; |
1; |
Parent Directory
| 
Revision Log
| 
Patch