lib/Text/Tradition/Directory.pm

   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         }
  91
  92         return $self;
  93 }
  94
  95 1;
  96
  97