trunk/Meteor/Controller.pm

#!/usr/bin/perl -w
###############################################################################
#   Meteor
#   An HTTP server for the 2.0 web
#   Copyright (c) 2006 contributing authors
#
#   Subscriber.pm
#
#       Description:
#       A Meteor Controller
#
###############################################################################
#
#   This program is free software; you can redistribute it and/or modify it
#   under the terms of the GNU General Public License as published by the Free
#   Software Foundation; either version 2 of the License, or (at your option)
#   any later version.
#
#   This program is distributed in the hope that it will be useful, but WITHOUT
#   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
#   FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
#   more details.
#
#   You should have received a copy of the GNU General Public License along
#   with this program; if not, write to the Free Software Foundation, Inc.,
#   59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
#   For more information visit www.meteorserver.org
#
###############################################################################

package Meteor::Controller;
###############################################################################
# Configuration
###############################################################################
        
        use strict;
        
        use Meteor::Connection;
        use Meteor::Channel;
        use Meteor::Subscriber;
        
        @Meteor::Controller::ISA=qw(Meteor::Connection);

###############################################################################
# Factory methods
###############################################################################
sub newFromServer {
        my $class=shift;
        
        my $self=$class->SUPER::newFromServer(shift);
        
        $::Statistics->{'current_controllers'}++;
        $::Statistics->{'controller_connections_accepted'}++;
        
        $self;
}

