Open Mash Cross Reference
mash/tcl/common/mash-remoteobject.tcl

   # mash-remoteobject.tcl --
   #
   #   A wrapper around Dp to allow RPC calls to remote object/methods.
   #   Remote object can be treated almost in the same way as local object.
   #
   # Copyright (c) 1996-2002 The Regents of the University of California.
   # All rights reserved.
   #
   # Redistribution and use in source and binary forms, with or without
  # modification, are permitted provided that the following conditions are met:
  #
  # A. Redistributions of source code must retain the above copyright notice,
  #    this list of conditions and the following disclaimer.
  # B. Redistributions in binary form must reproduce the above copyright notice,
  #    this list of conditions and the following disclaimer in the documentation
  #    and/or other materials provided with the distribution.
  # C. Neither the names of the copyright holders nor the names of its
  #    contributors may be used to endorse or promote products derived from this
  #    software without specific prior written permission.
  #
  # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
  # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
  # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
  # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  #
  # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/common/mash-remoteobject.tcl,v 1.1 2002/05/28 19:55:37 weitsang Exp $
  
  # Make sure Object's instproc are included
  import Application
  import Dp
  
  #-------------------------------------------------------------
  # Class:
  #   MashRemoteObject
  # Description:
  #   A wrapper around Dp that allows access to a remote object
  #   just like local object.  Mirror to remote object can be 
  #   created in different ways by passing different options
  #   to the constructor.  "new" takes a name of the Class and
  #   creates a new remote object, "copy" takes a name of a 
  #   remote object, "eval" takes an expression that will be
  #   remotely evaluated and returns a remote object.   
  #   IMPORTANT:  It is the caller responsibility to free remote
  #   object.  
  #-------------------------------------------------------------
  Class MashRemoteObject
  
  # Remove all instprocs (both Tcl and C) of Object, so that 
  # unknown will be called instead.  However, we cannot remove
  # instproc, since we still need it to define methods below.
  
  foreach instproc [Object info instcommands] {
      if {$instproc != "instvar" && 
          $instproc != "next" && 
          $instproc != "create" && 
          $instproc != "instproc"} {
          MashRemoteObject instproc $instproc { args } { 
              return [eval $self unknown $proc $args]
          }
      }
  }
  MashRemoteObject instproc init { rpc_channel op args } {
      $self instvar remote_object_ rpc_channel_ is_copy_
      switch $op {
          new {
              set remote_object_ [eval dp_RPC $rpc_channel new $args]
              set is_copy_ 0
          }
          copy {
              set remote_object_ [lindex $args 0]
              set is_copy_ 1
          }
          eval {
              set remote_object_ [eval dp_RPC $rpc_channel $args]
              set is_copy_ 1
          }
          default {
              error "Unknown option $op.  Valid options are new and copy"
          }
      }
      set rpc_channel_ $rpc_channel
  }
  
  MashRemoteObject instproc delete_tkvar { args } {
  }
  
  MashRemoteObject instproc destroy { args } {
      $self instvar is_copy_ rpc_channel_ remote_object_
      if {!$is_copy_} {
          catch {eval dp_RPC $rpc_channel_ delete $remote_object_}
      } 
      $self next
  }
 
 
 MashRemoteObject instproc unknown { args } {
     $self instvar rpc_channel_ remote_object_
     set result [eval dp_RPC $rpc_channel_ $remote_object_ [lindex $args 0] [lrange $args 1 end]]
     return $result
 }