home *** CD-ROM | disk | FTP | other *** search
/ Peanuts NeXT Software Archives / Peanuts-2.iso / Developer / webobjects / extensions / win-nt / WOPerl-lite-10e7.exe / Libraries / perl5 / WOPerl.pm
Encoding:
Perl POD Document  |  1996-08-09  |  2.4 KB  |  96 lines
  1. # $Id: WOPerl.PPM,v 1.2 1996/08/06 07:37:36 pedja Exp $ -*-perl-*-
  2. # Copyright 1995-6 TipTop Software
  3.  
  4. # $Id: ObjPerl.PPM,v 1.2 1996/08/06 06:37:06 pedja Exp $ -*-perl-*-
  5. # Copyright 1995-6 TipTop Software
  6. #############################################################################
  7. package ObjPerl;
  8.  
  9. require 5.001;
  10.  
  11. require Exporter;
  12. require DynaLoader;
  13. require AutoLoader;
  14.  
  15. $VERSION = "3.1";
  16.  
  17. $VERSION=$VERSION;
  18.  
  19. @ISA = qw(Exporter DynaLoader AutoLoader);
  20.  
  21. @EXPORT = qw(
  22.     msg_send msg_send_super class_lookup class
  23.     nil object_is_bad
  24.     ivar_get ivar_set ivar
  25.     pl obj
  26.  
  27. );
  28.  
  29. @EXPORT_OK = qw($interp %CONTROL);
  30.  
  31. sub EVAL { my @r=eval $_[0]; if($@) { my($err)=$@; $@=""; die $err; }; @r; };
  32. sub SOURCE { my @r=do $_[0]; if($@) { my($err)=$@; $@=""; die $err; }; @r; };
  33.  
  34. ############################################################################
  35. package ObjPerl::Object;
  36.  
  37. %OVERLOAD = (
  38.     'fallback' => TRUE,
  39.     '""' => \&Id_2_String,
  40.     '0+' => \&Id_2_Number,
  41.     'bool' => \&Id_2_Boolean,
  42.     '==' => \&Id_Is_Same,
  43.     '!=' => \&Id_Is_Not_Same,
  44.     'eq' => \&Id_Is_Equal,
  45.     'ne' => \&Id_Is_Not_Equal,
  46.  
  47. # Incr/Decr kludge (Perl 5.001, 5.002):
  48.     '++' => sub { $_[0]=&Id_2_Number($_[0])+1; },
  49. #    '++' => sub { $_[0]=ObjPerl::obj(&Id_2_Number($_[0])+1); },
  50.     '--' => sub { $_[0]=&Id_2_Number($_[0])-1; },
  51. #    '--' => sub { $_[0]=ObjPerl::obj(&Id_2_Number($_[0])-1); },
  52.     '=' => sub { return $_[0]; },
  53.  
  54. # Perl 5.001 neg kludge:
  55.     'neg' => sub { return -&Id_2_Number($_[0]); },
  56.  
  57. );
  58.  
  59. sub DESCR {
  60.   my($self)=shift;
  61.   my($bad)=ObjPerl::object_is_bad($self);
  62.   return "<BAD OBJECT: $bad>" if $bad;
  63.   return "nil" if ObjPerl::nil($self);
  64.   if($self==$self->class() && $self->respondsTo_('name')) {
  65.     return $self->name if $self==ObjPerl::class_lookup($self->name); # class
  66.     return "#" . $self->name; # meta-class
  67.   };
  68.   if($self->respondsTo_('description')) {
  69.     my $pool=class('NSAutoreleasePool')->alloc->init;
  70.     my $r=$self->description->cString;
  71.     $pool->release;
  72.     return $r;
  73.   }
  74.   return sprintf("<%s:0x%s>",$self->name,$$self);
  75. }
  76.  
  77. # EOF
  78.  
  79. #############################################################################
  80. package WOPerl;
  81. require Exporter;
  82. require DynaLoader;
  83.  
  84. import ObjPerl qw(:DEFAULT $interp %CONTROL);
  85.  
  86. @ISA = qw(Exporter DynaLoader);
  87.  
  88. $VERSION = "1.0" ;
  89. @EXPORT = @ObjPerl::EXPORT; push @EXPORT, qw($WOApp);
  90. @EXPORT_OK = @ObjPerl::EXPORT_OK;
  91.  
  92. bootstrap WOPerl $VERSION;
  93.  
  94. 1;
  95. __END__
  96.