TAO/orbsvcs/examples/Notify/MC/TkMonitor/monitor.pl

   1 #!/usr/bin/env perl -w
   2
   3 # ************************************************************
   4 # Description   : Front end for the Notify Service Monitor
   5 # Author        : Chad Elliott
   6 # Create Date   : 7/17/2007
   7 # ************************************************************
   8
   9 # ************************************************************
  10 # Subroutine Section
  11 # ************************************************************
  12
  13 sub BEGIN {
  14   if (!defined $ENV{OPALORB_ROOT}) {
  15     print STDERR "You must set the OPALORB_ROOT environment variable ",
  16                  "to the full path of opalORB.\n";
  17     exit(1);
  18   }
  19 }
  20
  21 # ************************************************************
  22 # Pragmas
  23 # ************************************************************
  24
  25 use strict;
  26 use FindBin;
  27 use File::Spec;
  28 use File::Basename;
  29
  30 use Tk;
  31
  32 use lib "$ENV{OPALORB_ROOT}";
  33 use lib "$ENV{OPALORB_ROOT}/Naming";
  34 use CORBA;
  35 use CosNotification::NotificationServiceMonitorControl;
  36
  37 my($basePath) = $FindBin::Bin;
  38 if ($^O eq 'VMS') {
  39   $basePath = File::Spec->rel2abs(dirname($0)) if ($basePath eq '');
  40   $basePath = VMS::Filespec::unixify($basePath);
  41 }
  42 unshift(@INC, $basePath . '/modules');
  43
  44 require MonitorControl;
  45
  46 # ************************************************************
  47 # Main Section
  48 # ************************************************************
  49
  50 try {
  51   my($orb) = CORBA::ORB_init(\@ARGV);
  52
  53   my($loc) = 'corbaname:rir:#TAO_MonitorAndControl';
  54   $loc = $ARGV[0] if (defined $ARGV[0]);
  55
  56   my($monitor) = new MonitorControl($orb, $loc);
  57   $monitor->Show();
  58 }
  59 catch CORBA::SystemException with {
  60   my($ex) = shift;
  61   print STDERR "$ex\n";
  62 }
  63 catch Error::Simple with {
  64   my($ex) = shift;
  65   print STDERR "Exception: $ex\n";
  66 };