lib/Prophet.pm
==============
use warnings;
use strict;

package Prophet;

our $VERSION = '0.01';

=head1 NAME

Prophet

=head1 DESCRIPTION

Prophet is a distributed database system designed for small to medium scale database applications (currently up to around 50,000 records of a given type).
Our early targets include things such as bug tracking.

=head2 Design goals

=head3 Arbitrary record schema

=head3 Replication

=head3 Disconnected operation

=head3 Peer to peer synchronization



=head2 Design constraints

=head3 Scaling

We don't currently intend for the first implementation of Prophet to scale to databases with millions of rows or hundreds of concurrent users. There's nothing that makes the design infeasible, but the infrastructure necessary for such a system will...needlessly hamstring it.

=cut

1;




lib/Prophet/App.pm
==================
package Prophet::App;
use Moose;
use Path::Class;
use Prophet::Config;

has handle => (
    is      => 'rw',
    isa     => 'Prophet::Replica',
    lazy    => 1,
    default => sub {
        my $self = shift;
        my $root = $ENV{'PROPHET_REPO'} || dir($ENV{'HOME'}, '.prophet');
        my $type = $self->default_replica_type;
        return Prophet::Replica->new({ url => $type.':file://' . $root, app_handle => $self});
    },
);

has resdb_handle => (
    is      => 'rw',
    isa     => 'Prophet::Replica',
    lazy    => 1,
    default => sub {
        my $self = shift;
        return $self->handle->resolution_db_handle
            if $self->handle->resolution_db_handle;
        my $root = ($ENV{'PROPHET_REPO'} || dir($ENV{'HOME'}, '.prophet')) . "_res";
        my $type = $self->default_replica_type;
        return Prophet::Replica->new({ url => $type.':file://' . $root });
    },
);

has config => (
    is      => 'rw',
    isa     => 'Prophet::Config',
    default => sub {
        my $self = shift;
        return Prophet::Config->new(app_handle => $self);
    },
    documentation => "This is the config instance for the running application",
);

use constant DEFAULT_REPLICA_TYPE => 'prophet';

=head1 NAME

Prophet::App

=cut

sub default_replica_type {
    my $self = shift;
    return $ENV{'PROPHET_REPLICA_TYPE'} || DEFAULT_REPLICA_TYPE;
}

sub require {
    my $self = shift;
    my $class = shift;
    $self->_require(module => $class);
}

sub try_to_require {
    my $self = shift;
    my $class = shift;
    $self->_require(module => $class, quiet => 1);
}


sub _require {
    my $self = shift;
    my %args = ( module => undef, quiet => undef, @_);
    my $class = $args{'module'};

    # Quick hack to silence warnings.
    # Maybe some dependencies were lost.
    unless ($class) {
        warn sprintf("no class was given at %s line %d\n", (caller)[1,2]);
        return 0;
    }

    return 1 if $self->already_required($class);

    # .pm might already be there in a weird interaction in Module::Pluggable
    my $file = $class;
    $file .= ".pm"
        unless $file =~ /\.pm$/;

    $file =~ s/::/\//g;

    my $retval = eval {
        local $SIG{__DIE__} = 'DEFAULT';
        CORE::require "$file"
    };

    my $error = $@;
    if (my $message = $error) {
        $message =~ s/ at .*?\n$//;
        if ($args{'quiet'} and $message =~ /^Can't locate \Q$file\E/) {
            return 0;
        }
        elsif ( $error !~ /^Can't locate $file/) {
            die $error;
        } else {
            warn sprintf("$message at %s line %d\n", (caller(1))[1,2]);
            return 0;
        }
    }

    return 1;
}

=head2 already_required class

Helper function to test whether a given class has already been require'd.

=cut

sub already_required {
    my ($self, $class) = @_;
    my $path =  join('/', split(/::/,$class)).".pm";
    return ( $INC{$path} ? 1 : 0);
}

__PACKAGE__->meta->make_immutable;
no Moose;

1;




lib/Prophet/CLI/Command/Log.pm
==============================
package Prophet::CLI::Command::Log;
use Moose;
extends 'Prophet::CLI::Command';

sub run {
    my $self   = shift;
    my $handle = $self->handle;
    my $newest = $self->arg('last') || $handle->latest_sequence_no;
    my $start  = $newest - ( $self->arg('count') || '20' );
    $start = 0 if $start < 0;

    $handle->traverse_changesets(
        after    => $start,
        callback => sub {
            my $changeset = shift;
            $self->handle_changeset($changeset);

        },
    );

}


sub handle_changeset {
    my $self      = shift;
    my $changeset = shift;
    print $changeset->as_string(
        change_header => sub {
            my $change = shift;
            $self->change_header($change);
        }
    );

}
sub change_header {
    my $self   = shift;
    my $change = shift;
    return
          " # "
        . $change->record_type . " "
        . $self->app_handle->handle->find_or_create_luid(
        uuid => $change->record_uuid )
        . " ("
        . $change->record_uuid . ")\n";

}


__PACKAGE__->meta->make_immutable;
no Moose;
1;




lib/Prophet/CLI/Command/Config.pm
=================================
package Prophet::CLI::Command::Config;
use Moose;
extends 'Prophet::CLI::Command';

sub run {
    my $self = shift;

    my $config = $self->config;

    print "Configuration:\n\n";
    my @files =@{$config->config_files};
    if (!scalar @files) {
        print $self->no_config_files;
        return;
    }
    for my $file (@files) {
        print "Config files:\n\n";
            print "$file\n";
    }
    print "\nYour configuration:\n\n";
    for my $item ($config->list) {
        print $item ." = ".$config->get($item)."\n";
    }

}

sub no_config_files {
    return "No configuration files found. "
         . " Either create a file called 'prophetrc' inside of "
         . $self->handle->fs_root
         . " or set the PROPHET_APP_CONFIG environment variable.\n\n";
}

__PACKAGE__->meta->make_immutable;
no Moose;

1;





lib/Prophet/CLI/Command/Export.pm
=================================
package Prophet::CLI::Command::Export;
use Moose;
extends 'Prophet::CLI::Command';

sub run {
    my $self = shift;

    $self->handle->export_to( path => $self->arg('path') );
}

__PACKAGE__->meta->make_immutable;
no Moose;

1;





lib/Prophet/CLI/Command/Search.pm
=================================
package Prophet::CLI::Command::Search;
use Moose;
extends 'Prophet::CLI::Command';
with 'Prophet::CLI::RecordCommand';
with 'Prophet::CLI::CollectionCommand';

has '+uuid' => (
    required => 0,
);

has 'sort_routine' => (
    is => 'rw',
    isa => 'CodeRef',
    required => 0,
    # default subs are executed immediately, hence the weird syntax for coderefs
    default => sub { sub {
                my $records = shift;
            return (sort { $a->luid <=> $b->luid } @$records);
        } },
    documentation => 'A subroutine which takes a hashref to a list of records and returns them sorted in some way.',
);

sub default_match { 1 }

sub get_search_callback {
    my $self = shift;

    my %prop_checks;
    for my $check ($self->prop_set) {
        push @{ $prop_checks{ $check->{prop} } }, $check;
    }

    my $regex = $self->arg('regex');

    return sub {
        my $item = shift;
        my $props = $item->get_props;
        my $did_limit = 0;

        if ($self->prop_names > 0) {
            $did_limit = 1;

            for my $prop (keys %prop_checks) {
                my $got = $props->{$prop};
                my $ok = 0;
                for my $check (@{ $prop_checks{$prop} }) {
                    $ok = 1
                        if $self->cmp_ok($check->{value}, $check->{cmp}, $got);
                }
                return 0 if !$ok;
            }
        }

        # if they specify a regex, it must match
        if ($regex) {
            $did_limit = 1;
            my $ok = 0;

            for (values %$props) {
                if (/$regex/) {
                    $ok = 1;
                    last;
                }
            }
            return 0 if !$ok;
        }

        return $self->default_match($item) if !$did_limit;

        return 1;
    };
}

sub cmp_ok {
    my $self = shift;
    my ($expected, $cmp, $got) = @_;

    $got = '' if !defined($got); # avoid undef warnings

    if ($cmp eq '=') {
        return 0 unless $got eq $expected;
    }
    elsif ($cmp eq '=~') {
        return 0 unless $got =~ $expected;
    }
    elsif ($cmp eq '!=' || $cmp eq '<>' || $cmp eq 'ne') {
        return 0 if $got eq $expected;
    }
    elsif ($cmp eq '!~') {
        return 0 if $got =~ $expected;
    }

    return 1;
}

sub run {
    my $self = shift;

    my $records = $self->get_collection_object();
    my $search_cb = $self->get_search_callback();
    $records->matching($search_cb);

    $self->display_terminal($records);
}

=head2 display_terminal $records

Takes a collection of records, sorts it according to C<$sort_routine>,
and then prints it to standard output using L<Prophet::Record->format_summary>
as the format.

=cut

sub display_terminal {
    my $self = shift;
    my $records = shift;

    my $items = $records->items;
    for ( $self->sort_routine->( $items) ) {
            print $_->format_summary . "\n";
    }
}

__PACKAGE__->meta->make_immutable;
no Moose;

1;





lib/Prophet/CLI/Command/Delete.pm
=================================
package Prophet::CLI::Command::Delete;
use Moose;
extends 'Prophet::CLI::Command';
with 'Prophet::CLI::RecordCommand';

sub run {
    my $self = shift;

    $self->require_uuid;
    my $record = $self->_load_record;

    if ( $record->delete ) {
        print $record->type . " " . $record->uuid . " deleted.\n";
    } else {
        print $record->type . " " . $record->uuid . "could not be deleted.\n";
    }

}

__PACKAGE__->meta->make_immutable;
no Moose;

1;





lib/Prophet/CLI/Command/Create.pm
=================================
package Prophet::CLI::Command::Create;
use Moose;
extends 'Prophet::CLI::Command';
with 'Prophet::CLI::RecordCommand';
has '+uuid' => ( required => 0);

has record => (
    is  => 'rw',
    isa => 'Prophet::Record',
    documentation => 'The record object of the created record.',
);

sub run {
    my $self   = shift;
    my $record = $self->_get_record_object;
    my ($val, $msg) = $record->create( props => $self->edit_props );
    if (!$val) {
        warn "Unable to create record: " . $msg . "\n";
    }
    if (!$record->uuid) {
        warn "Failed to create " . $record->record_type . "\n";
        return;
    }

    $self->record($record);

    print "Created " . $record->record_type . " " . $record->luid . " (".$record->uuid.")"."\n";
}

__PACKAGE__->meta->make_immutable;
no Moose;

1;





lib/Prophet/CLI/Command/Shell.pm
================================
#!/usr/bin/env perl
package Prophet::CLI::Command::Shell;
use Moose;
extends 'Prophet::CLI::Command';
use Path::Class 'file';

has name => (
    is => 'ro',
    isa => 'Str',
    default => sub { file($0)->basename },
);

