/* Copyright (c) 1997-2010
   Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Darmstadt, Germany)
   http://www.polymake.de

   This program is free software; you can redistribute it and/or modify it
   under the terms of the GNU General Public License as published by the
   Free Software Foundation; either version 2, or (at your option) any
   later version: http://www.gnu.org/licenses/gpl.txt.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.
--------------------------------------------------------------------------------
   $Project: polymake $$Id: Object.cc 9539 2010-03-08 00:43:21Z gawrilow $
*/

#include <polymake.h>

namespace pm { namespace perl {

   static cached_cv give_cv={ "Polymake::Core::Object::give", 0 },
                    give_nm_cv={ "Polymake::Core::Object::give_with_name", 0 },
		    take_cv={ "Polymake::Core::Object::take", 0 },
                    lookup_cv={ "Polymake::Core::Object::lookup_pv", 0 },
		    add_cv={ "Polymake::Core::Object::add", 0 },
		    remove_cv={ "Polymake::Core::Object::remove", 0 },
                    attach_cv={ "Polymake::Core::Object::attach", 0 },
                    remove_attachment_cv={ "Polymake::Core::Object::remove_attachment", 0 },
                    object_isa_cv={ "Polymake::Core::Object::isa", 0 },
                    objecttype_isa_cv={ "Polymake::Core::ObjectType::isa", 0 },
                    commit_cv={ "Polymake::Core::Object::commit", 0 },
                    new_cv={ "Polymake::Core::Object::new_named", 0 },
                    construct_cv={ "Polymake::Core::Object::construct", 0 },
                    copy_cv={ "Polymake::Core::Object::copy", 0 },
                    cast_cv={ "Polymake::Core::Object::cast", 0 },
                    load_cv={ "Polymake::User::load", 0 },
                    save_cv={ "Polymake::User::save", 0 },
                    load_data_cv={ "Polymake::User::load_data", 0 },
                    save_data_cv={ "Polymake::User::save_data", 0 },
                    object_type_name_cv={ "Polymake::Core::ObjectType::full_name", 0 };

   std::string Object::name() const
   {
      size_t l=0;
      const char *namep=pm_perl_get_string_value(*pm_perl_AV_fetch(obj_ref,pm_perl_Object_name_index), &l);
      return std::string(namep,l);
   }

   std::string Object::description() const
   {
      size_t l=0;
      const char *descrp=pm_perl_get_string_value(*pm_perl_AV_fetch(obj_ref,pm_perl_Object_description_index), &l);
      return std::string(descrp,l);
   }

   void Object::set_name(const std::string& name)
   {
      pm_perl_set_string_value(*pm_perl_AV_fetch(obj_ref,pm_perl_Object_name_index), name.c_str(), name.size());
   }

   void Object::set_description(const std::string& value, bool append)
   {
      SV *descr_sv=*pm_perl_AV_fetch(obj_ref,pm_perl_Object_description_index);
      if (append) {
	 pm_perl_append_string_value(descr_sv, value.c_str(), value.size());
      } else {
	 pm_perl_set_string_value(descr_sv, value.c_str(), value.size());
	 pm_perl_set_utf8_flag(descr_sv);
      }
   }

   std::string ObjectType::name() const
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      SV *ret=pm_perl_call_func_scalar(stack,&object_type_name_cv);
      if (!ret) throw exception();
      PropertyValue destroy_on_exit(ret);
      size_t l=0;
      const char *namep=pm_perl_get_string_value(ret, &l);
      return std::string(namep,l);
   }

