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
  36 ### over-ridden subs below
  37
  38 sub options {
  39     my $self     = shift;
  40     my $prop     = $self->{server};
  41     my $template = shift;
  42
  43     ### setup options in the parent classes
  44     $self->SUPER::options($template);
  45
  46
  47     #I add two parameters, test and script
  48     foreach(qw/test script/){
  49         $template->{$_} = \$prop->{$_};
  50     }
  51 }
  52
  53 sub post_configure_hook{
  54     my $self = shift;
  55     my $prop = $self->{server};
  56
  57     if (!defined($prop->{test}) || ($prop->{test} != 1)){
  58         #I assume test
  59         $prop->{test} = 1;
  60         $prop->{port} = 9001;
  61         $self->log(2, $self->log_time . " using TEST db, connect to port 9001");
  62     } else {
  63         $self->log(2, $self->log_time . " using normal db, connect to port 9000");
  64         $prop->{port} = 9000;
  65     }
  66
  67     if (! defined($prop->{script}) or $prop->{script} != 1){
  68         $self->log(2, $self->log_time . " NOT scripting");
  69         $prop->{script} = 0;
  70     } else {
  71         $self->log(2, $self->log_time . " I AM scripting");
  72     }
  73
  74     if ($prop->{script} == 1 && $prop->{test} == 0){
  75         die "cannot script without test\n";
  76     }
  77
  78 }
  79
  80 sub process_request {
  81     my $self = shift;
  82
  83     eval {
  84
  85         #I FORCE THE TEST DATABASE
  86         my $stash = Bcd::Data::StatementsStash->new($self->{server}->{test});
  87
  88         #at first the parsers are in text mode, the script for now it is off..
  89         #then I will find a way to pass the parameters...
  90
  91         my $input_parser = Bcd::Commands::InputCommandParser->new
  92             (Bcd::Common::CommonConstants::TEXT_MODE, $self->{server}->{script});
  93         my $output_stream = Bcd::Commands::OutputCommand->new
  94             (Bcd::Common::CommonConstants::TEXT_MODE);
  95         my $factory = Bcd::Data::Model->instance()->get_factory();
  96
  97         #local $SIG{'ALRM'} = sub { die "Timed Out!\n" };
  98
  99         local $/ = "\015\012";
 100         #my $timeout = 60; # give the user 30 seconds to type some lines
 101
 102         #my $previous_alarm = alarm($timeout);
 103         print main::greetings() . EOL;
 104         print "Ready for commands: \\q: quit \\b: binary \\t: text \\h: help." . EOL;
 105         while (<STDIN>) {
 106             chomp;
 107             if ($_ eq '\q'){
 108                 last;
 109             } elsif ($_ eq '\b'){
 110                 $input_parser->select_mode(Bcd::Common::CommonConstants::BINARY_MODE);
 111                 $output_stream->select_mode(Bcd::Common::CommonConstants::BINARY_MODE);
 112                 print "mode set to BIN" . EOL;
 113                 next;
 114             } elsif ($_ eq '\t'){
 115                 $input_parser->select_mode(Bcd::Common::CommonConstants::TEXT_MODE);
 116                 $output_stream->select_mode(Bcd::Common::CommonConstants::TEXT_MODE);
 117                 print "mode set to TEXT" . EOL;
 118                 next;
 119             } elsif ($_ eq '\h'){
 120                 print "Help not implemented so far. Sorry." . EOL;
 121                 next;
 122             }
 123
 124             my $cmd = $factory->get_command($_, $input_parser, $output_stream);
 125
 126             if (!defined($cmd)){
 127                 print "Unknown command '$_' type \\q to exit." . EOL;
 128             } else {
 129                 $cmd->exec($stash);
 130                 $self->log(2, $self->log_time . $cmd->{id_cmd} .  " " .
 131                                    $cmd->get_name() .
 132                                    $cmd->get_parameters_for_logging());
 133             }
 134             #alarm($timeout);
 135         }
 136         #alarm($previous_alarm);
 137
 138         $input_parser->end_of_input();
 139
 140     };
 141
 142     if ($@ =~ /timed out/i) {
 143         print STDOUT "Timed Out." . EOL;
 144         return;
 145     } else {
 146         print STDOUT "bye...$@" . EOL;
 147         return;
 148     }
 149
 150 }
 151
 152 sub pre_loop_hook{
 153     my $self = shift;
 154
 155     my $pid;
 156     if (!defined($pid = fork)) {
 157         die "cannot fork: $!";
 158         return;
 159     } elsif ($pid) {
 160         # I'm the parent
 161         $self->{bcd_bot_pid} = $pid;
 162         #this sleep is just to be almost sure that the manager
 163         #will init the cache file before any client arrives.
 164         sleep(2);
 165         return;
 166     }
 167
 168     #ok, I am the child... go on and start the manager...
 169     Bcd::Bots::Manager::run();
 170 }
 171
 172 sub pre_server_close_hook{
 173     my $self = shift;
 174     kill "INT", $self->{bcd_bot_pid};
 175     waitpid($self->{bcd_bot_pid}, 0);
 176 }
 177
 178 1;