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);
                $channel->addMessage($line);
                $self->write("OK$::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="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;
                }
                
                $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);
                }
        }
        
        $::Statistics->{'current_controllers'}--;
        
        $self->SUPER::close();
}

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			$channel->addMessage($line);
94			$self->write("OK$::CRLF");
95			}
96			elsif($cmd eq 'COUNTSUBSCRIBERS')
97			{
98			unless($line=~s/^\s+(\S+)$//)
99			{
100			$self->write("ERR Invalid command syntax$::CRLF");
101	knops.gerd	25
102	knops.gerd	11	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	knops.gerd	25
118	knops.gerd	11	return;
119			}
120
121			my $txt="OK$::CRLF".Meteor::Channel->listChannels()."--EOT--$::CRLF";
122
123			$self->write($txt);
124			}
125	knops.gerd	25	elsif($cmd eq 'SHOWSTATS')
126			{
127			# uptime
128			my $uptime=time-$::STARTUP_TIME;
129			my $txt="uptime: $uptime$::CRLF";
130
131			# channel_count
132			my $numChannels=Meteor::Channel->numChannels();
133			$txt.="channel_count: $numChannels$::CRLF";
134
135			foreach my $key (keys %{$::Statistics})
136			{
137			$txt.=$key.': '.$::Statistics->{$key}.$::CRLF;
138			}
139
140			$self->write($txt);
141			}
142	knops.gerd	11	elsif($cmd eq 'QUIT')
143			{
144			unless($line eq '')
145			{
146			$self->write("ERR Invalid command syntax$::CRLF");
147	knops.gerd	25
148	knops.gerd	11	return;
149			}
150
151			$self->write("OK$::CRLF");
152			$self->close(1);
153			}
154			else
155			{
156			# Should never get here
157			die("Unknown command '$cmd'");
158			}
159			}
160
161			sub close {
162			my $self=shift;
163			my $noShutdownMsg=shift;
164
165			unless($noShutdownMsg \|\| $self->{'remoteClosed'})
166			{
167			my $msg=$::CONF{'ControllerShutdownMsg'};
168			if(defined($msg) && $msg ne '')
169			{
170			$self->write($msg);
171			}
172			}
173
174	knops.gerd	25	$::Statistics->{'current_controllers'}--;
175
176	knops.gerd	11	$self->SUPER::close();
177			}
178
179			1;
180	andrew.betts	3	############################################################################EOF