src/lib/Bcd/Clients/Listener.pm

   1 package Bcd::Clients::Listener;
   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 #this file models a listener in our program.
  24 #A listener is simply a thread
  25
  26 # this file has been possible thanks to ideas from
  27 # http://www.perlmonks.org/?node_id=550235
  28 # I thereby thanks the BrowserUk user
  29
  30 use strict;
  31 use warnings;
  32 use threads;
  33 use threads::shared;
  34 use Thread::Queue;
  35 use Data::Dumper;
  36 #use commands::CommandFactory;
  37 use constant EOL => "\015\012";
  38 use Bcd::Data::Model;
  39 use Bcd::Data::StatementsStash;
  40
  41 use Log::Log4perl qw(:easy);
  42 Log::Log4perl->easy_init($INFO);
  43
  44 my $TEST_DATABASE : shared = 0;
  45
  46 sub use_test_database{
  47     my $self = shift;
  48     $TEST_DATABASE = 1;
  49 }
  50
  51 sub new{
  52
  53     my ($class, $script, $queue_files_to_delete) = @_;
  54
  55     my $self : shared;
  56     $self = &share({});
  57
  58     bless ($self, $class);
  59
  60     my $queue = new Thread::Queue;
  61     $self->{"q_streams"} = &share($queue);
  62
  63     #this is the number of the serving clients
  64     $self->{num_of_serving_clients} = 0;
  65     $self->{script} = $script;
  66
  67     my $thread = threads->new(\&_listener_thread, $self, $queue_files_to_delete);
  68     $thread->detach();
  69
  70     return $self;
  71 }
  72
  73 #this is the thread of the listener... It is run forever
  74 sub _listener_thread{
  75     my ($self, $queue_files_to_delete) = @_;
  76
  77     #Ok, I create here the stash...
  78     my $stash = Bcd::Data::StatementsStash->new($TEST_DATABASE);
  79
  80     while (1){
  81
  82         #ok, something happened
  83         my $client_to_serve = $self->{"q_streams"}->dequeue();
  84
  85         {
  86             lock($self);
  87             $self->{num_of_serving_clients} ++;
  88         }
  89
  90         #print "OK... received $client_to_serve to serve\n";
  91         open my $socket, "+<&=" . $client_to_serve or die $!;
  92
  93         if ($self->{script} == 1){
  94             my @time = localtime();
  95             my $year = $time[5] + 1900;
  96             my $month = $time[4] + 1;
  97             my $name = "/tmp/${year}_${month}_$time[3]_$time[2]_$time[1]_$time[0]_bc_script";
  98             open CMD_SCRIPT, "> $name" or die "cannot open file $name";
  99         }
 100
 101         local $/ = "\015\012";
 102         $socket->autoflush(1);
 103
 104         #${$self->{"am_I_busy"}} = 1;
 105
 106         print $socket  ">>>> ready for commands <<<<" . EOL;
 107
 108         my $index_cmd = 0;
 109
 110         while (<$socket>){
 111
 112             chomp; #the first line is the command's name
 113
 114             if ($self->{script} == 1){
 115                 #make a script
 116                 $index_cmd++;
 117                 #this is only an "horrible hack", because the file is really never quit,
 118                 #as the web site does not quit the socket... So in every case I have a backdoor
 119                 #to force the flush of the file and have a meaningful script.
 120                 CMD_SCRIPT->flush() if ($_ eq "an_get_summary");
 121
 122                 print CMD_SCRIPT "\n#### command $index_cmd \n";
 123                 print CMD_SCRIPT $_ . "\n";
 124             }
 125
 126
 127
 128             if (/^quit$/){
 129                 last;
 130             }
 131
 132             my $current_command = Bcd::Data::Model->instance()->get_command($_);
 133
 134             if (!$current_command){
 135                 print $socket "Unknown command: $_. Type quit to exit." . EOL;
 136                 next;
 137             }
 138
 139             #ok, let's parse the command
 140             $current_command->start_parsing_command();
 141
 142             while (<$socket>){
 143
 144                 chomp;
 145
 146                 if ($self->{script} == 1){
 147                     #make a script
 148                     print CMD_SCRIPT $_ . "\n";
 149                 }
 150
 151                 #is the client transmission finished?
 152                 unless (/^eot$/i){
 153                     #ok, feed the command
 154                     if (/^eot/i){
 155                         #the line starts with "eot" but not finish with it, remove the eot
 156                         $_ = substr($_, 3);
 157                     }
 158                     $current_command->parse_line($_);
 159                     next;
 160                 } else {
 161                     last; #exit the loop, the command has finished
 162                 }
 163             }
 164
 165             $current_command->eot();
 166
 167             #ok, now the command is prepared
 168
 169             #Bcd::Data::Model->instance()->execute_this_command($current_command);
 170
 171             #I should wait for the command execution...
 172             #$current_command->wait_for_execution();
 173
 174
 175             #####################################################################
 176             ## the command is executed here...
 177             get_logger()->info($current_command->{id_cmd}, " ",
 178                                $current_command->get_name(),
 179                                $current_command->get_parameters_for_logging());
 180             $current_command->exec($stash);
 181
 182             my $output = $current_command->get_output();
 183
 184             my $dumped = Dumper($output);
 185             #ok, now I have the dumped object
 186             $dumped =~ s/\012/\015\012/sg;
 187             $dumped =~ s/^(\.?)/$1$1/sg; #also at the start of the string...
 188             #$dumped =~ s/^(eot)/$1$1/sg; #also at the start of the string...
 189             $dumped =~ s/\015?\012(\.?)/\015\012$1$1/sg;
 190             #$dumped =~ s/\015?\012(eot)/\015\012$1$1/sg;
 191
 192
 193 #           foreach(@{$output}){
 194 #               #if the output starts with "eot" add another eot
 195 #               if (/^eot/i){
 196 #                   $_ = "eot" . $_;
 197 #               }
 198 #               print $socket $_ . EOL;
 199 #           }
 200             print $socket $dumped;
 201             print $socket "." . EOL; #end of transmission
 202
 203             #the command is no more necessary...
 204             #$current_command->finish();
 205
 206         }
 207
 208         print $socket  "bye..." . EOL;
 209         $socket->flush();
 210         close CMD_SCRIPT if $self->{script};
 211         close $socket or print ">>>>>>>>>>>>> help :  $!";
 212         #undef $socket;
 213
 214         #this should be closed...
 215         $queue_files_to_delete->enqueue($client_to_serve);
 216
 217         {
 218             lock($self);
 219             $self->{num_of_serving_clients} --;
 220         }
 221
 222     }
 223
 224 }
 225
 226 sub try_to_serve_this_client{
 227     my ($self, $client, $files_to_delete) = @_;
 228
 229     #let's lock the object
 230     lock($self);
 231
 232     #ok, I should try to see the free state
 233
 234     my $num_of_serving_clients = $self->{num_of_serving_clients};
 235
 236     if ($num_of_serving_clients != 0){
 237         return 1;
 238
 239     } else {
 240
 241         $files_to_delete->{fileno $client} = $client;
 242         $self->{"q_streams"}->enqueue(fileno $client);
 243
 244         return 0;
 245     }
 246
 247 }
 248
 249 1;