SWE/Object/Document.pm

package SWE::Object::Document;
use strict;
use warnings;
use SWE::Lang qw/%ContentMediaType/;
use UNIVERSAL::require;

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 repo ($) { $_[0]->{repo} }

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

sub reblessed : lvalue { $_[0]->{reblessed} }

sub rebless ($) {
  my $self = shift;
  return if $self->reblessed;

  my $id = $self->id;
  my $module;
  if (defined $id) {
    my $ct = $self->content_media_type;
    $module = $ContentMediaType{$ct}->{module} || $ContentMediaType{'text/x-suikawiki'}->{module};
  } else {
    $module = 'SWE::Object::Document::NotYet';
  }
  $module->require or die $@;
  bless $self, $module;

  $self->reblessed = 1;
}

## ------ Metadata ------

sub prop ($) {
  my $self = shift;
  return $self->{prop} ||= do {
    $self->prop_untainted = 0 unless $self->locked;
    $self->db->id_prop->get_data ($self->id);
  };
} # prop

sub prop_untainted ($) : lvalue { $_[0]->{prop_untainted} }

sub untainted_prop ($) {
  my $self = shift;
  delete $self->{prop} unless $self->prop_untainted;
  $self->prop_untainted = 1;
  return $self->prop;
} # untainted_prop

sub save_prop ($) {
  my $self = shift;
  
  $self->lock;

  unless ($self->prop_untainted) {
    require Carp;
    die "Can't save a tainted prop object" . Carp::longmess ();
  }

  my $prop = $self->prop or die "Can't save an uncreated prop object";
  $self->db->id_prop->set_data ($self->id => $prop);
  
  $self->unlock;
} # save_prop

sub content_media_type ($) {
  my $self = shift;
  return $self->prop->{'content-type'} // 'text/x-suikawiki';
} # content_media_type

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 title ($) {
  my $self = shift;

  my $prop = $self->prop;
  
  my $title = $prop->{title};
  return $title if defined $title and length $title;

  return $self->name;
} # title

sub name ($) {
  my $self = shift;

  my $prop = $self->prop;
  return [keys %{$prop->{name}}]->[0] // ''; ## XXXTODO: title-type
} # name

## ------ Indexing and Graph ------

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

sub get_or_create_graph_node ($) {
  my $self = shift;

  $self->lock;

  my $id_prop = $self->untainted_prop or do {
    $self->unlock;
    die "Can't obtain untainted prop object";
  };

  my $graph = $self->repo->graph;
  my $node;
  my $node_id = $id_prop->{node_id};
  if (defined $node_id) {
    $node = $graph->get_node_by_id ($node_id);
  } else {
    $node = $graph->create_node ($self->id);
    $node_id = $node->id;
    
    $id_prop->{node_id} = $node_id;
    $self->save_prop;
  }

  $self->unlock;

  return $node;
} # get_or_create_graph_node

# ------ Locking ------

sub lock ($) {
  my $self = shift;
  my $lock = $self->{lock} ||= $self->db->id_lock->get_lock ($self->id);
  $self->{lock_n}++ or $lock->lock;
} # lock

sub unlock ($) {
  my $self = shift;
  my $lock = $self->{lock};
  $self->{lock_n}--;
  if ($lock and $self->{lock_n} <= 0) {
    $lock->unlock;
    delete $self->{lock};
    delete $self->{lock_n};
    delete $self->{prop_untainted};
  }
} # unlock

