package OpenERP::OOM::Object::Base;

use 5.010;
use Carp;
use Data::Dumper;
use List::MoreUtils qw/uniq/;
use Moose;
use Try::Tiny;
use Try::Tiny::Retry;
use Time::HiRes qw/usleep/;

extends 'Moose::Object';
with 'OpenERP::OOM::DynamicUtils';


has 'id' => (
    isa => 'Int',
    is  => 'ro',
);

sub BUILD {
    my $self = shift;
    
    # Add methods to follow links
    my $links = $self->meta->link;
    while (my ($name, $link) = each %$links) {
        given ($link->{type}) {
            when ('single') {
                $self->meta->add_method(
                    $name,
                    sub {
                        my $obj = shift;
                        $obj->{"_$name"} //= $obj->class->schema->link($link->{class})->retrieve($link->{args}, $obj->{$link->{key}});
                        
                        unless ($obj->{"_$name"}) {
                            # FIXME: If $obj->{"_$name"} is undefined, we have a data integrity problem.
                            # Either the linked data is missing, or the key in the OpenERP object is missing.
                            die "Error linking to OpenERP object " . $obj->id . " of class " . ref($obj);
                        }
                        
                        # NOTE: this only links up the object from the linked object
                        # if it has a _source attribute
                        #
                        # has _source => (is => 'rw');
                        
                        if ($obj->{"_$name"}->can('_source')) {
                            # set the _source attribute to point back
                            # to the linked object.
                            $obj->{"_$name"}->_source($obj);
                        }
                        
                        return $obj->{"_$name"};
                    }
                )
            }
            when ('multiple') {
                $self->meta->add_method(
                    $name,
                    sub {
                        return $self->class->schema->link($link->{class})->retrieve_list($link->{args}, $self->{$link->{key}});
                    }
                )
            }
        }
    }
}


#-------------------------------------------------------------------------------


sub update {
    my $self = shift;
    
    if (my $update = shift) {
        while (my ($param, $value) = each %$update) {
            $self->$param($value);
        }
    }
    
    my $object;
    foreach my $attribute ($self->dirty_attributes) {
        next if ($attribute eq 'id');
        next if ($attribute =~ '^_');

        $object->{$attribute} = $self->{$attribute};
    }

    my $relationships = $self->meta->relationship;
    while (my ($name, $rel) = each %$relationships) {
        if ($object->{$rel->{key}}) {
            given ($rel->{type}) {
                when ('one2many') {
                    delete $object->{$rel->{key}};  # Don't update one2many relationships
                }
                when ('many2many') {
                    $object->{$rel->{key}} = [[6,0,$object->{$rel->{key}}]];
                }
            }
        }
    }

    # Force Str parameters to be object type RPC::XML::string
    foreach my $attribute ($self->meta->get_all_attributes) {
        if (exists $object->{$attribute->name}) {
            $object->{$attribute->name} = $self->prepare_attribute_for_send($attribute->type_constraint, $object->{$attribute->name});
        }
    }

    $self->class->_with_retries(sub {
        $self->class->schema->client->update($self->model, $self->id, $object);
    });
    $self->refresh;
    
    return $self;
}

#-------------------------------------------------------------------------------


sub update_single {
    my ($self, $property) = @_;
    my $value = $self->{$property};
    
    # Check to see if the property is the key to a many2many relationship
    my $relationships = $self->meta->relationship;
    my ($key) = grep { $relationships->{$_}->{key} eq $property } keys %$relationships;
    if($key)
    {
        my $rel = $relationships->{$key};
        if ($rel->{type} eq 'many2many') {
            $value = [[6,0,$value]];
        }
    }

    # Force Str parameters to be object type RPC::XML::string
    foreach my $attribute ($self->meta->get_all_attributes) {
        if ($attribute->name eq $property) {
            $value = $self->prepare_attribute_for_send($attribute->type_constraint, $value);
        }
    }
    
    $self->class->schema->client->update($self->model, $self->id, {$property => $value});
    return $self;
}

#-------------------------------------------------------------------------------


sub refresh {
    my $self = shift;
    
    my $new = $self->class->retrieve($self->id);
    
    foreach my $attribute ($self->meta->get_all_attributes) {
        my $name = $attribute->name;
        $self->{$name} = ($new->$name);
    }
    $self->mark_all_clean; # reset the dirty attribute
    
    return $self;
}


#-------------------------------------------------------------------------------


sub delete {
    my $self = shift;
    
    $self->class->schema->client->delete($self->model, $self->id);
}

sub _copy
{
    my $self = shift;

    my $id = $self->class->schema->client->copy($self->model, $self->id);
    # now load the new invoice and return it
    return $id;
}


