sakoh@sraco2.us.sra.co.jp (Hiroshi &) (02/21/91)
Hello, folks.
Now we have an object-oriented perl! (please allow me to call it OPERL).
Does it sound funny or insane :-) ?
As usual oo-languages, you can define classes and create instances.
Each instance can maintain its internal states independently.
Of course, it supports inheritance.
Since It's totally written in perl, you don't have to change perl
itself at all.
Although I tested the package on perl3.41, perl3.44 and perl4.0 only,
it should work on earlier versions if package feature works correctly.
Distribution kit is uuencoded since operl.pl contains control characters.
Sorry for no documents, however, you might find the way to use this package
easily at a glance (please refer to the samples).
There should be many way to improve the package.
Any comments are welcome.
By the way, I'd like to pass a scalar variable as an argument of 'package'
on execution time.
Is it a bad idea to have like:
sub sub1 {
package $context;
....
}
??
It would improve the performance of this package,
since I could avoid to use extra eval.
Hiroshi Sakoh
sakoh@sra.co.jp or uunet!sraco1!sakoh
---<cut here>--------------------------------------------
begin 664 operl.shar
M(R$O8FEN+W-H"B,@5&AI<R!I<R!A('-H96QL(&%R8VAI=F4N("!296UO=F4@
M86YY=&AI;F<@8F5F;W)E('1H:7,@;&EN92P*(R!T:&5N('5N<&%C:R!I="!B
M>2!S879I;F<@:70@:6X@82!F:6QE(&%N9"!T>7!I;F<@(G-H(&9I;&4B+@HC
M"B,@5W)A<'!E9"!B>2`@;VX@5V5D($9E8B`R,"`Q-CHU,CHR-"!-4U0@,3DY
M,0HC($-O;G1E;G1S.B`@8F%G+G!L('-E="YP;"!P;VEN="YP;"!S=&%C:RYP
M;"!O<&5R;"YP;"!S86UP;&4Q('-A;7!L93(@<V%M<&QE,PHC"7-A;7!L930@
M<V%M<&QE-0H@"F5C:&\@>"`M(&)A9RYP;`IS960@)W,O7D`O+R<@/B`B8F%G
M+G!L(B`\/"=`+R]%*D\J1B!B86<N<&PO+R<*(R$O=7-R+V)I;B]P97)L"G)E
M<75I<F4@)V]P97)L+G!L)SL*"B9D969C;&%S<R`H)V)A9R<L)W)O;W0G*3L*
M)F1E9FUE=&AO9"@G8F%G)RPG<'5T)RP@("`@("`G)&5L96UE;G1S>R1?6S!=
M?2LK.R<I.PHF9&5F;65T:&]D*"=B86<G+"=H;W=?;6%N>2<L("<D96QE;65N
M='-[)%];,%U].R<I.PHF9&5F;65T:&]D*"=B86<G+"=K:6YD<R<L("`@("=K
M97ES*"5E;&5M96YT<RD[)RD["B9D969M971H;V0H)V)A9R<L)V1E;&5T92<L
M(`H))V1E;&5T92`D96QE;65N='-[)%];,%U](&EF("TM)&5L96UE;G1S>R1?
M6S!=?2`\/2`P.R<I.PHF9&5F;65T:&]D*"=B86<G+"=H87,G+"`@("`@("=D
M969I;F5D*"1E;&5M96YT<WLD7ULP77TI)RD["B9D969M971H;V0H)V)A9R<L
M)W-I>F4G+"`@("`@)V9O<F5A8V@@)&X@*"5E;&5M96YT<RD@>R1S=6T@*ST@
M)&X[?3LD<W5M.R<I.PHF9&5F;65T:&]D*"=B86<G+"=D=6UP)RP*("`@("=W
M:&EL92`H*"1K97DL("1V86PI(#T@96%C:"`E96QE;65N=',I('MP<FEN="`B
M)&ME>2`]("1V86Q<;B([?2<I.PH*,3L*0"\O12I/*D8@8F%G+G!L+R\*8VAM
M;V0@=3UR+&<]<BQO/7(@8F%G+G!L"B`*96-H;R!X("T@<V5T+G!L"G-E9"`G
M<R]>0"\O)R`^(")S970N<&PB(#P\)T`O+T4J3RI&('-E="YP;"\O)PHC(2]U
M<W(O8FEN+W!E<FP*<F5Q=6ER92`G8F%G+G!L)SL*"B9D969C;&%S<R`H)W-E
M="<L)V)A9R<I.PHF9&5F;65T:&]D*"=S970G+"=P=70G+"`@("`G)&5L96UE
M;G1S>R1?6S!=?3TQ.R<I.PHF9&5F;65T:&]D*"=S970G+"=S:7IE)RP@("`G
M;&5N9W1H*"5E;&5M96YT<RD[)RD["@HQ.PI`+R]%*D\J1B!S970N<&PO+PIC
M:&UO9"!U/7(L9SUR+&\]<B!S970N<&P*(`IE8VAO('@@+2!P;VEN="YP;`IS
M960@)W,O7D`O+R<@/B`B<&]I;G0N<&PB(#P\)T`O+T4J3RI&('!O:6YT+G!L
M+R\G"B,A+W5S<B]B:6XO<&5R;`IR97%U:7)E("=O<&5R;"YP;"<["@HF9&5F
M8VQA<W,@*"=P;VEN="<L)W)O;W0G*3L*)F1E9FUE=&AO9"@G<&]I;G0G+"=I
M;FET)RP*("`@("<D>'@@/2!D969I;F5D*"1?6S!=*2`_("1?6S!=(#H@,#L@
M)'EY(#T@9&5F:6YE9"@D7ULQ72D@/R`D7ULQ72`Z(#`[)RD["B9D969M971H
M;V0H)W!O:6YT)RPG;6]V92<L"B`@("`G)'AX(#T@9&5F:6YE9"@D7ULP72D@
M/R`D7ULP72`Z("1X>#L@)'EY(#T@9&5F:6YE9"@D7ULQ72D@/R`D7ULQ72`Z
M("1Y>3LG*3L*)F1E9FUE=&AO9"@G<&]I;G0G+"=M;W9E>"<L("<D>'@@/2!D
M969I;F5D*"1?6S!=*2`_("1?6S!=(#H@)'AX.R<I.PHF9&5F;65T:&]D*"=P
M;VEN="<L)VUO=F5Y)RP@)R1Y>2`](&1E9FEN960H)%];,%TI(#\@)%];,%T@
M.B`D>7D[)RD["B9D969M971H;V0H)W!O:6YT)RPG<FUO=F4G+`H@("`@)R1X
M>"`K/2!D969I;F5D*"1?6S!=*2`_("1?6S!=(#H@,#L@)'EY("L](&1E9FEN
M960H)%];,5TI(#\@)%];,5T@.B`P.R<I.PHF9&5F;65T:&]D*"=P;VEN="<L
M)W)M;W9E>"<L("<D>'@@*ST@9&5F:6YE9"@D7ULP72D@/R`D7ULP72`Z(#`[
M)RD["B9D969M971H;V0H)W!O:6YT)RPG<FUO=F5Y)RP@)R1Y>2`K/2!D969I
M;F5D*"1?6S!=*2`_("1?6S!=(#H@,#LG*3L*)F1E9FUE=&AO9"@G<&]I;G0G
M+"=X)RP@)R1X>#LG*3L*)F1E9FUE=&AO9"@G<&]I;G0G+"=Y)RP@)R1Y>3LG
M*3L*"C$["D`O+T4J3RI&('!O:6YT+G!L+R\*8VAM;V0@=3UR+&<]<BQO/7(@
M<&]I;G0N<&P*(`IE8VAO('@@+2!S=&%C:RYP;`IS960@)W,O7D`O+R<@/B`B
M<W1A8VLN<&PB(#P\)T`O+T4J3RI&('-T86-K+G!L+R\G"B,A+W5S<B]B:6XO
M<&5R;`IR97%U:7)E("=O<&5R;"YP;"<["@HF9&5F8VQA<W,@*"=S=&%C:R<L
M)W)O;W0G*3L*)F1E9FUE=&AO9"@G<W1A8VLG+"=I;FET)RPG)&EN>"`](#`G
M*3L*)F1E9FUE=&AO9"@G<W1A8VLG+"=P=7-H)RPG)'-T:ULD:6YX*RM=(#T@
M)%];,%T[)RD["B9D969M971H;V0H)W-T86-K)RPG<&]P)RP*"2`@("=W87)N
M(")W87)N.B!E;7!T>2!S=&%C:RY<;B(@:68@*"1I;G@@/#T@,"D[)&EN>"`M
M+2!I9B`D:6YX(#X@,#LG*3L*)F1E9FUE=&AO9"@G<W1A8VLG+"=T;W`G+`H)
M("`@)W=A<FX@(G=A<FXZ(&5M<'1Y('-T86-K+EQN(B!I9B`H)&EN>"`\/2`P
M*3LD<W1K6R1I;G@@+2`Q72<I.PHF9&5F;65T:&]D*"=S=&%C:R<L)VQE;F=T
M:"<L)R1I;G@[)RD["B9D969M971H;V0H)W-T86-K)RPG9'5M<"<L)V9O<F5A
M8V@@)&ET96T@*$!S=&LI('MP<FEN="`B*"(@+B`D:71E;2`N("(I7&XB.WTG
M*3L*"C$["D`O+T4J3RI&('-T86-K+G!L+R\*8VAM;V0@=3UR+&<]<BQO/7(@
M<W1A8VLN<&P*(`IE8VAO('@@+2!O<&5R;"YP;`IS960@)W,O7D`O+R<@/B`B
M;W!E<FPN<&PB(#P\)T`O+T4J3RI&(&]P97)L+G!L+R\G"B,A+W5S<B]B:6XO
M<&5R;`HC"B,@)$AE861E<CH@;W!E<FPN<&PL=B`Q+C<@.3$O,#(O,C`@,34Z
M-#,Z,3D@<V%K;V@@17AP("0*(R!!;B!E>'!E<FEM96YT86P@;V)J96-T+6]R
M:65N=&5D('!A8VMA9V4@9F]R('!E<FPN"B,*<&%C:V%G92!O<&5R;#L*<F5Q
M=6ER92`G9'5M<'9A<BYP;"<["B,*(R!A;B!O8FIE8W0@:60@/2`D<F]O="`N
M("1S86QT.PHC"B1R;V]T(#T@)V]P97)L7R<[("`C(&]B:F5C="!I9"!R;V]T
M"B1S86QT(#T@)V$G.R`@("`@("`C(&]B:F5C="!I9"!S86QT.PH*(PHC("9D
M969C;&%S<RAC;&%S<RP@<W5P97)C;&%S<RD*(PIS=6(@;6%I;B=D969C;&%S
M<R'-U<&5R.PH@("`@?2!E;'-E('L*"7!R
M:6YT(")N;R!S=6-H('-U<&5R(&-L87-S.B(@+B`D<W5P97(@+B`B7&XB.PH@
M("`@?0I]"@HC"B,@)F1E9FUE=&AO9"AC;&%S<RP@;65T:&]D+"!B;V1Y*0HC
M"G-U8B!M86EN)V1E9FUE=&AO9"!["B`@("!L;V-A;"@D8VQA<W,I("`]('-H
M:69T.R`C(&-L87-S(&YA;64*("`@(&QO8V%L*"1M971H;V0I(#T@<VAI9G0[
M(",@;65T:&]D(&YA;64*("`@(&QO8V%L*"1B;V1Y*2`@(#T@<VAI9G0[(",@
M;65T:&]D(&)O9'D*("`@(&QO8V%L*"1D969S*3L*("`@(&QO8V%L*"1R97-U
M;'0I.PH*("`@(&EF("@A9&5F:6YE9"@D<W5P97)C;&%S<WLD8VQA<W-]*2D@
M>PH@("`@("`@('!R:6YT(")N;R!S=6-H(&-L87-S.B(@+B`D8VQA<W,@+B`B
M7&XB.PH@("`@("`@(')E='5R;B`M,3L*("`@('T*("`@("1M971H;V1S>R1C
M;&%S<WT@+CT@(B1M971H;V0Z(CL*("`@("1D969S(#T@<7$A<W5B("1C;&%S
M<R<D;65T:&]D('LA("X*"2`@("`@<2%L;V-A;"@D8V]N=&5X="D@/2!S:&EF
M=#L@(2`N"B`@("`@("`@("`@("!Q(65V86P@(G!A8VMA9V4@)&-O;G1E>'0[
M(B`N("<D<V5L9B`]("<@+B`B)&-O;G1E>'0[(B`N('$!(2`N"B`@("`@("`@
M("`@("`D8F]D>2`N('$A`3M].R$["B`@("`D<F5S=6QT(#T@979A;"`D9&5F
M<SL*("`@('!R:6YT("1`("X@(EQN(B!U;FQE<W,@)$`@97$@)R<["B`@("`D
M<F5S=6QT.PI]"@HC"B,@)FYE=V]B:F5C="AC;&%S<RD*(PIS=6(@;6%I;B=N
M97=O8FIE8W0@>PH@("`@;&]C86PH)&-L87-S*2`]('-H:69T.R`C(&-L87-S
M(&YA;64*("`@(&QO8V%L*"1N97=O8FHI.PH*("`@(&EF("@A9&5F:6YE9"@D
M<W5P97)C;&%S<WLD8VQA<W-]*2D@>PH@("`@("`@('!R:6YT(")N;R!S=6-H
M(&-L87-S.B(@+B`D8VQA<W,@+B`B7&XB.PH@("`@("`@(')E='5R;B`M,3L*
M("`@('T*"B`@("`D;F5W;V)J(#T@)')O;W0@+B`D<V%L="LK.PH@("`@)&UY
M8VQA<W-[)&YE=V]B:GT@/2`D8VQA<W,["@H@("`@)FUA:6XG<V5N9"@D;F5W
M;V)J+"`G:6YI="<L($!?*3L@(R!C86QL(&EN:70@=VET:"!A<F=S"B`@("!R
M971U<FX@)&YE=V]B:CL*?0H*(PHC("9S96YD*&]B:F5C="P@;65T:&]D+"!A
M<F<Q+"!A<F<R+"`N+BXI"B,*<W5B(&UA:6XG<V5N9"!["B`@("!L;V-A;"@D
M;V)J96-T*2`]('-H:69T.R`C(&]B:F5C"B`@("!L;V-A;"@D;65T:&]D*2`]
M('-H:69T.R`C(&UE=&AO9"!N86UE"B`@("!L;V-A;"@D8VQA<W,L("1R97-U
M;'0L("1X>7HI.PH*("`@(&EF("@D;6%I;B=M<V=T<F%C92`A/2`P*2!["@DD
M;7-G;&5V96P@*RL["@EW87)N(");)&US9VQE=F5L73HF<V5N9"@D;V)J96-T
M+"`D;65T:&]D+"!`7RDB.PH@("`@?0H@("`@:68@*"1O8FIE8W0@(7X@+UYO
M<&5R;%\O;RD@>PH@("`@("`@('=A<FX@(FYO('-U8V@@;V)J96-T.B(@+B`D
M;V)J96-T("X@(EQN(CL*"21M<V=L979E;"`M+2!I9B`D;6%I;B=M<V=T<F%C
M92`A/2`P.PH@("`@("`@(')E='5R;B`M,3L*("`@('T*("`@("1C;&%S<R`]
M("`D;7EC;&%S<WLD;V)J96-T?3L*"B`@("!W:&EL92`H:6YD97@H)&UE=&AO
M9'-[)&-L87-S?2P@(B1M971H;V0Z(BD@/"`P*2!["@EI9B`H)&-L87-S(&5Q
M("=R;V]T)RD@>PH)("`@('=A<FX@(G5N:VYO=VX@;65S<V%G93HB("X@)&UE
M=&AO9"`N(")<;B(["@D@("`@)&US9VQE=F5L("TM(&EF("1M86EN)VUS9W1R
M86-E("$](#`["B`@("`@("`@("`@(')E='5R;B!U;F1E9CL*("`@("`@("!]
M"B`@("`@("`@)&-L87-S(#T@)'-U<&5R8VQA<W-[)&-L87-S?3L@(R!C:&%I
M;B!T;R!S=7!E<B!C;&%S<PH@("`@?0H@("`@)'AY>B`]("(D8VQA<W,G)&UE
M=&AO9"([(",@<W5B<F]U=&EN92!T;R!B92!I;G9O:V5D"B`@("`D<F5S=6QT
M(#T@9&\@)'AY>B@D;V)J96-T+"!`7RD[("`@(R!S=6)R;W5T:6YE(&-A;&P*
M("`@('!R:6YT("1`("X@(EQN(B!U;FQE<W,@)$`@97$@)R<["B`@("!I9B`H
M)&UA:6XG;7-G=')A8V4@(3T@,"D@>PH)=V%R;B`B(#T]/B`B("X@*"@D<F5S
M=6QT(&5Q('5N9&5F*2`_("=U;F1E9B<@.B`D<F5S=6QT*2`N(")<;B(["@DD
M;7-G;&5V96P@+2T["B`@("!]"B`@("`D<F5S=6QT.PI]"@HC"B,@)F1U;7!C
M;&%S<R@I"B,*<W5B(&UA:6XG9'5M<&-L87-S('L*("`@('=H:6QE("@H)&ME
M>2P@)'9A;"D@/2!E86-H("5S=7!E<F-L87-S*2!["@EP<FEN="`D:V5Y("X@
M(B!I<R!A('-U8F-L87-S(&]F("(@+B`D=F%L("X@(EQN(CL*("`@('T*?0H*
M(PHC(&EM<&]R=&%N="!B=6EL="UI;B`Z("=R;V]T)R!C;&%S<PHC"B1S=7!E
M<F-L87-S>R=R;V]T)WT@/2`G<F]O="<[("`@("`C("=R;V]T)R!I<R!T:&4@
M<W5P97(@8VQA<W,@;V8@:71S96QF+@HF;6%I;B=D969M971H;V0H)W)O;W0G
M+"`G:6YI="<L("<G*3L@(R!D;R!N;W1H:6YG"B9M86EN)V1E9FUE=&AO9"@G
M<F]O="<L("=C;&%S<R<L"G$A"B`@("`D;W!E<FPG;7EC;&%S<WLD<V5L9GT[
M"B`A*3L*)FUA:6XG9&5F;65T:&]D*"=R;V]T)RP@)W-H;W=?<&%R96YT<R<L
M"G$A("!L;V-A;"@D8VQA<W,I(#T@)&]P97)L)VUY8VQA<W-[)'-E;&9].PH@
M("`@=VAI;&4@*"1C;&%S<R!N92`G<F]O="<I('L*"7!R:6YT("1C;&%S<R`N
M("(@+3X@(CL*("`@("`@("`D8VQA<W,@/2`D;W!E<FPG<W5P97)C;&%S<WLD
M8VQA<W-].R`C(&-H86EN('1O('1H92!S=7!E<B!C;&%S<PH@("`@?0H@("`@
M<')I;G0@(G)O;W1<;B(["B`A*3L*)FUA:6XG9&5F;65T:&]D*"=R;V]T)RP@
M)W-H;W=?<V5L9B<L"G$A("`@('!R:6YT(")C;&%S<SHB("X@)&]P97)L)VUY
M8VQA<W-[)'-E;&9]("X@(EQN(CL*("`@("`@<')I;G0@(FUE=&AO9',Z(B`N
M("1O<&5R;"=M971H;V1S>R1O<&5R;"=M>6-L87-S>R1S96QF?7T@+B`B7&XB
M.PH@("`@("`F;6%I;B=D=6UP=F%R*"1S96QF*3L*("$I.R`C('-E;&8@9'5M
M<`H*,3L*0"\O12I/*D8@;W!E<FPN<&PO+PIC:&UO9"!U/7(L9SUR+&\]<B!O
M<&5R;"YP;`H@"F5C:&\@>"`M('-A;7!L93$*<V5D("=S+UY`+R\G(#X@(G-A
M;7!L93$B(#P\)T`O+T4J3RI&('-A;7!L93$O+R<*(R$O=7-R+V)I;B]P97)L
M"G)E<75I<F4@)V]P97)L+G!L)SL*"B9D969C;&%S<R@G:&5L;&\G+"`G<F]O
M="<I.PHF9&5F8VQA<W,H)VAE:&4G+"`G:&5L;&\G*3L*)F1E9F-L87-S*"=F
M=69U)RP@)VAE:&4G*3L*"B9D=6UP8VQA<W,H*3L*"D`O+T4J3RI&('-A;7!L
M93$O+PIC:&UO9"!U/7)W>"QG/7)W>"QO/7)X('-A;7!L93$*(`IE8VAO('@@
M+2!S86UP;&4R"G-E9"`G<R]>0"\O)R`^(")S86UP;&4R(B`\/"=`+R]%*D\J
M1B!S86UP;&4R+R\G"B,A+W5S<B]B:6XO<&5R;`IR97%U:7)E("=O<&5R;"YP
M;"<["@HC(&1E9FEN92!N97<@8VQA<W,@)VAE;&QO)R!A<R!S=6)C;&%S<R!O
M9B`G<F]O="<*)F1E9F-L87-S("@G:&5L;&\G+"`G<F]O="<I.PH*(R`G:6YI
M="<@;65T:&]D('=I;&P@8F4@:6YV;VME9"!O;B!C<F5A=&EN9R!A;B!O8FIE
M8W0*)F1E9FUE=&AO9"@G:&5L;&\G+"`G:6YI="<L("<D:2`](#`[)RD["@HC
M(&UE=&AO9"`G861D,2<@861D<R`Q('1O("1I"B9D969M971H;V0H)VAE;&QO
M)RP@)V%D9#$G+"`G)&DK*SLG*3L*"B,@;65T:&]D("=S:&]W)R!S:&]W<R!T
M:&4@=F%L=64@;V8@)&D*)F1E9FUE=&AO9"@G:&5L;&\G+"`G<VAO=R<L("=P
M<FEN="`B+3X@(B`N("1I("X@(EQN(CLG*3L*"B1O,2`]("9N97=O8FIE8W0H
M)VAE;&QO)RD["B1O,B`]("9N97=O8FIE8W0H)VAE;&QO)RD["@IP<FEN="`B
M9FER<W0@(&]B:F5C=#TB("X@)&\Q("X@(EQN(CL*<')I;G0@(G-E8V]N9"!O
M8FIE8W0](B`N("1O,B`N(")<;B(["@IP<FEN="`B07!P;'D@<V5V97)A;"!O
M<&5R871I;VYS(&]N("1O,5QN(CL*)G-E;F0H)&\Q+"`G861D,2<I.PHF<V5N
M9"@D;S$L("=S:&]W)RD["B9S96YD*"1O,2P@)V%D9#$G*3L*)G-E;F0H)&\Q
M+"`G<VAO=R<I.PHF<V5N9"@D;S$L("=A9&0Q)RD["B9S96YD*"1O,2P@)W-H
M;W<G*3L*)G-E;F0H)&\Q+"`G861D,2<I.PHF<V5N9"@D;S$L("=S:&]W)RD[
M"@IP<FEN="`B4V5E/R!4:&5R92!I<R!N;R!C:&%N9V4@:6X@)&\R7&XB.PHF
M<V5N9"@D;S(L("=S:&]W)RD["@HF9'5M<&-L87-S*"D["D`O+T4J3RI&('-A
M;7!L93(O+PIC:&UO9"!U/7)W>"QG/7)W>"QO/7)X('-A;7!L93(*(`IE8VAO
M('@@+2!S86UP;&4S"G-E9"`G<R]>0"\O)R`^(")S86UP;&4S(B`\/"=`+R]%
M*D\J1B!S86UP;&4S+R\G"B,A+W5S<B]B:6XO<&5R;`IR97%U:7)E("=S970N
M<&PG.PH*)'-E=#$@/2`F;F5W;V)J96-T*"=S970G*3L@(R!%;&5M96YT<R!C
M86XG="!D=7!L:6-A=&4@:6X@<V5T(&-L87-S"B1B86<Q(#T@)FYE=V]B:F5C
M="@G8F%G)RD[(",@16QE;65N=',@8V%N(&1U<&QI8V%T92!I;B!B86<@8VQA
M<W,*"G!R:6YT("(J*B!S970@*BI<;B(["B9S96YD*"1S970Q+"`G<'5T)RP@
M)V)A;F%N82<I.PHF<V5N9"@D<V5T,2P@)W!U="<L("=A<'!L92<I.PHF<V5N
M9"@D<V5T,2P@)W!U="<L("=O<F%N9V4G*3L*)G-E;F0H)'-E=#$L("=P=70G
M+"`G;W)A;F=E)RD["B9S96YD*"1S970Q+"`G<'5T)RP@)V]R86YG92<I.PH*
M<')I;G0@(D]R86YG92!4;W1A;#TB("X@)G-E;F0H)'-E=#$L("=H;W=?;6%N
M>2<L("=O<F%N9V4G*2`N(")<;B(["B9S96YD*"1S970Q+"`G9'5M<"<I.PHF
M<V5N9"@D<V5T,2P@)W-H;W=?<V5L9B<I.PH*)G-E;F0H)'-E=#$L("=D96QE
M=&4G+"`G;W)A;F=E)RD["@IP<FEN="`B3W)A;F=E(%1O=&%L/2(@+B`F<V5N
M9"@D<V5T,2P@)VAO=U]M86YY)RP@)V]R86YG92<I("X@(EQN(CL*)G-E;F0H
M)'-E=#$L("=D=6UP)RD["B9S96YD*"1S970Q+"`G<VAO=U]S96QF)RD["@IP
M<FEN="`B*BH@8F%G("HJ7&XB.PHF<V5N9"@D8F%G,2P@)W!U="<L("=B86YA
M;F$G*3L*)G-E;F0H)&)A9S$L("=P=70G+"`G87!P;&4G*3L*)G-E;F0H)&)A
M9S$L("=P=70G+"`G;W)A;F=E)RD["B9S96YD*"1B86<Q+"`G<'5T)RP@)V]R
M86YG92<I.PHF<V5N9"@D8F%G,2P@)W!U="<L("=O<F%N9V4G*3L*"G!R:6YT
M(")/<F%N9V4@5&]T86P](B`N("9S96YD*"1B86<Q+"`G:&]W7VUA;GDG+"`G
M;W)A;F=E)RD@+B`B7&XB.PHF<V5N9"@D8F%G,2P@)V1U;7`G*3L*)G-E;F0H
M)&)A9S$L("=S:&]W7W-E;&8G*3L*"B9S96YD*"1B86<Q+"`G9&5L971E)RP@
M)V]R86YG92<I.PH*<')I;G0@(D]R86YG92!4;W1A;#TB("X@)G-E;F0H)&)A
M9S$L("=H;W=?;6%N>2<L("=O<F%N9V4G*2`N(")<;B(["B9S96YD*"1B86<Q
M+"`G9'5M<"<I.PHF<V5N9"@D8F%G,2P@)W-H;W=?<V5L9B<I.PI`+R]%*D\J
M1B!S86UP;&4S+R\*8VAM;V0@=3UR=W@L9SUR=W@L;SUR>"!S86UP;&4S"B`*
M96-H;R!X("T@<V%M<&QE-`IS960@)W,O7D`O+R<@/B`B<V%M<&QE-"(@/#PG
M0"\O12I/*D8@<V%M<&QE-"\O)PHC(2]U<W(O8FEN+W!E<FP*<F5Q=6ER92`G
M<W1A8VLN<&PG.PH*(R!C<F5A=&4@='=O(&EN<W1A;F-E<R!O9B!C;&%S<R`G
M<W1A8VLG"B1S,2`]("9N97=O8FIE8W0H)W-T86-K)RD["B1S,B`]("9N97=O
M8FIE8W0H)W-T86-K)RD["@HC('!U<V@@:71E;7,@;VYT;R!S=&%C:R`D<S$*
M)G-E;F0H)',Q+"`G<'5S:"<L(#$P*3L*)G-E;F0H)',Q+"`G<'5S:"<L(#(P
M*3L*)G-E;F0H)',Q+"`G<'5S:"<L(#,P*3L*"G!R:6YT(")T;W`@;V8@<W1A
M8VL@,3TB("X@)G-E;F0H)',Q+"`G=&]P)RD@+B`B7&XB.PIP<FEN="`B+2TM
M(&1U;7`@;V8@<W1A8VL@,2`M+2U<;B(["B9S96YD*"1S,2P@)V1U;7`G*3L*
M"B9S96YD*"1S,BP@)W!U<V@G+"`G2&5L;&\L('=O<FQD+B<I.PIP<FEN="`B
M=&]P(&]F('-T86-K(#(](B`N("9S96YD*"1S,BP@)W1O<"<I("X@(EQN(CL*
M"G!R:6YT("(M+2T@<VAO=R!M92`M+2U<;B(["B9S96YD*"1S,2P@)W-H;W=?
M<V5L9B<I.PIP<FEN="`B+2TM('-H;W<@;64@+2TM7&XB.PHF<V5N9"@D<S(L
M("=S:&]W7W-E;&8G*3L*"B9S96YD*"1S,2P@)W!O<"<I.PIP<FEN="`B=&]P
M(&]F('-T86-K(#$](B`N("9S96YD*"1S,2P@)W1O<"<I("X@(EQN(CL*"B9S
M96YD*"1S,2P@)W!O<"<I.PIP<FEN="`B=&]P(&]F('-T86-K(#$](B`N("9S
M96YD*"1S,2P@)W1O<"<I("X@(EQN(CL*"B9S96YD*"1S,2P@)W!O<"<I.PIP
M<FEN="`B=&]P(&]F('-T86-K(#$](B`N("9S96YD*"1S,2P@)W1O<"<I("X@
M(EQN(CL*0"\O12I/*D8@<V%M<&QE-"\O"F-H;6]D('4]<G=X+&<]<G=X+&\]
M<G@@<V%M<&QE-`H@"F5C:&\@>"`M('-A;7!L934*<V5D("=S+UY`+R\G(#X@
M(G-A;7!L934B(#P\)T`O+T4J3RI&('-A;7!L934O+R<*(R$O=7-R+V)I;B]P
M97)L"G)E<75I<F4@)W!O:6YT+G!L)SL*"B1M<V=T<F%C92`](#$[(",@;65S
M<V%G92!T<F%C92!O;@H*(R!C<F5A=&4@82!P;VEN="!`("@Q,"P@,C`I("XN
M+B!S964@)VEN:70G(&UE=&AO9`HD<#$@/2`F;F5W;V)J96-T*"=P;VEN="<L
M(#$P+"`R,"D["B9S96YD*"1P,2P@)W-H;W=?<V5L9B<I.PH*)G-E;F0H)'`Q
M+"`G;6]V92<L(#$P,"P@,3`P*3L*)G-E;F0H)'`Q+"`G<VAO=U]S96QF)RD[
M"@HF<V5N9"@D<#$L("=R;6]V92<L(#(P+"`R,"D["B9S96YD*"1P,2P@)W-H
M;W=?<V5L9B<I.PI`+R]%*D\J1B!S86UP;&4U+R\*8VAM;V0@=3UR=W@L9SUR
9=W@L;SUR>"!S86UP;&4U"B`*97AI="`P"F4U
`
end
--
sakoh@sra.co.jp
"Whereof one cannot speak, thereof one must remain silent." ---Wittgenstein
"Sometimes noise is significant." ---William Hewletttchrist@convex.COM (Tom Christiansen) (02/21/91)
$perl++? (study, study, study): die contented; --tom -- "UNIX was not designed to stop you from doing stupid things, because that would also stop you from doing clever things." -- Doug Gwyn Tom Christiansen tchrist@convex.com convex!tchrist
rbj@uunet.UU.NET (Root Boy Jim) (02/22/91)
sakoh@sraco2.us.sra.co.jp (Hiroshi &) writes: > >Now we have an object-oriented perl! (please allow me to call it OPERL). >Does it sound funny or insane :-) ? Sounds Irish. >Distribution kit is uuencoded since operl.pl contains control characters. Why, pray tell, does source code contain unprintables? Like C and postscript, perl makes it possible to represent unprintables by using \ escapes. It is bad form to do otherwise. I invite you to recode and repost your submission. -- [rbj@uunet 1] stty sane unknown mode: sane
sakoh@sraco2.us.sra.co.jp (Hiroshi &) (02/22/91)
in article <123551@uunet.UU.NET> rbj@uunet.UU.NET (Root Boy Jim) wrote: >>Why, pray tell, does source code contain unprintables? >> >>Like C and postscript, perl makes it possible to represent >>unprintables by using \ escapes. It is bad form to do otherwise. Actually ,the formerly posted source code contains portion like : q^A ... q^A (where ^A represents control-A) for some reason. I dont't think we can use q\001 ... q\001 instead. But you are right. That nuisance should be avoided as much as possible. Here I recode and repost my submission. There are no unprintable characters now. Thank you for your advice. * I don't want to claim that we should incorporate * OO features into perl itself. * I've just present this package as a tiny proof of flexibility of perl * and for fun :-) Hiroshi Sakoh sakoh@sra.co.jp or uunet!sraco1!sakoh ---<cut here>----------------------------------------------- #!/bin/sh # This is a shell archive. Remove anything before this line, # then unpack it by saving it in a file and typing "sh file". # # Wrapped by sraco2! on Fri Feb 22 00:58:00 MST 1991 # Contents: bag.pl operl.pl point.pl set.pl stack.pl sample1 sample2 sample3 # sample4 sample5 sample6 echo x - bag.pl sed 's/^@//' > "bag.pl" <<'@//E*O*F bag.pl//' #!/usr/bin/perl require 'operl.pl'; &defclass ('bag','root'); &defmethod('bag','put', '$elements{$_[0]}++;'); &defmethod('bag','how_many', '$elements{$_[0]};'); &defmethod('bag','kinds', 'keys(%elements);'); &defmethod('bag','delete', 'delete $elements{$_[0]} if --$elements{$_[0]} <= 0;'); &defmethod('bag','has', 'defined($elements{$_[0]})'); &defmethod('bag','size', 'foreach $n (%elements) {$sum += $n;};$sum;'); &defmethod('bag','dump', 'while (($key, $val) = each %elements) {print "$key = $val\n";}'); 1; @//E*O*F bag.pl// chmod u=r,g=r,o=r bag.pl echo x - operl.pl sed 's/^@//' > "operl.pl" <<'@//E*O*F operl.pl//' #!/usr/bin/perl # # $Header: operl.pl,v 1.7 91/02/20 15:43:19 sakoh Locked $ # An experimental object-oriented package for perl. # package operl; require 'dumpvar.pl'; # # an object id = $root . $salt; # $root = 'operl_'; # object id root $salt = 'a'; # object id salt; # # &defclass(class, superclass) # sub main'defclass { local($class) = shift; # class name local($super) = shift; # super class name if (defined($superclass{$super})) { $superclass{$class} = $super; } else { print "no such super class:" . $super . "\n"; } } # # &defmethod(class, method, body) # sub main'defmethod { local($class) = shift; # class name local($method) = shift; # method name local($body) = shift; # method body local($defs); local($result); if (!defined($superclass{$class})) { print "no such class:" . $class . "\n"; return -1; } $methods{$class} .= "$method:"; $defs = qq!sub $class'$method {! . q!local($context) = shift; ! . q!eval "package $context;" . '$self = ' . "$context;"! . qq!. q\001! . $body . qq!\001;};!; $result = eval $defs; print $@ . "\n" unless $@ eq ''; $result; } # # &newobject(class) # sub main'newobject { local($class) = shift; # class name local($newobj); if (!defined($superclass{$class})) { print "no such class:" . $class . "\n"; return -1; } $newobj = $root . $salt++; $myclass{$newobj} = $class; &main'send($newobj, 'init', @_); # call init with args return $newobj; } # # &send(object, method, arg1, arg2, ...) # sub main'send { local($object) = shift; # objec local($method) = shift; # method name local($class, $result, $xyz); if ($main'msgtrace != 0) { $msglevel ++; warn "[$msglevel]:&send($object, $method, @_)"; } if ($object !~ /^operl_/o) { warn "no such object:" . $object . "\n"; $msglevel -- if $main'msgtrace != 0; return -1; } $class = $myclass{$object}; while (index($methods{$class}, "$method:") < 0) { if ($class eq 'root') { warn "unknown message:" . $method . "\n"; $msglevel -- if $main'msgtrace != 0; return undef; } $class = $superclass{$class}; # chain to super class } $xyz = "$class'$method"; # subroutine to be invoked $result = do $xyz($object, @_); # subroutine call print $@ . "\n" unless $@ eq ''; if ($main'msgtrace != 0) { warn " ==> " . (($result eq undef) ? 'undef' : $result) . "\n"; $msglevel --; } $result; } # # &dumpclass() # sub main'dumpclass { while (($key, $val) = each %superclass) { print $key . " is a subclass of " . $val . "\n"; } } # # important built-in : 'root' class # $superclass{'root'} = 'root'; # 'root' is the super class of itself. &main'defmethod('root', 'init', ''); # do nothing &main'defmethod('root', 'class', q! $operl'myclass{$self}; !); &main'defmethod('root', 'show_parents', q! local($class) = $operl'myclass{$self}; while ($class ne 'root') { print $class . " -> "; $class = $operl'superclass{$class}; # chain to the super class } print "root\n"; !); &main'defmethod('root', 'show_self', q! print "class:" . $operl'myclass{$self} . "\n"; print "methods:" . $operl'methods{$operl'myclass{$self}} . "\n"; &main'dumpvar($self); !); # self dump 1; @//E*O*F operl.pl// chmod u=rw,g=r,o=r operl.pl echo x - point.pl sed 's/^@//' > "point.pl" <<'@//E*O*F point.pl//' #!/usr/bin/perl require 'operl.pl'; &defclass ('point','root'); &defmethod('point','init', '$xx = defined($_[0]) ? $_[0] : 0; $yy = defined($_[1]) ? $_[1] : 0;'); &defmethod('point','move', '$xx = defined($_[0]) ? $_[0] : $xx; $yy = defined($_[1]) ? $_[1] : $yy;'); &defmethod('point','movex', '$xx = defined($_[0]) ? $_[0] : $xx;'); &defmethod('point','movey', '$yy = defined($_[0]) ? $_[0] : $yy;'); &defmethod('point','rmove', '$xx += defined($_[0]) ? $_[0] : 0; $yy += defined($_[1]) ? $_[1] : 0;'); &defmethod('point','rmovex', '$xx += defined($_[0]) ? $_[0] : 0;'); &defmethod('point','rmovey', '$yy += defined($_[0]) ? $_[0] : 0;'); &defmethod('point','x', '$xx;'); &defmethod('point','y', '$yy;'); 1; @//E*O*F point.pl// chmod u=r,g=r,o=r point.pl echo x - set.pl sed 's/^@//' > "set.pl" <<'@//E*O*F set.pl//' #!/usr/bin/perl require 'bag.pl'; &defclass ('set','bag'); &defmethod('set','put', '$elements{$_[0]}=1;'); &defmethod('set','size', 'length(%elements);'); 1; @//E*O*F set.pl// chmod u=r,g=r,o=r set.pl echo x - stack.pl sed 's/^@//' > "stack.pl" <<'@//E*O*F stack.pl//' #!/usr/bin/perl require 'operl.pl'; &defclass ('stack','root'); &defmethod('stack','init','$inx = 0'); &defmethod('stack','push','$stk[$inx++] = $_[0];'); &defmethod('stack','pop', 'warn "warn: empty stack.\n" if ($inx <= 0);$inx -- if $inx > 0;'); &defmethod('stack','top', 'warn "warn: empty stack.\n" if ($inx <= 0);$stk[$inx - 1]'); &defmethod('stack','length','$inx;'); &defmethod('stack','dump','foreach $item (@stk) {print "(" . $item . ")\n";}'); 1; @//E*O*F stack.pl// chmod u=r,g=r,o=r stack.pl echo x - sample1 sed 's/^@//' > "sample1" <<'@//E*O*F sample1//' #!/usr/bin/perl require 'operl.pl'; &defclass('hello', 'root'); &defclass('hehe', 'hello'); &defclass('fufu', 'hehe'); &dumpclass(); @//E*O*F sample1// chmod u=rwx,g=rwx,o=rx sample1 echo x - sample2 sed 's/^@//' > "sample2" <<'@//E*O*F sample2//' #!/usr/bin/perl require 'operl.pl'; # define new class 'hello' as subclass of 'root' &defclass ('hello', 'root'); # 'init' method will be invoked on creating an object &defmethod('hello', 'init', '$i = 0;'); # method 'add1' adds 1 to $i &defmethod('hello', 'add1', '$i++;'); # method 'show' shows the value of $i &defmethod('hello', 'show', 'print "-> " . $i . "\n";'); $o1 = &newobject('hello'); $o2 = &newobject('hello'); print "first object=" . $o1 . "\n"; print "second object=" . $o2 . "\n"; print "Apply several operations on $o1\n"; &send($o1, 'add1'); &send($o1, 'show'); &send($o1, 'add1'); &send($o1, 'show'); &send($o1, 'add1'); &send($o1, 'show'); &send($o1, 'add1'); &send($o1, 'show'); print "See? There is no change in $o2\n"; &send($o2, 'show'); &dumpclass(); @//E*O*F sample2// chmod u=rwx,g=rwx,o=rx sample2 echo x - sample3 sed 's/^@//' > "sample3" <<'@//E*O*F sample3//' #!/usr/bin/perl require 'set.pl'; $set1 = &newobject('set'); # Elements can't duplicate in set class $bag1 = &newobject('bag'); # Elements can duplicate in bag class print "** set **\n"; &send($set1, 'put', 'banana'); &send($set1, 'put', 'apple'); &send($set1, 'put', 'orange'); &send($set1, 'put', 'orange'); &send($set1, 'put', 'orange'); print "Orange Total=" . &send($set1, 'how_many', 'orange') . "\n"; &send($set1, 'dump'); &send($set1, 'show_self'); &send($set1, 'delete', 'orange'); print "Orange Total=" . &send($set1, 'how_many', 'orange') . "\n"; &send($set1, 'dump'); &send($set1, 'show_self'); print "** bag **\n"; &send($bag1, 'put', 'banana'); &send($bag1, 'put', 'apple'); &send($bag1, 'put', 'orange'); &send($bag1, 'put', 'orange'); &send($bag1, 'put', 'orange'); print "Orange Total=" . &send($bag1, 'how_many', 'orange') . "\n"; &send($bag1, 'dump'); &send($bag1, 'show_self'); &send($bag1, 'delete', 'orange'); print "Orange Total=" . &send($bag1, 'how_many', 'orange') . "\n"; &send($bag1, 'dump'); &send($bag1, 'show_self'); @//E*O*F sample3// chmod u=rwx,g=rwx,o=rx sample3 echo x - sample4 sed 's/^@//' > "sample4" <<'@//E*O*F sample4//' #!/usr/bin/perl require 'stack.pl'; # create two instances of class 'stack' $s1 = &newobject('stack'); $s2 = &newobject('stack'); # push items onto stack $s1 &send($s1, 'push', 10); &send($s1, 'push', 20); &send($s1, 'push', 30); print "top of stack 1=" . &send($s1, 'top') . "\n"; print "--- dump of stack 1 ---\n"; &send($s1, 'dump'); &send($s2, 'push', 'Hello, world.'); print "top of stack 2=" . &send($s2, 'top') . "\n"; print "--- show me ---\n"; &send($s1, 'show_self'); print "--- show me ---\n"; &send($s2, 'show_self'); &send($s1, 'pop'); print "top of stack 1=" . &send($s1, 'top') . "\n"; &send($s1, 'pop'); print "top of stack 1=" . &send($s1, 'top') . "\n"; &send($s1, 'pop'); print "top of stack 1=" . &send($s1, 'top') . "\n"; @//E*O*F sample4// chmod u=rwx,g=rwx,o=rx sample4 echo x - sample5 sed 's/^@//' > "sample5" <<'@//E*O*F sample5//' #!/usr/bin/perl require 'point.pl'; $msgtrace = 1; # message trace on # create a point @ (10, 20) ... see 'init' method $p1 = &newobject('point', 10, 20); &send($p1, 'show_self'); &send($p1, 'move', 100, 100); &send($p1, 'show_self'); &send($p1, 'rmove', 20, 20); &send($p1, 'show_self'); @//E*O*F sample5// chmod u=rwx,g=rwx,o=rx sample5 echo x - sample6 sed 's/^@//' > "sample6" <<'@//E*O*F sample6//' #!/usr/bin/perl require 'operl.pl'; # define new class 'hello' as subclass of 'root' &defclass ('hello', 'root'); # 'init' method will be invoked on creating an object &defmethod('hello', 'init', '$i = 0;'); # method 'add1' adds 1 to $i &defmethod('hello', 'add1', '$i++;'); # method 'show' shows the value of $i &defmethod('hello', 'show', 'print "-> " . $i . "\n";'); # define new class 'hello2' as subclass of 'hello' &defclass ('hello2', 'hello'); # method 'add2' adds 2 to itself (send add1 to self twice) # you can refer to the current object as $self &defmethod('hello', 'add2', <<'METHOD' ); &main'send($self, 'add1'); &main'send($self, 'add1'); METHOD $o1 = &newobject('hello2'); &send($o1, 'show'); &send($o1, 'add2'); &send($o1, 'show'); @//E*O*F sample6// chmod u=rwx,g=rwx,o=rx sample6 exit 0 -- sakoh@sra.co.jp "Whereof one cannot speak, thereof one must remain silent." ---Wittgenstein "Sometimes noise is significant." ---William Hewlett
kayvan@apple.com (Kayvan Sylvan) (02/23/91)
Cool!!! I like it a lot!!! Larry has created a monster, and there are other people all around the world adding arms and legs and various other body parts to it... ---Kayvan | Kayvan Sylvan Unix/C, GNU tools 879 Lewiston Drive 408-978-1407 | | Sylvan Associates GUIs, Databases San Jose, CA 95136 Think Globally | | Networking, X apple!satyr!kayvan Act Locally | | === Currently looking for contracts === Hire me now! Avoid the rush! === |