SWE/DB/SuikaWiki3.pm

package SWE::DB::SuikaWiki3;
use strict;

require Encode::EUCJPSW;

sub new ($) {
  my $self = bless {
    ns_suffix => '.ns',
    leaf_suffix => '.txt',
    root_key => ['HomePage'],
    root_directory_name => ',/',
  }, shift;

  return $self;
} # new

my $get_file_name = sub {
  my $self = shift;
  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-sw', $_) } @$key;
  $file_name =~ s/\Q$self->{ns_suffix}\E$/$self->{leaf_suffix}/;
  
  return $file_name;
}; # $get_file_name

sub get_data ($$) {
  my $self = $_[0];
  my $file_name = $get_file_name->($self, [@{$_[1]}]);

  return undef unless -f $file_name;

  open my $file, '<:encoding(euc-jp-sw)', $file_name
      or die "$0: $file_name: $!";
  local $/ = undef;
  return scalar <$file>;
} # get_data

sub set_data ($$$) {

## not implemented yet.

} # set_data

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