The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

use CORBA::omniORB ids => [ 'IDL:Bank:1.0' => undef ];
use Error qw(:try);

use strict;

my $orb = CORBA::ORB_init("omniORB4");
my ($ids,$id);
$ids = $orb->list_initial_services();
print "initial services:\n";
foreach $id (@{$ids}) {
  print "\t$id\n";
}
my $ir = $orb->resolve_initial_references("InterfaceRepository");
if( CORBA::is_nil($ir) ) {
  print "Can't connect to InterfaceRepository service\n";
  exit 1;
}

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

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

#$account->_set_prefs ( { favorite_color => 'taupe',
#		         lottery_numbers => [ 21, 63, 83, 96 ],
#		         nickname => 'Dopey' });

#print "$$\n";
#sleep 5;

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 );
$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,
	  "(", $account->get_pref_any('pt_color')->type->kind,")","\n";
print "As an any: nickname is now ",
          $account->get_pref_any('pt_nickname')->value,
	  "(", $account->get_pref_any('pt_nickname')->type->kind,")","\n";
my $ln = $account->get_pref_any('pt_lotnum')->value;
print "As an any: lottery_numbers are now ",
	  join(" ", @{$ln}),
	  "(", $account->get_pref_any('pt_lotnum')->type->kind,")","\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 Bank::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";
};

# DynAny
{
  my $dafact = $orb->resolve_initial_references("DynAnyFactory");

  my $da_any = $account->get_da_struct();
  print "Any kind = ", $da_any->type->kind, "\n";
  my $da = $dafact->create_dyn_any( $da_any );
  print "DynamicAny kind ", $da->type->kind, "\n";

  my $da_struct = DynamicAny::DynStruct::_narrow($da);
  my $struct = $da_struct->get_members();
  print "da_struct {\n";
  my $field;
  foreach $field (@{$struct}) {
    print $field->{id},"=", $field->{value}->value, "\n";
  }
  print "}\n";

  # test for plain DynAny
  {
    my $da_long = $dafact->create_dyn_any( $struct->[0]->{value} );
    print "lval=",$da_long->get_long(),"\n";
    $da_long->destroy();
    my $da_string = $dafact->create_dyn_any( $struct->[1]->{value} );
    print "sval=",$da_string->get_string(),"\n";
    $da_string->destroy();
  }
  #test for CORBA::Fixed
  {
    my $da = $dafact->create_dyn_any( $struct->[2]->{value} );
    my $da_fixed = DynamicAny::DynFixed::_narrow($da);
    print "fval=",$da_fixed->get_value(),"\n";
    $da->destroy();
  }
  #test for CORBA::Enum
  {
    my $da = $dafact->create_dyn_any( $struct->[3]->{value} );
    my $da_enum = DynamicAny::DynEnum::_narrow($da);
    print "fval=",$da_enum->get_as_string(),"(",$da_enum->get_as_ulong(),")\n";
    $da->destroy();
  }

  # set members
  {
    my $lval_any = new CORBA::Any (CORBA::TypeCode->new('IDL:CORBA/Long:1.0'),   18 );
    my $sval_any = new CORBA::Any (CORBA::TypeCode->new('IDL:CORBA/String:1.0'), "eightteen" );
    my $fval_any = new CORBA::Any (CORBA::TypeCode->new('IDL:Bank/Amount:1.0'),  "18.08" );
    my $enval_any = new CORBA::Any (CORBA::TypeCode->new('IDL:Bank/Account/da_enum:1.0'), "da_enum_3" );
    $da_struct->set_members( 
    [
      { id => 'lval', value => $lval_any },
      { id => 'sval', value => $sval_any },
      { id => 'fval', value => $fval_any },
      { id => 'enval',value => $enval_any },
    ]);
  }

  # get_members_as_dyn_any
  {
    my $struct = $da_struct->get_members_as_dyn_any();
    print "dyn_any_struct {\n";
    print $struct->[0]->{id},"=",$struct->[0]->{value}->get_long(),"\n";
    print $struct->[1]->{id},"=",$struct->[1]->{value}->get_string(),"\n";
    my $da_fixed = DynamicAny::DynFixed::_narrow($struct->[2]->{value});
    print $struct->[2]->{id},"=",$da_fixed->get_value(),"\n";
    my $da_enum = DynamicAny::DynEnum::_narrow($struct->[3]->{value});
    print $struct->[3]->{id},"=",$da_enum->get_as_string(),"(",$da_enum->get_as_ulong(),")\n";
    print "}\n";
  }
}

# inout
my $smth = "asd";
print "inout: want '$smth'\n";
$account->set_new_get_old( \$smth );
print "inout: was '$smth' - MUST BE EMPTY\n";
$smth = "qwe";
$account->set_new_get_old( \$smth );
print "inout: was '$smth' - MUST BE 'asd'\n";

print "Successful completion\n"