###############################################################################
# Instance methods
###############################################################################
sub processLine {
        my $self=shift;
        my $line=shift;
        
        # ADDMESSAGE channel1 Message text
        # < OK
        # ADDMESSAGE
        # < ERR Invalid command syntax
        # COUNTSUBSCRIBERS channel1
        # < OK 344
        
        unless($line=~s/^(ADDMESSAGE|COUNTSUBSCRIBERS|LISTCHANNELS|LISTSUBSCRIBERS|LISTCONNECTIONS|DESCRIBE|SHOWSTATS|QUIT)//)
        {
                $self->write("ERR Invalid command syntax$::CRLF");
                
                return;
        }
        
        my $cmd=$1;
        
        if($cmd eq 'ADDMESSAGE')
        {
                unless($line=~s/^\s+(\S+)\s//)
                {
                        $self->write("ERR Invalid command syntax$::CRLF");
                        
                        return;
                }
                
                my $channelName=$1;
                my $channel=Meteor::Channel->channelWithName($channelName);
                my $msg=$channel->addMessage($line);
                my $msgID=$msg->id();
                $self->write("OK\t$msgID$::CRLF");
        }
        elsif($cmd eq 'COUNTSUBSCRIBERS')
        {
                unless($line=~s/^\s+(\S+)$//)
                {
                        $self->write("ERR Invalid command syntax$::CRLF");
                        return;
                }
                
                my $channelName=$1;
                my $numSubscribers=0;
                my $channel=Meteor::Channel->channelWithName($channelName,1);
                $numSubscribers=$channel->subscriberCount() if($channel);
                
                $self->write("OK $numSubscribers$::CRLF");
        }
        elsif($cmd eq 'LISTCHANNELS')
        {
                unless($line eq '')
                {
                        $self->write("ERR Invalid command syntax$::CRLF");
                        return;
                }
                
                my $txt="OK$::CRLF".Meteor::Channel->listChannels()."--EOT--$::CRLF";
                
                $self->write($txt);
        }
        elsif($cmd eq 'LISTSUBSCRIBERS')
        {
                unless($line eq '')
                {
                        $self->write("ERR Invalid command syntax$::CRLF");
                        return;
                }
                
                my $txt="OK$::CRLF".Meteor::Subscriber->listSubscribers()."--EOT--$::CRLF";
                
                $self->write($txt);
        }
        elsif($cmd eq 'LISTCONNECTIONS')
        {
                unless($line eq '')
                {
                        $self->write("ERR Invalid command syntax$::CRLF");
                        return;
                }
                
                my $txt="OK$::CRLF".Meteor::Connection->listConnections()."--EOT--$::CRLF";
                
                $self->write($txt);
        }
        elsif($cmd eq 'DESCRIBE')
        {
                unless($line=~s/^\s+(\S+)$//)
                {
                        $self->write("ERR Invalid command syntax$::CRLF");
                        return;
                }
                
                my $filenum=$1;
                my $condesc=Meteor::Connection->describeConnWithFileNum($filenum);
                if ($condesc != -1) {
                        $self->write("OK$::CRLF");
                        $self->write($condesc);
                        $self->write("--EOT--$::CRLF");

                } else {
                        $self->write("ERR Unknown client$::CRLF");
                }               
        }
        elsif($cmd eq 'SHOWSTATS')
        {
                # uptime
                my $uptime=time-$::STARTUP_TIME;
                my $txt="OK$::CRLF"."uptime: $uptime$::CRLF";
                
                # channel_count
                my $numChannels=Meteor::Channel->numChannels();
                $txt.="channel_count: $numChannels$::CRLF";
                
                # connection_count
                my $numConnections=Meteor::Connection->connectionCount();
                $txt.="connection_count: $numConnections$::CRLF";

                # subscriber count = current_subscribers + number of pollers in last minute
                my $now = time; my $numpoll = 0;
                foreach my $key (keys %{$::Pollers}) {
                        if($::Pollers->{$key} < ($now-60) || Meteor::Subscriber->subscriberExists($key)) {
                                delete $::Pollers->{$key};
                        } else {
                                $numpoll++;
                        }
                }
                my $numsub = 0;
                if (exists($::Statistics->{'current_subscribers'})) {
                        $numsub = $::Statistics->{'current_subscribers'};
                }
                $txt.="real_subscribers: ".($numpoll+$numsub)."$::CRLF";

                foreach my $key (keys %{$::Statistics})
                {
                        $txt.=$key.': '.$::Statistics->{$key}.$::CRLF;
                }
                
                $txt.="--EOT--$::CRLF";
                
                $self->write($txt);
        }
        elsif($cmd eq 'QUIT')
        {
                unless($line eq '')
                {
                        $self->write("ERR Invalid command syntax$::CRLF");
                        
                        return;
                }
                
                $self->write("OK$::CRLF");
                $self->close(1);
        }
        else
        {
                # Should never get here
                die("Unknown command '$cmd'");
        }
}

sub close {
        my $self=shift;
        my $noShutdownMsg=shift;
        
        unless($noShutdownMsg || $self->{'remoteClosed'})
        {
                my $msg=$::CONF{'ControllerShutdownMsg'};
                if(defined($msg) && $msg ne '')
                {
                        $self->write($msg);
                }
        }
        
        $self->SUPER::close();
}

sub didClose {
        
        $::Statistics->{'current_controllers'}--;
}

1;
############################################################################EOF
1	knops.gerd	11	#!/usr/bin/perl -w
2			###############################################################################
3			# Meteor
4			# An HTTP server for the 2.0 web
5			# Copyright (c) 2006 contributing authors
6			#
7			# Subscriber.pm
8			#
9			# Description:
10			# A Meteor Controller
11			#
12			###############################################################################
13			#
14			# This program is free software; you can redistribute it and/or modify it
15			# under the terms of the GNU General Public License as published by the Free
16			# Software Foundation; either version 2 of the License, or (at your option)
17			# any later version.
18			#
19			# This program is distributed in the hope that it will be useful, but WITHOUT
20			# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
21			# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
22			# more details.
23			#
24			# You should have received a copy of the GNU General Public License along
25			# with this program; if not, write to the Free Software Foundation, Inc.,
26			# 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
27			#
28			# For more information visit www.meteorserver.org
29			#
30			###############################################################################
31
32			package Meteor::Controller;
33			###############################################################################
34			# Configuration
35			###############################################################################
36
37			use strict;
38
39			use Meteor::Connection;
40			use Meteor::Channel;
41	knops.gerd	25	use Meteor::Subscriber;
42	knops.gerd	11
43			@Meteor::Controller::ISA=qw(Meteor::Connection);
44
45			###############################################################################
46	knops.gerd	25	# Factory methods
47			###############################################################################
48			sub newFromServer {
49			my $class=shift;
50
51			my $self=$class->SUPER::newFromServer(shift);
52
53			$::Statistics->{'current_controllers'}++;
54			$::Statistics->{'controller_connections_accepted'}++;
55
56			$self;
57			}
58
59			###############################################################################
60	knops.gerd	11	# Instance methods
61			###############################################################################
62			sub processLine {
63			my $self=shift;
64			my $line=shift;
65
66			# ADDMESSAGE channel1 Message text
67			# < OK
68			# ADDMESSAGE
69			# < ERR Invalid command syntax
70			# COUNTSUBSCRIBERS channel1
71			# < OK 344
72
73	andrew.betts	62	unless($line=~s/^(ADDMESSAGE\|COUNTSUBSCRIBERS\|LISTCHANNELS\|LISTSUBSCRIBERS\|LISTCONNECTIONS\|DESCRIBE\|SHOWSTATS\|QUIT)//)
74	knops.gerd	11	{
75			$self->write("ERR Invalid command syntax$::CRLF");
76
77			return;
78			}
79
80			my $cmd=$1;
81
82			if($cmd eq 'ADDMESSAGE')
83			{
84			unless($line=~s/^\s+(\S+)\s//)
85			{
86			$self->write("ERR Invalid command syntax$::CRLF");
87	knops.gerd	25
88	knops.gerd	11	return;
89			}
90
91			my $channelName=$1;
92			my $channel=Meteor::Channel->channelWithName($channelName);
93	knops.gerd	46	my $msg=$channel->addMessage($line);
94			my $msgID=$msg->id();
95			$self->write("OK\t$msgID$::CRLF");
96	knops.gerd	11	}
97			elsif($cmd eq 'COUNTSUBSCRIBERS')
98			{
99			unless($line=~s/^\s+(\S+)$//)
100			{
101			$self->write("ERR Invalid command syntax$::CRLF");
102			return;
103			}
104
105			my $channelName=$1;
106			my $numSubscribers=0;
107			my $channel=Meteor::Channel->channelWithName($channelName,1);
108			$numSubscribers=$channel->subscriberCount() if($channel);
109
110			$self->write("OK $numSubscribers$::CRLF");
111			}
112			elsif($cmd eq 'LISTCHANNELS')
113			{
114			unless($line eq '')
115			{
116			$self->write("ERR Invalid command syntax$::CRLF");
117			return;
118			}
119
120			my $txt="OK$::CRLF".Meteor::Channel->listChannels()."--EOT--$::CRLF";
121
122			$self->write($txt);
123			}
124	andrew.betts	62	elsif($cmd eq 'LISTSUBSCRIBERS')
125			{
126			unless($line eq '')
127			{
128			$self->write("ERR Invalid command syntax$::CRLF");
129			return;
130			}
131
132			my $txt="OK$::CRLF".Meteor::Subscriber->listSubscribers()."--EOT--$::CRLF";
133
134			$self->write($txt);
135			}
136			elsif($cmd eq 'LISTCONNECTIONS')
137			{
138			unless($line eq '')
139			{
140			$self->write("ERR Invalid command syntax$::CRLF");
141			return;
142			}
143
144			my $txt="OK$::CRLF".Meteor::Connection->listConnections()."--EOT--$::CRLF";
145
146			$self->write($txt);
147			}
148			elsif($cmd eq 'DESCRIBE')
149			{
150			unless($line=~s/^\s+(\S+)$//)
151			{
152			$self->write("ERR Invalid command syntax$::CRLF");
153			return;
154			}
155
156			my $filenum=$1;
157			my $condesc=Meteor::Connection->describeConnWithFileNum($filenum);
158			if ($condesc != -1) {
159			$self->write("OK$::CRLF");
160			$self->write($condesc);
161			$self->write("--EOT--$::CRLF");
162
163			} else {
164			$self->write("ERR Unknown client$::CRLF");
165			}
166			}
167	knops.gerd	25	elsif($cmd eq 'SHOWSTATS')
168			{
169			# uptime
170			my $uptime=time-$::STARTUP_TIME;
171	knops.gerd	43	my $txt="OK$::CRLF"."uptime: $uptime$::CRLF";
172	knops.gerd	25
173			# channel_count
174			my $numChannels=Meteor::Channel->numChannels();
175			$txt.="channel_count: $numChannels$::CRLF";
176
177	andrew.betts	62	# connection_count
178			my $numConnections=Meteor::Connection->connectionCount();
179			$txt.="connection_count: $numConnections$::CRLF";
180
181			# subscriber count = current_subscribers + number of pollers in last minute
182			my $now = time; my $numpoll = 0;
183			foreach my $key (keys %{$::Pollers}) {
184			if($::Pollers->{$key} < ($now-60) \|\| Meteor::Subscriber->subscriberExists($key)) {
185			delete $::Pollers->{$key};
186			} else {
187			$numpoll++;
188			}
189			}
190			my $numsub = 0;
191			if (exists($::Statistics->{'current_subscribers'})) {
192			$numsub = $::Statistics->{'current_subscribers'};
193			}
194			$txt.="real_subscribers: ".($numpoll+$numsub)."$::CRLF";
195
196	knops.gerd	25	foreach my $key (keys %{$::Statistics})
197			{
198			$txt.=$key.': '.$::Statistics->{$key}.$::CRLF;
199			}
200
201	knops.gerd	43	$txt.="--EOT--$::CRLF";
202
203	knops.gerd	25	$self->write($txt);
204			}
205	knops.gerd	11	elsif($cmd eq 'QUIT')
206			{
207			unless($line eq '')
208			{
209			$self->write("ERR Invalid command syntax$::CRLF");
210	knops.gerd	25
211	knops.gerd	11	return;
212			}
213
214			$self->write("OK$::CRLF");
215			$self->close(1);
216			}
217			else
218			{
219			# Should never get here
220			die("Unknown command '$cmd'");
221			}
222			}
223
224			sub close {
225			my $self=shift;
226			my $noShutdownMsg=shift;
227
228			unless($noShutdownMsg \|\| $self->{'remoteClosed'})
229			{
230			my $msg=$::CONF{'ControllerShutdownMsg'};
231			if(defined($msg) && $msg ne '')
232			{
233			$self->write($msg);
234			}
235			}
236
237			$self->SUPER::close();
238			}
239
240	knops.gerd	37	sub didClose {
241
242			$::Statistics->{'current_controllers'}--;
243			}
244
245	knops.gerd	11	1;
246	andrew.betts	3	############################################################################EOF