has term => (
    is      => 'ro',
    isa     => 'Term::ReadLine::Stub',
    lazy    => 1,
    handles => [qw/readline addhistory/],
    default => sub {
        require Term::ReadLine;
        return Term::ReadLine->new("Prophet shell");
    },
);

    our $HIST = $ENV{PROPHET_HISTFILE}
            || (($ENV{HOME} || (getpwuid($<))[7]) . "/.prophetreplhist");
    our $LEN = $ENV{PROPHET_HISTLEN} || 500;




sub prompt {
    my $self = shift;
    return $self->name . '> ';
}

sub preamble {
    return join "\n",
        "Prophet $Prophet::VERSION",
        'Type "help", "about", or "copying" for more information.',
}

sub read {
    my $self = shift;
    $self->readline($self->prompt);
}

sub eval {
    my $self = shift;
    my $line = shift;

    eval {
        local $SIG{__DIE__} = 'DEFAULT';
        $self->cli->run_one_command(split ' ', $line);
    };
    warn $@ if $@;
}

sub run {
    my $self = shift;

    local $| = 1;

    print $self->preamble . "\n";

    $self->cli->interactive_shell(1);
    while ( defined(my $cmd = $self->read)) {
        next if $cmd =~ /^\s*$/;

        last if $cmd =~ /^\s*q(?:uit)?\s*$/i
             || $cmd =~ /^\s*exit\s*$/i;

        $self->eval($cmd);
    }
}

# make the REPL history persistent
around run => sub {
    my $orig = shift;
    my $self = shift;
    $self->_read_repl_history();
    $self->$orig(@_);
    $self->_write_repl_history();
};


# we use eval here because only some Term::ReadLine subclasses support
# persistent history. it also seems that ->can doesn't work because of AUTOLOAD
# trickery. :(

sub _read_repl_history {
    my $self = shift;
    eval {
        local $SIG{__DIE__};
        $self->term->stifle_history($LEN);
        $self->term->ReadHistory($HIST)
            if -f $HIST;
    };
}

sub _write_repl_history {
    my $self = shift;

    eval {
        local $SIG{__DIE__};
        $self->term->WriteHistory($HIST)
            or warn "Unable to write to shell history file $HIST";
    };
}


__PACKAGE__->meta->make_immutable;
no Moose;

1;





lib/Prophet/CLI/Command/Update.pm
=================================
package Prophet::CLI::Command::Update;
use Moose;
extends 'Prophet::CLI::Command';
with 'Prophet::CLI::RecordCommand';

sub edit_record {
    my $self   = shift;
    my $record = shift;

    my $props = $record->get_props;
    # don't feed in existing values if we're not interactively editing
    my $defaults = $self->has_arg('edit') ? $props : undef;

    my @ordering = ( );
    # we want props in $record->props_to_show to show up in the editor if --edit
    # is supplied too
    if ($record->can('props_to_show') && $self->has_arg('edit')) {
        @ordering = $record->props_to_show;
        map { $props->{$_} = '' if !exists($props->{$_}) } @ordering;
    }

    return $self->edit_props(arg => 'edit', defaults => $defaults,
        ordering => \@ordering);
}

sub run {
    my $self = shift;

    $self->require_uuid;
    my $record = $self->_load_record;

    my $new_props = $self->edit_record($record);
    my $result = $record->set_props( props => $new_props );

    if ($result) {
        print $record->type . " " . $record->luid . " (".$record->uuid.")"." updated.\n";

    } else {
        print "SOMETHING BAD HAPPENED "
            . $record->type . " "
            . $record->luid . " ("
            . $record->uuid
            . ") not updated.\n";
    }
}

__PACKAGE__->meta->make_immutable;
no Moose;

1;





lib/Prophet/CLI/Command/Publish.pm
==================================
package Prophet::CLI::Command::Publish;
use Moose;
extends 'Prophet::CLI::Command::Export';
with 'Prophet::CLI::PublishCommand';
with 'Prophet::CLI::CollectionCommand';

use Path::Class;

sub view_classes {
 return ['Prophet::Server::View'];
}

before run => sub {
    my $self = shift;
    die "Please specify a --to.\n" unless $self->has_arg('to');

    # set the temp directory where we will do all of our work, which will be
    # published via rsync
    $self->set_arg(path => $self->tempdir);
};

around run => sub {
    my $orig = shift;
    my $self = shift;

    my $export_html = $self->has_arg('html');
    my $export_replica = $self->has_arg('replica');

    # if the user specifies nothing, then publish the replica
    $export_replica = 1 if !$export_html;

    # if we have the html argument, populate the tempdir with rendered templates
    $self->export_html() if ($export_html);

    # otherwise, do the normal prophet export this replica
        $self->$orig(@_) if ($export_replica);
    
};

# the tempdir is populated, now publish it
after run => sub {
    my $self = shift;
    my $from = $self->arg('path');
    my $to   = $self->arg('to');

    $self->publish_dir(
        from => $from,
        to   => $to,
    );

    print "Publish complete.\n";
};

sub export_html {
	my $self = shift;
        my $path = dir($self->arg('path'));

        # if they specify both html and replica, then stick rendered templates
        # into a subdirectory. if they specify only html, assume they really
        # want to publish directly into the specified directory
        if ($self->has_arg('replica')){
            $path = $path->subdir('html');
            $path->mkpath;
        }

        $self->render_templates_into($path);
    }

# helper methods for rendering templates
sub render_templates_into {
    my $self = shift;
    my $dir  = shift;

    require Prophet::Server::View;
    Template::Declare->init(roots => __PACKAGE__->view_classes);

    # allow user to specify a specific type to render
    my @types = $self->type || $self->types_to_render;

    for my $type (@types) {
        my $subdir = $dir->subdir($type);
        $subdir->mkpath;

        my $records = $self->get_collection_object(type => $type);
        $records->matching(sub { 1 });

        my $fh = $subdir->file('index.html')->openw;
        print { $fh } Template::Declare->show('record_table' => $records);
        close $fh;

        for my $record ($records->items) {
            my $fh = $subdir->file($record->uuid . '.html')->openw;
            print { $fh } Template::Declare->show('record' => $record);
        }
    }
}

sub should_skip_type {
    my $self = shift;
    my $type = shift;

    # should we skip all _private types?
    return 1 if $type eq '_merge_tickets';

    return 0;
}

sub types_to_render {
    my $self = shift;

    return grep { !$self->should_skip_type($_) }
           @{ $self->handle->list_types };
}

__PACKAGE__->meta->make_immutable;
no Moose;

1;





lib/Prophet/CLI/Command/NotFound.pm
===================================
package Prophet::CLI::Command::NotFound;
use Moose;
extends 'Prophet::CLI::Command';

sub run {
    my $self = shift;
    $self->fatal_error( "The command you ran could not be found. Perhaps running '$0 help' would help?" );
}

__PACKAGE__->meta->make_immutable;
no Moose;

1;





lib/Prophet/CLI/Command/Show.pm
===============================
package Prophet::CLI::Command::Show;
use Moose;
use Params::Validate;
extends 'Prophet::CLI::Command';
with 'Prophet::CLI::RecordCommand';

sub run {
    my $self = shift;

    $self->require_uuid;
    my $record = $self->_load_record;

    print $self->stringify_props(
        record => $record,
        batch   => $self->has_arg('batch'),
        verbose => $self->has_arg('verbose'),
    );
}

=head2 stringify_props

Returns a stringified form of the properties suitable for displaying directly
to the user. Also includes luid and uuid.

You may define a "color_prop" method which transforms a property name and value
(by adding color).

You may also define a "color_prop_foo" method which transforms values of
property "foo" (by adding color).

=cut

sub stringify_props {
    my $self = shift;
    my %args = validate( @_, {record => { ISA => 'Prophet::Record'},
                            batch =>  1,
                            verbose => 1});

    my $record = $args{'record'};
    my $props = $record->get_props;

    my $colorize = $args{'batch'} ? 0 : 1;

    # which props are we going to display?
    my @show_props;
    if ($record->can('props_to_show')) {
        @show_props = $record->props_to_show(\%args);

        # if they ask for verbosity, then display all the other fields
        # after the fields that our subclass wants to show
        if ($args{verbose}) {
            my %already_shown = map { $_ => 1 } @show_props;
            push @show_props, grep { !$already_shown{$_} }
                              sort keys %$props;
        }
    }
    else {
        @show_props = ('id', sort keys %$props);
    }

    # kind of ugly but it simplifies the code
    $props->{id} = $record->luid ." (" . $record->uuid . ")";

    my $max_length = 0;
    my @fields;

    for my $field (@show_props) {
        my $value = $props->{$field};

        # don't bother displaying unset fields
        next if !defined($value);

        # color if we can (and should)
        my ($colorized_field, $colorized_value);
        if ($colorize) {
            ($colorized_field,$colorized_value) = $record->colorize($field => $value);

    }
        push @fields, [$field, ($colorized_field|| $field), ($colorized_value ||$value)];

        # don't check length($field) here, since coloring will increase the
        # length but we only care about display length
        $max_length = length($field)
            if length($field) > $max_length;
    }

    $max_length = 0 if $args{batch};

    # this code is kind of ugly. we need to format based on uncolored length
    return join '',
           map {
               my ($field, $colorized_field, $colorized_value) = @$_;
               $colorized_field .= ':';
               $colorized_field .= ' ' x ($max_length - length($field));
               "$colorized_field $colorized_value\n"
           }
           @fields;
}

__PACKAGE__->meta->make_immutable;
no Moose;

1;





lib/Prophet/CLI/Command/History.pm
==================================
package Prophet::CLI::Command::History;
use Moose;
extends 'Prophet::CLI::Command';
with 'Prophet::CLI::RecordCommand';

sub run {
    my $self = shift;

    $self->require_uuid;
    my $record = $self->_load_record;

    print $record->history_as_string;
}

__PACKAGE__->meta->make_immutable;
no Moose;

1;






lib/Prophet/CLI/Command/Pull.pm
===============================
package Prophet::CLI::Command::Pull;
use Moose;
extends 'Prophet::CLI::Command::Merge';

override run => sub {
    my $self = shift;
    my @from;

    $self->set_arg( db_uuid => $self->handle->db_uuid ) 
        unless ($self->arg('db_uuid'));

    my %previous_sources = $self->_read_cached_upstream_replicas;
    push @from, $self->arg('from')
        if ($self->arg('from') && ( !$self->has_arg('all') || !$previous_sources{$self->arg('from')}));
    push @from, keys %previous_sources if $self->has_arg('all');

    my @bonjour_replicas = $self->find_bonjour_replicas;

    die "Please specify a --from, --local or --all.\n"
        unless ( $self->has_arg('from')
        || $self->has_arg('local')
        || $self->has_arg('all') );

    $self->set_arg( to => $self->cli->app_handle->default_replica_type
            . ":file://"
            . $self->handle->fs_root );

    for my $from ( @from, @bonjour_replicas ) {
        print "Pulling from $from\n";
        #if ( $self->has_arg('all') || $self->has_arg('local') );
        $self->set_arg( from => $from );
        super();
        print "\n";
    }

    if ( $self->arg('from') && !exists $previous_sources{$self->arg('from')} ) {
        $previous_sources{$self->arg('from')} = 1;
        $self->_write_cached_upstream_replicas(%previous_sources);
    }
};

