CORBA-MICO

 view release on metacpan or  search on metacpan

Account.idl  view on Meta::CPAN

    enum PrefType {
      pt_color, pt_lotnum, pt_nickname
    };

    union Preference switch (PrefType) {
      case pt_color: Color favorite_color;
      case pt_lotnum: numbers lottery_numbers;
      case pt_nickname: string nickname;
    };
    
    attribute Preferences prefs;
    attribute Face appearance;


    void set_pref ( in Preference p );
    Preference get_pref ( in PrefType t );
    any get_pref_any ( in PrefType t );

    void deposit( in Amount a );
    void withdraw( in Amount a ) raises (InsufficientFunds);
    long long add ( in long long a, in long long b );

client  view on Meta::CPAN

}

print "BGLN=", ::BGLN(), "\n";

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;
#read STDIN,$a,1;

for (my $i=0;$i<0;$i++) {
    $account->deposit( 1 );
}

client  view on Meta::CPAN

$account->deposit( 100 );
print "Balance is ".$account->balance."\n";
$account->deposit( 100 );
print "Balance is ".$account->balance."\n";
$account->withdraw( 240 );
print "Balance is ".$account->balance."\n";
$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 
  ; -- ;  
   ;;;;	  

server  view on Meta::CPAN

@MyAccount::ISA = qw(POA_Bank::Account);

use Error qw(:try);

sub new {
    my ($class) = @_;
    my $self = bless {}, $class;

    $self->{current_balance} = 0;
    $self->{prefs} = {
		      favorite_color => 'burgundy',
		      lottery_numbers => [ 1, 2, 3, 4],
		      nickname => 'Sneezy'
		     };
    $self->{appearance} = [ map { [ (0..9) ] } 0..5 ];
    $self->{something} = "";

    $self;
}

sub set_pref {
    my $self = shift;
    my ($d, $v) = @{shift()};

    if ($d eq "pt_color") {
	$self->{prefs}->{favorite_color} = $v;
    } elsif ($d eq "pt_lotnum") {
	$self->{prefs}->{lottery_numbers} = $v;
    } elsif ($d eq "pt_nickname") {
	$self->{prefs}->{nickname} = $v;
    }
}

sub get_pref {
    my ($self,$d) = @_;

    if ($d eq "pt_color") {
	return [$d, $self->{prefs}->{favorite_color}];
    } elsif ($d eq "pt_lotnum") {
	return [$d, $self->{prefs}->{lottery_numbers}];
    } elsif ($d eq "pt_nickname") {
	return [$d, $self->{prefs}->{nickname}];
    }
}

sub get_pref_any {
    my ($self,$d) = @_;

    if ($d eq "pt_color") {
	return new CORBA::Any (CORBA::TypeCode->new('IDL:Bank/Account/Color:1.0'),
			       $self->{prefs}->{favorite_color});
    } elsif ($d eq "pt_lotnum") {
	return new CORBA::Any (CORBA::TypeCode->new('IDL:Bank/Account/numbers:1.0'),
			       $self->{prefs}->{lottery_numbers});
    } elsif ($d eq "pt_nickname") {
	return new CORBA::Any (CORBA::TypeCode->new('IDL:CORBA/String:1.0'),
			       $self->{prefs}->{nickname});
    }
}

sub get_da_struct {
    my $self = shift;

    my $res = {
      lval => 17,
      sval => "seventeen",
      fval => "17.03",

server  view on Meta::CPAN

    $poa->create_reference("IDL:Bank/AcctCounter:1.0");
}

sub add {
    my ($self, $a, $b) = @_;
    $a+$b;
}

# Possible alternative mapping
#
#sub prefs {
#    ($self, $val) = @_;
#    defined $val || return $self->{prefs};
#    $self->{prefs} = $val;
#}

sub _set_appearance {
    my ($self,$a) = @_;
    $self->{appearance} = $a;
}

sub _get_appearance {
    $_[0]->{appearance};
}

sub _get_prefs {
    $_[0]->{prefs};
}

sub _set_prefs {
    my ($self,$p) = @_;
    $self->{prefs} = $p;
}

###
sub set_new_get_old {
    my ($self,$smth) = @_;
    my $old = $self->{something};
    $self->{something} = $$smth;
    $$smth = $old;
}