sub copy
{
    my ($self, @args) = @_;
    my $args = shift;
    my $id = $self->_copy;
    # passing args through allows for field refinement.
    my $clone = $self->class->retrieve($id, @args);
    return $clone;
}

#-------------------------------------------------------------------------------


sub print {
    my $self = shift;
    
    say "Print called";
}


#-------------------------------------------------------------------------------


sub real_create_related
{
    my $self = shift;
    my $relation_name = shift;
    my $object = shift;

    # find relationship class
    my $class = $self->relationship_class($relation_name);
    my $data = $class->_collapse_data_to_ids($object);

    $self->class->schema->client->update($self->model, $self->id, {$relation_name => [[ 0, 0, $data ]]});

    # FIXME: need to check what happens to existing data
    # how do you add multiple objects ?
    return;
}


sub create_related {
    my ($self, $relation_name, $object) = @_;
    
    ### Creating related object 
    ### $relation_name
    ### with initial data:
    ### $object
    my $created_obj;
    
    if (my $relation = $self->meta->relationship->{$relation_name}) {
        given ($relation->{type}) {
            when ('one2many') {
                my $class = $self->meta->name;
                if ($class =~ m/(.*?)::(\w+)$/) {
                    my ($base, $name) = ($1, $2);
                    my $related_class = $base . "::" . $relation->{class};
                    
                    $self->ensure_class_loaded($related_class);
                    my $related_meta = $related_class->meta->relationship;
                    
                    my $far_end_relation;
                    REL: for my $key (keys %$related_meta) {
                        my $value = $related_meta->{$key};
                        if ($value->{class} eq $name) {
                            $far_end_relation = $key;
                            last REL;
                        }
                    }
                    
                    if ($far_end_relation) {
                        my $foreign_key = $related_meta->{$far_end_relation}->{key};
                        
                        ### Far end relation exists
                        $created_obj = $self->class->schema->class($relation->{class})->create({
                            %$object,
                            $foreign_key => $self->id,
                        });
                        
                        $self->refresh;
                    } else {
                        my $new_object = $self->class->schema->class($relation->{class})->create($object);
                        
                        $created_obj = $new_object;
                        $self->refresh;
                        
                        unless (grep {$new_object->id} @{$self->{$relation->{key}}}) {
                            push @{$self->{$relation->{key}}}, $new_object->id;
                            $self->update;
                        }
                    }
                }
            }
            when ('many2many') {
                say "create_related many2many";
            }
            when ('many2one') {
                say "create_related many2one";
            }
        }
    } elsif ($relation = $self->meta->link->{$relation_name}) {
        given ($relation->{type}) {
            when ('single') {
                ### Creating linked object
                try {
                    my $id = $self->class->schema->link($relation->{class})->create($relation->{args}, $object);
                    $created_obj = $id;
                    ### Linked object created with key $id
                    $self->{$relation->{key}} = $id;
                    $self->update_single($relation->{key});
                    undef $self->{"_$relation_name"};
                } catch {
                    die "Error creating linked object: $_[0]";
                };
            }
            when ('multiple') {
                say "create_linked multiple";
            }
        }
    }
    else {
        croak "Can not find relation $relation_name";
    }
    return $created_obj if $created_obj;
}

sub _id
{
    my $val = shift;
    return ref $val ? $val->id : $val;
}


sub find_related {
    my ($self) = shift;
    my @results = $self->search_related(@_);
    if(scalar @results > 1)
    {
        # should this just croak?
        carp 'find_related returned more than 1 result';
    }
    if(@results)
    {
        return $results[0];
    }
}


sub relationship_class
{
    my ($self, $relationship) = @_;
    if (my $relation = $self->meta->relationship->{$relationship}) {
        my $type = $relation->{type};
        croak 'Cannot get a class for a DBIC relationship' if $type eq 'single' 
                                                            || $type eq 'multiple';
        my $class = $relation->{class};
        return $self->class->schema->class($class);
    }
    croak "Unable to find relation $relationship";
}


sub search_related {
    my ($self, $relation_name, @search) = @_;

    # find the relation details and add it to the search criteria.
    if (my $relation = $self->meta->relationship->{$relation_name}) {
        given ($relation->{type}) {
            when ('one2many') {
                my $class = $self->meta->name;
                if ($class =~ m/(.*?)::(\w+)$/) {
                    my ($base, $name) = ($1, $2);
                    my $related_class = $self->class->schema->class($relation->{class});
                    my $related_meta = $related_class->object->meta->relationship;
                    
                    my $far_end_relation;
                    REL: for my $key (keys %$related_meta) {
                        my $value = $related_meta->{$key};
                        if ($value->{class} eq $name) {
                            $far_end_relation = $key;
                            last REL;
                        }
                    }
                    
                    if ($far_end_relation) {

                        my $foreign_key = $related_meta->{$far_end_relation}->{key};
                        
                        push @search, [ $foreign_key, '=', $self->id ];
                        return $related_class->search(@search);
                        
                    } else {
                        # well, perhaps we could fix this, but I can't be bothered at the moment.
                        croak 'Unable to search_related without relationship back';
                    }
                }
            }
            when ('many2many') {
                croak 'Unable to search_related many2many relationships';
            }
            when ('many2one') {
                croak 'Unable to search_related many2one relationships';
            }
        }
    } elsif ($relation = $self->meta->link->{$relation_name}) {
        croak 'Unable to search_related outside NonOpenERP';
    }

    croak 'Unable to search_related'; # beat up the lame programmer who did this.
}


