view release on metacpan or  search on metacpan

lib/DB/CouchDB/Schema.pm  view on Meta::CPAN

        $self->server($db);
        $self->load_schema_from_db();
    }
}

=head2 load_schema_from_script($script)

loads a CouchDB Schema from a json script file. This is sort of like the DDL
in a SQL DB only its essentially just a list of _design/* documents for the CouchDB

=cut

sub load_schema_from_script {
    my $self = shift;
    my $script = shift;
    $self->schema($self->server->json->decode($script));
    return $self;
}

=head2 load_schema_from_db()

Loads a CouchDB Schema from the Database on the server. this can later be dumped
to a file and pushed to a database using load_schema_from_script.

This method gets called for you during object construction so that you will have
a current look at the CouchDB Schema stored in your object.

=cut

sub load_schema_from_db {
    my $self = shift;
    my $db = $self->server;
    #load our schema
    my $doc_list = $self->get_views();
    my @schema;
    while (my $docname = $doc_list->next_key() ) {
        my $doc = $db->get_doc($docname);
        $self->_mk_view_accessor($doc);
        push @schema, $doc;
    }
    $self->schema(\@schema);
    return $self;
}

=head2 get_views()

Returns a List of all the views in the database;

=cut

sub get_views {
    my $self = shift;
    my $db = $self->server;
    #load our schema
    return $db->all_docs({startkey => '"_design/"',
                                  endkey   => '"_design/ZZZZZ"'});
}

=head2 dump_db

dumps the entire db to a file for backup

=cut

#TODO(jwall) tool to dump the whole db to a backup file
sub dump_whole_db {
    my $self = shift;
    my $pretty = shift;
    my $db = $self->server;
    #load our schema
    my $doc_list = $db->all_docs();
    my @docs;
    while (my $docname = $doc_list->next_key() ) {
        my $doc = $db->get_doc($docname);
        push @docs, $doc;
    }
    $db->json->pretty([$pretty]);
    my $script = $db->json->encode(\@docs);
    $db->json->pretty([undef]);
    return $script;
}

sub _mk_view_accessor {
    my $self = shift;
    my $doc = shift;
    my $id = $doc->{_id};
    return unless $id =~  /^_design/;
    my ($design) = $id =~ /^_design\/(.+)/;
    my $views = $doc->{views};
    for my $view (keys %$views) {
        my $method = $design."_".$view;
        $self->views()->{$method} = sub {
                my $args = shift;
                return $self->server->view($design."/$view", $args);
            };

        #use Moose and Class::Mop to dynamically add our method
        __PACKAGE__->meta->add_method($method, sub {
                my $self = shift;
                my $args = shift;
                if ( $self->{views}{$method} ) {
                    return $self->{views}{$method}->($args);
                }
                croak "The view $id does not exist in this database";
            }
        );
    }
}

=head2 schema

Returns the database schema as an arrayref of _design/ docs serialized to perl
objects. You can update you schema by modifying this object if you know what
you are doing. Then push the modifications to your database.

=cut

sub _schema_no_revs {
    my $self = shift;
    my @schema;
    for my $doc (@{ $self->schema() }) {
        my %newdoc = %$doc;
        delete $newdoc{_rev};
        push @schema, \%newdoc;
    }