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|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 '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";
                
                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	knops.gerd	25	unless($line=~s/^(ADDMESSAGE\|COUNTSUBSCRIBERS\|LISTCHANNELS\|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	knops.gerd	25
103	knops.gerd	11	return;
104			}
105
106			my $channelName=$1;
107			my $numSubscribers=0;
108			my $channel=Meteor::Channel->channelWithName($channelName,1);
109			$numSubscribers=$channel->subscriberCount() if($channel);
110
111			$self->write("OK $numSubscribers$::CRLF");
112			}
113			elsif($cmd eq 'LISTCHANNELS')
114			{
115			unless($line eq '')
116			{
117			$self->write("ERR Invalid command syntax$::CRLF");
118	knops.gerd	25
119	knops.gerd	11	return;
120			}
121
122			my $txt="OK$::CRLF".Meteor::Channel->listChannels()."--EOT--$::CRLF";
123
124			$self->write($txt);
125			}
126	knops.gerd	25	elsif($cmd eq 'SHOWSTATS')
127			{
128			# uptime
129			my $uptime=time-$::STARTUP_TIME;
130	knops.gerd	43	my $txt="OK$::CRLF"."uptime: $uptime$::CRLF";
131	knops.gerd	25
132			# channel_count
133			my $numChannels=Meteor::Channel->numChannels();
134			$txt.="channel_count: $numChannels$::CRLF";
135
136			foreach my $key (keys %{$::Statistics})
137			{
138			$txt.=$key.': '.$::Statistics->{$key}.$::CRLF;
139			}
140
141	knops.gerd	43	$txt.="--EOT--$::CRLF";
142
143	knops.gerd	25	$self->write($txt);
144			}
145	knops.gerd	11	elsif($cmd eq 'QUIT')
146			{
147			unless($line eq '')
148			{
149			$self->write("ERR Invalid command syntax$::CRLF");
150	knops.gerd	25
151	knops.gerd	11	return;
152			}
153
154			$self->write("OK$::CRLF");
155			$self->close(1);
156			}
157			else
158			{
159			# Should never get here
160			die("Unknown command '$cmd'");
161			}
162			}
163
164			sub close {
165			my $self=shift;
166			my $noShutdownMsg=shift;
167
168			unless($noShutdownMsg \|\| $self->{'remoteClosed'})
169			{
170			my $msg=$::CONF{'ControllerShutdownMsg'};
171			if(defined($msg) && $msg ne '')
172			{
173			$self->write($msg);
174			}
175			}
176
177			$self->SUPER::close();
178			}
179
180	knops.gerd	37	sub didClose {
181
182			$::Statistics->{'current_controllers'}--;
183			}
184
185	knops.gerd	11	1;
186	andrew.betts	3	############################################################################EOF