SWE/DB/IDProps.pm

package SWE::DB::IDProps;
use strict;

sub new ($) {
  my $self = bless {
    root_directory_name => './',
    leaf_suffix => '.props',
  }, shift;
  return $self;
} # new

sub _get_file_name ($$$) {
  my $self = shift;
  my $id = $_[0] + 0;
  my $mkdir = $_[1];
  
  my $dir = $self->{root_directory_name} . int ($id / 1000);
  my $file_name = $dir . '/' . ($id % 1000) . $self->{leaf_suffix};

  unless ($mkdir) {
    return $file_name;
  }
  
  unless (-d $dir) {
    mkdir $dir or die "$0: $dir: $!";
  }

  unless (-d $dir . '/CVS') {
    ## TODO: ...
  }

  return $file_name;
} # _get_file_name

sub get_data ($$) {
  my $self = shift;
  my $file_name = $self->_get_file_name ($_[0]);
  
  unless (-f $file_name) {
    return undef;
  }
  
  my $r = {};
  
  open my $file, '<:encoding(utf8)', $file_name or die "$0: $file_name: $!";
  while (<$file>) {
    tr/\x0D\x0A//d;
    my ($n, $v) = split /:/, $_, 2;
    if ($n =~ s/^\@//) {
      push @{$r->{$n} ||= []}, $v // '';
    } elsif ($n =~ s/^%//) {
      $r->{$n}->{$v // ''} = 1;
    } else {
      $n =~ s/^\$//;
      $r->{$n} = $v // '';
    }
  }
  
  return $r;
} # get_data

sub set_data ($$$) {
  my $self = shift;
  my $file_name = $self->_get_file_name ($_[0], 1);
  my $prop = $_[1];
  
  my $has_file = -f $file_name;

  open my $file, '>:encoding(utf8)', $file_name or die "$0: $file_name: $!";
  for my $prop_name (sort {$a cmp $b} keys %$prop) {
    if (ref $prop->{$prop_name} eq 'ARRAY') {
      my $v = '@' . $prop_name;
      $v =~ tr/\x0D\x0A://d;
      for (@{$prop->{$prop_name}}) {
        my $pv = $_;
        $pv =~ tr/\x0D\x0A/  /;
        print $file $v . ':' . $pv . "\x0A";
      }
    } elsif (ref $prop->{$prop_name} eq 'HASH') {
      my $v = '%' . $prop_name;
      $v =~ tr/\x0D\x0A://d;
      for (sort {$a cmp $b} keys %{$prop->{$prop_name}}) {
        next unless $prop->{$prop_name}->{$_};
        my $pv = $_;
        $pv =~ tr/\x0D\x0A/  /;
        print $file $v . ':' . $pv . "\x0A";
      }
    } else {
      my $v = '$' . $prop_name;
      $v =~ tr/\x0D\x0A://d;
      my $pv = $prop->{$prop_name};
      $pv =~ tr/\x0D\x0A/  /;
      print $file $v . ':' . $pv . "\x0A";
    }
  }
  close $file;

## TODO:
#  system_ ('cvs', 'add', $file_name) unless $has_file;
} # set_data

1;
1	wakaba	1.1	package SWE::DB::IDProps;
2			use strict;
3
4			sub new ($) {
5			my $self = bless {
6			root_directory_name => './',
7			leaf_suffix => '.props',
8			}, shift;
9			return $self;
10			} # new
11
12			sub _get_file_name ($$$) {
13			my $self = shift;
14			my $id = $_[0] + 0;
15			my $mkdir = $_[1];
16
17			my $dir = $self->{root_directory_name} . int ($id / 1000);
18			my $file_name = $dir . '/' . ($id % 1000) . $self->{leaf_suffix};
19
20			unless ($mkdir) {
21			return $file_name;
22			}
23
24			unless (-d $dir) {
25			mkdir $dir or die "$0: $dir: $!";
26			}
27
28			unless (-d $dir . '/CVS') {
29			## TODO: ...
30			}
31
32			return $file_name;
33			} # _get_file_name
34
35			sub get_data ($$) {
36			my $self = shift;
37			my $file_name = $self->_get_file_name ($_[0]);
38
39			unless (-f $file_name) {
40	wakaba	1.2	return undef;
41	wakaba	1.1	}
42
43			my $r = {};
44
45			open my $file, '<:encoding(utf8)', $file_name or die "$0: $file_name: $!";
46			while (<$file>) {
47			tr/\x0D\x0A//d;
48			my ($n, $v) = split /:/, $_, 2;
49			if ($n =~ s/^\@//) {
50			push @{$r->{$n} \|\|= []}, $v // '';
51			} elsif ($n =~ s/^%//) {
52			$r->{$n}->{$v // ''} = 1;
53			} else {
54			$n =~ s/^\$//;
55			$r->{$n} = $v // '';
56			}
57			}
58
59			return $r;
60			} # get_data
61
62			sub set_data ($$$) {
63			my $self = shift;
64			my $file_name = $self->_get_file_name ($_[0], 1);
65			my $prop = $_[1];
66
67			my $has_file = -f $file_name;
68
69			open my $file, '>:encoding(utf8)', $file_name or die "$0: $file_name: $!";
70			for my $prop_name (sort {$a cmp $b} keys %$prop) {
71			if (ref $prop->{$prop_name} eq 'ARRAY') {
72			my $v = '@' . $prop_name;
73			$v =~ tr/\x0D\x0A://d;
74			for (@{$prop->{$prop_name}}) {
75			my $pv = $_;
76			$pv =~ tr/\x0D\x0A/ /;
77			print $file $v . ':' . $pv . "\x0A";
78			}
79			} elsif (ref $prop->{$prop_name} eq 'HASH') {
80			my $v = '%' . $prop_name;
81			$v =~ tr/\x0D\x0A://d;
82			for (sort {$a cmp $b} keys %{$prop->{$prop_name}}) {
83			next unless $prop->{$prop_name}->{$_};
84			my $pv = $_;
85			$pv =~ tr/\x0D\x0A/ /;
86			print $file $v . ':' . $pv . "\x0A";
87			}
88			} else {
89			my $v = '$' . $prop_name;
90			$v =~ tr/\x0D\x0A://d;
91			my $pv = $prop->{$prop_name};
92			$pv =~ tr/\x0D\x0A/ /;
93			print $file $v . ':' . $pv . "\x0A";
94			}
95			}
96			close $file;
97
98			## TODO:
99			# system_ ('cvs', 'add', $file_name) unless $has_file;
100			} # set_data
101
102			1;