   SV* Object::_give(const char *name, size_t nl) const
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      stack=pm_perl_push_string_arg(stack,name,nl);
      SV *ret=pm_perl_call_func_scalar(stack,&give_cv);
      if (!ret) throw exception();
      return ret;
   }

   SV* Object::_lookup(const char *name, size_t nl) const
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      stack=pm_perl_push_string_arg(stack,name,nl);
      SV *ret=pm_perl_call_method_scalar(stack,"lookup");
      if (!ret) throw exception();
      return ret;
   }

   SV* Object::_give_with_property_name(const char *name, size_t nl, std::string& given) const
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      stack=pm_perl_push_string_arg(stack,name,nl);
      int ret=pm_perl_call_func_list(stack,&give_nm_cv);
      if (ret<0) throw exception();
      if (ret==0) throw std::runtime_error(std::string("property ") + name + " does not exist");
      PropertyValue(pm_perl_pop_result(false)) >> given;
      return pm_perl_pop_result(true);
   }

   SV* Object::_lookup_with_property_name(const char *name, size_t nl, std::string& given) const
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      stack=pm_perl_push_string_arg(stack,name,nl);
      int ret=pm_perl_call_method_list(stack,"lookup_with_name");
      if (ret<0) throw exception();
      if (ret==0) return pm_perl_undef();
      PropertyValue(pm_perl_pop_result(false)) >> given;
      return pm_perl_pop_result(true);
   }

   SV* Object::_lookup(const char *name, size_t nl, const std::string& subobj_name) const
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      stack=pm_perl_push_string_arg(stack,name,nl);
      stack=pm_perl_push_string_arg(stack,subobj_name.c_str(),subobj_name.size());
      SV *ret=pm_perl_call_method_scalar(stack,"lookup");
      if (!ret) throw exception();
      return ret;
   }

   SV* Object::_give(const char *name, size_t nl, const Hash& props, property_type t) const
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      stack=pm_perl_push_string_arg(stack,name,nl);
      stack=pm_perl_push_arg(stack,props.get());
      if (t==temporary) stack=pm_perl_push_arg(stack,pm_perl_TRUE());
      SV *ret=pm_perl_call_func_scalar(stack,&give_cv);
      if (!ret) throw exception();
      return ret;
   }

   void Object::save(const std::string& filename) const
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      stack=pm_perl_push_string_arg(stack, filename.c_str(), filename.size());
      int ret=pm_perl_call_func_void(stack,&save_cv);
      if (ret<0) throw exception();
   }

   Object Object::load(const std::string& filename)
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_string_arg(stack, filename.c_str(), filename.size());
      SV *ret=pm_perl_call_func_scalar(stack,&load_cv);
      if (!ret) throw exception();
      return Object(ret);
   }

   SV* Object::_lookup(const char *name, size_t nl, const Hash& props) const
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      stack=pm_perl_push_string_arg(stack,name,nl);
      stack=pm_perl_push_arg(stack,props.get());
      SV *ret=pm_perl_call_method_scalar(stack,"lookup");
      if (!ret) throw exception();
      return ret;
   }

   Array Object::_give_all(const char *name, size_t nl) const
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      stack=pm_perl_push_string_arg(stack,name,nl);
      // signaling the list context here makes PropertyMultipleValue return the whole array, not only the first subobject
      int ret=pm_perl_call_method_list(stack,"lookup");
      if (ret<0) throw exception();
      Array arr;
      PropertyValue(ret>0 ? pm_perl_pop_result(true) : pm_perl_undef(), value_allow_undef) >> arr;
      return arr;
   }

   SV* Object::_get_attachment(const char *name, size_t nl) const
   {
      return pm_perl_incr_SV(pm_perl_HV_fetch(*pm_perl_AV_fetch(obj_ref,pm_perl_Object_attachments_index), name, nl, false));
   }

   bool Object::_exists(const char *name, size_t nl) const
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      stack=pm_perl_push_string_arg(stack,name,nl);
      int ret=pm_perl_call_func_bool(stack,&lookup_cv,false);
      if (ret<0) throw exception();
      return ret;
   }

   void Object::_add(const char *name, size_t nl, const Object& sub_obj, property_type t) const
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      stack=pm_perl_push_string_arg(stack,name,nl);
      stack=pm_perl_push_arg(stack,sub_obj.obj_ref);
      if (t==temporary) stack=pm_perl_push_arg(stack,pm_perl_TRUE());
      int ret=pm_perl_call_func_void(stack,&add_cv);
      if (ret<0) throw exception();
   }

   void Object::_remove(const char *name, size_t nl) const
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      stack=pm_perl_push_string_arg(stack,name,nl);
      int ret=pm_perl_call_func_void(stack,&remove_cv);
      if (ret<0) throw exception();
   }

   void Object::_remove_attachment(const char *name, size_t nl) const
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      stack=pm_perl_push_string_arg(stack,name,nl);
      int ret=pm_perl_call_func_void(stack,&remove_attachment_cv);
      if (ret<0) throw exception();
   }

   void Object::remove(const Object& sub_obj) const
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      stack=pm_perl_push_arg(stack,sub_obj.obj_ref);
      int ret=pm_perl_call_func_void(stack,&remove_cv);
      if (ret<0) throw exception();
   }

   SV* ObjectType::construct_type(const char *type_name, size_t tl, SV** (*fill)(SV**))
   {
      cached_cv generic_type;
      generic_type.addr=pm_perl_lookup_sub_in_class(pm_perl_lookup_class_in_app(type_name,tl), "generic_type", 12);
      if (!generic_type.addr) throw std::runtime_error("Type "+std::string(type_name)+" does not exist or is not parameterized");
      SV **stack=pm_perl_start_funcall();
      stack=fill(stack);
      if (!stack) {
	 pm_perl_cancel_funcall();
	 throw std::runtime_error("One of the type parameters is not declared in the rules");
      }
      SV *proto=pm_perl_call_func_scalar(stack,&generic_type);
      if (!proto) throw exception();
      return proto;
   }

   bool ObjectType::isa(const ObjectType& type) const
   {
      if (operator==(type)) return true;
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      stack=pm_perl_push_arg(stack,type.obj_ref);
      int ret=pm_perl_call_func_bool(stack,&objecttype_isa_cv,true);
      if (ret<0) throw exception();
      return ret;
   }

   bool Object::isa(const ObjectType& type) const
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      stack=pm_perl_push_arg(stack,type.obj_ref);
      int ret=pm_perl_call_func_bool(stack,&object_isa_cv,true);
      if (ret<0) throw exception();
      return ret;
   }

   bool Object::_isa(const char *type_name, size_t tl) const
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      stack=pm_perl_push_string_arg(stack,type_name,tl);
      int ret=pm_perl_call_func_bool(stack,&object_isa_cv,true);
      if (ret<0) throw exception();
      return ret;
   }

   ObjectType Object::type() const
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      SV *type_ref=pm_perl_call_method_scalar(stack, "type");
      if (!type_ref) throw exception();
      return ObjectType(type_ref);
   }

   False* Value::retrieve(ObjectType& x) const
   {
      if (pm_perl_is_object_reference(sv))
	 pm_perl_copy_ref(sv, &x.obj_ref);
      else
	 throw std::runtime_error("input value is not a valid ObjectType");
      return 0;
   }

   False* Value::retrieve(Object& x) const
   {
      if (pm_perl_is_object_reference(sv))
	 pm_perl_copy_ref(sv, &x.obj_ref);
      else
	 throw std::runtime_error("input value is not a valid Object");
      return 0;
   }

   void PropertyOut::put() const
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj);
      stack=pm_perl_push_string_arg(stack,name,nl);
      stack=pm_perl_push_arg(stack,const_cast<PropertyOut*>(this)->get_temp());
      int ret;
      if (t==attachment) {
	 ret=pm_perl_call_func_void(stack,&attach_cv);
      } else {
	 if (t==temporary) stack=pm_perl_push_arg(stack,pm_perl_TRUE());
	 ret=pm_perl_call_func_void(stack,&take_cv);
      }
      if (ret<0) throw exception();
   }

   void Object::_create(const ObjectType& type, const char* name, size_t nl)
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,type.obj_ref);
      if (name) stack=pm_perl_push_string_arg(stack,name,nl);
      obj_ref=pm_perl_call_func_scalar(stack,&new_cv);
      if (!obj_ref) throw exception();
      needs_commit=true;
   }

   void Object::_create_copy(const ObjectType& type, const Object& src)
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,type.obj_ref);
      stack=pm_perl_push_arg(stack,src.obj_ref);
      obj_ref=pm_perl_call_func_scalar(stack,&construct_cv);
      if (!obj_ref) throw exception();
      needs_commit=false;
   }

   Object Object::copy() const
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      SV *copy_ref=pm_perl_call_func_scalar(stack,&copy_cv);
      if (!copy_ref) throw exception();
      return Object(copy_ref);
   }

   Object& Object::cast(const ObjectType& type)
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,obj_ref);
      stack=pm_perl_push_arg(stack,type.obj_ref);
      if (pm_perl_call_func_void(stack,&cast_cv)<0) throw exception();
      return *this;
   }

   void Value::put(const ObjectType& x, SV*, const char*, int)
   {
      if (x.obj_ref)
	 pm_perl_set_copy(sv, x.obj_ref);
      else
	 throw std::runtime_error("invalid assignment of a void object type");
   }

   void Value::put(const Object& x, SV*, const char *fup, int)
   {
      if (x.obj_ref) {
	 if (x.needs_commit) {
	    x.needs_commit=false;
	    // if the read_only flag is set, then we are called from parent_object.take();
	    // in this case the childs transaction must be hung into the parents one.
	    if ((options & (value_read_only|value_expect_lval))!=value_read_only &&
		pm_perl_is_defined(*pm_perl_AV_fetch(x.obj_ref,pm_perl_Object_transaction_index))) {
	       SV **stack=pm_perl_start_funcall();
	       stack=pm_perl_push_arg(stack,x.obj_ref);
	       int ret=pm_perl_call_func_void(stack,&commit_cv);
	       if (ret<0) throw exception();
	    }
	 }
	 pm_perl_set_copy(sv, x.obj_ref);
	 if (fup != 0) {
	    // returning a new Object to perl
	    SV *name=*pm_perl_AV_fetch(x.obj_ref,pm_perl_Object_name_index);
	    if (!pm_perl_is_defined(name)) {
	       if (SV *var_name=pm_perl_name_of_ret_var())
		  pm_perl_set_copy(name,var_name);
	    }
	 }
      } else {
	 throw std::runtime_error("invalid assignment of a void object");
      }
   }

   Object Object::parent() const
   {
      if (obj_ref) {
	 SV *parent_ref=*pm_perl_AV_fetch(obj_ref,pm_perl_Object_parent_index);
	 if (pm_perl_is_defined(parent_ref)) return Object(pm_perl_init_ref(parent_ref));
      }
      return Object();
   }

   PropertyValue load_data(const std::string& filename)
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_string_arg(stack, filename.c_str(), filename.size());
      SV *ret=pm_perl_call_func_scalar(stack,&load_data_cv);
      if (!ret) throw exception();
      return PropertyValue(ret);
   }

   void _save_data(SV* sv, const std::string& filename, const std::string& description)
   {
      SV **stack=pm_perl_start_funcall();
      stack=pm_perl_push_arg(stack,sv);
      stack=pm_perl_push_string_arg(stack, filename.c_str(), filename.size());
      stack=pm_perl_push_string_arg(stack, description.c_str(), description.size());
      int ret=pm_perl_call_func_void(stack,&save_data_cv);
      if (ret<0) throw exception();
   }
} }