#-------------------------------------------------------------------------------


sub add_related {
    my ($self, $relation_name, $object) = @_;

    if (my $relation = $self->meta->relationship->{$relation_name}) {
        given ($relation->{type}) {
            when ('one2many') {
                # FIXME - is this the same process as adding a many2many relationship?
            }
            when ('many2many') {
                push @{$self->{$relation->{key}}}, _id($object);
                $self->{$relation->{key}} = [uniq @{$self->{$relation->{key}}}];
                $self->update_single($relation->{key});
            }
        }
    } elsif ($relation = $self->meta->link->{$relation_name}) {
        given ($relation->{type}) {
            when ('multiple') {
                # FIXME - handle linked as well as related objects
            }
        }
    }
}


#-------------------------------------------------------------------------------


sub set_related {
    my ($self, $relation_name, $object) = @_;
    
    if (my $relation = $self->meta->relationship->{$relation_name}) {
        given ($relation->{type}) {
            when ('many2one') {
                $self->{$relation->{key}} = $object ? _id($object) : undef;
                $self->update_single($relation->{key});
            }
            when ('many2many') {
                my @array;
                if($object)
                {
                    if(ref $object eq 'ARRAY')
                    {
                        @array = map { _id($_) } @$object;
                    }
                    else 
                    {
                        push @array, _id($object);
                    }
                }
                $self->{$relation->{key}} = \@array;
                $self->update_single($relation->{key});
            }
            default {
                carp "Cannot use set_related() on a $_ relationship";
            }
        }
    } else {
        carp "Relation '$relation_name' does not exist!";
    }
}


sub execute_workflow
{
    my ($self, $workflow) = @_;

    retry
    {
        $self->class->schema->client->object_exec_workflow($workflow, $self->model, $self->id);
    }
    retry_if {/current transaction is aborted, commands ignored until end of transaction block/}
    catch
    {
        die $_; # rethrow the unhandled exception
    };
}


sub execute
{
    my $self   = shift;
    my $action = shift;
    my @params = @_;

    my @args = ($action, $self->model, [$self->id], @params);
    my $retval;
    $self->class->_with_retries(sub {
        $retval = $self->class->schema->client->object_execute(@args);
    });
    return $retval;
}


sub executex
{
    my ($self, $action, @rest) = @_;

    my @args = ($action, $self->model, [$self->id]);
    push @args, @rest if @rest;
    my $retval;
    $self->class->_with_retries(sub {
        $retval = $self->class->schema->client->object_execute(@args);
    });
    return $retval;
}


sub get_report
{
    my $self = shift;
    my $report_id = shift;

    my $id = $self->class->schema->client->report_report($report_id, $self->id,
            { 
                model       => $self->model, 
                id          => $self->id,
                report_type => 'pdf',
            }, @_);

    # the report_report function returns only a report id, which is all we need to pass to the next function call
    # but report_report_get don't work first time (?!) so we need to call it recursively until with get an answer
    my $data;
    while(!$data)
    {
        $data = $self->class->schema->client->report_report_get($id);
        sleep 1;
    }
    return $data;
}


1;

__END__

=pod

=encoding UTF-8

=head1 NAME

OpenERP::OOM::Object::Base

=head1 VERSION

version 0.43

=head1 DESCRIPTION

Provides a base set of properties and methods for OpenERP::OOM objects (update, delete, etc).

=head1 NAME

OpenERP::OOM::Class::Base

=head1 SYNOPSYS

 my $obj = $schema->class('Name')->create(\%args);
 
 say $obj->id;
 
 $obj->name('New name');
 $obj->update;
 
 $obj->delete;

=head1 PROPERTIES

=head2 id

Returns the OpenERP ID of an object.

 say $obj->id;

=head2 BUILD

The BUILD method sets up the methods for the links to the attached objects.

=head1 METHODS

=head2 update

Updates an object in OpenERP after its properties have been changed.

 $obj->name('New name');
 $obj->update;

Also allows a hashref to be passed to update multiple properties:

 $obj->update({
    name  => 'new name',
    ref   => 'new reference',
    price => 'new price',
 });

