SWE/DB/SuikaWiki3.pm

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

require Encode::EUCJP1997;

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

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

  return undef unless -f $file_name;

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

sub set_data ($$$) {

## not implemented yet.

} # set_data

1;
1	wakaba	1.1	package SWE::DB::SuikaWiki3;
2			use strict;
3
4			require Encode::EUCJP1997;
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-1997', $_) } @$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 = shift;
33			my $file_name = $get_file_name->($self, $_[0]);
34
35			return undef unless -f $file_name;
36
37			open my $file, '<:encoding(euc-jp-1997)', $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;