Changeset 1cf32e7d for perlwrap.pm


Ignore:
Timestamp:
Mar 28, 2007, 9:32:11 PM (14 years ago)
Author:
Nelson Elhage <nelhage@mit.edu>
Branches:
master, barnowl_perlaim, debian, release-1.4, release-1.5, release-1.6, release-1.7, release-1.8, release-1.9
Children:
b3a40c7
Parents:
3066d23 (diff), a387d12e (diff)
Note: this is a merge changeset, the changes displayed below correspond to the merge itself.
Use the (diff) links above to see all the changes relative to each parent.
Message:
Merging the PAR branch back to trunk.

r20272@phanatique (orig r665):  nelhage | 2007-03-14 19:25:05 -0400
 Branching for the PAR module rewrite.
 r20274@phanatique (orig r667):  nelhage | 2007-03-16 00:45:19 -0400
 First phase of the module rewrite. Internals now (IMO) somewhat
 cleaner.
 
  r19586@phanatique:  nelhage | 2007-03-14 20:35:39 -0400
  First pass at a cleaned up perlwrap.pm
  
  * Using a new hook style
  * Modules loaded by BarnOwl::ModuleLoader (not yet written)
  
  reload is unimplemented for now. If possible, I'd like it to live
  elsewhere.
  
  r19587@phanatique:  nelhage | 2007-03-14 20:36:58 -0400
  Switching to the new underscore internal hook names.
  r19592@phanatique:  nelhage | 2007-03-16 00:34:00 -0400
  Actually switch to _receive_msg
  
  r19593@phanatique:  nelhage | 2007-03-16 00:34:27 -0400
  Some minor cleanup of perlwrap.pm. Shoving fake entries into @INC.
  
  r19594@phanatique:  nelhage | 2007-03-16 00:34:47 -0400
  First revision of ModuleLoader.
  
 
 r20281@phanatique (orig r669):  nelhage | 2007-03-17 14:48:02 -0400
  r20279@phanatique:  nelhage | 2007-03-17 14:46:56 -0400
  For reasons I don't claim to understand, using the old-style new was
  throwing odd errors about undefined functions.
  
 
 r20286@phanatique (orig r670):  nelhage | 2007-03-18 16:28:23 -0400
  r20282@phanatique:  nelhage | 2007-03-17 14:48:22 -0400
  Report more errors when something goes wrong
  
 
 r20287@phanatique (orig r671):  nelhage | 2007-03-18 16:28:31 -0400
  r20285@phanatique:  nelhage | 2007-03-18 16:28:18 -0400
  Adding the new M::Iified jabber module. There isn't a target to build
  the PAR yet.
 
 r20291@phanatique (orig r672):  nelhage | 2007-03-18 19:14:04 -0400
  r20290@phanatique:  nelhage | 2007-03-18 19:13:57 -0400
  Adding a Module::Install plugin for building barnowl plugins. It needs
  a lot of improvement.
 
 r20309@phanatique (orig r673):  nelhage | 2007-03-19 14:14:23 -0400
  r20301@phanatique:  nelhage | 2007-03-19 13:31:07 -0400
  Changing the dependency on the par target, so we don't rebuild unless
  we need to.
 
 r20310@phanatique (orig r674):  nelhage | 2007-03-19 14:14:33 -0400
  r20303@phanatique:  nelhage | 2007-03-19 13:32:25 -0400
  Modifying the makefile to build and install perl modules
 
 r20643@phanatique (orig r677):  nelhage | 2007-03-23 15:09:45 -0400
  r20640@phanatique:  nelhage | 2007-03-23 15:09:38 -0400
  Implement loading of unpacked modules, and module reloading.
 
 r20645@phanatique (orig r678):  nelhage | 2007-03-23 15:11:05 -0400
  r20644@phanatique:  nelhage | 2007-03-23 15:10:57 -0400
  Tighten up the reloaded regex a little.
  
 
 r20649@phanatique (orig r679):  nelhage | 2007-03-23 16:18:44 -0400
  r20648@phanatique:  nelhage | 2007-03-23 16:18:25 -0400
  Correctly install modules on a clean install.
  
 
 r20655@phanatique (orig r680):  nelhage | 2007-03-25 12:53:07 -0400
  r20650@phanatique:  nelhage | 2007-03-23 17:01:20 -0400
  Still not sure why old-style new seems to be eiting us so much...
  
 
 r20656@phanatique (orig r681):  nelhage | 2007-03-25 12:53:11 -0400
  r20653@phanatique:  nelhage | 2007-03-25 12:52:38 -0400
  Let's not segfault if the user asks for a nonexistant style in .owl/startup
  
 
 r20657@phanatique (orig r682):  nelhage | 2007-03-25 12:53:16 -0400
  r20654@phanatique:  nelhage | 2007-03-25 12:52:59 -0400
  That line doesn't need to be there twice -- probably a mismerge
  
 
 r20706@phanatique (orig r683):  nelhage | 2007-03-26 21:04:43 -0400
  r20704@phanatique:  nelhage | 2007-03-26 20:00:24 -0400
  We don't need two package lines..
  
 
 r20707@phanatique (orig r684):  nelhage | 2007-03-26 21:04:54 -0400
  r20705@phanatique:  nelhage | 2007-03-26 21:04:37 -0400
  Getting rid of indirect object syntax new calls. Quoting perlobj:
  
  > But what if there are no arguments? In that case, Perl must guess what
  > you want. Even worse, it must make that guess *at compile time*. Usually
  > Perl gets it right, but when it doesn't you get a function call compiled
  > as a method, or vice versa. This can introduce subtle bugs that are hard
  > to detect.
  > 
  > For example, a call to a method "new" in indirect notation -- as C++
  > programmers are wont to make -- can be miscompiled into a subroutine
  > call if there's already a "new" function in scope. You'd end up calling
  > the current package's "new" as a subroutine, rather than the desired
  > class's method. The compiler tries to cheat by remembering bareword
  > "require"s, but the grief when it messes up just isn't worth the years
  > of debugging it will take you to track down such subtle bugs.
      
 
 r20710@phanatique (orig r685):  nelhage | 2007-03-26 21:14:41 -0400
  r20708@phanatique:  nelhage | 2007-03-26 21:11:34 -0400
  Adding a reload-modules command
  
 
 r20711@phanatique (orig r686):  nelhage | 2007-03-26 21:14:49 -0400
  r20709@phanatique:  nelhage | 2007-03-26 21:14:31 -0400
  Moving Net::Jabber into Jabber.par
 
 r20714@phanatique (orig r687):  nelhage | 2007-03-26 21:18:13 -0400
  r20713@phanatique:  nelhage | 2007-03-26 21:17:59 -0400
  Don't install .svn dirs
  
 
 r20720@phanatique (orig r688):  nelhage | 2007-03-27 22:04:10 -0400
  r20719@phanatique:  nelhage | 2007-03-27 22:04:03 -0400
  Implementing an LRU cache of the message list fmtexts. This reduces
  memory usage by roughly 1MB/kilo-zephyrs in steady state.
 

 r20272@phanatique (orig r665):  nelhage | 2007-03-14 19:25:05 -0400
 Branching for the PAR module rewrite.
 r20274@phanatique (orig r667):  nelhage | 2007-03-16 00:45:19 -0400
 First phase of the module rewrite. Internals now (IMO) somewhat
 cleaner.
 
  r19586@phanatique:  nelhage | 2007-03-14 20:35:39 -0400
  First pass at a cleaned up perlwrap.pm
  
  * Using a new hook style
  * Modules loaded by BarnOwl::ModuleLoader (not yet written)
  
  reload is unimplemented for now. If possible, I'd like it to live
  elsewhere.
  
  r19587@phanatique:  nelhage | 2007-03-14 20:36:58 -0400
  Switching to the new underscore internal hook names.
  r19592@phanatique:  nelhage | 2007-03-16 00:34:00 -0400
  Actually switch to _receive_msg
  
  r19593@phanatique:  nelhage | 2007-03-16 00:34:27 -0400
  Some minor cleanup of perlwrap.pm. Shoving fake entries into @INC.
  
  r19594@phanatique:  nelhage | 2007-03-16 00:34:47 -0400
  First revision of ModuleLoader.
  
 
 r20281@phanatique (orig r669):  nelhage | 2007-03-17 14:48:02 -0400
  r20279@phanatique:  nelhage | 2007-03-17 14:46:56 -0400
  For reasons I don't claim to understand, using the old-style new was
  throwing odd errors about undefined functions.
  
 
 r20286@phanatique (orig r670):  nelhage | 2007-03-18 16:28:23 -0400
  r20282@phanatique:  nelhage | 2007-03-17 14:48:22 -0400
  Report more errors when something goes wrong
  
 
 r20287@phanatique (orig r671):  nelhage | 2007-03-18 16:28:31 -0400
  r20285@phanatique:  nelhage | 2007-03-18 16:28:18 -0400
  Adding the new M::Iified jabber module. There isn't a target to build
  the PAR yet.
 
 r20291@phanatique (orig r672):  nelhage | 2007-03-18 19:14:04 -0400
  r20290@phanatique:  nelhage | 2007-03-18 19:13:57 -0400
  Adding a Module::Install plugin for building barnowl plugins. It needs
  a lot of improvement.
 
 r20309@phanatique (orig r673):  nelhage | 2007-03-19 14:14:23 -0400
  r20301@phanatique:  nelhage | 2007-03-19 13:31:07 -0400
  Changing the dependency on the par target, so we don't rebuild unless
  we need to.
 
 r20310@phanatique (orig r674):  nelhage | 2007-03-19 14:14:33 -0400
  r20303@phanatique:  nelhage | 2007-03-19 13:32:25 -0400
  Modifying the makefile to build and install perl modules
 
 r20643@phanatique (orig r677):  nelhage | 2007-03-23 15:09:45 -0400
  r20640@phanatique:  nelhage | 2007-03-23 15:09:38 -0400
  Implement loading of unpacked modules, and module reloading.
 
 r20645@phanatique (orig r678):  nelhage | 2007-03-23 15:11:05 -0400
  r20644@phanatique:  nelhage | 2007-03-23 15:10:57 -0400
  Tighten up the reloaded regex a little.
  
 
 r20649@phanatique (orig r679):  nelhage | 2007-03-23 16:18:44 -0400
  r20648@phanatique:  nelhage | 2007-03-23 16:18:25 -0400
  Correctly install modules on a clean install.
  
 
 r20655@phanatique (orig r680):  nelhage | 2007-03-25 12:53:07 -0400
  r20650@phanatique:  nelhage | 2007-03-23 17:01:20 -0400
  Still not sure why old-style new seems to be eiting us so much...
  
 
 r20656@phanatique (orig r681):  nelhage | 2007-03-25 12:53:11 -0400
  r20653@phanatique:  nelhage | 2007-03-25 12:52:38 -0400
  Let's not segfault if the user asks for a nonexistant style in .owl/startup
  
 
 r20657@phanatique (orig r682):  nelhage | 2007-03-25 12:53:16 -0400
  r20654@phanatique:  nelhage | 2007-03-25 12:52:59 -0400
  That line doesn't need to be there twice -- probably a mismerge
  
 
 r20706@phanatique (orig r683):  nelhage | 2007-03-26 21:04:43 -0400
  r20704@phanatique:  nelhage | 2007-03-26 20:00:24 -0400
  We don't need two package lines..
  
 
 r20707@phanatique (orig r684):  nelhage | 2007-03-26 21:04:54 -0400
  r20705@phanatique:  nelhage | 2007-03-26 21:04:37 -0400
  Getting rid of indirect object syntax new calls. Quoting perlobj:
  
  > But what if there are no arguments? In that case, Perl must guess what
  > you want. Even worse, it must make that guess *at compile time*. Usually
  > Perl gets it right, but when it doesn't you get a function call compiled
  > as a method, or vice versa. This can introduce subtle bugs that are hard
  > to detect.
  > 
  > For example, a call to a method "new" in indirect notation -- as C++
  > programmers are wont to make -- can be miscompiled into a subroutine
  > call if there's already a "new" function in scope. You'd end up calling
  > the current package's "new" as a subroutine, rather than the desired
  > class's method. The compiler tries to cheat by remembering bareword
  > "require"s, but the grief when it messes up just isn't worth the years
  > of debugging it will take you to track down such subtle bugs.
      
 
 r20710@phanatique (orig r685):  nelhage | 2007-03-26 21:14:41 -0400
  r20708@phanatique:  nelhage | 2007-03-26 21:11:34 -0400
  Adding a reload-modules command
  
 
 r20711@phanatique (orig r686):  nelhage | 2007-03-26 21:14:49 -0400
  r20709@phanatique:  nelhage | 2007-03-26 21:14:31 -0400
  Moving Net::Jabber into Jabber.par
 
 r20714@phanatique (orig r687):  nelhage | 2007-03-26 21:18:13 -0400
  r20713@phanatique:  nelhage | 2007-03-26 21:17:59 -0400
  Don't install .svn dirs
  
 
 r20720@phanatique (orig r688):  nelhage | 2007-03-27 22:04:10 -0400
  r20719@phanatique:  nelhage | 2007-03-27 22:04:03 -0400
  Implementing an LRU cache of the message list fmtexts. This reduces
  memory usage by roughly 1MB/kilo-zephyrs in steady state.
 
