use strict;
use warnings;

#
#			Interface Definition Language (OMG IDL CORBA v3.0)
#

use CORBA::Python::class;

package CORBA::Python::serverVisitor;

use base qw(CORBA::Python::classVisitor);

use File::Basename;
use POSIX qw(ctime);

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self = {};
	bless($self, $class);
	my ($parser) = @_;
	$self->{srcname} = $parser->YYData->{srcname};
	$self->{srcname_size} = $parser->YYData->{srcname_size};
	$self->{srcname_mtime} = $parser->YYData->{srcname_mtime};
	$self->{symbtab} = $parser->YYData->{symbtab};
	$self->{server} = 1;
	if (exists $parser->YYData->{opt_J}) {
		$self->{base_package} = $parser->YYData->{opt_J};
	} else {
		$self->{base_package} = "";
	}
	$self->{done_hash} = {};
	$self->{marshal} = 1;
	$self->{stringify} = 1;
	$self->{compare} = 1;
	$self->{id} = 1;
	$self->{old_object} = exists $parser->YYData->{opt_O};
	$self->{indent} = "";
	$self->{out} = undef;
	$self->{import} = "import PyIDL as CORBA\n"
					. "import PyIDL.cdr as CDR\n"
					. "import PyIDL.iop as IOP\n"
					. "import PyIDL.giop as GIOP\n"
					. "\n";
	$self->{scope} = undef;
	return $self;
}

#
#	3.5		OMG IDL Specification		(inherited)
#

#
#	3.7		Module Declaration			(inherited)
#

#
#	3.8		Interface Declaration
#

sub visitRegularInterface {
	my $self = shift;
	my($node) = @_;
	my $FH = $self->{out};
	$self->{indent} = "    ";
	$self->{itf} = $node;
	print $FH "\n";
	if ($self->{old_object}) {
		print $FH "class ",$node->{py_name},"_skel";
		if (exists $node->{inheritance} and exists $node->{inheritance}->{list_interface}) {
			print $FH "(";
			my $first = 1;
			foreach (@{$node->{inheritance}->{list_interface}}) {
				print $FH ", " unless ($first);
				my $base = $self->_get_defn($_);
				print $FH $self->_get_scoped_name($base, $node);
				$first = 0;
			}
			print $FH ")";
		}
		print $FH ":\n";
	} else {
		print $FH "class ",$node->{py_name},,"_skel(";
		if (exists $node->{inheritance} and exists $node->{inheritance}->{list_interface}) {
			my $first = 1;
			foreach (@{$node->{inheritance}->{list_interface}}) {
				print $FH ", " unless ($first);
				my $base = $self->_get_defn($_);
				print $FH $self->_get_scoped_name($base, $node);
				$first = 0;
			}
		} else {
			print $FH "object";
		}
		print $FH "):\n";
	}
	print $FH "    \"\"\" Interface: ",$node->{repos_id}," \"\"\"\n";
	print $FH "\n";
	$self->{repos_id} = $node->{repos_id};
	foreach (@{$node->{list_decl}}) {
		$self->_get_defn($_)->visit($self);
	}
	if ($self->{id}) {
		print $FH "    def _get_id(cls):\n";
		print $FH "        return '",$node->{repos_id},"'\n";
		print $FH "\n";
		print $FH "    corba_id = classmethod(_get_id)\n";
		print $FH "\n";
	}
	print $FH "\n";
	$self->{indent} = "";
	delete $self->{itf};
}

sub visitAbstractInterface {
	my $self = shift;
	my($node) = @_;
	my $FH = $self->{out};
	$self->{indent} = "    ";
	$self->{itf} = $node;
	print $FH "\n";
	if ($self->{old_object}) {
		print $FH "class ",$node->{py_name},"_skel";
		if (exists $node->{inheritance} and exists $node->{inheritance}->{list_interface}) {
			print $FH "(";
			my $first = 1;
			foreach (@{$node->{inheritance}->{list_interface}}) {
				print $FH ", " unless ($first);
				my $base = $self->_get_defn($_);
				print $FH $self->_get_scoped_name($base, $node);
				$first = 0;
			}
			print $FH ")";
		}
		print $FH ":\n";
	} else {
		print $FH "class ",$node->{py_name},,"_skel(";
		if (exists $node->{inheritance} and exists $node->{inheritance}->{list_interface}) {
			my $first = 1;
			foreach (@{$node->{inheritance}->{list_interface}}) {
				print $FH ", " unless ($first);
				my $base = $self->_get_defn($_);
				print $FH $self->_get_scoped_name($base, $node);
				$first = 0;
			}
		} else {
			print $FH "object";
		}
		print $FH "):\n";
	}
	print $FH "    \"\"\" Abstract Interface: ",$node->{repos_id}," \"\"\"\n";
	print $FH "\n";
	$self->{repos_id} = $node->{repos_id};
	foreach (@{$node->{list_decl}}) {
		$self->_get_defn($_)->visit($self);
	}
	print $FH "\n";
	$self->{indent} = "";
	delete $self->{itf};
}

#
#	3.9		Value Declaration			(inherited)
#

#
#	3.10	Constant Declaration		(inherited)
#

#
#	3.11	Type Declaration			(inherited)
#

#
#	3.12	Exception Declaration		(inherited)
#

#
#	3.13	Operation Declaration
#

