SWE/Object/Document.pm

package SWE::Object::Document;
use strict;
use warnings;

sub new ($%) {
  my $class = shift;
  my $self = bless {@_}, $class;

  return $self;
}

sub new_id ($%) {
  my $self = shift->new (@_);
  
  ## NOTE: MUST be executed in names_lock.

  my $idgen = $self->db->id;
  my $id = $idgen->get_next_id;
  $self->{id} = $id;

  return $self;
} # new_id

sub db { $_[0]->{db} }

sub id { $_[0]->{id} }

sub associate_names ($$%) {
  my ($self, $names, %args) = @_;

  ## NOTE: names_lock MUST be executed before the invocation.

  my $id = $self->id;
  my $time = $args{time} || time;
  my $sw3_pages = $self->{sw3_pages}; ## TODO: ...

  my $vc = $self->db->vc;

  my $name_prop_db = $self->{name_prop_db}; ## TODO: ...
  local $name_prop_db->{version_control} = $vc;

  my $name_history_db = $self->db->name_history;
  local $name_history_db->{version_control} = $vc;
  
  for my $name (keys %$names) {
    my $name_props = $name_prop_db->get_data ($name);
    unless (defined $name_props) {
      my $sw3id = $sw3_pages->get_data ($name);
      main::convert_sw3_page ($sw3id => $name); ## TODO: ...
      
      $name_props = $name_prop_db->get_data ($name);
      unless (defined $name_props) {
        $name_history_db->append_data ($name => [$time, 'c']);
      }
    }
    
    push @{$name_props->{id} ||= []}, $id;
    $name_props->{name} = $name;
    $name_prop_db->set_data ($name => $name_props);
    
    $name_history_db->append_data ($name => [$time, 'a', $id]);
  }

  my $user = $args{user} || '(anon)';
  $vc->commit_changes ("id=$id created by $user");
} # associate_names

sub update_tfidf ($$) {
  my ($self, $doc) = @_; ## TODO: $doc should not be an argument

  ## It is REQUIRED to lock the $id before the invocation of this
  ## method to keep the consistency of tfidf data for the $id.

  my $id = $self->id;

  my $tfidf_db = $self->db->id_tfidf;

  require SWE::Data::FeatureVector;

  my $deleted_terms = SWE::Data::FeatureVector->parse_stringref
      ($tfidf_db->get_data ($id))->as_key_hashref;

  my $tc = $doc->document_element->text_content;

  ## TODO: use element semantics...

  my $orig_tfs = {};
  my $all_terms = 0;
  main::for_unique_words ($tc => sub {
    $orig_tfs->{$_[0]} = $_[1];
    $all_terms += $_[1];
  }); ## TODO: XXX

  my $names_index_db = $self->db->name_inverted_index;
  $names_index_db->lock;

  my $idgen = $self->db->id;
  my $doc_number = $idgen->get_last_id;
  
  my $terms = SWE::Data::FeatureVector->new;
  for my $term (keys %$orig_tfs) {
    my $n_tf = $orig_tfs->{$term} / $all_terms;
    
    my $df = $names_index_db->get_count ($term);
    my $idf = log ($doc_number / ($df + 1));
      
    my $tfidf = $n_tf * $idf;
    
    $terms->set_tfidf ($term, $tfidf);
    $names_index_db->add_data ($term => $id => $tfidf);

    delete $deleted_terms->{$term};
  }

  for my $term (keys %$deleted_terms) {
    $names_index_db->delete_data ($term, $id);
  }
  
  $tfidf_db->set_data ($id => \( $terms->stringify ));
} # update_tfidf

1;
1	wakaba	1.1	package SWE::Object::Document;
2			use strict;
3			use warnings;
4
5			sub new ($%) {
6			my $class = shift;
7			my $self = bless {@_}, $class;
8
9			return $self;
10			}
11
12	wakaba	1.3	sub new_id ($%) {
13			my $self = shift->new (@_);
14
15	wakaba	1.4	## NOTE: MUST be executed in names_lock.
16
17	wakaba	1.3	my $idgen = $self->db->id;
18			my $id = $idgen->get_next_id;
19			$self->{id} = $id;
20
21			return $self;
22			} # new_id
23
24	wakaba	1.1	sub db { $_[0]->{db} }
25
26			sub id { $_[0]->{id} }
27
28			sub associate_names ($$%) {
29			my ($self, $names, %args) = @_;
30
31			## NOTE: names_lock MUST be executed before the invocation.
32
33			my $id = $self->id;
34			my $time = $args{time} \|\| time;
35			my $sw3_pages = $self->{sw3_pages}; ## TODO: ...
36
37			my $vc = $self->db->vc;
38
39			my $name_prop_db = $self->{name_prop_db}; ## TODO: ...
40			local $name_prop_db->{version_control} = $vc;
41
42			my $name_history_db = $self->db->name_history;
43			local $name_history_db->{version_control} = $vc;
44
45			for my $name (keys %$names) {
46			my $name_props = $name_prop_db->get_data ($name);
47			unless (defined $name_props) {
48			my $sw3id = $sw3_pages->get_data ($name);
49			main::convert_sw3_page ($sw3id => $name); ## TODO: ...
50
51			$name_props = $name_prop_db->get_data ($name);
52			unless (defined $name_props) {
53			$name_history_db->append_data ($name => [$time, 'c']);
54			}
55			}
56
57			push @{$name_props->{id} \|\|= []}, $id;
58			$name_props->{name} = $name;
59			$name_prop_db->set_data ($name => $name_props);
60
61			$name_history_db->append_data ($name => [$time, 'a', $id]);
62			}
63
64			my $user = $args{user} \|\| '(anon)';
65			$vc->commit_changes ("id=$id created by $user");
66			} # associate_names
67
68	wakaba	1.2	sub update_tfidf ($$) {
69			my ($self, $doc) = @_; ## TODO: $doc should not be an argument
70
71			## It is REQUIRED to lock the $id before the invocation of this
72			## method to keep the consistency of tfidf data for the $id.
73
74			my $id = $self->id;
75
76			my $tfidf_db = $self->db->id_tfidf;
77
78			require SWE::Data::FeatureVector;
79
80			my $deleted_terms = SWE::Data::FeatureVector->parse_stringref
81			($tfidf_db->get_data ($id))->as_key_hashref;
82
83			my $tc = $doc->document_element->text_content;
84
85			## TODO: use element semantics...
86
87			my $orig_tfs = {};
88			my $all_terms = 0;
89			main::for_unique_words ($tc => sub {
90			$orig_tfs->{$_[0]} = $_[1];
91			$all_terms += $_[1];
92			}); ## TODO: XXX
93
94			my $names_index_db = $self->db->name_inverted_index;
95			$names_index_db->lock;
96
97			my $idgen = $self->db->id;
98			my $doc_number = $idgen->get_last_id;
99
100			my $terms = SWE::Data::FeatureVector->new;
101			for my $term (keys %$orig_tfs) {
102			my $n_tf = $orig_tfs->{$term} / $all_terms;
103
104			my $df = $names_index_db->get_count ($term);
105			my $idf = log ($doc_number / ($df + 1));
106
107			my $tfidf = $n_tf * $idf;
108
109			$terms->set_tfidf ($term, $tfidf);
110			$names_index_db->add_data ($term => $id => $tfidf);
111
112			delete $deleted_terms->{$term};
113			}
114
115			for my $term (keys %$deleted_terms) {
116			$names_index_db->delete_data ($term, $id);
117			}
118
119			$tfidf_db->set_data ($id => \( $terms->stringify ));
120			} # update_tfidf
121
122	wakaba	1.1	1;