File:
1 edited

Legend:

Unmodified
Added
Removed
  • perlwrap.pm

    r37dd88c r1cf32e7d  
    77# XXX NOTE: This file is sourced before almost any barnowl
    88# architecture is loaded. This means, for example, that it cannot
    9 # execute any owl commands. Any code that needs to do so, should
    10 # create a function wrapping it and push it onto @onStartSubs
    11 
     9# execute any owl commands. Any code that needs to do so should live
     10# in BarnOwl::Hooks::_startup
    1211
    1312use strict;
     
    1514
    1615package BarnOwl;
    17 
    1816
    1917BEGIN {
     
    4442    my ($m) = @_;
    4543    $m->legacy_populate_global();
    46     return &BarnOwl::Hooks::receive_msg($m);
     44    return &BarnOwl::Hooks::_receive_msg($m);
    4745}
    4846
     
    204202
    205203sub smartfilter {
    206     die("smartfilter not supported for this message");
     204    die("smartfilter not supported for this message\n");
    207205}
    208206
     
    351349#####################################################################
    352350################################################################################
    353 package BarnOwl;
    354 
    355 ################################################################################
    356 # Mainloop hook
    357 ################################################################################
    358 
    359 our $shutdown;
    360 $shutdown = 0;
    361 our $reload;
    362 $reload = 0;
    363 
    364 #Run this on start and reload. Adds modules
    365 sub onStart
    366 {
    367     _load_owlconf();
    368     reload_init();
    369     loadModules();
    370 }
    371 ################################################################################
    372 # Reload Code, taken from /afs/sipb/user/jdaniel/project/owl/perl
    373 ################################################################################
    374 sub reload_hook (@)
    375 {
    376     BarnOwl::Hooks::startup();
    377     return 1;
    378 }
    379 
    380 sub reload
    381 {
    382     # Use $reload to tell modules that we're performing a reload.
    383   {
    384       local $reload = 1;
    385       BarnOwl::mainloop_hook() if *BarnOwl::mainloop_hook{CODE};
    386   }
    387 
    388   @BarnOwl::Hooks::onMainLoop = ();
    389   @BarnOwl::Hooks::onStartSubs = ();
    390 
    391   # Do reload
    392   package main;
    393   if (-r $BarnOwl::configfile) {
    394       undef $@;
    395       do $BarnOwl::configfile;
    396       BarnOwl::error("Error reloading $BarnOwl::configfile: $@") if $@;
    397   }
    398   BarnOwl::reload_hook(@_);
    399   package BarnOwl;
    400 }
    401 
    402 sub reload_init ()
    403 {
    404     BarnOwl::command('alias reload perl BarnOwl::reload()');
    405     BarnOwl::command('bindkey global "C-x C-r" command reload');
    406 }
    407 
    408 ################################################################################
    409 # Loads modules from ~/.owl/modules and owl's data directory
    410 ################################################################################
    411 
    412 sub loadModules () {
    413     my @modules;
    414     my $rv;
    415     foreach my $dir ( BarnOwl::get_data_dir() . "/modules",
    416                       $ENV{HOME} . "/.owl/modules" )
    417     {
    418         opendir( MODULES, $dir );
    419 
    420         # source ./modules/*.pl
    421         @modules = sort grep( /\.pl$/, readdir(MODULES) );
    422 
    423         foreach my $mod (@modules) {
    424             unless ($rv = do "$dir/$mod") {
    425                 BarnOwl::error("Couldn't load $dir/$mod:\n $@") if $@;
    426                 BarnOwl::error("Couldn't run $dir/$mod:\n $!") unless defined $rv;
    427             }
    428         }
    429         closedir(MODULES);
    430     }
    431 }
     351
     352package BarnOwl::Hook;
     353
     354sub new {
     355    my $class = shift;
     356    return bless [], $class;
     357}
     358
     359sub run {
     360    my $self = shift;
     361    my @args = @_;
     362    return map {$_->(@args)} @$self;
     363}
     364
     365sub add {
     366    my $self = shift;
     367    my $func = shift;
     368    die("Not a coderef!") unless ref($func) eq 'CODE';
     369    push @$self, $func;
     370}
     371
     372sub clear {
     373    my $self = shift;
     374    @$self = ();
     375}
     376
     377package BarnOwl::Hooks;
     378
     379use Exporter;
     380
     381our @EXPORT_OK = qw($startup $shutdown
     382                    $receiveMessage $mainLoop
     383                    $getBuddyList);
     384
     385our %EXPORT_TAGS = (all => [@EXPORT_OK]);
     386
     387our $startup = BarnOwl::Hook->new;
     388our $shutdown = BarnOwl::Hook->new;
     389our $receiveMessage = BarnOwl::Hook->new;
     390our $mainLoop = BarnOwl::Hook->new;
     391our $getBuddyList = BarnOwl::Hook->new;
     392
     393# Internal startup/shutdown routines called by the C code
    432394
    433395sub _load_owlconf {
    434     # Only do this the first time
    435     return if $BarnOwl::reload;
    436396    # load the config  file
    437397    if ( -r $BarnOwl::configfile ) {
     
    451411}
    452412
    453 package BarnOwl::Hooks;
    454 
    455 # Arrays of subrefs to be called at specific times.
    456 our @onStartSubs = ();
    457 our @onReceiveMsg = ();
    458 our @onMainLoop = ();
    459 our @onGetBuddyList = ();
    460 
    461 # Functions to call hook lists
    462 sub runHook($@)
    463 {
    464     my $hook = shift;
    465     my @args = @_;
    466     $_->(@args) for (@$hook);
    467 }
    468 
    469 sub runHook_accumulate($@)
    470 {
    471     my $hook = shift;
    472     my @args = @_;
    473     return join("\n", map {$_->(@args)} @$hook);
    474 }
    475 
    476 ################################################################################
    477 # Startup and Shutdown code
    478 ################################################################################
    479 sub startup
    480 {
    481     # Modern versions of owl provides a great place to have startup stuff.
    482     # Put things in ~/.owl/startup
    483 
    484     #So that the user's .owlconf can have startsubs, we don't clear
    485     #onStartSubs; reload does however
    486     @onReceiveMsg = ();
    487     @onMainLoop = ();
    488     @onGetBuddyList = ();
    489 
    490     BarnOwl::onStart();
    491 
    492     runHook(\@onStartSubs);
    493 
     413sub _startup {
     414    _load_owlconf();
     415
     416    if(eval {require BarnOwl::ModuleLoader}) {
     417        eval {
     418            BarnOwl::ModuleLoader->load_all;
     419        };
     420        BarnOwl::error("Error loading modules: $@") if $@;
     421    } else {
     422        BarnOwl::error("Can't load BarnOwl::ModuleLoader, loadable module support disabled:\n$@");
     423    }
     424   
     425    $startup->run(0);
    494426    BarnOwl::startup() if *BarnOwl::startup{CODE};
    495427}
    496428
    497 sub shutdown
    498 {
    499 # Modern versions of owl provides a great place to have shutdown stuff.
    500 # Put things in ~/.owl/shutdown
    501 
    502     # use $shutdown to tell modules that that's what we're doing.
    503     $BarnOwl::shutdown = 1;
     429sub _shutdown {
     430    $shutdown->run;
     431   
     432    BarnOwl::shutdown() if *BarnOwl::shutdown{CODE};
     433}
     434
     435sub _receive_msg {
     436    my $m = shift;
     437
     438    $receiveMessage->run($m);
     439   
     440    BarnOwl::receive_msg($m) if *BarnOwl::receive_msg{CODE};
     441}
     442
     443sub _mainloop_hook {
     444    $mainLoop->run;
    504445    BarnOwl::mainloop_hook() if *BarnOwl::mainloop_hook{CODE};
    505 
    506     BarnOwl::shutdown() if *BarnOwl::shutdown{CODE};
    507 }
    508 
    509 sub mainloop_hook
    510 {
    511     runHook(\@onMainLoop);
    512     BarnOwl::mainloop_hook() if *BarnOwl::mainloop_hook{CODE};
    513 }
    514 
    515 ################################################################################
    516 # Hooks into receive_msg()
    517 ################################################################################
    518 
    519 sub receive_msg
    520 {
    521     my $m = shift;
    522     runHook(\@onReceiveMsg, $m);
    523     BarnOwl::receive_msg($m) if *BarnOwl::receive_msg{CODE};
    524 }
    525 
    526 ################################################################################
    527 # Hooks into get_blist()
    528 ################################################################################
    529 
    530 sub get_blist
    531 {
    532     return runHook_accumulate(\@onGetBuddyList);
     446}
     447
     448sub _get_blist {
     449    return join("\n", $getBuddyList->run);
    533450}
    534451
     
    644561# switch to package main when we're done
    645562package main;
    646 # alias the hooks
    647 {
    648     no strict 'refs';
    649     foreach my $hook  qw (onStartSubs
    650                           onReceiveMsg
    651                           onMainLoop
    652                           onGetBuddyList ) {
    653         *{"main::".$hook} = \*{"BarnOwl::Hooks::".$hook};
    654         *{"owl::".$hook} = \*{"BarnOwl::Hooks::".$hook};
    655     }
    656 }
     563
     564# Shove a bunch of fake entries into @INC so modules can use or
     565# require them without choking
     566$::INC{$_} = 1 for (qw(BarnOwl.pm BarnOwl/Hooks.pm
     567                       BarnOwl/Message.pm BarnOwl/Style.pm));
    657568
    6585691;
     570
Note: See TracChangeset for help on using the changeset viewer.