=head2 find_bonjour_replicas

Probes the local network for bonjour replicas if the local arg is specified.

Returns a list of found replica URIs.

=cut

sub find_bonjour_replicas {
    my $self = shift;
    my @bonjour_replicas;
    if ( $self->has_arg('local') ) {
        Prophet::App->try_to_require('Net::Bonjour');
        if ( Prophet::App->already_required('Net::Bonjour') ) {
            print "Probing for local database replicas with Bonjour\n";
            my $res = Net::Bonjour->new('prophet');
            $res->discover;
            foreach my $entry ( $res->entries ) {
                if ( $entry->name eq $self->arg('db_uuid') ) {
                    print "Found a database replica on " . $entry->hostname."\n";
                    my $uri = URI->new();
                    $uri->scheme( 'http' );
                    $uri->host($entry->hostname);
                    $uri->port( $entry->port );
                    $uri->path('replica/');
                    push @bonjour_replicas,  $uri->canonical.""; #scalarize
                }
            }
        }

    }
    return @bonjour_replicas;
}

=head2 _read_cached_upstream_replicas

Returns a hash containing url => 1 pairs, where the URLs are the replicas that
have been previously pulled from.

=cut

sub _read_cached_upstream_replicas {
    my $self = shift;
    return map { $_ => 1 } $self->handle->_read_cached_upstream_replicas;
}

=head2 _write_cached_upstream_replicas %replicas

Writes the replica URLs given in C<keys %replicas> to the current Prophet
repository's upstream replica cache (these replicas will be pulled from when a
user specifies --all).

=cut

sub _write_cached_upstream_replicas {
    my $self  = shift;
    my %repos = @_;
    return $self->handle->_write_cached_upstream_replicas(keys %repos);
}

__PACKAGE__->meta->make_immutable;
no Moose;



1;





lib/Prophet/CLI/Command/Server.pm
=================================
package Prophet::CLI::Command::Server;
use Moose;
extends 'Prophet::CLI::Command';

use Prophet::Server;

sub run {
    my $self = shift;
    my $server = $self->_setup_server();
    $server->run;
}

sub _setup_server {
    my $self = shift;
    my $server = Prophet::Server->new( $self->arg('port') || 8080 );
    $server->app_handle( $self->app_handle );
    $server->setup_template_roots();
    return $server;
}



__PACKAGE__->meta->make_immutable;
no Moose;

1;





lib/Prophet/CLI/Command/Push.pm
===============================
package Prophet::CLI::Command::Push;
use Moose;
extends 'Prophet::CLI::Command::Merge';

before run => sub {
    my $self = shift;

    die "Please specify a --to.\n" if !$self->has_arg('to');

    $self->set_arg(from => $self->app_handle->default_replica_type.":file://".$self->handle->fs_root);
    $self->set_arg(db_uuid => $self->handle->db_uuid);
};

__PACKAGE__->meta->make_immutable;
no Moose;

1;





lib/Prophet/CLI/Command/Merge.pm
================================
package Prophet::CLI::Command::Merge;
use Moose;
extends 'Prophet::CLI::Command';

sub run {
    my $self = shift;

    my (@alt_from, @alt_to);

    if ($self->has_arg('db_uuid')) {
        push @alt_from, join '/', $self->arg('from'), $self->arg('db_uuid');
        push @alt_to,   join '/', $self->arg('to'),   $self->arg('db_uuid');
    }

    my $source = Prophet::Replica->new(
        url       => $self->arg('from'),
        app_handle => $self->app_handle,
        _alt_urls => \@alt_from,
    );

    my $target = Prophet::Replica->new(
        url       => $self->arg('to'),
        app_handle => $self->app_handle,
        _alt_urls => \@alt_to,
    );

    $target->import_resolutions_from_remote_replica(
        from  => $source,
        force => $self->has_arg('force'),
    );

    my $changesets = $self->_do_merge( $source, $target );

    $self->print_report($changesets);
}


sub print_report {
    my $self = shift;
    my $changesets = shift;
    if ($changesets == 0) {
        print "No new changesets.\n";
    }
    elsif ($changesets == 1) {
        print "Merged one changeset.\n";
    }
    else {
        print "Merged $changesets changesets.\n";
    }
}

=head2 _do_merge $source $target

Merges changesets from the source replica into the target replica.

Fails fatally if the source and target are the same, or the target is
not writable.

Conflicts are resolved by either the resolver specified in the
C<PROPHET_RESOLVER> environmental variable, the C<prefer> argument
(can be set to C<to> or C<from>, in which case Prophet will
always prefer changesets from one replica or the other), or by
using a default resolver.

Returns the number of changesets merged.

=cut

sub _do_merge {
    my ( $self, $source, $target ) = @_;

    my %import_args = (
        from  => $source,
        resdb => $self->resdb_handle,
        force => $self->has_arg('force'),
    );

    local $| = 1;

    $self->validate_merge_replicas($source => $target);

    $import_args{resolver_class} = $self->merge_resolver();

    my $changesets = 0;

    my $source_latest = $source->latest_sequence_no() || 0;
    my $source_last_seen = $target->last_changeset_from_source($source->uuid) || 0;

    if( $self->has_arg('verbose') ) {
        print "Integrating changes from ".$source_last_seen . " to ". $source_latest."\n";
    }


    if( $self->has_arg('verbose') ) {
        $import_args{reporting_callback} = sub {
            my %args = @_;
            print $args{changeset}->as_string;
            $changesets++;
        };
    } else {
        require Time::Progress;
        my $progress = Time::Progress->new();
        $progress->attr( max => ($source_latest - $source_last_seen));

        $import_args{reporting_callback} = sub {
            my %args = @_;
            $changesets++;
            print $progress->report( "%30b %p %E // ". ($args{changeset}->created || 'Undated'). " " .(sprintf("%-12s",$args{changeset}->creator||'')) ."\r" , $changesets);

        };

    }

    $target->import_changesets( %import_args);
    return $changesets;
}


sub validate_merge_replicas {
    my $self = shift;
    my $source = shift;
    my $target = shift;

    if ( $target->uuid eq $source->uuid ) {
        $self->fatal_error(
                  "You appear to be trying to merge two identical replicas. "
                . "Either you're trying to merge a replica to itself or "
                . "someone did a bad job cloning your database." );
    }

    if ( !$target->can_write_changesets ) {
        $self->fatal_error( $target->url
                . " does not accept changesets. Perhaps it's unwritable."
        );
    }
}

sub merge_resolver {
    my $self = shift;

    my $prefer = $self->arg('prefer') || 'none';

    my $resolver = $ENV{'PROPHET_RESOLVER'} ? 'Prophet::Resolver::' . $ENV{'PROPHET_RESOLVER'}
        : $prefer eq 'to'   ? 'Prophet::Resolver::AlwaysTarget'
        : $prefer eq 'from' ? 'Prophet::Resolver::AlwaysSource'
        :                     ();
    return $resolver;
}


__PACKAGE__->meta->make_immutable;
no Moose;

1;





lib/Prophet/CLI/PublishCommand.pm
=================================
package Prophet::CLI::PublishCommand;
use Moose::Role;

use Path::Class;
use File::Temp ();

sub tempdir { dir(File::Temp::tempdir(CLEANUP => 1)) }

sub publish_dir {
    my $self = shift;
    my %args = @_;

    my @args;
    push @args, '--recursive';
    push @args, '--verbose' if $self->context->has_arg('verbose');

    push @args, '--';

    push @args, dir($args{from})->children;

    push @args, $args{to};

    my $rsync = $ENV{RSYNC} || "rsync";
    my $ret = system($rsync, @args);

    if ($ret == -1) {
        die "You must have 'rsync' installed to use this command.

If you have rsync but it's not in your path, set environment variable \$RSYNC to the absolute path of your rsync executable.\n";
    }

    return $ret;
}

no Moose::Role;

1;





lib/Prophet/CLI/Command.pm
==========================
package Prophet::CLI::Command;
use Moose;

use Params::Validate qw(validate);

has cli => (
    is => 'rw',
    isa => 'Prophet::CLI',
    weak_ref => 1,
    handles => [
        qw/app_handle handle resdb_handle config/,
    ],
);

has context => (
    is => 'rw',
    isa => 'Prophet::CLIContext',
    handles => [ 
        qw/args  set_arg  arg  has_arg  delete_arg  arg_names/,
        qw/props set_prop prop has_prop delete_prop prop_names/,
        'add_to_prop_set', 'prop_set',
    ],

);


sub fatal_error {
    my $self   = shift;
    my $reason = shift;

    # always skip this fatal_error function when generating a stack trace
    local $Carp::CarpLevel = $Carp::CarpLevel + 1;

    die $reason . "\n";
}

=head2 require_uuid

Checks to make sure the uuid attribute is set. Prints an error and dies
if it is not set.

=cut

sub require_uuid {
    my $self    = shift;

    if (!$self->has_uuid) {
        my $type = $self->type;
        my $name = (split /::/, $self->meta->name)[-1];
        die "\u$type \l$name requires a luid or uuid (use --id to specify).\n";
    }
}

=head2 edit_text [text] -> text

Filters the given text through the user's C<$EDITOR> using
L<Proc::InvokeEditor>.

=cut

sub edit_text {
    my $self = shift;
    my $text = shift;

    # don't invoke the editor in a script, the test will appear to hang
    die "Tried to invoke an editor in a test script!"
        if $ENV{IN_PROPHET_TEST_COMMAND};

    require Proc::InvokeEditor;
    return scalar Proc::InvokeEditor->edit($text);
}

=head2 edit_hash hash => hashref, ordering => arrayref

Filters the hash through the user's C<$EDITOR> using L<Proc::InvokeEditor>.

No validation is done on the input or output.

If the optional ordering argument is specified, hash keys will be presented
in that order (with unspecified elements following) for edit.

If the record class for the current type defines a C<props_not_to_edit>
routine, those props will not be presented for editing.

False values are not returned unless a prop is removed from the output.

=cut

