/* This file was autogenerated from perlwrap.pm.  DO NOT EDIT !!!! */

char *owl_perlwrap_codebuff = 
   "# $Id: perlwrap.pm 1118 2008-08-26 00:11:16Z nelhage $\n"
   "#\n"
   "# This is all linked into the binary and evaluated when perl starts up...\n"
   "#\n"
   "#####################################################################\n"
   "#####################################################################\n"
   "# XXX NOTE: This file is sourced before almost any barnowl\n"
   "# architecture is loaded. This means, for example, that it cannot\n"
   "# execute any owl commands. Any code that needs to do so should live\n"
   "# in BarnOwl::Hooks::_startup\n"
   "\n"
   "use strict;\n"
   "use warnings;\n"
   "\n"
   "package BarnOwl;\n"
   "\n"
   "=head1 NAME\n"
   "\n"
   "BarnOwl\n"
   "\n"
   "=head1 DESCRIPTION\n"
   "\n"
   "The BarnOwl module contains the core of BarnOwl's perl\n"
   "bindings. Source in this module is also run at startup to bootstrap\n"
   "barnowl by defining things like the default style.\n"
   "\n"
   "=for NOTE\n"
   "These following functions are defined in perlglue.xs. Keep the\n"
   "documentation here in sync with the user-visible commands defined\n"
   "there!\n"
   "\n"
   "=head2 command STRING\n"
   "\n"
   "Executes a BarnOwl command in the same manner as if the user had\n"
   "executed it at the BarnOwl command prompt. If the command returns a\n"
   "value, return it as a string, otherwise return undef.\n"
   "\n"
   "=head2 getcurmsg\n"
   "\n"
   "Returns the current message as a C<BarnOwl::Message> subclass, or\n"
   "undef if there is no message selected\n"
   "\n"
   "=head2 getnumcols\n"
   "\n"
   "Returns the width of the display window BarnOwl is currently using\n"
   "\n"
   "=head2 getidletime\n"
   "\n"
   "Returns the length of time since the user has pressed a key, in\n"
   "seconds.\n"
   "\n"
   "=head2 zephyr_getrealm\n"
   "\n"
   "Returns the zephyr realm barnowl is running in\n"
   "\n"
   "=head2 zephyr_getsender\n"
   "\n"
   "Returns the fully-qualified name of the zephyr sender barnowl is\n"
   "running as, e.g. C<nelhage@ATHENA.MIT.EDU>\n"
   "\n"
   "=head2 zephyr_zwrite COMMAND MESSAGE\n"
   "\n"
   "Sends a zephyr programmatically. C<COMMAND> should be a C<zwrite>\n"
   "command line, and C<MESSAGE> is the zephyr body to send.\n"
   "\n"
   "=head2 ztext_stylestrip STRING\n"
   "\n"
   "Strips zephyr formatting from a string and returns the result\n"
   "\n"
   "=head2 zephyr_getsubs\n"
   "\n"
   "Returns the list of subscription triples <class,instance,recipient>,\n"
   "separated by newlines.\n"
   "\n"
   "=head2 queue_message MESSAGE\n"
   "\n"
   "Enqueue a message in the BarnOwl message list, logging it and\n"
   "processing it appropriately. C<MESSAGE> should be an instance of\n"
   "BarnOwl::Message or a subclass.\n"
   "\n"
   "=head2 admin_message HEADER BODY\n"
   "\n"
   "Display a BarnOwl B<Admin> message, with the given header and body.\n"
   "\n"
   "=head2 start_question PROMPT CALLBACK\n"
   "\n"
   "Displays C<PROMPT> on the screen and lets the user enter a line of\n"
   "text, and calls C<CALLBACK>, which must be a perl subroutine\n"
   "reference, with the text the user entered\n"
   "\n"
   "=head2 start_password PROMPT CALLBACK\n"
   "\n"
   "Like C<start_question>, but echoes the user's input as C<*>s when they\n"
   "input.\n"
   "\n"
   "=head2 start_edit_win PROMPT CALLBACK\n"
   "\n"
   "Like C<start_question>, but displays C<PROMPT> on a line of its own\n"
   "and opens the editwin. If the user cancels the edit win, C<CALLBACK>\n"
   "is not invoked.\n"
   "\n"
   "=head2 get_data_dir\n"
   "\n"
   "Returns the BarnOwl system data directory, where system libraries and\n"
   "modules are stored\n"
   "\n"
   "=head2 get_config_dir\n"
   "\n"
   "Returns the BarnOwl user configuration directory, where user modules\n"
   "and configuration are stored (by default, C<$HOME/.owl>)\n"
   "\n"
   "=head2 popless_text TEXT\n"
   "\n"
   "Show a popup window containing the given C<TEXT>\n"
   "\n"
   "=head2 popless_ztext TEXT\n"
   "\n"
   "Show a popup window containing the provided zephyr-formatted C<TEXT>\n"
   "\n"
   "=head2 error STRING\n"
   "\n"
   "Reports an error and log it in `show errors'. Note that in any\n"
   "callback or hook called in perl code from BarnOwl, a C<die> will be\n"
   "caught and passed to C<error>.\n"
   "\n"
   "=head2 getnumcolors\n"
   "\n"
   "Returns the number of colors this BarnOwl is capable of displaying\n"
   "\n"
   "=head2 add_dispatch FD CALLBACK\n"
   "\n"
   "Adds a file descriptor to C<BarnOwl>'s internal C<select()>\n"
   "loop. C<CALLBACK> will be invoked whenever data is available to be\n"
   "read from C<FD>.\n"
   "\n"
   "=head2 remove_dispatch FD\n"
   "\n"
   "Remove a file descriptor previously registered via C<add_dispatch>\n"
   "\n"
   "=head2 create_style NAME OBJECT\n"
   "\n"
   "Creates a new barnowl style with the given NAME defined by the given\n"
   "object. The object must have a C<description> method which returns a\n"
   "string description of the style, and a and C<format_message> method\n"
   "which accepts a C<BarnOwl::Message> object and returns a string that\n"
   "is the result of formatting the message for display.\n"
   "\n"
   "=cut\n"
   "\n"
   "\n"
   "BEGIN {\n"
   "# bootstrap in C bindings and glue\n"
   "    *owl:: = \\*BarnOwl::;\n"
   "    bootstrap BarnOwl 1.2;\n"
   "};\n"
   "\n"
   "use lib(get_data_dir() . \"/lib\");\n"
   "use lib(get_config_dir() . \"/lib\");\n"
   "\n"
   "# perlconfig.c will set this to the value of the -c command-line\n"
   "# switch, if present.\n"
   "our $configfile;\n"
   "\n"
   "if(!$configfile && -f $ENV{HOME} . \"/.barnowlconf\") {\n"
   "    $configfile = $ENV{HOME} . \"/.barnowlconf\";\n"
   "}\n"
   "$configfile ||= $ENV{HOME}.\"/.owlconf\";\n"
   "\n"
   "# populate global variable space for legacy owlconf files\n"
   "sub _receive_msg_legacy_wrap {\n"
   "    my ($m) = @_;\n"
   "    $m->legacy_populate_global();\n"
   "    return &BarnOwl::Hooks::_receive_msg($m);\n"
   "}\n"
   "\n"
   "=head2 AUTOLOAD\n"
   "\n"
   "BarnOwl.pm has a C<AUTOLOAD> method that translates unused names in\n"
   "the BarnOwl:: namespace to a call to BarnOwl::command() with that\n"
   "command. Underscores are also translated to C<->s, so you can do\n"
   "e.g. C<BarnOwl::start_command()> and it will be translated into\n"
   "C<start-command>.\n"
   "\n"
   "So, if you're looking for functionality that you can't find in the\n"
   "perl interface, check C<:show commands> or C<commands.c> in the\n"
   "BarnOwl source tree -- there's a good chance it exists as a BarnOwl\n"
   "command.\n"
   "\n"
   "=head3 BUGS\n"
   "\n"
   "There are horrible quoting issues here. The AUTOLOAD simple joins your\n"
   "commands with spaces and passes them unmodified to C<::command>\n"
   "\n"
   "=cut\n"
   "\n"
   "# make BarnOwl::<command>(\"foo\") be aliases to BarnOwl::command(\"<command> foo\");\n"
   "sub AUTOLOAD {\n"
   "    our $AUTOLOAD;\n"
   "    my $called = $AUTOLOAD;\n"
   "    $called =~ s/.*:://;\n"
   "    $called =~ s/_/-/g;\n"
   "    return &BarnOwl::command(\"$called \".join(\" \",@_));\n"
   "}\n"
   "\n"
   "=head2 new_command NAME FUNC [{ARGS}]\n"
   "\n"
   "Add a new owl command. When owl executes the command NAME, FUNC will\n"
   "be called with the arguments passed to the command, with NAME as the\n"
   "first argument.\n"
   "\n"
   "ARGS should be a hashref containing any or all of C<summary>,\n"
   "C<usage>, or C<description> keys:\n"
   "\n"
   "=over 4\n"
   "\n"
   "=item summary\n"
   "\n"
   "A one-line summary of the purpose of the command\n"
   "\n"
   "=item usage\n"
   "\n"
   "A one-line usage synopsis, showing available options and syntax\n"
   "\n"
   "=item description\n"
   "\n"
   "A longer description of the syntax and semantics of the command,\n"
   "explaining usage and options\n"
   "\n"
   "=back\n"
   "\n"
   "=cut\n"
   "\n"
   "sub new_command {\n"
   "    my $name = shift;\n"
   "    my $func = shift;\n"
   "    my $args = shift || {};\n"
   "    my %args = (\n"
   "        summary     => \"\",\n"
   "        usage       => \"\",\n"
   "        description => \"\",\n"
   "        %{$args}\n"
   "    );\n"
   "\n"
   "    BarnOwl::new_command_internal($name, $func, $args{summary}, $args{usage}, $args{description});\n"
   "}\n"
   "\n"
   "=head2 new_variable_int NAME [{ARGS}]\n"
   "\n"
   "=head2 new_variable_bool NAME [{ARGS}]\n"
   "\n"
   "=head2 new_variable_string NAME [{ARGS}]\n"
   "\n"
   "Add a new owl variable, either an int, a bool, or a string, with the\n"
   "specified name.\n"
   "\n"
   "ARGS can optionally contain the following keys:\n"
   "\n"
   "=over 4\n"
   "\n"
   "=item default\n"
   "\n"
   "The default and initial value for the variable\n"
   "\n"
   "=item summary\n"
   "\n"
   "A one-line summary of the variable's purpose\n"
   "\n"
   "=item description\n"
   "\n"
   "A longer description of the function of the variable\n"
   "\n"
   "=back\n"
   "\n"
   "=cut\n"
   "\n"
   "sub new_variable_int {\n"
   "    unshift @_, \\&BarnOwl::new_variable_int_internal, 0;\n"
   "    goto \\&_new_variable;\n"
   "}\n"
   "\n"
   "sub new_variable_bool {\n"
   "    unshift @_, \\&BarnOwl::new_variable_bool_internal, 0;\n"
   "    goto \\&_new_variable;\n"
   "}\n"
   "\n"
   "sub new_variable_string {\n"
   "    unshift @_, \\&BarnOwl::new_variable_string_internal, \"\";\n"
   "    goto \\&_new_variable;\n"
   "}\n"
   "\n"
   "sub _new_variable {\n"
   "    my $func = shift;\n"
   "    my $default_default = shift;\n"
   "    my $name = shift;\n"
   "    my $args = shift || {};\n"
   "    my %args = (\n"
   "        summary     => \"\",\n"
   "        description => \"\",\n"
   "        default     => $default_default,\n"
   "        %{$args});\n"
   "    $func->($name, $args{default}, $args{summary}, $args{description});\n"
   "}\n"
   "\n"
   "=head2 quote STRING\n"
   "\n"
   "Return a version of STRING fully quoted to survive processing by\n"
   "BarnOwl's command parser.\n"
   "\n"
   "=cut\n"
   "\n"
   "sub quote {\n"
   "    my $str = shift;\n"
   "    return \"''\" if $str eq '';\n"
   "    if ($str !~ /['\" ]/) {\n"
   "        return \"$str\";\n"
   "    }\n"
   "    if ($str !~ /'/) {\n"
   "        return \"'$str'\";\n"
   "    }\n"
   "    $str =~ s/\"/\"'\"'\"/g;\n"
   "    return '\"' . $str . '\"';\n"
   "}\n"
   "\n"
   "#####################################################################\n"
   "#####################################################################\n"
   "\n"
   "package BarnOwl::Message;\n"
   "\n"
   "sub new {\n"
   "    my $class = shift;\n"
   "    my %args = (@_);\n"
   "    if($class eq __PACKAGE__ && $args{type}) {\n"
   "        $class = \"BarnOwl::Message::\" . ucfirst $args{type};\n"
   "    }\n"
   "    return bless {%args}, $class;\n"
   "}\n"
   "\n"
   "sub type        { return shift->{\"type\"}; }\n"
   "sub direction   { return shift->{\"direction\"}; }\n"
   "sub time        { return shift->{\"time\"}; }\n"
   "sub id          { return shift->{\"id\"}; }\n"
   "sub body        { return shift->{\"body\"}; }\n"
   "sub sender      { return shift->{\"sender\"}; }\n"
   "sub recipient   { return shift->{\"recipient\"}; }\n"
   "sub login       { return shift->{\"login\"}; }\n"
   "sub is_private  { return shift->{\"private\"}; }\n"
   "\n"
   "sub is_login    { return shift->login eq \"login\"; }\n"
   "sub is_logout   { return shift->login eq \"logout\"; }\n"
   "sub is_loginout { my $m=shift; return ($m->is_login or $m->is_logout); }\n"
   "sub is_incoming { return (shift->{\"direction\"} eq \"in\"); }\n"
   "sub is_outgoing { return (shift->{\"direction\"} eq \"out\"); }\n"
   "\n"
   "sub is_deleted  { return shift->{\"deleted\"}; }\n"
   "\n"
   "sub is_admin    { return (shift->{\"type\"} eq \"admin\"); }\n"
   "sub is_generic  { return (shift->{\"type\"} eq \"generic\"); }\n"
   "sub is_zephyr   { return (shift->{\"type\"} eq \"zephyr\"); }\n"
   "sub is_aim      { return (shift->{\"type\"} eq \"AIM\"); }\n"
   "sub is_jabber   { return (shift->{\"type\"} eq \"jabber\"); }\n"
   "sub is_icq      { return (shift->{\"type\"} eq \"icq\"); }\n"
   "sub is_yahoo    { return (shift->{\"type\"} eq \"yahoo\"); }\n"
   "sub is_msn      { return (shift->{\"type\"} eq \"msn\"); }\n"
   "sub is_loopback { return (shift->{\"type\"} eq \"loopback\"); }\n"
   "\n"
   "# These are overridden by appropriate message types\n"
   "sub is_ping     { return 0; }\n"
   "sub is_mail     { return 0; }\n"
   "sub is_personal { return shift->is_private; }\n"
   "sub class       { return undef; }\n"
   "sub instance    { return undef; }\n"
   "sub realm       { return undef; }\n"
   "sub opcode      { return undef; }\n"
   "sub header      { return undef; }\n"
   "sub host        { return undef; }\n"
   "sub hostname    { return undef; }\n"
   "sub auth        { return undef; }\n"
   "sub fields      { return undef; }\n"
   "sub zsig        { return undef; }\n"
   "sub zwriteline  { return undef; }\n"
   "sub login_host  { return undef; }\n"
   "sub login_tty   { return undef; }\n"
   "\n"
   "# This is for back-compat with old messages that set these properties\n"
   "# New protocol implementations are encourages to user override these\n"
   "# methods.\n"
   "sub replycmd         { return shift->{replycmd}};\n"
   "sub replysendercmd   { return shift->{replysendercmd}};\n"
   "\n"
   "sub pretty_sender    { return shift->sender; }\n"
   "sub pretty_recipient { return shift->recipient; }\n"
   "\n"
   "sub delete {\n"
   "    my ($m) = @_;\n"
   "    &BarnOwl::command(\"delete --id \".$m->id);\n"
   "}\n"
   "\n"
   "sub undelete {\n"
   "    my ($m) = @_;\n"
   "    &BarnOwl::command(\"undelete --id \".$m->id);\n"
   "}\n"
   "\n"
   "# Serializes the message into something similar to the zwgc->vt format\n"
   "sub serialize {\n"
   "    my ($this) = @_;\n"
   "    my $s;\n"
   "    for my $f (keys %$this) {\n"
   "	my $val = $this->{$f};\n"
   "	if (ref($val) eq \"ARRAY\") {\n"
   "	    for my $i (0..@$val-1) {\n"
   "		my $aval;\n"
   "		$aval = $val->[$i];\n"
   "		$aval =~ s/\\n/\\n$f.$i: /g;\n"
   "		$s .= \"$f.$i: $aval\\n\";\n"
   "	    }\n"
   "	} else {\n"
   "	    $val =~ s/\\n/\\n$f: /g;\n"
   "	    $s .= \"$f: $val\\n\";\n"
   "	}\n"
   "    }\n"
   "    return $s;\n"
   "}\n"
   "\n"
   "# Populate the annoying legacy global variables\n"
   "sub legacy_populate_global {\n"
   "    my ($m) = @_;\n"
   "    $BarnOwl::direction  = $m->direction ;\n"
   "    $BarnOwl::type       = $m->type      ;\n"
   "    $BarnOwl::id         = $m->id        ;\n"
   "    $BarnOwl::class      = $m->class     ;\n"
   "    $BarnOwl::instance   = $m->instance  ;\n"
   "    $BarnOwl::recipient  = $m->recipient ;\n"
   "    $BarnOwl::sender     = $m->sender    ;\n"
   "    $BarnOwl::realm      = $m->realm     ;\n"
   "    $BarnOwl::opcode     = $m->opcode    ;\n"
   "    $BarnOwl::zsig       = $m->zsig      ;\n"
   "    $BarnOwl::msg        = $m->body      ;\n"
   "    $BarnOwl::time       = $m->time      ;\n"
   "    $BarnOwl::host       = $m->host      ;\n"
   "    $BarnOwl::login      = $m->login     ;\n"
   "    $BarnOwl::auth       = $m->auth      ;\n"
   "    if ($m->fields) {\n"
   "	@BarnOwl::fields = @{$m->fields};\n"
   "	@main::fields = @{$m->fields};\n"
   "    } else {\n"
   "	@BarnOwl::fields = undef;\n"
   "	@main::fields = undef;\n"
   "    }\n"
   "}\n"
   "\n"
   "sub smartfilter {\n"
   "    die(\"smartfilter not supported for this message\\n\");\n"
   "}\n"
   "\n"
   "# Display fields -- overridden by subclasses when needed\n"
   "sub login_type {\"\"}\n"
   "sub login_extra {\"\"}\n"
   "sub long_sender {\"\"}\n"
   "\n"
   "# The context in which a non-personal message was sent, e.g. a chat or\n"
   "# class\n"
   "sub context {\"\"}\n"
   "\n"
   "# Some indicator of context *within* $self->context. e.g. the zephyr\n"
   "# instance\n"
   "sub subcontext {\"\"}\n"
   "\n"
   "#####################################################################\n"
   "#####################################################################\n"
   "\n"
   "package BarnOwl::Message::Admin;\n"
   "\n"
   "use base qw( BarnOwl::Message );\n"
   "\n"
   "sub header       { return shift->{\"header\"}; }\n"
   "\n"
   "#####################################################################\n"
   "#####################################################################\n"
   "\n"
   "package BarnOwl::Message::Generic;\n"
   "\n"
   "use base qw( BarnOwl::Message );\n"
   "\n"
   "#####################################################################\n"
   "#####################################################################\n"
   "\n"
   "package BarnOwl::Message::Loopback;\n"
   "\n"
   "use base qw( BarnOwl::Message );\n"
   "\n"
   "# all loopback messages are private\n"
   "sub is_private {\n"
   "  return 1;\n"
   "}\n"
   "\n"
   "sub replycmd {return 'loopwrite';}\n"
   "sub replysendercmd {return 'loopwrite';}\n"
   "\n"
   "#####################################################################\n"
   "#####################################################################\n"
   "\n"
   "package BarnOwl::Message::AIM;\n"
   "\n"
   "use base qw( BarnOwl::Message );\n"
   "\n"
   "# all non-loginout AIM messages are private for now...\n"
   "sub is_private {\n"
   "    return !(shift->is_loginout);\n"
   "}\n"
   "\n"
   "sub replycmd {\n"
   "    my $self = shift;\n"
   "    if ($self->is_incoming) {\n"
   "        return \"aimwrite \" . BarnOwl::quote($self->sender);\n"
   "    } else {\n"
   "        return \"aimwrite \" . BarnOwl::quote($self->recipient);\n"
   "    }\n"
   "}\n"
   "\n"
   "sub replysendercmd {\n"
   "    return shift->replycmd;\n"
   "}\n"
   "\n"
   "#####################################################################\n"
   "#####################################################################\n"
   "\n"
   "package BarnOwl::Message::Zephyr;\n"
   "\n"
   "use constant WEBZEPHYR_PRINCIPAL => \"daemon.webzephyr\";\n"
   "use constant WEBZEPHYR_CLASS     => \"webzephyr\";\n"
   "use constant WEBZEPHYR_OPCODE    => \"webzephyr\";\n"
   "\n"
   "use base qw( BarnOwl::Message );\n"
   "\n"
   "sub strip_realm {\n"
   "    my $sender = shift;\n"
   "    my $realm = BarnOwl::zephyr_getrealm();\n"
   "    $sender =~ s/\\@$realm$//;\n"
   "    return $sender;\n"
   "}\n"
   "\n"
   "sub login_type {\n"
   "    return (shift->zsig eq \"\") ? \"(PSEUDO)\" : \"\";\n"
   "}\n"
   "\n"
   "sub login_extra {\n"
   "    my $m = shift;\n"
   "    return undef if (!$m->is_loginout);\n"
   "    my $s = lc($m->host);\n"
   "    $s .= \" \" . $m->login_tty if defined $m->login_tty;\n"
   "    return $s;\n"
   "}\n"
   "\n"
   "sub long_sender {\n"
   "    my $m = shift;\n"
   "    return $m->zsig;\n"
   "}\n"
   "\n"
   "sub context {\n"
   "    return shift->class;\n"
   "}\n"
   "\n"
   "sub subcontext {\n"
   "    return shift->instance;\n"
   "}\n"
   "\n"
   "sub login_tty {\n"
   "    my ($m) = @_;\n"
   "    return undef if (!$m->is_loginout);\n"
   "    return $m->fields->[2];\n"
   "}\n"
   "\n"
   "sub login_host {\n"
   "    my ($m) = @_;\n"
   "    return undef if (!$m->is_loginout);\n"
   "    return $m->fields->[0];\n"
   "}\n"
   "\n"
   "sub zwriteline  { return shift->{\"zwriteline\"}; }\n"
   "\n"
   "sub is_ping     { return (lc(shift->opcode) eq \"ping\"); }\n"
   "\n"
   "sub is_personal {\n"
   "    my ($m) = @_;\n"
   "    return ((lc($m->class) eq \"message\")\n"
   "	    && (lc($m->instance) eq \"personal\")\n"
   "	    && $m->is_private);\n"
   "}\n"
   "\n"
   "sub is_mail {\n"
   "    my ($m) = @_;\n"
   "    return ((lc($m->class) eq \"mail\") && $m->is_private);\n"
   "}\n"
   "\n"
   "sub pretty_sender {\n"
   "    my ($m) = @_;\n"
   "    return strip_realm($m->sender);\n"
   "}\n"
   "\n"
   "sub pretty_recipient {\n"
   "    my ($m) = @_;\n"
   "    return strip_realm($m->recipient);\n"
   "}\n"
   "\n"
   "# These are arguably zephyr-specific\n"
   "sub class       { return shift->{\"class\"}; }\n"
   "sub instance    { return shift->{\"instance\"}; }\n"
   "sub realm       { return shift->{\"realm\"}; }\n"
   "sub opcode      { return shift->{\"opcode\"}; }\n"
   "sub host        { return shift->{\"hostname\"}; }\n"
   "sub hostname    { return shift->{\"hostname\"}; }\n"
   "sub header      { return shift->{\"header\"}; }\n"
   "sub auth        { return shift->{\"auth\"}; }\n"
   "sub fields      { return shift->{\"fields\"}; }\n"
   "sub zsig        { return shift->{\"zsig\"}; }\n"
   "\n"
   "sub zephyr_cc {\n"
   "    my $self = shift;\n"
   "    return $1 if $self->body =~ /^\\s*cc:\\s+([^\\n]+)/i;\n"
   "    return undef;\n"
   "}\n"
   "\n"
   "sub replycmd {\n"
   "    my $self = shift;\n"
   "    my $sender = shift;\n"
   "    $sender = 0 unless defined $sender;\n"
   "    my ($class, $instance, $to, $cc);\n"
   "    if($self->is_outgoing) {\n"
   "        return $self->{zwriteline};\n"
   "    }\n"
   "\n"
   "    if($sender && $self->opcode eq WEBZEPHYR_OPCODE) {\n"
   "        $class = WEBZEPHYR_CLASS;\n"
   "        $instance = $self->sender;\n"
   "        $to = WEBZEPHYR_PRINCIPAL;\n"
   "    } elsif($self->class eq WEBZEPHYR_CLASS\n"
   "            && $self->is_loginout) {\n"
   "        $class = WEBZEPHYR_CLASS;\n"
   "        $instance = $self->instance;\n"
   "        $to = WEBZEPHYR_PRINCIPAL;\n"
   "    } elsif($self->is_loginout || $sender) {\n"
   "        $class = 'MESSAGE';\n"
   "        $instance = 'PERSONAL';\n"
   "        $to = $self->sender;\n"
   "    } else {\n"
   "        $class = $self->class;\n"
   "        $instance = $self->instance;\n"
   "        $to = $self->recipient;\n"
   "        $cc = $self->zephyr_cc();\n"
   "        if($to eq '*' || $to eq '') {\n"
   "            $to = '';\n"
   "        } elsif($to !~ /^@/) {\n"
   "            $to = $self->sender;\n"
   "        }\n"
   "    }\n"
   "\n"
   "    my $cmd;\n"
   "    if(lc $self->opcode eq 'crypt') {\n"
   "        $cmd = 'zcrypt';\n"
   "    } else {\n"
   "        $cmd = 'zwrite';\n"
   "    }\n"
   "\n"
   "    if (lc $class ne 'message') {\n"
   "        $cmd .= \" -c \" . BarnOwl::quote($self->class);\n"
   "    }\n"
   "    if (lc $instance ne 'personal') {\n"
   "        $cmd .= \" -i \" . BarnOwl::quote($self->instance);\n"
   "    }\n"
   "    if ($to ne '') {\n"
   "        $to = strip_realm($to);\n"
   "        if (defined $cc) {\n"
   "            my @cc = grep /^[^-]/, ($to, split /\\s+/, $cc);\n"
   "            my %cc = map {$_ => 1} @cc;\n"
   "            delete $cc{strip_realm(BarnOwl::zephyr_getsender())};\n"
   "            @cc = keys %cc;\n"
   "            $cmd .= \" -C \" . join(\" \", @cc);\n"
   "        } else {\n"
   "            if(BarnOwl::getvar('smartstrip') eq 'on') {\n"
   "                $to = BarnOwl::zephyr_smartstrip_user($to);\n"
   "            }\n"
   "            $cmd .= \" $to\";\n"
   "        }\n"
   "    }\n"
   "    return $cmd;\n"
   "}\n"
   "\n"
   "sub replysendercmd {\n"
   "    my $self = shift;\n"
   "    return $self->replycmd(1);\n"
   "}\n"
   "\n"
   "#####################################################################\n"
   "#####################################################################\n"
   "#####################################################################\n"
   "\n"
   "package BarnOwl::Hook;\n"
   "\n"
   "=head1 BarnOwl::Hook\n"
   "\n"
   "=head1 DESCRIPTION\n"
   "\n"
   "A C<BarnOwl::Hook> represents a list of functions to be triggered on\n"
   "some event. C<BarnOwl> exports a default set of these (see\n"
   "C<BarnOwl::Hooks>), but can also be created and used by module code.\n"
   "\n"
   "=head2 new\n"
   "\n"
   "Creates a new Hook object\n"
   "\n"
   "=cut\n"
   "\n"
   "sub new {\n"
   "    my $class = shift;\n"
   "    return bless [], $class;\n"
   "}\n"
   "\n"
   "=head2 run [ARGS]\n"
   "\n"
   "Calls each of the functions registered with this hook with the given\n"
   "arguments.\n"
   "\n"
   "=cut\n"
   "\n"
   "sub run {\n"
   "    my $self = shift;\n"
   "    my @args = @_;\n"
   "    return map {$self->_run($_,@args)} @$self;\n"
   "}\n"
   "\n"
   "sub _run {\n"
   "    my $self = shift;\n"
   "    my $fn = shift;\n"
   "    my @args = @_;\n"
   "    no strict 'refs';\n"
   "    return $fn->(@args);\n"
   "}\n"
   "\n"
   "=head2 add SUBREF\n"
   "\n"
   "Registers a given subroutine with this hook\n"
   "\n"
   "=cut\n"
   "\n"
   "sub add {\n"
   "    my $self = shift;\n"
   "    my $func = shift;\n"
   "    die(\"Not a coderef!\") unless ref($func) eq 'CODE' || !ref($func);\n"
   "    return if grep {$_ eq $func} @$self;\n"
   "    push @$self, $func;\n"
   "}\n"
   "\n"
   "=head2 clear\n"
   "\n"
   "Remove all functions registered with this hook.\n"
   "\n"
   "=cut\n"
   "\n"
   "sub clear {\n"
   "    my $self = shift;\n"
   "    @$self = ();\n"
   "}\n"
   "\n"
   "package BarnOwl::Hooks;\n"
   "\n"
   "=head1 BarnOwl::Hooks\n"
   "\n"
   "=head1 DESCRIPTION\n"
   "\n"
   "C<BarnOwl::Hooks> exports a set of C<BarnOwl::Hook> objects made\n"
   "available by BarnOwl internally. \n"
   "\n"
   "=head2 USAGE\n"
   "\n"
   "Modules wishing to respond to events in BarnOwl should register\n"
   "functions with these hooks.\n"
   "\n"
   "=head2 EXPORTS\n"
   "\n"
   "None by default. Either import the hooks you need explicitly, or refer\n"
   "to them with fully-qualified names. Available hooks are:\n"
   "\n"
   "=over 4\n"
   "\n"
   "=item $startup\n"
   "\n"
   "Called on BarnOwl startup, and whenever modules are\n"
   "reloaded. Functions registered with the C<$startup> hook get a true\n"
   "argument if this is a reload, and false if this is a true startup\n"
   "\n"
   "=item $shutdown\n"
   "\n"
   "Called before BarnOwl shutdown\n"
   "\n"
   "=item $receiveMessage\n"
   "\n"
   "Called with a C<BarnOwl::Message> object every time BarnOwl appends a\n"
   "new message to its message list\n"
   "\n"
   "=item $mainLoop\n"
   "\n"
   "Called on every pass through the C<BarnOwl> main loop. This is\n"
   "guaranteed to be called at least once/sec and may be called more\n"
   "frequently.\n"
   "\n"
   "=item $getBuddyList\n"
   "\n"
   "Called to display buddy lists for all protocol handlers. The result\n"
   "from every function registered with this hook will be appended and\n"
   "displayed in a popup window, with zephyr formatting parsed.\n"
   "\n"
   "=back\n"
   "\n"
   "=cut\n"
   "\n"
   "use Exporter;\n"
   "\n"
   "our @EXPORT_OK = qw($startup $shutdown\n"
   "                    $receiveMessage $newMessage\n"
   "                    $mainLoop $getBuddyList);\n"
   "\n"
   "our %EXPORT_TAGS = (all => [@EXPORT_OK]);\n"
   "\n"
   "our $startup = BarnOwl::Hook->new;\n"
   "our $shutdown = BarnOwl::Hook->new;\n"
   "our $receiveMessage = BarnOwl::Hook->new;\n"
   "our $newMessage = BarnOwl::Hook->new;\n"
   "our $mainLoop = BarnOwl::Hook->new;\n"
   "our $getBuddyList = BarnOwl::Hook->new;\n"
   "\n"
   "# Internal startup/shutdown routines called by the C code\n"
   "\n"
   "sub _load_perl_commands {\n"
   "    # Load builtin perl commands\n"
   "    BarnOwl::new_command(style => \\&BarnOwl::Style::style_command,\n"
   "                       {\n"
   "                           summary => \"creates a new style\",\n"
   "                           usage   => \"style <name> perl <function_name>\",\n"
   "                           description =>\n"
   "                           \"A style named <name> will be created that will\\n\" .\n"
   "                           \"format messages using the perl function <function_name>.\\n\\n\" .\n"
   "                           \"SEE ALSO: show styles, view -s, filter -s\\n\\n\" .\n"
   "                           \"DEPRECATED in favor of BarnOwl::create_style(NAME, OBJECT)\",\n"
   "                          });\n"
   "}\n"
   "\n"
   "sub _load_owlconf {\n"
   "    # load the config  file\n"
   "    if ( -r $BarnOwl::configfile ) {\n"
   "        undef $@;\n"
   "        package main;\n"
   "        do $BarnOwl::configfile;\n"
   "        if($@) {\n"
   "            BarnOwl::error(\"In startup: $@\\n\");\n"
   "            return;\n"
   "        }\n"
   "        package BarnOwl;\n"
   "        if(*BarnOwl::format_msg{CODE}) {\n"
   "            # if the config defines a legacy formatting function, add 'perl' as a style \n"
   "            BarnOwl::create_style(\"perl\", BarnOwl::Style::Legacy->new(\n"
   "                \"BarnOwl::format_msg\",\n"
   "                \"User-defined perl style that calls BarnOwl::format_msg\"\n"
   "                . \" with legacy global variable support\",\n"
   "                1));\n"
   "             BarnOwl::set(\"-q default_style perl\");\n"
   "        }\n"
   "    }\n"
   "}\n"
   "\n"
   "# These are the internal hooks called by the barnowl C code, which\n"
   "# take care of dispatching to the appropriate perl hooks, and deal\n"
   "# with compatibility by calling the old, fixed-name hooks.\n"
   "\n"
   "sub _startup {\n"
   "    _load_perl_commands();\n"
   "    _load_owlconf();\n"
   "\n"
   "    if(eval {require BarnOwl::ModuleLoader}) {\n"
   "        eval {\n"
   "            BarnOwl::ModuleLoader->load_all;\n"
   "        };\n"
   "        BarnOwl::error(\"$@\") if $@;\n"
   "\n"
   "    } else {\n"
   "        BarnOwl::error(\"Can't load BarnOwl::ModuleLoader, loadable module support disabled:\\n$@\");\n"
   "    }\n"
   "    \n"
   "    $startup->run(0);\n"
   "    BarnOwl::startup() if *BarnOwl::startup{CODE};\n"
   "}\n"
   "\n"
   "sub _shutdown {\n"
   "    $shutdown->run;\n"
   "    \n"
   "    BarnOwl::shutdown() if *BarnOwl::shutdown{CODE};\n"
   "}\n"
   "\n"
   "sub _receive_msg {\n"
   "    my $m = shift;\n"
   "\n"
   "    $receiveMessage->run($m);\n"
   "    \n"
   "    BarnOwl::receive_msg($m) if *BarnOwl::receive_msg{CODE};\n"
   "}\n"
   "\n"
   "sub _new_msg {\n"
   "    my $m = shift;\n"
   "\n"
   "    $newMessage->run($m);\n"
   "    \n"
   "    BarnOwl::new_msg($m) if *BarnOwl::new_msg{CODE};\n"
   "}\n"
   "\n"
   "sub _mainloop_hook {\n"
   "    $mainLoop->run;\n"
   "    BarnOwl::mainloop_hook() if *BarnOwl::mainloop_hook{CODE};\n"
   "}\n"
   "\n"
   "sub _get_blist {\n"
   "    return join(\"\\n\", $getBuddyList->run);\n"
   "}\n"
   "\n"
   "################################################################################\n"
   "# Built-in perl styles\n"
   "################################################################################\n"
   "package BarnOwl::Style::Default;\n"
   "################################################################################\n"
   "# Branching point for various formatting functions in this style.\n"
   "################################################################################\n"
   "sub format_message\n"
   "{\n"
   "    my $self = shift;\n"
   "    my $m    = shift;\n"
   "    my $fmt;\n"
   "\n"
   "    if ( $m->is_loginout) {\n"
   "        $fmt = $self->format_login($m);\n"
   "    } elsif($m->is_ping && $m->is_personal) {\n"
   "        $fmt = $self->format_ping($m);\n"
   "    } elsif($m->is_admin) {\n"
   "        $fmt = $self->format_admin($m);\n"
   "    } else {\n"
   "        $fmt = $self->format_chat($m);\n"
   "    }\n"
   "    $fmt = BarnOwl::Style::boldify($fmt) if $self->should_bold($m);\n"
   "    return $fmt;\n"
   "}\n"
   "\n"
   "sub should_bold {\n"
   "    my $self = shift;\n"
   "    my $m = shift;\n"
   "    return $m->is_personal && $m->direction eq \"in\";\n"
   "}\n"
   "\n"
   "sub description {\"Default style\";}\n"
   "\n"
   "BarnOwl::create_style(\"default\", \"BarnOwl::Style::Default\");\n"
   "\n"
   "################################################################################\n"
   "\n"
   "sub format_time {\n"
   "    my $self = shift;\n"
   "    my $m = shift;\n"
   "    my ($time) = $m->time =~ /(\\d\\d:\\d\\d)/;\n"
   "    return $time;\n"
   "}\n"
   "\n"
   "sub format_login {\n"
   "    my $self = shift;\n"
   "    my $m = shift;\n"
   "    return sprintf(\n"
   "        '@b<%s%s> for @b(%s) (%s) %s',\n"
   "        uc( $m->login ),\n"
   "        $m->login_type,\n"
   "        $m->pretty_sender,\n"
   "        $m->login_extra,\n"
   "        $self->format_time($m)\n"
   "       );\n"
   "}\n"
   "\n"
   "sub format_ping {\n"
   "    my $self = shift;\n"
   "    my $m = shift;\n"
   "    return \"\\@b(PING) from \\@b(\" . $m->pretty_sender . \")\";\n"
   "}\n"
   "\n"
   "sub format_admin {\n"
   "    my $self = shift;\n"
   "    my $m = shift;\n"
   "    return \"\\@bold(OWL ADMIN)\\n\" . $self->indent_body($m);\n"
   "}\n"
   "\n"
   "sub format_chat {\n"
   "    my $self = shift;\n"
   "    my $m = shift;\n"
   "    my $header = $self->chat_header($m);\n"
   "    return $header . \"\\n\". $self->indent_body($m);\n"
   "}\n"
   "\n"
   "sub chat_header {\n"
   "    my $self = shift;\n"
   "    my $m = shift;\n"
   "    my $header;\n"
   "    if ( $m->is_personal ) {\n"
   "        if ( $m->direction eq \"out\" ) {\n"
   "            $header = ucfirst $m->type . \" sent to \" . $m->pretty_recipient;\n"
   "        } else {\n"
   "            $header = ucfirst $m->type . \" from \" . $m->pretty_sender;\n"
   "        }\n"
   "    } else {\n"
   "        $header = $m->context;\n"
   "        if(defined $m->subcontext) {\n"
   "            $header .= ' / ' . $m->subcontext;\n"
   "        }\n"
   "        $header .= ' / @b{' . $m->pretty_sender . '}';\n"
   "    }\n"
   "\n"
   "    if($m->opcode) {\n"
   "        $header .= \" [\" . $m->opcode . \"]\";\n"
   "    }\n"
   "    $header .= \"  \" . $self->format_time($m);\n"
   "    $header .= $self->format_sender($m);\n"
   "    return $header;\n"
   "}\n"
   "\n"
   "sub format_sender {\n"
   "    my $self = shift;\n"
   "    my $m = shift;\n"
   "    my $sender = $m->long_sender;\n"
   "    $sender =~ s/\\n.*$//s;\n"
   "    return \"  (\" . $sender . '@color[default]' . \")\";\n"
   "}\n"
   "\n"
   "sub indent_body\n"
   "{\n"
   "    my $self = shift;\n"
   "    my $m = shift;\n"
   "\n"
   "    my $body = $m->body;\n"
   "    if ($m->{should_wordwrap}) {\n"
   "      $body = BarnOwl::wordwrap($body, BarnOwl::getnumcols()-8);\n"
   "    }\n"
   "    # replace newline followed by anything with\n"
   "    # newline plus four spaces and that thing.\n"
   "    $body =~ s/\\n(.)/\\n    $1/g;\n"
   "    # Trim trailing newlines.\n"
   "    $body =~ s/\\n*$//;\n"
   "    return \"    \".$body;\n"
   "}\n"
   "\n"
   "package BarnOwl::Style::Basic;\n"
   "our @ISA=qw(BarnOwl::Style::Default);\n"
   "\n"
   "sub description {\"Compatability alias for the default style\";}\n"
   "\n"
   "BarnOwl::create_style(\"basic\", \"BarnOwl::Style::Basic\");\n"
   "\n"
   "package BarnOwl::Style::OneLine;\n"
   "# Inherit format_message to dispatch\n"
   "our @ISA = qw(BarnOwl::Style::Default);\n"
   "\n"
   "use constant BASE_FORMAT => '%s %-13.13s %-11.11s %-12.12s ';\n"
   "\n"
   "sub description {\"Formats for one-line-per-message\"}\n"
   "\n"
   "BarnOwl::create_style(\"oneline\", \"BarnOwl::Style::OneLine\");\n"
   "\n"
   "################################################################################\n"
   "\n"
   "sub format_login {\n"
   "  my $self = shift;\n"
   "  my $m = shift;\n"
   "  return sprintf(\n"
   "    BASE_FORMAT,\n"
   "    '<',\n"
   "    $m->type,\n"
   "    uc( $m->login ),\n"
   "    $m->pretty_sender)\n"
   "    . ($m->login_extra ? \"at \".$m->login_extra : '');\n"
   "}\n"
   "\n"
   "sub format_ping {\n"
   "  my $self = shift;\n"
   "  my $m = shift;\n"
   "  return sprintf(\n"
   "    BASE_FORMAT,\n"
   "    '<',\n"
   "    $m->type,\n"
   "    'PING',\n"
   "    $m->pretty_sender)\n"
   "}\n"
   "\n"
   "sub format_chat\n"
   "{\n"
   "  my $self = shift;\n"
   "  my $m = shift;\n"
   "  my $dir = lc($m->{direction});\n"
   "  my $dirsym = '-';\n"
   "  if ($dir eq 'in') {\n"
   "    $dirsym = '<';\n"
   "  }\n"
   "  elsif ($dir eq 'out') {\n"
   "    $dirsym = '>';\n"
   "  }\n"
   "\n"
   "  my $line;\n"
   "  if ($m->is_personal) {\n"
   "    $line= sprintf(BASE_FORMAT,\n"
   "                   $dirsym,\n"
   "                   $m->type,\n"
   "                   '',\n"
   "                   ($dir eq 'out'\n"
   "                    ? $m->pretty_recipient\n"
   "                    : $m->pretty_sender));\n"
   "  }\n"
   "  else {\n"
   "    $line = sprintf(BASE_FORMAT,\n"
   "                    $dirsym,\n"
   "                    $m->context,\n"
   "                    $m->subcontext,\n"
   "                    ($dir eq 'out'\n"
   "                     ? $m->pretty_recipient\n"
   "                     : $m->pretty_sender));\n"
   "  }\n"
   "\n"
   "  my $body = $m->{body};\n"
   "  $body =~ tr/\\n/ /;\n"
   "  $line .= $body;\n"
   "  return $line;\n"
   "}\n"
   "\n"
   "# Format owl admin messages\n"
   "sub format_admin\n"
   "{\n"
   "  my $self = shift;\n"
   "  my $m = shift;\n"
   "  my $line = sprintf(BASE_FORMAT, '<', 'ADMIN', '', '');\n"
   "  my $body = $m->{body};\n"
   "  $body =~ tr/\\n/ /;\n"
   "  return $line.$body;\n"
   "}\n"
   "\n"
   "package BarnOwl::Style;\n"
   "\n"
   "# This takes a zephyr to be displayed and modifies it to be displayed\n"
   "# entirely in bold.\n"
   "sub boldify\n"
   "{\n"
   "    local $_ = shift;\n"
   "    if ( !(/\\)/) ) {\n"
   "        return '@b(' . $_ . ')';\n"
   "    } elsif ( !(/\\>/) ) {\n"
   "        return '@b<' . $_ . '>';\n"
   "    } elsif ( !(/\\}/) ) {\n"
   "        return '@b{' . $_ . '}';\n"
   "    } elsif ( !(/\\]/) ) {\n"
   "        return '@b[' . $_ . ']';\n"
   "    } else {\n"
   "        my $txt = \"\\@b($_\";\n"
   "        $txt =~ s/\\)/\\)\\@b\\[\\)\\]\\@b\\(/g;\n"
   "        return $txt . ')';\n"
   "    }\n"
   "}\n"
   "\n"
   "sub style_command {\n"
   "    my $command = shift;\n"
   "    if(scalar @_ != 3 || $_[1] ne 'perl') {\n"
   "        die(\"Usage: style <name> perl <function>\\n\");\n"
   "    }\n"
   "    my $name = shift;\n"
   "    my $perl = shift;\n"
   "    my $fn   = shift;\n"
   "    {\n"
   "        # For historical reasons, assume unqualified references are\n"
   "        # in main::\n"
   "        package main;\n"
   "        no strict 'refs';\n"
   "        unless(*{$fn}{CODE}) {\n"
   "            die(\"Unable to create style '$name': no perl function '$fn'\\n\");\n"
   "        }\n"
   "    }\n"
   "    BarnOwl::create_style($name, BarnOwl::Style::Legacy->new($fn));\n"
   "}\n"
   "\n"
   "package BarnOwl::Style::Legacy;\n"
   "\n"
   "sub new {\n"
   "    my $class = shift;\n"
   "    my $func  = shift;\n"
   "    my $desc  = shift;\n"
   "    my $useglobals = shift;\n"
   "    $useglobals = 0 unless defined($useglobals);\n"
   "    return bless {function    => $func,\n"
   "                  description => $desc,\n"
   "                  useglobals  => $useglobals}, $class;\n"
   "}\n"
   "\n"
   "sub description {\n"
   "    my $self = shift;\n"
   "    return $self->{description} ||\n"
   "    (\"User-defined perl style that calls \" . $self->{function});\n"
   "};\n"
   "\n"
   "sub format_message {\n"
   "    my $self = shift;\n"
   "    if($self->{useglobals}) {\n"
   "        $_[0]->legacy_populate_global();\n"
   "    }\n"
   "    {\n"
   "      package main;\n"
   "      no strict 'refs';\n"
   "      goto \\&{$self->{function}};\n"
   "    }\n"
   "}\n"
   "\n"
   "\n"
   "# switch to package main when we're done\n"
   "package main;\n"
   "\n"
   "# Shove a bunch of fake entries into @INC so modules can use or\n"
   "# require them without choking\n"
   "$::INC{$_} = 1 for (qw(BarnOwl.pm BarnOwl/Hooks.pm\n"
   "                       BarnOwl/Message.pm BarnOwl/Style.pm));\n"
   "\n"
   "1;\n"
   "\n"
   ;