sub locked ($) {
  return (($_[0]->{lock_n} // 0) > 0);
} # locked

# ------ Format Convertion ------

sub to_text ($) {
  my $self = shift;

  return $self->{content_db}->get_data ($self->id); # XXX
} # to_text

sub to_text_media_type ($) {
  my $self = shift;
  return $self->content_media_type;
} # to_text_media_type

sub to_xml_media_type ($) {
  return undef;
} # to_xml_media_type

sub to_xml ($) {
  return undef;
} # to_xml

sub to_html_fragment ($) {
  return (undef, undef);
} # to_html_fragment

1;
1	package SWE::Object::Document;
2	use strict;
3	use warnings;
4	use SWE::Lang qw/%ContentMediaType/;
5	use UNIVERSAL::require;
6
7	sub new ($%) {
8	my $class = shift;
9	my $self = bless {@_}, $class;
10
11	return $self;
12	}
13
14	sub new_id ($%) {
15	my $self = shift->new (@_);
16
17	## NOTE: MUST be executed in names_lock.
18
19	my $idgen = $self->db->id;
20	my $id = $idgen->get_next_id;
21	$self->{id} = $id;
22
23	return $self;
24	} # new_id
25
26	sub db ($) { $_[0]->{db} }
27
28	sub repo ($) { $_[0]->{repo} }
29
30	sub id ($) { $_[0]->{id} }
31
32	sub reblessed : lvalue { $_[0]->{reblessed} }
33
34	sub rebless ($) {
35	my $self = shift;
36	return if $self->reblessed;
37
38	my $id = $self->id;
39	my $module;
40	if (defined $id) {
41	my $ct = $self->content_media_type;
42	$module = $ContentMediaType{$ct}->{module} \|\| $ContentMediaType{'text/x-suikawiki'}->{module};
43	} else {
44	$module = 'SWE::Object::Document::NotYet';
45	}
46	$module->require or die $@;
47	bless $self, $module;
48
49	$self->reblessed = 1;
50	}
51
52	## ------ Metadata ------
53
54	sub prop ($) {
55	my $self = shift;
56	return $self->{prop} \|\|= do {
57	$self->prop_untainted = 0 unless $self->locked;
58	$self->db->id_prop->get_data ($self->id);
59	};
60	} # prop
61
62	sub prop_untainted ($) : lvalue { $_[0]->{prop_untainted} }
63
64	sub untainted_prop ($) {
65	my $self = shift;
66	delete $self->{prop} unless $self->prop_untainted;
67	$self->prop_untainted = 1;
68	return $self->prop;
69	} # untainted_prop
70
71	sub save_prop ($) {
72	my $self = shift;
73
74	$self->lock;
75
76	unless ($self->prop_untainted) {
77	require Carp;
78	die "Can't save a tainted prop object" . Carp::longmess ();
79	}
80
81	my $prop = $self->prop or die "Can't save an uncreated prop object";
82	$self->db->id_prop->set_data ($self->id => $prop);
83
84	$self->unlock;
85	} # save_prop
86
87	sub content_media_type ($) {
88	my $self = shift;
89	return $self->prop->{'content-type'} // 'text/x-suikawiki';
90	} # content_media_type
91
92	sub associate_names ($$%) {
93	my ($self, $names, %args) = @_;
94
95	## NOTE: names_lock MUST be executed before the invocation.
96
97	my $id = $self->id;
98	my $time = $args{time} \|\| time;
99	my $sw3_pages = $self->{sw3_pages}; ## TODO: ...
100
101	my $vc = $self->db->vc;
102
103	my $name_prop_db = $self->{name_prop_db}; ## TODO: ...
104	local $name_prop_db->{version_control} = $vc;
105
106	my $name_history_db = $self->db->name_history;
107	local $name_history_db->{version_control} = $vc;
108
109	for my $name (keys %$names) {
110	my $name_props = $name_prop_db->get_data ($name);
111	unless (defined $name_props) {
112	my $sw3id = $sw3_pages->get_data ($name);
113	main::convert_sw3_page ($sw3id => $name); ## TODO: ...
114
115	$name_props = $name_prop_db->get_data ($name);
116	unless (defined $name_props) {
117	$name_history_db->append_data ($name => [$time, 'c']);
118	}
119	}
120
121	push @{$name_props->{id} \|\|= []}, $id;
122	$name_props->{name} = $name;
123	$name_prop_db->set_data ($name => $name_props);
124
125	$name_history_db->append_data ($name => [$time, 'a', $id]);
126	}
127
128	my $user = $args{user} \|\| '(anon)';
129	$vc->commit_changes ("id=$id created by $user");
130	} # associate_names
131
132	sub title ($) {
133	my $self = shift;
134
135	my $prop = $self->prop;
136
137	my $title = $prop->{title};
138	return $title if defined $title and length $title;
139
140	return $self->name;
141	} # title
142
143	sub name ($) {
144	my $self = shift;
145
146	my $prop = $self->prop;
147	return [keys %{$prop->{name}}]->[0] // ''; ## XXXTODO: title-type
148	} # name
149
150	## ------ Indexing and Graph ------
151
152	sub update_tfidf ($$) {
153	my ($self, $doc) = @_; ## TODO: $doc should not be an argument
154
155	## It is REQUIRED to lock the $id before the invocation of this
156	## method to keep the consistency of tfidf data for the $id.
157
158	my $id = $self->id;
159
160	my $tfidf_db = $self->db->id_tfidf;
161
162	require SWE::Data::FeatureVector;
163
164	my $deleted_terms = SWE::Data::FeatureVector->parse_stringref
165	($tfidf_db->get_data ($id))->as_key_hashref;
166
167	my $tc = $doc->document_element->text_content;
168
169	## TODO: use element semantics...
170
171	my $orig_tfs = {};
172	my $all_terms = 0;
173	main::for_unique_words ($tc => sub {
174	$orig_tfs->{$_[0]} = $_[1];
175	$all_terms += $_[1];
176	}); ## TODO: XXX
177
178	my $names_index_db = $self->db->name_inverted_index;
179	$names_index_db->lock;
180
181	my $idgen = $self->db->id;
182	my $doc_number = $idgen->get_last_id;
183
184	my $terms = SWE::Data::FeatureVector->new;
185	for my $term (keys %$orig_tfs) {
186	my $n_tf = $orig_tfs->{$term} / $all_terms;
187
188	my $df = $names_index_db->get_count ($term);
189	my $idf = log ($doc_number / ($df + 1));
190
191	my $tfidf = $n_tf * $idf;
192
193	$terms->set_tfidf ($term, $tfidf);
194	$names_index_db->add_data ($term => $id => $tfidf);
195
196	delete $deleted_terms->{$term};
197	}
198
199	for my $term (keys %$deleted_terms) {
200	$names_index_db->delete_data ($term, $id);
201	}
202
203	$tfidf_db->set_data ($id => \( $terms->stringify ));
204	} # update_tfidf
205
206	sub get_or_create_graph_node ($) {
207	my $self = shift;
208
209	$self->lock;
210
211	my $id_prop = $self->untainted_prop or do {
212	$self->unlock;
213	die "Can't obtain untainted prop object";
214	};
215
216	my $graph = $self->repo->graph;
217	my $node;
218	my $node_id = $id_prop->{node_id};
219	if (defined $node_id) {
220	$node = $graph->get_node_by_id ($node_id);
221	} else {
222	$node = $graph->create_node ($self->id);
223	$node_id = $node->id;
224
225	$id_prop->{node_id} = $node_id;
226	$self->save_prop;
227	}
228
229	$self->unlock;
230
231	return $node;
232	} # get_or_create_graph_node
233
234	# ------ Locking ------
235
236	sub lock ($) {
237	my $self = shift;
238	my $lock = $self->{lock} \|\|= $self->db->id_lock->get_lock ($self->id);
239	$self->{lock_n}++ or $lock->lock;
240	} # lock
241
242	sub unlock ($) {
243	my $self = shift;
244	my $lock = $self->{lock};
245	$self->{lock_n}--;
246	if ($lock and $self->{lock_n} <= 0) {
247	$lock->unlock;
248	delete $self->{lock};
249	delete $self->{lock_n};
250	delete $self->{prop_untainted};
251	}
252	} # unlock
253
254	sub locked ($) {
255	return (($_[0]->{lock_n} // 0) > 0);
256	} # locked
257
258	# ------ Format Convertion ------
259
260	sub to_text ($) {
261	my $self = shift;
262
263	return $self->{content_db}->get_data ($self->id); # XXX
264	} # to_text
265
266	sub to_text_media_type ($) {
267	my $self = shift;
268	return $self->content_media_type;
269	} # to_text_media_type
270
271	sub to_xml_media_type ($) {
272	return undef;
273	} # to_xml_media_type
274
275	sub to_xml ($) {
276	return undef;
277	} # to_xml
278
279	sub to_html_fragment ($) {
280	return (undef, undef);
281	} # to_html_fragment
282
283	1;