sub edit_hash {
    my $self = shift;
    validate( @_, { hash => 1, ordering => 0 } );
    my %args = @_;
    my $hash = $args{'hash'};
    my @ordering = @{ $args{'ordering'} || [] };
    my $record = $self->_get_record_object;
    my $do_not_edit = $record->can('props_not_to_edit') ? $record->props_not_to_edit : '';

    if (@ordering) {
        # add any keys not in @ordering to the end of it
        my %keys_in_ordering;
        map { $keys_in_ordering{$_} = 1 if exists($hash->{$_}) } @ordering;
        map { push @ordering, $_ if !exists($keys_in_ordering{$_}) } keys %$hash;
    } else {
        @ordering = sort keys %$hash;
    }

    # filter out props we don't want to present for editing
    @ordering = grep { !/$do_not_edit/ } @ordering;

    my $input = join "\n", map { "$_: $hash->{$_}" } @ordering;

    my $output = $self->edit_text($input);

    die "Aborted.\n" if $input eq $output;

    # parse the output
    my $filtered = {};
    foreach my $line (split "\n", $output) {
        if ($line =~ m/^([^:]+):\s*(.*)$/) {
            my $prop = $1;
            my $val = $2;
            # don't return empty values
            $filtered->{$prop} = $val unless !($val);
        }
    }
    no warnings 'uninitialized';

    # if a key is deleted intentionally, set its value to ''
    foreach my $prop (keys %$hash) {
        if (!exists $filtered->{$prop} and $prop =~ !/$do_not_edit/) {
            $filtered->{$prop} = '';
        }
    }

    # filter out unchanged keys as they clutter changesets if they're set again
    map { delete $filtered->{$_} if $hash->{$_} eq $filtered->{$_} } keys %$filtered;

    return $filtered;
}

=head2 edit_props arg => str, defaults => hashref, ordering => arrayref

Returns a hashref of the command's props mixed in with any default props.
If the "arg" argument is specified, (default "edit", use C<undef> if you only
want default arguments), then L</edit_hash> is invoked on the property list.

If the C<ordering> argument is specified, properties will be presented in that
order (with unspecified props following) if filtered through L</edit_hash>.

=cut

sub edit_props {
    my $self = shift;
    my %args = @_;
    my $arg  = $args{'arg'} || 'edit';
    my $defaults = $args{'defaults'};

    my %props;
    if ($defaults) {
        %props = (%{ $defaults }, %{ $self->props });
    } else {
        %props = %{$self->props};
    }

    if ($self->has_arg($arg)) {
        return $self->edit_hash(hash => \%props, ordering => $args{'ordering'});
    }

    return \%props;
}

__PACKAGE__->meta->make_immutable;
no Moose;

1;





lib/Prophet/CLI/Dispatcher.pm
=============================
package Prophet::CLI::Dispatcher;
use strict;
use warnings;
use Path::Dispatcher::Declarative -base;

# "ticket display $ID" -> "ticket display --id=$ID"
on qr{ (.*) \s+ ( \d+ | [A-Z0-9]{36} ) $ }x => sub {
    my %args = @_;
    $args{cli}->set_arg(id => $2);
    run($1, %args);
};

on qr{^(\w+)} => sub {
    my %args = @_;

    my $cmd = __PACKAGE__->resolve_builtin_aliases($1);

    my @possible_classes = (
        ("Prophet::CLI::Command::" . ucfirst lc $cmd),
        "Prophet::CLI::Command::NotFound",
    );

    my $cli = $args{cli};

    for my $class (@possible_classes) {
        if ($cli->_try_to_load_cmd_class($class)) {
            return $args{got_command}->($class);
        }
    }
};

on qr{^\s*$} => sub {
    run(__PACKAGE__->default_command, @_);

};

my %CMD_MAP = (
    ls      => 'search',
    new     => 'create',
    edit    => 'update',
    rm      => 'delete',
    del     => 'delete',
    list    => 'search',
    display => 'show',
);

sub resolve_builtin_aliases {
    my $self = shift;
    my @cmds = @_;

    if (my $replacement = $CMD_MAP{ lc $cmds[-1] }) {
        $cmds[-1] = $replacement;
    }

    @cmds = map { ucfirst lc } @cmds;

    return wantarray ? @cmds : $cmds[-1];
}

=head2 default_command

Returns the "default" command for use when no arguments were specified on the
command line. In Prophet, it's "shell" but your subclass can change that.

=cut

sub default_command { "shell" }

1;





lib/Prophet/CLI/RecordCommand.pm
================================
package Prophet::CLI::RecordCommand;
use Moose::Role;
use Params::Validate;
use Prophet::Record;


has type => (
    is        => 'rw',
    isa       => 'Str',
    required  => 0,
    predicate => 'has_type',
);

has uuid => (
    is        => 'rw',
    isa       => 'Str',
    required  => 0,
    predicate => 'has_uuid',
);

has record_class => (
    is  => 'rw',
    isa => 'Prophet::Record',
);

=head2 _get_record_object [{ type => 'type' }]

Tries to determine a record class from either the given type argument or
the current object's C<$type> attribute.

Returns a new instance of the record class on success, or throws a fatal
error with a stack trace on failure.

=cut

sub _get_record_object {
    my $self = shift;
    my %args = validate(@_, {
        type => { default => $self->type },
    });

    my $constructor_args = {
        app_handle => $self->cli->app_handle,
        handle     => $self->cli->handle,
        type       => $args{type},
    };

    if ($args{type}) {
        my $class = $self->_type_to_record_class($args{type});
        return $class->new($constructor_args);
    }
    elsif (my $class = $self->record_class) {
        Prophet::App->require($class);
        return $class->new($constructor_args);
    }
    else {
        Carp::confess("I was asked to get a record object, but I have neither a type nor a record class");
    }
}

=head2 _load_record

Attempts to load the record specified by the C<uuid> attribute.

Returns the loaded record on success, or throws a fatal error if no
record can be found.

=cut

sub _load_record {
    my $self = shift;
    my $record = $self->_get_record_object;
    $record->load( uuid => $self->uuid )
        || $self->fatal_error("I couldn't find the " . $self->type . ' ' . $self->uuid);
    return $record;
}

=head2 _type_to_record_class $type

Takes a type and tries to figure out a record class name from it.
Returns C<'Prophet::Record'> if no better class name is found.

=cut

sub _type_to_record_class {
    my $self = shift;
    my $type = shift;
    my $try = $self->cli->app_class . "::Model::" . ucfirst( lc($type) );
    Prophet::App->try_to_require($try);    # don't care about fails
    return $try if ( $try->isa('Prophet::Record') );

    $try = $self->cli->app_class . "::Record";
    Prophet::App->try_to_require($try);    # don't care about fails
    return $try if ( $try->isa('Prophet::Record') );
    return 'Prophet::Record';
}

no Moose::Role;

1;





lib/Prophet/CLI/CollectionCommand.pm
====================================
package Prophet::CLI::CollectionCommand;
use Moose::Role;
with 'Prophet::CLI::RecordCommand';

use Params::Validate;

sub get_collection_object {
    my $self = shift;
    my %args = validate(@_, {
        type => { default => $self->type },
    });

    my $record_class = $self->_get_record_object(type => $args{type});
    my $class = $record_class->collection_class;
    Prophet::App->require($class);

    my $records = $class->new(
        app_handle => $self->app_handle,
        handle     => $self->handle,
        type       => $args{type} || $self->type,
    );

    return $records;
}

no Moose::Role;

1;





lib/Prophet/CLI.pm
==================
package Prophet::CLI;
use Moose;
use MooseX::ClassAttribute;

use Prophet;
use Prophet::Replica;
use Prophet::CLI::Command;
use Prophet::CLI::Dispatcher;
use Prophet::CLIContext;

use List::Util 'first';

has app_class => (
    is      => 'rw',
    isa     => 'ClassName',
    default => 'Prophet::App',
);

has record_class => (
    is      => 'rw',
    isa     => 'ClassName',
    lazy    => 1,
    default => 'Prophet::Record',
);

has app_handle => (
    is      => 'rw',
    isa     => 'Prophet::App',
    lazy    => 1,
    handles => [qw/handle resdb_handle config/],
    default => sub {
        return $_[0]->app_class->new;
    },
);


has context => (
    is => 'rw',
    isa => 'Prophet::CLIContext',
    lazy => 1,
    default => sub {
        return Prophet::CLIContext->new( app_handle => shift->app_handle);
    }

);

has interactive_shell => ( 
    is => 'rw',
    isa => 'Bool',
    default => sub { 0}
);


=head2 _record_cmd

handles the subcommand for a particular type

=cut

=head2 dispatcher -> Class

Returns the dispatcher used to dispatch command lines. You'll want to override
this in your subclass.

=cut

sub dispatcher { "Prophet::CLI::Dispatcher" }

=head2 _get_cmd_obj

Attempts to determine a command object based on aliases and the currently
set commands, arguments, and properties. Returns the class on success;
dies on failure.

This routine will use a C<CLI::Command::Shell> class if no arguments are
specified.

This routine will use a C<CLI::Command::NotFound> class as a last resort, so
failure should occur rarely if ever.

=cut

sub _get_cmd_obj {
    my $self = shift;

    my $command = join ' ', @{ $self->context->primary_commands };

    # yeah this kind of sucks but there's no sane way to tell 
    my $class;
    my %dispatcher_args = (
        cli            => $self,
        context        => $self->context,
        got_command    => sub { $class = shift },
        dispatching_on => $self->context->primary_commands,
    );

    $self->dispatcher->run($command, %dispatcher_args);
    die "I don't know how to parse '$command'. Are you sure that's a valid command?\n" unless $class;

    my %constructor_args = (
        cli      => $self,
        context  => $self->context,
        commands => $self->context->primary_commands,
        type     => $self->context->type,
    );

    # undef causes type constraint violations
    for my $key (keys %constructor_args) {
        delete $constructor_args{$key}
            if !defined($constructor_args{$key});
    }

    $constructor_args{uuid} = $self->context->uuid
        if $self->context->has_uuid;

    return $class->new(%constructor_args);
}

sub _try_to_load_cmd_class {
    my $self = shift;
    my $class = shift;
    Prophet::App->try_to_require($class);
    return $class if $class->isa('Prophet::CLI::Command');

    warn "Invalid class $class - not a subclass of Prophet::CLI::Command."
        if $class !~ /::$/ # don't warn about "Prophet::CLI::Command::" (which happens on "./bin/sd")
        && Prophet::App->already_required($class);

    return undef;
}


=head2 run_one_command

Runs a command specified by commandline arguments given in an
ARGV-like array of argumnents and key value pairs . To use in a
commandline front-end, create a L<Prophet::CLI> object and pass in
your main app class as app_class, then run this routine.

Example:

 my $cli = Prophet::CLI->new({ app_class => 'App::SD' });
 $cli->run_one_command(@ARGV);

=cut

sub run_one_command {
    my $self = shift;
    my @args = (@_);

     #  really, we shouldn't be doing this stuff from the command dispatcher

   $self->context(Prophet::CLIContext->new( app_handle => $self->app_handle)); 
   $self->context->setup_from_args(@args);
    if ( my $cmd_obj = $self->_get_cmd_obj() ) {
        $cmd_obj->run();
    }
}

=head2 invoke outhandle, ARGV_COMPATIBLE_ARRAY

Run the given command. If outhandle is true, select that as the file handle
for the duration of the command.

=cut

sub invoke {
    my ($self, $output, @args) = @_;
    my $ofh;

    $ofh = select $output if $output;
    my $ret = eval {
        local $SIG{__DIE__} = 'DEFAULT';
        $self->run_one_command(@args);
    };
    warn $@ if $@;
    select $ofh if $ofh;
    return $ret;
}


