src/lib/Bcd.pm

   1 package Bcd;
   2
   3 # This file is part of the breadcrumbs daemon (bcd).
   4 # Copyright (C) 2007 Pasqualino Ferrentino
   5
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; either version 2 of the License, or
   9 # (at your option) any later version.
  10
  11 # This program is distributed in the hope that it will be useful, but
  12 # WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 # General Public License for more details.
  15
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program; if not, write to the Free Software
  18 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  19 # 02110-1301, USA.
  20
  21 # Contact: lino.ferrentino@yahoo.it (in Italian, English or German).
  22
  23 use strict;
  24 use warnings;
  25 use constant EOL => "\015\012";
  26
  27 use base qw(Net::Server::Fork);
  28 use Bcd::Data::Model;
  29 use Bcd::Data::StatementsStash;
  30 use Bcd::Commands::OutputCommand;
  31 use Bcd::Bots::Manager;
  32 use Bcd::Commands::InputCommandParser;
  33 use POSIX ":sys_wait_h";
  34 use Data::Dumper;
  35 use Pod::Usage;
  36
  37 ### over-ridden subs below
  38
  39 #this does not work, because I have the 0.94 version...
  40 # sub default_values{
  41 #     return {
  42 #       conf_file => './etc/bcd.conf',
  43 #     };
  44 #}
  45
  46 sub options {
  47     my $self     = shift;
  48     my $prop     = $self->{server};
  49     my $template = shift;
  50
  51     ### setup options in the parent classes
  52     $self->SUPER::options($template);
  53
  54
  55     #I add some parameters
  56     foreach(qw/test script help bcd_home mailer new_ant_nest_bot_frequency/){
  57         $template->{$_} = \$prop->{$_};
  58     }
  59 }
  60
  61 sub post_configure_hook{
  62     my $self = shift;
  63     my $prop = $self->{server};
  64
  65     if (defined($prop->{help}) && $prop->{help} == 1){
  66         pod2usage(2);
  67     }
  68
  69     if (!defined($prop->{test}) || ($prop->{test} != 1)){
  70         #I assume not test
  71         $prop->{test} = 0;
  72         $self->log(2, $self->log_time . " using normal db, connect to port 9000");
  73         $prop->{port} = 9000;
  74     } else {
  75         $prop->{port} = 9001;
  76         $self->log(2, $self->log_time . " using TEST db, connect to port 9001");
  77     }
  78
  79     if (! defined($prop->{script}) or $prop->{script} != 1){
  80         $self->log(2, $self->log_time . " NOT scripting");
  81         $prop->{script} = 0;
  82     } else {
  83         $self->log(2, $self->log_time . " I AM scripting");
  84     }
  85
  86     if ($prop->{script} == 1 && $prop->{test} == 0){
  87         pod2usage(2);
  88     }
  89
  90 }
  91
  92 sub process_request {
  93     my $self = shift;
  94
  95     eval {
  96
  97         #I FORCE THE TEST DATABASE
  98         my $stash = Bcd::Data::StatementsStash->new($self->{server});
  99
 100         #at first the parsers are in text mode, the script for now it is off..
 101         #then I will find a way to pass the parameters...
 102
 103         my $input_parser = Bcd::Commands::InputCommandParser->new
 104             (Bcd::Common::CommonConstants::TEXT_MODE, $self->{server}->{script});
 105         my $output_stream = Bcd::Commands::OutputCommand->new
 106             (Bcd::Common::CommonConstants::TEXT_MODE);
 107         my $factory = Bcd::Data::Model->instance()->get_factory();
 108
 109         #local $SIG{'ALRM'} = sub { die "Timed Out!\n" };
 110
 111         local $/ = "\015\012";
 112         #my $timeout = 60; # give the user 30 seconds to type some lines
 113
 114         #my $previous_alarm = alarm($timeout);
 115         print main::greetings() . EOL;
 116         print "Ready for commands: \\q: quit \\b: binary \\t: text \\h: help." . EOL;
 117         while (<STDIN>) {
 118             chomp;
 119             if ($_ eq '\q'){
 120                 last;
 121             } elsif ($_ eq '\b'){
 122                 $input_parser->select_mode(Bcd::Common::CommonConstants::BINARY_MODE);
 123                 $output_stream->select_mode(Bcd::Common::CommonConstants::BINARY_MODE);
 124                 print "mode set to BIN" . EOL;
 125                 next;
 126             } elsif ($_ eq '\t'){
 127                 $input_parser->select_mode(Bcd::Common::CommonConstants::TEXT_MODE);
 128                 $output_stream->select_mode(Bcd::Common::CommonConstants::TEXT_MODE);
 129                 print "mode set to TEXT" . EOL;
 130                 next;
 131             } elsif ($_ eq '\h'){
 132                 print "Help not implemented so far. Sorry." . EOL;
 133                 next;
 134             }
 135
 136             my $cmd_id = $stash->get_next_cmd_id();
 137             my $cmd = $factory->get_command($_, $cmd_id, $input_parser, $output_stream);
 138
 139             if (!defined($cmd)){
 140                 print "Unknown command '$_' type \\q to exit." . EOL;
 141             } else {
 142                 $cmd->exec($stash);
 143                 $self->log(2, $self->log_time . " " . $cmd->{id_cmd} .  " " .
 144                                    $cmd->get_name() .
 145                                    $cmd->get_parameters_for_logging());
 146             }
 147             #alarm($timeout);
 148         }
 149         #alarm($previous_alarm);
 150
 151         $input_parser->end_of_input();
 152
 153     };
 154
 155     if ($@ =~ /timed out/i) {
 156         print STDOUT "Timed Out." . EOL;
 157         return;
 158     } else {
 159         print STDOUT "bye...$@" . EOL;
 160         return;
 161     }
 162
 163 }
 164
 165 sub pre_loop_hook{
 166     my $self = shift;
 167
 168     my $pid;
 169     if (!defined($pid = fork)) {
 170         die "cannot fork: $!";
 171         return;
 172     } elsif ($pid) {
 173         # I'm the parent
 174         $self->{bcd_bot_pid} = $pid;
 175         #this sleep is just to be almost sure that the manager
 176         #will init the cache file before any client arrives.
 177         sleep(2);
 178         return;
 179     }
 180
 181     #ok, I am the child... go on and start the manager...
 182     Bcd::Bots::Manager::run($self->{server});
 183 }
 184
 185 sub pre_server_close_hook{
 186     my $self = shift;
 187
 188     if (!defined($self->{bcd_bot_pid})){
 189         return;
 190     }
 191
 192     kill "INT", $self->{bcd_bot_pid};
 193     waitpid($self->{bcd_bot_pid}, 0);
 194 }
 195
 196 1;