=head2 update_single

Updates OpenERP with a single property of an object.

 $obj->name('New name');
 $obj->status('Active');
 
 $obj->update_single('name');  # Only the 'name' property is updated

=head2 refresh

Reloads an object's properties from OpenERP.

 $obj->refresh;

=head2 delete

Deletes an object from OpenERP.

 my $obj = $schema->class('Partner')->retrieve(60);
 $obj->delete;

=head2 copy

Clone the current object, returning the new object.

This is equivalent to pressing duplicate in the OpenERP user interface.

=head2 print

This is a debug method.

=head2 real_create_related

This actually does the create related via OpenERP.

I'm not sure in what scenarios you should use it versus the scenario's you 
shouldn't.  Suck it and see.

It will create calls like this,

# DEBUG_RPC:rpc.request:('execute', 'db', 1, '*', ('stock.partial.picking', 'write', [1], {'product_moves_out': [(0, 0, {'prodlot_id': False, 'product_id': 16, 'product_uom': 1, 'quantity': 10.0})]}, {'lang': 'en_GB', 'search_default_available': 1, 'project_id': False, 'tz': False, '__last_update': {'stock.partial.picking,1': False}, 'active_model': 'ir.ui.menu', 'section_id': False, 'contact_display': 'partner_address', 'active_ids': [3], 'active_id': 316}))

Note that it will not return the object created.

=head2 create_related

Creates a related or linked object.

 $obj->create_related('address',{
     street   => 'Drury Lane',
     postcode => 'CV21 3DE',
 });

=head2 find_related

Finds a property related to the current object.

    my $line = $po->find_related('order_lines', [ 'id', '=', 1 ]);

This only works with relationships to OpenERP objects (i.e. not DBIC) and 
to one2many relationships where the other side of the relationship has a field
pointing back to the object you are searching from.

In any other case the method will croak.

If the search criteria return more than one result it will whine.

=head2 relationship_class

Returns the OpenERP::OOM::Class object for the relationship passed in.

Obviously this only works for the OpenERP relationships.  It will croak
if you ask for a relationship to a DBIC object.

=head2 search_related

Searches for objects of a relation associated with this object.

    my @lines = $po->search_related('order_lines', [ 'state', '=', 'draft' ]);

This only works with relationships to OpenERP objects (i.e. not DBIC) and 
to one2many relationships where the other side of the relationship has a field
pointing back to the object you are searching from.

In any other case the method will croak.

=head2 add_related

Adds a related or linked object to a one2many, many2many, or multiple relationship.

 my $partner  = $schema->class('Partner')->find(...);
 my $category = $schema->class('PartnerCategory')->find(...);
 
 $partner->add_related('category', $category);

=head2 set_related

Like the DBIx::Class set_related.  Sets up a link to a related object.

=head2 execute_workflow

Performs an exec_workflow in OpenERP.  

    $self->execute_workflow('purchase_confirm');

Is likely to translate to something like this,

    # DEBUG_RPC:rpc.request:('exec_workflow', 'db', 1, '*', ('purchase.order', 'purchase_confirm', 24))

The 24 is the id of the object.

=head2 execute

Performs an execute in OpenERP.  

    $self->execute('action_process');

Is likely to translate to something like this,

    # DEBUG_RPC:rpc.request:('execute', 'gooner', 1, '*', ('stock.picking', 'action_process', [26], {'lang': 'en_GB', 'search_default_available': 1, 'active_ids': [316], 'tz': False, 'active_model': 'ir.ui.menu', 'section_id': False, 'contact_display': 'partner_address', 'project_id': False, 'active_id': 316}))

The 26 is the id of the object.

=head2 executex

Similar to execute but it allows you to specify any number of parameters.

Primarily created to prevent any compatibility problems with other callers.
Although I'm not entirely sure if there are any.

    $self->executex('add_invoices_to_payment', [1,2], [3,4]);

Translates roughly to 

    execute_kw(..., 'payment.order', 'add_invoices_to_payment', [5], [1, 2], [3, 4])

Stick a hash on the end of the list of params to pass a context object.

=head2 get_report

To print a purchase order we need to send a report, then get it, then display it, then print it (and you don't want to know about all the traffic behind the scenes...)

The first step looks like this:

    # DEBUG_RPC:rpc.request:('report', 'aquarius_openerp_jj_staging', 1, '*', (u'purchase.quotation', [1], {'model': u'purchase.order', 'id': 1, 'report_type': u'pdf'}, {'lang': u'en_GB', 'active_ids': [1], 'tz': False, 'active_model': u'purchase.order', 'section_id': False, 'search_default_draft': 1, 'project_id': False, 'active_id': 1}))

=head1 AUTHOR

Jon Allen (JJ), <jj@opusvl.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011-2016 by OpusVL.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
