/[meteor]/googlecode.com/svn/trunk/Meteor/Channel.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /googlecode.com/svn/trunk/Meteor/Channel.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 50 - (hide annotations)
Wed Feb 27 13:55:35 2008 UTC (12 years, 1 month ago) by andrew.betts
File size: 8214 byte(s)
Added crossdomain.xml for flash clients
Incremented version number
Moved 'new message' debug notice to more useful location
Moved default for ChannelInfoTemplate to correct position alphabetically in code
Set simpler default HeaderTemplate
Added LogTimeFormat
Updated description of PingInterval, Persist
Corrected misspelling of Parameter
Reformatted debug output for config initialisation
Added recognition of null byte in config
Fixed problem with mode recognition
Fixed resuming from given message ID
Fixed sending of message backlog
Fixed Shlemiels
Logged connection duration on leavechannel
Fixed name support in channelinfotemplate
Added logging of reasons for connection closes
Abbreviated log output
Fixed tracking of subscriber IDs
Added logging of user agent
Fixed incorrect key for MessageTemplate in Subscriber.pm
Add some additional code comments
Fixed incorrect closure of new connection if previous connection close was waiting on write buffer

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 Channel
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::Channel;
33     ###############################################################################
34     # Configuration
35     ###############################################################################
36    
37     use strict;
38    
39     use Meteor::Message;
40    
41     our %Channels=();
42     our $MessageID=0;
43    
44     ###############################################################################
45     # Class methods
46     ###############################################################################
47     sub channelWithName {
48     my $class=shift;
49     my $channelName=shift;
50     my $avoidCreation=shift;
51    
52     unless(exists($Channels{$channelName}))
53     {
54     return undef if($avoidCreation);
55     #
56     # Create new channel
57     #
58     $Channels{$channelName}=$class->newChannel($channelName);
59    
60     &::syslog('debug',"New channel $channelName");
61     }
62    
63     return $Channels{$channelName};
64     }
65    
66     sub listChannels {
67     my $class=shift;
68    
69     my $list='';
70     foreach my $channelName (sort keys %Channels)
71     {
72     my $channel=$Channels{$channelName};
73    
74     $list.=$channelName.'('.$channel->messageCount().'/'.$channel->subscriberCount().")$::CRLF";
75     }
76    
77     $list;
78     }
79    
80 knops.gerd 45 sub listChannelsUsingTemplate {
81     my $class=shift;
82     my $template=shift;
83    
84     return '' unless(defined($template) && $template ne '');
85    
86     my $list='';
87     foreach my $channelName (sort keys %Channels)
88     {
89     my $channel=$Channels{$channelName};
90    
91     $list.=$channel->descriptionWithTemplate($template);
92     }
93    
94     $list;
95     }
96    
97 knops.gerd 11 sub deleteChannel {
98     my $class=shift;
99     my $channelName=shift;
100    
101     delete($Channels{$channelName});
102     }
103    
104     sub trimMessageStoresByTimestamp {
105     my $class=shift;
106     my $minTimeStamp=shift;
107    
108     return unless($minTimeStamp);
109    
110     map { $_->trimMessageStoreByTimestamp($minTimeStamp) } (values %Channels);
111     }
112    
113     sub clearAllBuffers {
114     my $class=shift;
115    
116     map { $_->clearBuffer() } (values %Channels);
117     }
118    
119 knops.gerd 25 sub numChannels {
120    
121     return scalar(keys %Channels);
122     }
123    
124 knops.gerd 11 ###############################################################################
125     # Factory methods
126     ###############################################################################
127     sub new {
128     #
129     # Create a new empty instance
130     #
131     my $class=shift;
132    
133     my $obj={};
134    
135     bless($obj,$class);
136     }
137    
138     sub newChannel {
139     #
140     # new instance from new server connection
141     #
142     my $self=shift->new();
143    
144     my $name=shift;
145     $self->{'name'}=$name;
146    
147     $self->{'subscribers'}=[];
148     $self->{'messages'}=[];
149    
150     $self;
151     }
152    
153     sub DESTROY {
154     my $self=shift;
155    
156     my @subscribers=@{$self->{'subscribers'}};
157 knops.gerd 13 map { $_->closeChannel($self->{'name'}) } @subscribers;
158 knops.gerd 11 }
159    
160     ###############################################################################
161     # Instance methods
162     ###############################################################################
163     sub name {
164     shift->{'name'};
165     }
166    
167     sub addSubscriber {
168     my $self=shift;
169     my $subscriber=shift;
170     my $startId=shift;
171     my $persist=shift;
172 knops.gerd 47 my $mode=shift || '';
173     my $userAgent=shift || '';
174 knops.gerd 11
175     # Note: negative $startId means go back that many messages
176 andrew.betts 50 my $startIndex=$self->indexForMessageID($startId);
177     my $logStartIndex = $startIndex || $self->lastMsgID() || 0;
178 knops.gerd 11
179     push(@{$self->{'subscribers'}},$subscriber) if($persist);
180    
181 knops.gerd 47 &::syslog('info','',
182     'joinchannel',
183     $subscriber->{'subscriberID'},
184     $self->{'name'},
185     $mode,
186 andrew.betts 50 $logStartIndex,
187 knops.gerd 47 $userAgent
188     );
189    
190 knops.gerd 11 return unless(defined($startIndex));
191    
192     my $msgCount=scalar(@{$self->{'messages'}});
193     my $txt='';
194    
195     $startIndex=0 if($startIndex<0);
196    
197 andrew.betts 50 if($startIndex<$msgCount) {
198     $subscriber->sendMessages(@{$self->{'messages'}}[$startIndex..$msgCount-1]);
199 knops.gerd 11 }
200     }
201    
202     sub removeSubscriber {
203     my $self=shift;
204     my $subscriber=shift;
205 knops.gerd 47 my $reason=shift ||'unknown';
206 knops.gerd 11
207     my $idx=undef;
208 andrew.betts 50 my $numsubs = scalar(@{$self->{'subscribers'}});
209     for(my $i=0;$i<$numsubs;$i++)
210 knops.gerd 11 {
211     if($self->{'subscribers'}->[$i]==$subscriber)
212     {
213     $idx=$i;
214     last;
215     }
216     }
217    
218     if(defined($idx))
219     {
220     splice(@{$self->{'subscribers'}},$idx,1);
221 knops.gerd 47
222 andrew.betts 50 my $timeConnected = time - $subscriber->{'ConnectionStart'};
223 knops.gerd 47 &::syslog('info','',
224     'leavechannel',
225     $subscriber->{'subscriberID'},
226     $self->{'name'},
227 andrew.betts 50 $timeConnected,
228 knops.gerd 47 $subscriber->{'MessageCount'},
229     $subscriber->{'bytesWritten'},
230     $reason
231     );
232 knops.gerd 11 }
233    
234     $self->checkExpiration();
235     }
236    
237     sub subscriberCount {
238     my $self=shift;
239    
240     scalar(@{$self->{'subscribers'}});
241     }
242    
243     sub addMessage {
244     my $self=shift;
245     my $messageText=shift;
246    
247     my $message=Meteor::Message->newWithID($MessageID++);
248 knops.gerd 16 $message->setText($messageText);
249     $message->setChannelName($self->{'name'});
250 knops.gerd 11 push(@{$self->{'messages'}},$message);
251 andrew.betts 50 &::syslog('debug',"New message ".$message->{"id"}." on channel ".$self->{'name'});
252 knops.gerd 11
253     $self->trimMessageStoreBySize();
254    
255 knops.gerd 45 map { $_->sendMessages($message) } @{$self->{'subscribers'}};
256 knops.gerd 46
257     $message;
258 knops.gerd 11 }
259    
260     sub messageCount {
261     my $self=shift;
262    
263     scalar(@{$self->{'messages'}});
264     }
265    
266     sub trimMessageStoreBySize {
267     my $self=shift;
268    
269     my $numMessages=scalar(@{$self->{'messages'}});
270    
271     if($numMessages>$::CONF{'MaxMessagesPerChannel'})
272     {
273     splice(@{$self->{'messages'}},0,-$::CONF{'MaxMessagesPerChannel'});
274     }
275     }
276    
277     sub trimMessageStoreByTimestamp {
278     my $self=shift;
279     my $ts=shift;
280    
281     while(scalar(@{$self->{'messages'}})>0 && $self->{'messages'}->[0]->timestamp()<$ts)
282     {
283     my $msg=shift(@{$self->{'messages'}});
284     }
285    
286     $self->checkExpiration();
287     }
288    
289     sub clearBuffer {
290     my $self=shift;
291    
292     $self->{'messages'}=[];
293    
294     $self->checkExpiration();
295     }
296    
297     sub checkExpiration {
298     my $self=shift;
299    
300     if($self->messageCount()==0 && $self->subscriberCount()==0)
301     {
302     my $name=$self->name();
303     &::syslog('debug',"Channel expired: $name");
304     $self->deleteChannel($name);
305     }
306     }
307    
308     sub indexForMessageID {
309     my $self=shift;
310     my $id=shift;
311    
312     # the messages is always sorted by ID, so we can
313     # use a binary search to find the message.
314     # return undef if there are no messages or the
315     # ID is that of the last message.
316     # Otherwise return the ID of the found message
317     # of if no message with that ID exists the one
318     # with the next higher ID
319     #
320     return undef unless(defined($id));
321    
322 knops.gerd 46 my $numMessages=scalar(@{$self->{'messages'}});
323 knops.gerd 11
324     return undef unless($numMessages);
325     return -1 unless($id ne '');
326    
327     # Note: negative $id means go back that many messages
328     return $numMessages+$id if($id<0);
329    
330     my $low=0;
331     my $high=$numMessages-1;
332     my $mid;
333     my $cond;
334     while($low<=$high)
335     {
336     $mid=($low+$high)>>1;
337     $cond=$id <=> $self->{'messages'}->[$mid]->id();
338     if($cond<0)
339     {
340     $high=$mid-1;
341     }
342     elsif($cond>0)
343     {
344     $low=$mid+1;
345     }
346     else
347     {
348     return $mid;
349     }
350     }
351    
352     return undef if($low>=$numMessages);
353    
354     return $low;
355     }
356    
357 knops.gerd 46 sub lastMsgID {
358     my $self=shift;
359     my $numMessages=scalar(@{$self->{'messages'}});
360 andrew.betts 50 return undef unless($numMessages>0);
361 knops.gerd 46 @{$self->{'messages'}}[-1]->id();
362     }
363    
364 knops.gerd 45 sub descriptionWithTemplate {
365     my $self=shift;
366     my $template=shift;
367    
368     $template=~s/~([a-zA-Z0-9_]*)~/
369 andrew.betts 50 if(!defined($1) || $1 eq '') {
370 knops.gerd 45 '~';
371 andrew.betts 50 } elsif($1 eq 'messageCount') {
372 knops.gerd 45 $self->messageCount();
373 andrew.betts 50 } elsif($1 eq 'subscriberCount') {
374 knops.gerd 45 $self->subscriberCount();
375 andrew.betts 50 } elsif($1 eq 'lastMsgID') {
376 knops.gerd 46 $self->lastMsgID();
377 andrew.betts 50 } elsif($1 eq 'name') {
378     $self->{'name'};
379     } else {
380 knops.gerd 45 '';
381     }
382     /gex;
383    
384     $template;
385     }
386    
387 knops.gerd 11 1;
388 andrew.betts 3 ############################################################################EOF

  ViewVC Help
Powered by ViewVC 1.1.26