view release on metacpan or  search on metacpan

client  view on Meta::CPAN

#!/usr/bin/perl -w

use CORBA::ORBit idl => [ qw(Account.idl) ];

use Error qw(:try);

use strict;

#  CORBA::ORBit::debug_wait;

#  open IOR, "/home/otaylor/devel/corba-mico-nofixed/ir.ref";
#  my $ior = <IOR>;
#  close IOR;

#  unshift @ARGV, "--ORBIfaceRepoIOR" => $ior;

my $orb = CORBA::ORB_init("orbit-local-orb");

open IOR, "account.ref";
my $ior = <IOR>;
close IOR;

my $account = $orb->string_to_object($ior);

for (my $i=0;$i<0;$i++) {
    $account->deposit( 1 );
}
$account->deposit( 100 );
$account->deposit( 100 );
$account->deposit( 100 );
$account->deposit( 100 );
$account->deposit( 100 / 3);
$account->withdraw( 240 );
$account->withdraw( 10 );

print "Balance is ".$account->balance."\n";

my $prefs = $account->_get_prefs;
print "Favorite color is ",$prefs->{favorite_color},"\n";
print "Lottery numbers are ",
    join(" ", @{$prefs->{lottery_numbers}}),"\n";
print "Nickname is ",$prefs->{nickname},"\n";

$account->set_pref ( [ 'pt_color', 'chartreuse', ] );
$account->set_pref ( [ 'pt_nickname', 'Grumpy', ] );

$account->_set_appearance ( [ map { [ split // ] } split /\n/, <<'FACE' ] );
  /****\  
 ;     	; 
 [ O  O ] 
 l   \ 	l 
  ; -- ;  
   ;;;;	  
FACE

for (@{$account->_get_appearance}) {
    print join("",@$_),"\n";
}

print "Favorite color is now ",$account->get_pref('pt_color')->[1],"\n";
print "As an any: favorite color is now ",
          $account->get_pref_any('pt_color')->value,"\n";
print "As an any: nickname is now ",
          $account->get_pref_any('pt_nickname')->value,"\n";

print "2 * 1,000,000,000,0000 pennies = ", 
    $account->add ('1 000 000 000 000', '1 000 000 000 000'),
    " pennies\n";

print "Withdrawing \$100,000\n";
try {
    $account->withdraw (100_000);
} catch Account::Account::InsufficientFunds with {
    my $e = shift;
    print STDERR "Oops. I don't have that much money\n";
    print STDERR "    (I need $e->{overdraft} more)\n";
};

my $counter = $account->counter();
print join(" ", map { $counter->next } (1..10)), "\n";

$counter->destroy();
try {
    $counter->next;
} catch CORBA::Exception with {
    print "Caught $_[0], while counting with a destroyed counter\n";
};

# Try getting some typecodes

my $tc1 = new CORBA::TypeCode "IDL:Account/Account/Preferences:1.0";
my $tc2 = new CORBA::TypeCode "IDL:Account/Amounts:1.0";
my $tc3 = new CORBA::TypeCode "IDL:CORBA/Double:1.0";

print "Successful completion\n"