djabberd

#!/usr/bin/perl
use strict;
use warnings;

BEGIN {
    # tell debugger of sub enter/exit,
    $^P |= 0x01  if     $ENV{TRACE_DJABBERD};
    # keep descriptive string value of all anon subs maintained per coderef:
    $^P |= 0x200 unless $ENV{NDEBUG_SUB_NAMES};
};

use lib 'lib';
use vars qw($DEBUG $daemonize $conffile $logconf);
use Getopt::Long;
use Pod::Usage;

BEGIN {
    # We need to set up the logger before we "use DJabberd", because
    # most of the DJabberd libs will immediately make calls into
    # DJabberd::Log.

    $DEBUG = 0;
    $daemonize = 0;
    $conffile = undef;
    $logconf = undef;
    my $help;

    Getopt::Long::GetOptions(
        'd|daemon'     => \$daemonize,
        'debug=i'      => \$DEBUG,
        'conffile=s'   => \$conffile,
        'logconf=s'    => \$logconf,
        'h|help',      => \$help,
    );

    if ($help) {
        pod2usage();
    }

    my @try_logconf_conf = ();
    if (defined($logconf)) {
        die "Can't find logging configuration file $logconf" unless -e $logconf;
        @try_logconf_conf = ( $logconf );
    }
    else {
        @try_logconf_conf = ( "etc/log.conf", "/etc/djabberd/log.conf", "etc/log.conf.default" );
    }
    use DJabberd::Log;
    DJabberd::Log->set_logger(@try_logconf_conf);

}

use DJabberd;
use FindBin qw($Bin);
BEGIN {
    # while the core ("use DJabberd" above) must be in normal paths,
    # we open up the lib paths here, so make it easy to work in
    # the subversion directories and have cousin plugins in their
    # dev locations, but not system-wide installed.
    if (-e "$Bin/Makefile.PL") {  # lame check to see if we're in dev directory
        opendir(my $dh, "$Bin/../");
        foreach my $d (grep { /^DJabberd-/ } readdir($dh)) {
            my $dir = "$Bin/../$d/lib";
            next unless -d $dir;
            unshift(@INC, $dir);
        }
    }
}


my $server = DJabberd->new(
                           daemonize => $daemonize
                           );

if (defined $conffile) {
    die "Can't find configuration file ".$conffile unless -e $conffile;
}
my @try_conf = defined $conffile ? ($conffile) : ( "/etc/djabberd/djabberd.conf", "djabberd.conf" );
shift @try_conf while @try_conf && ! -e $try_conf[0];
die "No configuration file found; please specify --conffile argument.\n" unless @try_conf;

$server->load_config($try_conf[0]);

$server->run;

package DB;
no strict 'refs';
no utf8;

sub DB{};
sub sub {
    # localize CALL_DEPTH so that we don't need to decrement it after the sub
    # is called
    local $DB::CALL_DEPTH = $DB::CALL_DEPTH+1;
    #my @foo = @_;
    my $fileline = "";
    if (ref $DB::sub eq "CODE") {
        my @caller = caller;
        my $pkg = $caller[0];
        my $line = $caller[2];
        $fileline = " called from $pkg, line $line";
    }
    warn ("." x $DB::CALL_DEPTH . " ($DB::CALL_DEPTH) $DB::sub$fileline\n");

    # Call our subroutine. @_ gets passed on for us.
    # by calling it last, we don't need to worry about "wantarray", etc
    # by returning it like this, the caller's expectations are conveyed to
    # the called routine
    &{$DB::sub};
}

__END__

=head1 NAME

djabberd

=head1 SYNOPSIS

djabberd [--daemon] [debug=<x>] [conffile=<path>] [logconf=<path>]

 Options:
 -d --daemon          Run the program in the background as a daemon
    --debug=NUMBER    Turn on debugging
    --conffile=PATH   Path to config file
    --logconf=PATH    Path to log config file (Log4Perl)
 -h --help            This help message

=head1 SEE ALSO

L<DJabberd::Config>