$OurNet::BBS::PlServer::VERSION
=
'0.1'
;
sub
daemonize {
my
$self
=
shift
;
$ROOT
=
shift
;
my
$server
= __PACKAGE__->new({
'pidfile'
=>
'none'
,
'facility'
=>
'daemon'
,
'methods'
=> {
'OurNet::BBS::PlServer'
=> {
'NewHandle'
=> 1,
'CallMethod'
=> 1,
'DestroyHandle'
=> 1,
'spawn'
=> 1,
'invoke'
=> 1,
'rootref'
=> 1,
},
},
'localport'
=>
shift
|| 2000,
'mode'
=>
'fork'
,
});
$server
->Bind();
}
sub
spawn {
return
(
bless
(\
$ROOT
,
$_
[0]));
}
sub
rootref {
return
ref
(
$ROOT
);
}
sub
invoke {
my
$self
=
shift
;
my
$obj
=
$$self
;
while
(
my
$op
=
shift
) {
my
$param
=
shift
;
my
$arg
=
shift
(@{
$param
});
if
(
$op
=~ m/^OBJECT\.(.+)/) {
@_
=
$obj
->$1(
$arg
, @{
$param
});
return
unless
$#_
== 0;
$obj
=
$_
[0];
}
elsif
(
$op
eq
'HASH.FETCH'
) {
$obj
=
$obj
->{
$arg
};
}
elsif
(
$op
eq
'HASH.DESTROY'
) {
return
;
}
elsif
(
$op
eq
'ARRAY.DESTROY'
) {
return
;
}
elsif
(
$op
eq
'HASH.FETCHARRAY'
) {
$obj
=
$obj
->[
$arg
];
}
elsif
(
$op
eq
'ARRAY.FETCH'
) {
$obj
=
$obj
->[
$arg
];
}
elsif
(
$op
eq
'ARRAY.FETCHSIZE'
) {
$obj
= $
}
elsif
(
$op
eq
'ARRAY.DEREFERENCE'
) {
return
@{
$obj
};
}
elsif
(
$op
eq
'HASH.DEREFERENCE'
) {
return
%{
$obj
};
}
elsif
(
$op
eq
'ARRAY.STORE'
) {
return
(
$obj
->[
$arg
] =
$param
->[0]);
}
elsif
(
$op
eq
'HASH.STORE'
) {
return
(
$obj
->{
$arg
} =
$param
->[0]);
}
elsif
(
$op
eq
'ARRAY.DELETE'
) {
return
(
delete
$obj
->[
$arg
]);
}
elsif
(
$op
eq
'HASH.DELETE'
) {
return
(
delete
$obj
->{
$arg
});
}
elsif
(
$op
eq
'ARRAY.PUSH'
) {
return
(
push
@{
$obj
->{
$arg
}}, @{
$param
});
}
elsif
(
$op
eq
'ARRAY.POP'
) {
$obj
=
pop
(@{
$obj
->{
$arg
}});
}
elsif
(
$op
eq
'ARRAY.SHIFT'
) {
$obj
=
shift
(@{
$obj
->{
$arg
}});
}
elsif
(
$op
eq
'HASH.EXISTS'
) {
return
exists
(
$obj
->{
$arg
});
}
elsif
(
$op
eq
'ARRAY.EXISTS'
) {
return
exists
(
$obj
->[
$arg
]);
}
elsif
(
$op
eq
'ARRAY.UNSHIFT'
) {
return
(
unshift
@{
$obj
->{
$arg
}}, @{
$param
});
}
else
{
warn
"Unknown OP: $op\n"
;
}
}
return
(
ref
(
$obj
)) ? (
'OBJECT.SPAWN'
,
scalar
$obj
) :
$obj
;
}