__PACKAGE__->meta->make_immutable;
no Moose;

1;





lib/Prophet/Replica/file.pm
===========================
package Prophet::Replica::file;
use base 'Prophet::Replica::prophet';
sub scheme { 'file'}

1;




lib/Prophet/Replica/http.pm
===========================
package Prophet::Replica::http;
use base 'Prophet::Replica::prophet';
sub scheme { 'http'}

1;




lib/Prophet/Replica/prophet.pm
==============================
package Prophet::Replica::prophet;
use Moose;
extends 'Prophet::Replica';
use Params::Validate qw(:all);
use LWP::Simple ();
use Path::Class;
use Digest::SHA1 qw(sha1_hex);
use File::Find::Rule;
use Data::UUID;
use JSON;


has '+db_uuid' => (
    lazy    => 1,
    default => sub { shift->_read_file('database-uuid') },
);

has _uuid => (
    is => 'rw',
);


has replica_version => (
    is      => 'ro',
    lazy    => 1,
    default => sub { shift->_read_file('replica-version') }
);

has fs_root_parent => (
    is      => 'rw',
    lazy    => 1,
    default => sub {
        my $self = shift;
        return $self->url =~ m{^file://(.*)/.*?$} ? dir($1) : undef;
    },
);

has fs_root => (
    is      => 'rw',
    lazy    => 1,
    default => sub {
        my $self = shift;
        return $self->url =~ m{^file://(.*)$} ? dir($1) : undef;
    },
);

has current_edit => (
    is => 'rw',
);

has current_edit_records => (
    metaclass => 'Collection::Array',
    is        => 'rw',
    isa       => 'ArrayRef',
    default   => sub { [] },
);


has '+resolution_db_handle' => (
    isa     => 'Prophet::Replica | Undef',
    lazy    => 1,
    default => sub {
        my $self = shift;
        return if $self->is_resdb || $self->is_state_handle;
        return Prophet::Replica->new({
            url      => "prophet:" . $self->url . '/resolutions',
            is_resdb => 1,
        })
    },
);

#has '+state_handle' => (
#    isa     => 'Prophet::Replica | Undef',
#    lazy    => 1,
#    default => sub {
#        return if $self->is_state_handle;
#        return Prophet::Replica->new({
#            url             => "prophet:" . $self->url,
#            is_state_handle => 1
#        });
#    },
#);

use constant scheme            => 'prophet';
use constant cas_root          => 'cas';
use constant record_cas_dir    => dir( __PACKAGE__->cas_root => 'records' );
use constant changeset_cas_dir => dir( __PACKAGE__->cas_root => 'changesets' );
use constant record_dir        => 'records';
use constant userdata_dir      => 'userdata';
use constant changeset_index   => 'changesets.idx';

=head1 Replica Format

=head4 overview
 
 $URL
    /<db-uuid>/
        /replica-uuid
        /latest-sequence-no
        /replica-version
        /cas/records/<substr(sha1,0,1)>/substr(sha1,1,1)/<sha1>
        /cas/changesets/<substr(sha1,0,1)>/substr(sha1,1,1)/<sha1>
        /records (optional?)
            /<record type> (for resolution is actually _prophet-resolution-<cas-key>)
                /<record uuid> which is a file containing a list of 0 or more rows
                    last-changed-sequence-no : cas key
                                    
        /changesets.idx
    
            index which has records:
                each record is : local-replica-seq-no : original-uuid : original-seq-no : cas key
            ...
    
        /resolutions/
            /replica-uuid
            /latest-sequence-no
            /cas/<substr(sha1,0,1)>/substr(sha1,1,1)/<sha1>
            /content (optional?)
                /_prophet-resolution-<cas-key>   (cas-key == a hash the conflicting change)
                    /<record uuid>  (record uuid == the originating replica)
                        last-changed-sequence-no : <cas key to the content of the resolution>
                                        
            /changesets.idx
                index which has records:
                    each record is : local-replica-seq-no : original-uuid : original-seq-no : cas key
                ...


Inside the top level directory for the mirror, you'll find a directory named as B<a hex-encoded UUID>.
This directory is the root of the published replica. The uuid uniquely identifes the database being replicated.
All replicas of this database will share the same UUID.

Inside the B<<db-uuid>> directory, are a set of files and directories that make up the actual content of the database replica:

=over 2

=item C<replica-uuid>

Contains the replica's hex-encoded UUID.

=item C<replica-version>

Contains a single integer that defines the replica format.

The current replica version is 1.

=item C<latest-sequence-no>

Contains a single integer, the replica's most recent sequence number.

=item C<cas/records>

=item C<cas/changesets>

The C<cas> directory holds changesets and records, each keyed by a
hex-encoded hash of the item's content. Inside the C<cas> directory, you'll find
a two-level deep directory tree of single-character hex digits. 
You'll find  the changeset with the sha1 digest  C<f4b7489b21f8d107ad8df78750a410c028abbf6c>
inside C<cas/changesets/f/4/f4b7489b21f8d107ad8df78750a410c028abbf6c>.

You'll find the record with the sha1 digest C<dd6fb674de879a1a4762d690141cdfee138daf65> inside
C<cas/records/d/d/dd6fb674de879a1a4762d690141cdfee138daf65>.


TODO: define the format for changesets and records


=item C<records>

Files inside the C<records> directory are index files which list off all published versions of a record and the key necessary to retrieve the record from the I<content-addressed store>.

Inside the C<records> directory, you'll find directories named for each
C<type> in your database. Inside each C<type> directory, you'll find a two-level directory tree of single hexadecimal digits. You'll find the record with the type <Foo> and the UUID C<29A3CA16-03C5-11DD-9AE0-E25CFCEE7EC4> stored in 

 records/Foo/2/9/29A3CA16-03C5-11DD-9AE0-E25CFCEE7EC4


The format of record files is:

    <unsigned-long-int: last-changed-sequence-no><40 chars of hex: cas key>

The file is sorted in asecnding order by revision id.


=item C<changesets.idx>

The C<changesets.idx> file lists each changeset in this replica and
provides an index into the B<content-addressed storage> to fetch
the content of the changeset.

The format of record files is:

    <unsigned-long-int: sequence-no><16 bytes: changeset original source uuid><unsigned-long-int: changeset original source sequence no><16 bytes: cas key - sha1 sum of the changeset's content>

The file is sorted in ascending order by revision id.


=item C<resolutions>

=over 2

=item TODO DOC RESOLUTIONS


=back

=back

=cut

=head2 BUILD

Open a connection to the SVN source identified by C<$self->url>.

=cut

sub BUILD {
    my $self = shift;
    my $args = shift;

    for ($self->{url}, @{ $self->{_alt_urls} }) {
        s/^prophet://;  # url-based constructor in ::replica should do better
        s{/$}{};
    }

    $self->_try_alt_urls($args);
    $self->_probe_or_create_db;
}

sub state_handle { return shift; }

sub _try_alt_urls {
    my $self = shift;
    my $args = shift;

    return unless @{ $self->{_alt_urls} };

    # try each URL in turn. since the "url" attribute is usually specified
    # directly by the user (and the others are calculated from that), we
    # save the error caused by the "url" attribute to throw if all
    # alternates fail

    my $error;
    for my $url ($self->{url}, @{ $self->{_alt_urls} }) {
        my $new_self = eval {
            local $SIG{__DIE__} = 'DEFAULT';
            my $obj = $self->new(%$args, url => $url, _alt_urls => []);
            $obj->_probe_or_create_db;
            $obj;
        };

        if ($new_self) {
            # XXX: yes this is a little offensive. but we can't outright replace
            # $self this late in the game, and we cannot foresee which
            # attributes will need clearing, so this is the simplest way to
            # make sure everything is consistent
            %$self = %$new_self;
            return 1;
        }

        $error ||= $@;
    }

    die $error if $error;
}

sub _probe_or_create_db {
    my $self = shift;

    return if $self->replica_version;

    if ( $self->fs_root_parent ) {

        # We have a filesystem based replica. we can perform a create
        $self->initialize();

    } elsif ($self->can_write_changesets) {
        die "We can only create file: based prophet replicas. It looks like you're trying to create " . $self->url;
    } else {
        die "Prophet couldn't find a replica at \"".$self->url."\"\n\n".
            "Please check the number and dial again.\n";
        
    }

}

use constant can_read_records    => 1;
use constant can_read_changesets => 1;
sub can_write_changesets { return ( shift->fs_root ? 1 : 0 ) }
sub can_write_records    { return ( shift->fs_root ? 1 : 0 ) }

sub initialize {
    my $self = shift;
    my %args = validate( @_, { db_uuid => 0 } );
    dir( $self->fs_root, $_ )->mkpath
        for (
        $self->record_dir,     $self->cas_root,
        $self->record_cas_dir, $self->changeset_cas_dir,
        $self->userdata_dir
        );

    $self->set_db_uuid( $args{'db_uuid'} || Data::UUID->new->create_str );
    $self->set_latest_sequence_no("0");
    $self->set_replica_uuid( Data::UUID->new->create_str );
    $self->_write_file(
        path    => 'replica-version',
        content => '1'
    );
}

sub latest_sequence_no {
    my $self = shift;
    $self->_read_file('latest-sequence-no');
}

sub set_latest_sequence_no {
    my $self = shift;
    my $id   = shift;
    $self->_write_file(
        path    => 'latest-sequence-no',
        content => scalar($id)
    );
}

sub _increment_sequence_no {
    my $self = shift;
    my $seq  = $self->latest_sequence_no + 1;
    $self->set_latest_sequence_no($seq);
    return $seq;
}

=head2 uuid

Return the replica SVN repository's UUID

=cut

sub uuid {
    my $self = shift;
    $self->_uuid( $self->_read_file('replica-uuid') ) unless $self->_uuid;
    return $self->_uuid;
}

sub set_replica_uuid {
    my $self = shift;
    my $uuid = shift;
    $self->_write_file(
        path    => 'replica-uuid',
        content => $uuid
    );

}

before set_db_uuid => sub {
    my $self = shift;
    my $uuid = shift;
    $self->_write_file(
        path    => 'database-uuid',
        content => $uuid
    );
};

=head1 Internals of record handling

=cut

sub _write_record {
    my $self = shift;
    my %args = validate( @_, { record => { isa => 'Prophet::Record' }, } );
    my $record = $args{'record'};

    $self->_write_serialized_record(
        type  => $record->type,
        uuid  => $record->uuid,
        props => $record->get_props,
    );
}

sub _write_serialized_record {
    my $self = shift;
    my %args = validate( @_, { type => 1, uuid => 1, props => 1 } );

    for ( keys %{ $args{'props'} } ) {
        delete $args{'props'}->{$_}
            if ( !defined $args{'props'}->{$_} || $args{'props'}->{$_} eq '' );
    }
    my ($cas_key) = $self->_write_to_cas(
        data    => $args{props},
        cas_dir => $self->record_cas_dir
    );

       my $record =   {uuid    => $args{uuid},
        type    => $args{type},
        cas_key => $cas_key};

    $self->_prepare_record_index_update(
           uuid    => $args{uuid},
        type    => $args{type},
        cas_key => $cas_key);
}


sub _prepare_record_index_update {
    my $self   = shift;
    my %record = (@_);

    # If we're inside an edit, we can record the changeset info into the index
    if ( $self->current_edit ) {
        push @{ $self->current_edit_records }, \%record;

    } else {
        # If we're not inside an edit, we're likely exporting the replica
        # TODO: the replica exporter code should probably be retooled
        $self->_write_record_index_entry(%record);
    }

}

use constant RECORD_INDEX_SIZE => ( 4 + 20 );

sub _write_record_index_entry {
    my $self         = shift;
    my %args         = validate( @_, { type => 1, uuid => 1, cas_key => 1, changeset_id => 0 } );
    my $idx_filename = $self->_record_index_filename(
        uuid => $args{uuid},
        type => $args{type}
    );

    my $index_path = file( $self->fs_root, $idx_filename );
    $index_path->parent->mkpath;

    open( my $record_index, ">>" . $index_path);

    # XXX TODO: skip if the index already has this version of the record;
    # XXX TODO FETCH THAT
    my $record_last_changed_changeset = $args{'changeset_id'} || 0;
    my $index_row = pack( 'NH40', $record_last_changed_changeset, $args{cas_key} );
    print $record_index $index_row || die $!;
    close $record_index;
}

sub _read_record_index_entry {
    my $self = shift;
    my %args = validate( @_, { type => 1, uuid => 1 } );

    # XXX TODO - we shouldn't compute all entries just to get the last
    my @entries = $self->_read_record_index(
        type => $args{type},
        uuid => $args{uuid}
    );
    return @{$entries[-1] || []};

}


sub _read_record_index {
    my $self = shift;
    my %args = validate( @_, { type => 1, uuid => 1 } );

    my $idx_filename = $self->_record_index_filename(
        uuid => $args{uuid},
        type => $args{type}
    );

    my $index = $self->_read_file($idx_filename);
    return undef unless $index;

    # XXX TODO THIS CODE IS HACKY AND SHOULD BE SHOT;
    my $count = length($index) / RECORD_INDEX_SIZE;
    my @entries;
    for my $offset ( 0 .. ( $count - 1 ) ) {
        my ( $seq, $key ) = unpack(
            'NH40',
            substr(
                $index, ( $offset ) * RECORD_INDEX_SIZE,
                RECORD_INDEX_SIZE
            )
        );
        push @entries, [ $seq => $key ];
    }
    return @entries;
}

sub _delete_record_index {
    my $self         = shift;
    my %args         = validate( @_, { type => 1, uuid => 1 } );
    my $idx_filename = $self->_record_index_filename(
        uuid => $args{uuid},
        type => $args{type}
    );
    file( $self->fs_root => $idx_filename )->remove
        || die "Could not delete record $idx_filename: " . $!;
}

sub _read_serialized_record {
    my $self = shift;
    my %args = validate( @_, { type => 1, uuid => 1 } );

    my $casfile = $self->_record_cas_filename(
        type => $args{'type'},
        uuid => $args{'uuid'}
    );

    return undef unless $casfile;
    return from_json( $self->_read_file($casfile), { utf8 => 1 } );
}

sub _record_index_filename {
    my $self = shift;
    my %args = validate( @_, { uuid => 1, type => 1 } );
    return file(
        $self->_record_type_root( $args{'type'} ),
        $self->_hashed_dir_name($args{uuid})
    );
}


sub _hashed_dir_name {
    my $self = shift;
    my $hash = shift;

    return (substr( $hash, 0, 1 ), substr( $hash, 1, 1 ), $hash);
}


sub _record_cas_filename {
    my $self         = shift;
    my %args         = validate( @_, { type => 1, uuid => 1 } );

    my ($seq,$key) = $self->_read_record_index_entry( type => $args{'type'}, uuid => $args{'uuid'});


    return undef unless ($key and ($key ne '0'x40));
    # XXX: deserialize the changeset content from the cas with $key
    my $casfile = file(
        $self->record_cas_dir,
        $self->_hashed_dir_name($key)
    );

    return $casfile;
}

sub _record_type_root {
    my $self = shift;
    my $type = shift;
    return dir( $self->record_dir, $type );
}

sub _write_changeset {
    my $self = shift;
    my %args = validate( @_,
        { index_handle => 1, changeset => { isa => 'Prophet::ChangeSet' } } );

    my $changeset = $args{'changeset'};
    my $fh        = $args{'index_handle'};

    my $hash_changeset = $changeset->as_hash;

# XXX TODO: we should not be calculating the changeset's sha1 with the 'replica_uuid' and 'sequence_no' inside it. that makes every replica have a different hash for what should be the samechangeset.

    # These ttwo things should never actually get stored
   my $seqno = delete $hash_changeset->{'sequence_no'};
    my $uuid  = delete $hash_changeset->{'replica_uuid'};

    my $cas_key = $self->_write_to_cas(
        data    => $hash_changeset,
        cas_dir => $self->changeset_cas_dir
    );

    my $packed_cas_key = pack( 'H40', $cas_key );

    my $changeset_index_line = pack( 'Na16Na20',
        $seqno,
        Data::UUID->new->from_string( $changeset->original_source_uuid ),
        $changeset->original_sequence_no,
        $packed_cas_key );
    print $fh $changeset_index_line || die $!;

}

=head2 traverse_changesets { after => SEQUENCE_NO, callback => sub { } } 

Walks through all changesets after $after, calling $callback on each.


=cut

# each record is : local-replica-seq-no : original-uuid : original-seq-no : cas key
#                  4                    16              4                 20

use constant CHG_RECORD_SIZE => ( 4 + 16 + 4 + 20 );


sub _get_changeset_index_entry {
    my $self = shift;
    my %args = validate(@_, { sequence_no => 1, index_file => 1});

    my $chgidx = $args{index_file};
    my $rev = $args{'sequence_no'};
        my $index_record = substr( $$chgidx, ( $rev - 1 ) * CHG_RECORD_SIZE,
            CHG_RECORD_SIZE );
        my ( $seq, $orig_uuid, $orig_seq, $key )
            = unpack( 'Na16NH40', $index_record );

        $orig_uuid = Data::UUID->new->to_string($orig_uuid);
        $self->log( "REV: $rev - seq $seq - originally $orig_seq from "
                . substr( $orig_uuid, 0, 6 )
                . " data key $key" );

        # XXX: deserialize the changeset content from the cas with $key
        my $casfile = file( $self->changeset_cas_dir,
            $self->_hashed_dir_name($key)
        );

        my $changeset = $self->_deserialize_changeset(
            content              => $self->_read_file($casfile),
            original_source_uuid => $orig_uuid,
            original_sequence_no => $orig_seq,
            sequence_no          => $seq
        );

        return $changeset;
}


sub traverse_changesets {
    my $self = shift;
    my %args = validate(
        @_,
        {   after    => 1,
            callback => 1,
        }
    );

    my $first_rev = ( $args{'after'} + 1 ) || 1;
    my $latest = $self->latest_sequence_no();

    my $chgidx = $self->_read_changeset_index;
    $self->log("Traversing changesets between $first_rev and $latest");
    for my $rev ( $first_rev .. $latest ) {
        my $changeset = $self->_get_changeset_index_entry(
            sequence_no    => $rev,
            index_file => $chgidx
        );

        $args{callback}->($changeset);
    }
}

sub _read_changeset_index {
    my $self =shift;
    my $chgidx    = $self->_read_file( $self->changeset_index );
    return \$chgidx;
}

=head2 changesets_for_record { uuid => $uuid, type => $type }

Returns an ordered set of changeset objects for all changesets containing
changes to this object. 

Note that changesets may include changes to other records

=cut

sub changesets_for_record {
    my $self = shift;
    my %args = validate( @_, { uuid => 1, type => 1 } );

    my @record_index = $self->_read_record_index( type => $args{'type'}, uuid => $args{'uuid'});

    my $changeset_index = $self->_read_changeset_index();

    my @changesets;
    foreach my $item (@record_index) {
        my $sequence = $item->[0];
        push @changesets, $self->_get_changeset_index_entry( sequence_no => $sequence, index_file => $changeset_index);
    }

    return @changesets;

}


sub _deserialize_changeset {
    my $self = shift;
    my %args = validate(
        @_,
        {   content              => 1,
            original_sequence_no => 1,
            original_source_uuid => 1,
            sequence_no          => 1
        }
    );

    require Prophet::ChangeSet;
    my $content_struct = from_json( $args{content} , { utf8 => 1 });
    my $changeset      = Prophet::ChangeSet->new_from_hashref($content_struct);

    $changeset->source_uuid( $self->uuid );
    $changeset->sequence_no( $args{'sequence_no'} );
    $changeset->original_source_uuid( $args{'original_source_uuid'} );
    $changeset->original_sequence_no( $args{'original_sequence_no'} );
    return $changeset;
}

sub _get_changeset_index_handle {
    my $self = shift;

    open( my $cs_file, ">>" . file( $self->fs_root, $self->changeset_index ) )
        || die $!;
    return $cs_file;
}

sub _write_to_cas {
    my $self = shift;
    my %args = validate( @_,
        { content_ref => 0, cas_dir => 1, data => 0  } );
    my $content;
    if ( $args{'content_ref'} ) {
        $content = ${ $args{'content_ref'} };
    } elsif ( $args{'data'} ) {
        $content = to_json($args{'data'}, { canonical => 1, pretty=> 0, utf8=>1}  );
    }
    my $fingerprint = sha1_hex($content);
    my $content_filename = file(
        $args{'cas_dir'},
            $self->_hashed_dir_name($fingerprint)
    );

    $self->_write_file( path => $content_filename, content => $content );
    return $fingerprint;
}

sub _write_file {
    my $self = shift;
    my %args = validate( @_, { path => 1, content => 1 } );

    my $file = file( $self->fs_root => $args{'path'} );
    my $parent = $file->parent;
    unless ( -d $parent ) {
        $parent->mkpath || die "Failed to create directory " . $file->parent;
    }

    my $fh = $file->openw;
    print $fh scalar( $args{'content'} )
        ; # can't do "||" as we die if we print 0" || die "Could not write to " . $args{'path'} . " " . $!;
    close $fh || die $!;
}

=head2 _file_exists PATH

Returns true if PATH is a file or directory in this replica's directory structure

=cut

sub _file_exists {
    my $self = shift;
    my ($file) = validate_pos( @_, 1 );

    if (! $self->fs_root ) {
        # HTTP Replica
        return $self->_read_file($file) ? 1 : 0;
    }

    my $path = file( $self->fs_root, $file );
   if    ( -f $path ) { return 1 }
   elsif ( -d $path ) { return 2 }
   else               { return 0 }
}

sub read_file {
    my $self = shift;
    my ($file) = validate_pos( @_, 1 );
    if ($self->fs_root) {
        my $qualified_file = file( $self->fs_root => $file );
        return undef if ( not dir($self->fs_root)->subsumes($qualified_file));
    }
    return $self->_read_file($file);
}

sub _read_file {
    my $self = shift;
    my ($file) = validate_pos( @_, 1 );
    if ( $self->fs_root ) {
        return eval {
            local $SIG{__DIE__} = 'DEFAULT';
            $self->_slurp (file( $self->fs_root => $file ))
        };
    } else {    # http replica
        return LWP::Simple::get( $self->url . "/" . $file );
    }


}

sub _slurp {
    my $self = shift;
    my $abspath = shift;
    open (my $fh, "<", "$abspath") || die $!;
    my @lines = <$fh>;
    close $fh;
    return join('',@lines);

}

sub begin_edit {
    my $self = shift;
    my %args = validate(@_, {
        source => 0, # the changeset that we're replaying, if applicable
    });

    my $source = $args{source};

    my $creator = $source ? $source->creator : $self->changeset_creator;
    my $created = $source && $source->created;

    require Prophet::ChangeSet;
    my $changeset = Prophet::ChangeSet->new({
        source_uuid => $self->uuid,
        creator     => $creator,
        $created ? (created => $created) : (),
    });
    $self->current_edit($changeset);
    $self->current_edit_records([]);

}

sub _set_original_source_metadata_for_current_edit {
    my $self = shift;
    my ($changeset) = validate_pos( @_, { isa => 'Prophet::ChangeSet' } );

    $self->current_edit->original_source_uuid(
        $changeset->original_source_uuid );
    $self->current_edit->original_sequence_no(
        $changeset->original_sequence_no );
}

sub commit_edit {
    my $self     = shift;
    my $sequence = $self->_increment_sequence_no;
    $self->current_edit->original_sequence_no($sequence)
        unless ( $self->current_edit->original_sequence_no );
    $self->current_edit->original_source_uuid( $self->uuid )
        unless ( $self->current_edit->original_source_uuid );
    $self->current_edit->sequence_no($sequence);
    for my $record (@{$self->current_edit_records}) {
         $self->_write_record_index_entry(changeset_id => $sequence, %$record);
    }
    $self->_write_changeset_to_index( $self->current_edit );
}

sub _write_changeset_to_index {
    my $self      = shift;
    my $changeset = shift;
    my $handle    = $self->_get_changeset_index_handle;
    $self->_write_changeset( index_handle => $handle, changeset => $changeset );
    close($handle) || die "Failed to close changeset handle: " . $handle;
    $self->current_edit(undef);
}

sub _after_record_changes {
    my $self = shift;
    my ($changeset) = validate_pos( @_, { isa => 'Prophet::ChangeSet' } );

    $self->current_edit->is_nullification( $changeset->is_nullification );
    $self->current_edit->is_resolution( $changeset->is_resolution );
}

sub create_record {
    my $self = shift;
    my %args = validate( @_, { uuid => 1, props => 1, type => 1 } );

    my $inside_edit = $self->current_edit ? 1 : 0;
    $self->begin_edit() unless ($inside_edit);

    $self->_write_serialized_record(
        type  => $args{'type'},
        uuid  => $args{'uuid'},
        props => $args{'props'}
    );

    my $change = Prophet::Change->new(
        {   record_type => $args{'type'},
            record_uuid => $args{'uuid'},
            change_type => 'add_file'
        }
    );

    foreach my $name ( keys %{ $args{props} } ) {
        $change->add_prop_change(
            name => $name,
            old  => undef,
            new  => $args{props}->{$name}
        );
    }

    $self->current_edit->add_change( change => $change );

    $self->commit_edit unless ($inside_edit);
}

sub delete_record {
    my $self = shift;
    my %args = validate( @_, { uuid => 1, type => 1 } );

    my $inside_edit = $self->current_edit ? 1 : 0;
    $self->begin_edit() unless ($inside_edit);


    my $change = Prophet::Change->new(
        {   record_type => $args{'type'},
            record_uuid => $args{'uuid'},
            change_type => 'delete'
        }
    );
    $self->current_edit->add_change( change => $change );
    
    $self->_prepare_record_index_update( uuid    => $args{uuid}, type    => $args{type}, cas_key => '0'x40);

    $self->commit_edit() unless ($inside_edit);
    return 1;
}

sub set_record_props {
    my $self = shift;
    my %args = validate( @_, { uuid => 1, props => 1, type => 1 } );

    my $inside_edit = $self->current_edit ? 1 : 0;
    $self->begin_edit() unless ($inside_edit);

    my $old_props = $self->get_record_props(
        uuid => $args{'uuid'},
        type => $args{'type'}
    );
    my %new_props = %$old_props;
    foreach my $prop ( keys %{ $args{props} } ) {
        if ( !defined $args{props}->{$prop} ) {
            delete $new_props{$prop};
        } else {
            $new_props{$prop} = $args{props}->{$prop};
        }
    }
    $self->_write_serialized_record(
        type  => $args{'type'},
        uuid  => $args{'uuid'},
        props => \%new_props
    );

    my $change = Prophet::Change->new(
        {   record_type => $args{'type'},
            record_uuid => $args{'uuid'},
            change_type => 'update_file'
        }
    );

    foreach my $name ( keys %{ $args{props} } ) {
        $change->add_prop_change(
            name => $name,
            old  => $old_props->{$name},
            new  => $args{props}->{$name}
        );
    }
    $self->current_edit->add_change( change => $change );

    $self->commit_edit() unless ($inside_edit);
    return 1;
}

sub get_record_props {
    my $self = shift;
    my %args = validate( @_, { uuid => 1, type => 1 } );
    return $self->_read_serialized_record(
        uuid => $args{'uuid'},
        type => $args{'type'}
    );
}

sub record_exists {
    my $self = shift;
    my %args = validate( @_, { uuid => 1, type => 1 } );
    return undef unless $args{'uuid'};
    return $self->_record_cas_filename(
            type => $args{'type'},
            uuid => $args{'uuid'}
    ) ? 1 : 0;

}

sub list_records {
    my $self = shift;
    my %args = validate( @_ => { type => 1 } );

    #return just the filenames, which, File::Find::Rule doesn't seem capable of
        my @record_uuids = map { my @path = split( qr'/', $_ ); pop @path }
            File::Find::Rule->file->maxdepth(3)->in(
            dir( $self->fs_root, $self->_record_type_root( $args{'type'} ) )
            );

    

    return [grep {$self->_record_cas_filename(type => $args{'type'}, uuid => $_ ) }@record_uuids
    ];
}

sub list_types {
    my $self = shift;

    return [ map { my @path = split( qr'/', $_ ); pop @path }
            File::Find::Rule->mindepth(1)->maxdepth(1)
            ->in( dir( $self->fs_root, $self->record_dir ) ) ];

}

sub type_exists {
    my $self = shift;
    my %args = validate( @_, { type => 1 } );
    return $self->_file_exists( $self->_record_type_root( $args{'type'} ) );
}

=head2 read_userdata_file

Returns the contents of the given file in this replica's userdata directory.
Returns C<undef> if the file does not exist.

=cut

sub read_userdata_file {
    my $self = shift;
    my %args = validate( @_, { path => 1 } );

    $self->_read_file(file($self->userdata_dir, $args{path}));
}

=head2 write_userdata_file

Writes the given string to the given file in this replica's userdata directory.

=cut

sub write_userdata_file {
    my $self = shift;
    my %args = validate( @_, { path => 1, content => 1 } );

    $self->_write_file(
        path    => file($self->userdata_dir, $args{path}),
        content => $args{content},
    );
}

__PACKAGE__->meta->make_immutable;
no Moose;

1;




lib/Prophet/Replica/svn.pm
==========================
package Prophet::Replica::svn;
use Moose;
extends 'Prophet::Replica';
use Params::Validate qw(:all);

# require rather than use to make them late-binding
use Prophet::ChangeSet;

has ra => (
    is      => 'rw',
    isa     => 'SVN::Ra',
    lazy    => 1,
    default => sub {
        my $self = shift;
        require Prophet::Replica::svn::Util;
        my ( $baton, $ref ) = SVN::Core::auth_open_helper( Prophet::Replica::svn::Util->get_auth_providers );
        my $config = Prophet::Replica::svn::Util->svnconfig;
        return SVN::Ra->new(url => $self->url, config => $config, auth => $baton, pool => $self->_pool);
    },
);

has fs_root => (
    is => 'rw',
);

has repo_handle => (
    is => 'rw',
);

has current_edit => (
    is => 'rw',
);

has _pool => (
    is => 'rw',
);

use constant scheme => 'svn';


=head2 setup

Open a connection to the SVN source identified by C<$self->url>.

=cut

sub setup {
    my $self = shift;
   require SVN::Core; require SVN::Ra; require SVN::Delta; require SVN::Repos; require SVN::Fs;
    $self->_pool(SVN::Pool->new);
    if ( $self->url =~ /^file:\/\/(.*)$/ ) {
        $self->_setup_repo_connection( repository => $1 );
        #$self->state_handle( $self->prophet_handle ); XXX DO THIS RIGHT
    }

    if ( $self->is_resdb ) {

        # XXX: should probably just point to self
        return;
    }

    my $res_url = "svn:" . $self->url;
    $res_url =~ s/(\_res|)$/_res/;
    $self->resolution_db_handle( __PACKAGE__->new( { url => $res_url, is_resdb => 1 } ) );
}

sub state_handle { return shift }  #XXX TODO better way to handle this?


sub _setup_repo_connection {
    my $self = shift;
    my %args = validate( @_, { repository => 1, db_uuid => 0 } );
    $self->fs_root( $args{'repository'} );
    $self->set_db_uuid( $args{'db_uuid'} ) if ( $args{'db_uuid'} );
    
    my $repos = eval {
        local $SIG{__DIE__} = 'DEFAULT';
        SVN::Repos::open( $self->fs_root );
    };
    # If we couldn't open the repository handle, we should create it
    if ( $@ && !-d $self->fs_root ) {
        $repos = SVN::Repos::create( $self->fs_root, undef, undef, undef, undef, $self->_pool );
    }
    $self->repo_handle($repos);
    $self->_determine_db_uuid;
    $self->_create_nonexistent_dir( $self->db_uuid );
}


=head2 uuid

Return the replica SVN repository's UUID

=cut

sub uuid {
    my $self = shift;
    return $self->repo_handle->fs->get_uuid;
}

sub latest_sequence_no {
    my $self = shift;
    Carp::cluck unless ($self->ra);
    $self->ra->get_latest_revnum;
}


sub traverse_changesets {
    my $self = shift;
    my %args = validate( @_,
        {   after    => 1,
            callback => 1,
        }
    );

    my $first_rev = ( $args{'after'} + 1 ) || 1;
    my $last_rev = $self->latest_sequence_no();


    die "You must implement latest_sequence_no in " . blessed($self) . ", or override traverse_changesets"
        unless defined $last_rev;

    for my $rev ( $first_rev .. $self->latest_sequence_no ) {
            my $changeset = $self->_fetch_changeset($rev);
        $args{callback}->( $changeset);
    }
}


sub _fetch_changeset {
    my $self   = shift;
    my $rev    = shift;

    require Prophet::Replica::svn::ReplayEditor;
    my $editor = Prophet::Replica::svn::ReplayEditor->new( _debug => 0 );
    my $pool = SVN::Pool->new_default;

    # This horrible hack is here because I have no idea how to pass custom variables into the editor
    $editor->{revision} = $rev;

    $self->ra->replay( $rev, 0, 1, $editor );
    return $self->_recode_changeset( $editor->dump_deltas, $self->ra->rev_proplist($rev) );

}

sub _recode_changeset {
    my $self      = shift;
    my $entry     = shift;
    my $revprops  = shift;
    my $changeset = Prophet::ChangeSet->new({
        creator              => $self->changeset_creator,
        sequence_no          => $entry->{'revision'},
        source_uuid          => $self->uuid,
        original_source_uuid => $revprops->{'prophet:original-source'} || $self->uuid,
        original_sequence_no => $revprops->{'prophet:original-sequence-no'} || $entry->{'revision'},
        is_nullification     => ( ( $revprops->{'prophet:special-type'} || '' ) eq 'nullification' ) ? 1 : undef,
        is_resolution        => ( ( $revprops->{'prophet:special-type'} || '' ) eq 'resolution' ) ? 1 : undef,
    });

    # add each record's changes to the changeset
    for my $path ( keys %{ $entry->{'paths'} } ) {
        if ( $path =~ qr|^(.+)/(.*?)/(.*?)$| ) {
            my ( $prefix, $type, $record ) = ( $1, $2, $3 );
            my $change = Prophet::Change->new(
                {   record_type   => $type,
                    record_uuid   => $record,
                    change_type => $entry->{'paths'}->{$path}->{fs_operation}
                }
            );
            for my $name ( keys %{ $entry->{'paths'}->{$path}->{prop_deltas} } ) {
                $change->add_prop_change(
                    name => $name,
                    old  => $entry->{paths}->{$path}->{prop_deltas}->{$name}->{'old'},
                    new  => $entry->{paths}->{$path}->{prop_deltas}->{$name}->{'new'},
                );
            }

            $changeset->add_change( change => $change );

        } else {
            warn "Discarding change to a non-record: $path" if 0;
        }

    }
    return $changeset;
}





=head1 CODE BELOW THIS LINE 

=cut

our $DEBUG = '0';
use Params::Validate qw(:all);



use constant can_read_records => 1;
use constant can_write_records => 1;
use constant can_read_changesets => 1;
use constant can_write_changesets => 1;


=head2 _current_root

Returns a handle to the svn filesystem's HEAD

=cut

sub _current_root {
    my $self = shift;
    $self->repo_handle->fs->revision_root( $self->repo_handle->fs->youngest_rev );
}

use constant USER_PROVIDED_DB_UUID => 1;
use constant DETECTED_DB_UUID      => 2;
use constant CREATED_DB_UUID       => 3;

sub _determine_db_uuid {
    my $self = shift;
    return USER_PROVIDED_DB_UUID if $self->db_uuid;
    my @known_replicas = keys %{ $self->_current_root->dir_entries("/") };

    for my $key ( keys %{ $self->_current_root->dir_entries("/") } ) {
        if ( $key =~ /^_prophet-/ ) {
            $self->set_db_uuid($key);
            return DETECTED_DB_UUID;
        }
    }

    # no luck. create one

    $self->set_db_uuid( "_prophet-" . Data::UUID->new->create_str() );
    return CREATED_DB_UUID;
}

sub _after_record_changes {
    my $self = shift;
    my ($changeset) = validate_pos( @_, { isa => 'Prophet::ChangeSet' } );

    $self->current_edit->change_prop( 'prophet:special-type' => 'nullification' ) if ( $changeset->is_nullification );
    $self->current_edit->change_prop( 'prophet:special-type' => 'resolution' )    if ( $changeset->is_resolution );
}


sub _set_original_source_metadata_for_current_edit {
    my $self = shift;
    my ($changeset) = validate_pos( @_, { isa => 'Prophet::ChangeSet' } );

    $self->current_edit->change_prop( 'prophet:original-source'      => $changeset->original_source_uuid );
    $self->current_edit->change_prop( 'prophet:original-sequence-no' => $changeset->original_sequence_no );
}

sub _create_nonexistent_dir {
    my $self = shift;
    my $dir  = shift;
    my $pool = SVN::Pool->new_default;
    my $root = $self->current_edit ? $self->current_edit->root : $self->_current_root;

    unless ( $root->is_dir($dir) ) {
        my $inside_edit = $self->current_edit ? 1 : 0;
        $self->begin_edit() unless ($inside_edit);
        $self->current_edit->root->make_dir($dir);
        $self->commit_edit() unless ($inside_edit);
    }
}




=head2 begin_edit

Starts a new transaction within the replica's backend database. Sets L</current_edit> to that edit object.

Returns $self->current_edit.

=cut

sub begin_edit {
    my $self = shift;
    my $fs   = $self->repo_handle->fs;
    $self->current_edit( $fs->begin_txn( $fs->youngest_rev ) );
    return $self->current_edit;
}

=head2 commit_edit

Finalizes L</current_edit> and sets the 'svn:author' change-prop to the current user.

=cut

sub commit_edit {
    my $self = shift;
    my $txn  = shift;
    $self->current_edit->change_prop( 'svn:author', ( $ENV{'PROPHET_USER'} || $ENV{'USER'} ) );
    $self->current_edit->commit;
    $self->current_edit(undef);

}

=head2 create_record { type => $TYPE, uuid => $uuid, props => { key-value pairs }}

Create a new record of type C<$type> with uuid C<$uuid>  within the current replica.

Sets the record's properties to the key-value hash passed in as the C<props> argument.

If called from within an edit, it uses the current edit. Otherwise it manufactures and finalizes one of its own.

=cut

sub create_record {
    my $self = shift;
    my %args = validate( @_, { uuid => 1, props => 1, type => 1 } );

    $self->_create_nonexistent_dir( join( '/', $self->db_uuid, $args{'type'} ) );

    my $inside_edit = $self->current_edit ? 1 : 0;
    $self->begin_edit() unless ($inside_edit);

    my $file = $self->_file_for( uuid => $args{uuid}, type => $args{'type'} );
    $self->current_edit->root->make_file($file);
    {
        my $stream = $self->current_edit->root->apply_text( $file, undef );

        # print $stream Dumper( $args{'props'} );
        close $stream;
    }
    $self->_set_record_props(
        uuid  => $args{uuid},
        props => $args{props},
        type  => $args{'type'}
    );
    $self->commit_edit() unless ($inside_edit);
    return 1;
}

sub _set_record_props {
    my $self = shift;
    my %args = validate( @_, { uuid => 1, props => 1, type => 1 } );

    my $file = $self->_file_for( uuid => $args{uuid}, type => $args{type} );
    foreach my $prop ( keys %{ $args{'props'} } ) {
        eval {
            local $SIG{__DIE__} = 'DEFAULT';
            $self->current_edit->root->change_node_prop( $file, $prop, $args{'props'}->{$prop}, undef )
        };
        Carp::confess($@) if ($@);
    }
}

=head2 delete_record {uuid => $uuid, type => $type }

Deletes the record C<$uuid> of type C<$type> from the current replica. 

Manufactures its own new edit if C<$self->current_edit> is undefined.

=cut

sub delete_record {
    my $self = shift;
    my %args = validate( @_, { uuid => 1, type => 1 } );

    my $inside_edit = $self->current_edit ? 1 : 0;
    $self->begin_edit() unless ($inside_edit);

    $self->current_edit->root->delete( $self->_file_for( uuid => $args{uuid}, type => $args{type} ) );
    $self->commit_edit() unless ($inside_edit);
    return 1;
}

=head2 set_record_props { uuid => $uuid, type => $type, props => {hash of kv pairs }}


Updates the record of type C<$type> with uuid C<$uuid> to set each property defined by the props hash. It does NOT alter any property not defined by the props hash.

Manufactures its own current edit if none exists.

=cut

sub set_record_props {
    my $self = shift;
    my %args = validate( @_, { uuid => 1, props => 1, type => 1 } );

    my $inside_edit = $self->current_edit ? 1 : 0;
    $self->begin_edit() unless ($inside_edit);

    my $file = $self->_file_for( uuid => $args{uuid}, type => $args{'type'} );
    $self->_set_record_props(
        uuid  => $args{uuid},
        props => $args{props},
        type  => $args{'type'}
    );
    $self->commit_edit() unless ($inside_edit);

}

=head2 get_record_props {uuid => $uuid, type => $type }

Returns a hashref of all properties for the record of type $type with uuid C<$uuid>.

=cut

sub get_record_props {
    my $self = shift;
    my %args = validate( @_, { uuid => 1, type => 1 } );
    return $self->_current_root->node_proplist( $self->_file_for( uuid => $args{'uuid'}, type => $args{'type'} ) );
}

=head2 _file_for { uuid => $UUID, type => $type }

Returns a file path within the repository (starting from the root)

=cut

sub _file_for {
    my $self = shift;
    my %args = validate( @_, { uuid => 1, type => 1 } );
    Carp::cluck unless $args{uuid};
    my $file = join( "/", $self->_directory_for_type( type => $args{'type'} ), $args{'uuid'} );
    return $file;

}

sub _directory_for_type {
    my $self = shift;
    my %args = validate( @_, { type => 1 } );
    Carp::cluck unless defined $args{type};
    return join( "/", $self->db_uuid, $args{'type'} );

}

=head2 record_exists {uuid => $uuid, type => $type, root => $root }

Returns true if the record in question exists. False otherwise

=cut

sub record_exists {
    my $self = shift;
    my %args = validate( @_, { uuid => 1, type => 1, root => undef } );

    my $root = $args{'root'} || $self->_current_root;
    return $root->check_path( $self->_file_for( uuid => $args{'uuid'}, type => $args{'type'} ) );

}

=head2 list_records { type => $type }

Returns a reference to a list of all the records of type $type

=cut

sub list_records {
    my $self = shift;
    my %args = validate( @_ => { type => 1 } );
    return [ keys %{ $self->_current_root->dir_entries( $self->db_uuid . '/' . $args{type} . '/' ) } ];
}

=head2 list_types

Returns a reference to a list of all the known types in your Prophet database

=cut

sub list_types {
    my $self = shift;
    return [ keys %{ $self->_current_root->dir_entries( $self->db_uuid . '/' ) } ];
}


=head2 type_exists { type => $type }

Returns true if we have any records of type C<$type>

=cut


sub type_exists {
    my $self = shift;
    my %args = validate( @_, { type => 1, root => undef } );

    my $root = $args{'root'} || $self->_current_root;
    return $root->check_path( $self->_directory_for_type( type => $args{'type'}, ) );

}

__PACKAGE__->meta->make_immutable;
no Moose;

1;

