Commit | Line | Data |
8d9a1cd8 |
1 | package Text::Tradition::Directory; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | use Moose; |
6 | use KiokuDB::TypeMap; |
7 | use KiokuDB::TypeMap::Entry::Naive; |
8 | |
9 | extends 'KiokuX::Model'; |
10 | |
11 | has data_hash => ( |
12 | traits => ['Hash'], |
13 | default => sub { {} }, |
14 | handles => { |
15 | tradition => 'get', |
16 | stemma => 'get', |
17 | add_tradition => 'set', |
18 | add_stemma => 'set', |
19 | traditions => 'keys', |
20 | }, |
21 | ); |
22 | |
23 | has typemap => ( |
24 | is => 'rw', |
25 | isa => 'KiokuDB::TypeMap', |
26 | default => sub { |
27 | KiokuDB::TypeMap->new( |
28 | isa_entries => { |
29 | "Graph::Easy::Base" => KiokuDB::TypeMap::Entry::Naive->new, |
30 | "Graph" => KiokuDB::TypeMap::Entry::Naive->new, |
31 | "Graph::AdjacencyMap" => KiokuDB::TypeMap::Entry::Naive->new, |
32 | } |
33 | ); |
34 | }, |
35 | ); |
36 | |
37 | around 'tradition' => sub { |
38 | my( $orig, $self, @arg ) = @_; |
39 | my $data = $self->$orig( @arg ); |
40 | return $data->{'object'}; |
41 | }; |
42 | |
43 | around 'stemma' => sub { |
44 | my( $orig, $self, @arg ) = @_; |
45 | my $data = $self->$orig( @arg ); |
46 | return $data->{'stemma'}; |
47 | }; |
48 | |
49 | around 'add_tradition' => sub { |
50 | my( $orig, $self, $id, $obj ) = @_; |
51 | $self->$orig( $id => { 'object' => $obj } ); |
52 | }; |
53 | |
54 | around 'add_stemma' => sub { |
55 | my( $orig, $self, $id, $obj ) = @_; |
56 | $self->{data_hash}->{$id}->{'stemma'} = $obj; |
57 | }; |
58 | |
59 | # Load all the relevant data from the DSN we were passed. |
60 | |
61 | sub BUILD { |
62 | my $self = shift; |
63 | my $args = shift; |
64 | |
65 | if( exists $args->{'dsn'} ) { |
66 | # Connect to self, get the traditions and stemmas, and save them |
67 | # in the directory. |
68 | my $scope = $self->new_scope; |
69 | my $stream = $self->root_set; |
70 | my %stemmata; |
71 | until( $stream->is_done ) { |
72 | foreach my $obj ( $stream->items ) { |
73 | my $uuid = $self->object_to_id( $obj ); |
74 | if( ref( $obj ) eq 'Text::Tradition' ) { |
75 | $self->add_tradition( $uuid => $obj ); |
76 | } elsif( ref( $obj ) eq 'Text::Tradition::Stemma' ) { |
77 | $stemmata{$obj->collation} = $obj; |
78 | } else { |
79 | warn "Found root object in DB that is neither tradition nor stemma: $obj"; |
80 | } |
81 | } |
82 | } |
83 | # Now match the stemmata to their traditions. |
84 | foreach my $id ( $self->traditions ) { |
85 | my $c = $self->tradition( $id )->collation; |
86 | if( exists $stemmata{$c} ) { |
87 | $self->add_stemma( $id => $stemmata{$c} ); |
88 | } |
89 | } |
90 | } |
8d9a1cd8 |
91 | } |
92 | |
93 | 1; |
94 | |
95 | |