sub visitOperation {
	my $self = shift;
	my ($node) = @_;
	my $FH = $self->{out};
	print $FH "    def _skel_",$node->{py_name},"(self, request):\n";
	print $FH "        \"\"\" Operation ",$node->{repos_id}," \"\"\"\n" if ($node->{py_name} !~ /^_/);
	print $FH "        reply_body = CDR.OutputBuffer()\n";
	if (scalar(@{$node->{list_in}}) + scalar(@{$node->{list_inout}})) {
		print $FH "        _params = []\n";
		print $FH "        try :\n";
		foreach (@{$node->{list_param}}) {		# parameter
			next if ($_->{attr} eq 'out');
			my $type = $self->_get_defn($_->{type});
			if (exists $type->{full}) {
				print $FH "            _params.append(",$self->_get_scoped_name($type, $self->{itf}),".demarshal(request))\n";
			} else {
				my $type_name = $type->{value};
				$type_name =~ s/ /_/g;
				print $FH "            _params.append(CORBA.demarshal(request, '",$type_name,"'))\n";
			}
		}
		print $FH "        except :\n";
		print $FH "            CORBA.marshal(reply_body, 'string', 'IDL:CORBA/BAD_PARAM:1.0')\n";
		print $FH "            CORBA.marshal(reply_body, 'unsigned_long', 2)\n";
		print $FH "            CORBA.marshal(reply_body, 'unsigned_long', 1)	# COMPLETED_NO \n";
		print $FH "            return (GIOP.SYSTEM_EXCEPTION, reply_body)\n";
	}
	if (exists $node->{modifier}) {		# oneway
		if (scalar(@{$node->{list_in}})) {
			print $FH "        self.",$node->{py_name},"(_params)\n";
		} else {
			print $FH "        self.",$node->{py_name},"()\n";
		}
		print $FH "        return (None, None)\n";
	} else {
		print $FH "        try :\n";
		my $first = 1;
		my $nb = 0;
		my $ret = '';
		my $type = $self->_get_defn($node->{type});
		unless ($type->isa("VoidType")) {
			$ret = "_return";
			$nb ++;
			$first = 0;
		}
		foreach (@{$node->{list_param}}) {		# paramater
			next if ($_->{attr} eq 'in');
			$ret .= ", " unless ($first);
			$ret .= $_->{py_name};
			$nb ++;
			$first = 0;
		}
		if ($nb > 1) {
			$ret = "(" . $ret . ")";
		}
		if ($nb) {
			if (scalar(@{$node->{list_in}}) + scalar(@{$node->{list_inout}})) {
				print $FH "            ",$ret," = self.",$node->{py_name},"(*_params)\n";
			} else {
				print $FH "            ",$ret," = self.",$node->{py_name},"()\n";
			}
			print $FH "            try :\n";
			unless ($type->isa("VoidType")) {
				if (exists $type->{full}) {
					print $FH "                _return.marshal(reply_body)\n";
				} else {
					my $type_name = $type->{value};
					$type_name =~ s/ /_/g;
					print $FH "                CORBA.marshal(reply_body, '",$type_name,"', _return)\n";
				}
			}
			foreach (@{$node->{list_param}}) {	# parameter
				next if ($_->{attr} eq 'in');
				$type = $self->_get_defn($_->{type});
				if (exists $type->{full}) {
					print $FH "                ",$_->{py_name},".marshal(reply_body)\n";
				} else {
					my $type_name = $type->{value};
					$type_name =~ s/ /_/g;
					print $FH "                CORBA.marshal(reply_body, '",$type_name,"', ",$_->{py_name},")\n";
				}
			}
			print $FH "            except :\n";
			print $FH "                reply_body = CDR.OutputBuffer()\t# reset\n";
			print $FH "                CORBA.marshal(reply_body, 'string', 'IDL:CORBA/MARSHAL:1.0')\n";
			print $FH "                CORBA.marshal(reply_body, 'unsigned_long', 9)\n";
			print $FH "                CORBA.marshal(reply_body, 'unsigned_long', 2)	# COMPLETED_MAYBE \n";
			print $FH "                return (GIOP.SYSTEM_EXCEPTION, reply_body)\n";
		} else {
			if (scalar(@{$node->{list_in}})) {
				print $FH "            self.",$node->{py_name},"(*_params)\n";
			} else {
				print $FH "            self.",$node->{py_name},"()\n";
			}
		}
		print $FH "            return (GIOP.NO_EXCEPTION, reply_body)\n";
		foreach (@{$node->{list_raise}}) {
			my $defn = $self->_get_defn($_);
			print $FH "        except ",$self->_get_scoped_name($defn, $self->{itf}),", e:\n";
			print $FH "            try :\n";
			print $FH "                CORBA.marshal(reply_body, 'string', e.corba_id())\n";
			if (exists $defn->{list_expr}) {
				print $FH "                e.marshal(reply_body)\n";
			}
			print $FH "            except :\n";
			print $FH "                reply_body = CDR.OutputBuffer()\t# reset\n";
			print $FH "                CORBA.marshal(reply_body, 'string', 'IDL:CORBA/MARSHAL:1.0')\n";
			print $FH "                CORBA.marshal(reply_body, 'unsigned_long', 9)\n";
			print $FH "                CORBA.marshal(reply_body, 'unsigned_long', 2)	# COMPLETED_MAYBE \n";
			print $FH "                return (GIOP.SYSTEM_EXCEPTION, reply_body)\n";
			print $FH "            return (GIOP.USER_EXCEPTION, reply_body)\n";
		}
		print $FH "        except CORBA.SystemException, e:\n";
		print $FH "            CORBA.marshal(reply_body, 'string', e.repos_id)\n";
		print $FH "            CORBA.marshal(reply_body, 'unsigned_long', e.minor)\n";
		print $FH "            CORBA.marshal(reply_body, 'unsigned_long', e.completed)\n";
		print $FH "            return (GIOP.SYSTEM_EXCEPTION, reply_body)\n";
	}
	print $FH "\n";
}

#
#	3.14	Attribute Declaration		(inherited)
#

1;

