From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

AUTRIJUS / OurNet-1.4-alpha2 / lib / OurNet / BBS.pm 

            

              
1
2
3
4
5
6
7
8
9
10
—
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
—
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127

              
package OurNet::BBS;
require 5.005;
$OurNet::BBS::VERSION = "0.1";
use strict;
use base qw/OurNet::BBS::Base/;
use fields qw/backend bbsroot brdshmkey maxboard sessionshmkey maxsession
              usershmkey maxuser _cache/;
use OurNet::BBS::Utils;
=head1 NAME
OurNet::BBS - Component Object Model for BBS systems
=head1 SYNOPSIS
    use strict;
    use OurNet::BBS;
     
    my $backend = 'CVIC'; # same as 'OurNet::BBS::CVIC'
    my $bbsroot = '/srv/bbs/cvic';
    my $board   = 'sysop';
    my $BBS     = OurNet::BBS->new($backend, $bbsroot);
    my $brd     = $BBS->{boards}{$board};
    my $mtime;
     
    printf (
        "This BBS has %d boards, %d groups.\n",
        scalar keys(%{$BBS->{boards}}),
        scalar keys(%{$BBS->{groups}}),
    );
     
    eval { $mtime = $brd->{articles}->mtime };
    die "Error: cannot read board $board -- $@\n" if $@;
     
    printf (
        "The $board board has %d articles, %d toplevel archive entries.\n",
        $#{$brd->{articles}}, $#{$brd->{archives}},
    );
     
    # A simple Sysop board article monitor
    print "Watching for new articles...\n";
     
    while (1) {
        print "=== wait here ($mtime) ===\n";
        sleep 5 until ($brd->{articles}->refresh);
     
        foreach my $article (@{$brd->{articles}}[1..$#{$brd->{articles}}]) {
                print "Found article: $article->{title}\n" if $article->btime > $mtime;
        }
     
        $mtime = $brd->{articles}->mtime;
    }
=head1 DESCRIPTION
OurNet::BBS implements a flexible object model for different BBS backends.
More detailed document is expected to appear soon.
=cut
sub refresh_boards {
    my ($self, $key) = @_;
    return $self->fillin($key, 'BoardGroup', $self->{bbsroot},
                         $self->{brdshmkey}, $self->{maxboard});
}
sub refresh_groups {
    my ($self, $key) = @_;
    return $self->fillin($key, 'GroupGroup', $self->{bbsroot});
}
sub refresh_sessions {
    my ($self, $key) = @_;
    return $self->fillin($key, 'SessionGroup', $self->{bbsroot},
                         $self->{sessionshmkey}, $self->{maxsession});
}
sub refresh_users {
    my ($self, $key) = @_;
    return $self->fillin($key, 'UserGroup', $self->{bbsroot},
                         $self->{usershmkey}, $self->{maxuser});
}
sub refresh_meta {
    # do nothing -- as of now
}
sub fillin {
    my ($self, $key, $class) = splice(@_, 0, 3);
    return if defined($self->{_cache}{$key});
    my $prefix = (index($self->{backend}, '::') > -1 ? '' : (ref($self).'::'));
    my $module = "$prefix$self->{backend}/$class.pm";
    $module =~ s|::|/|g;
    require $module;
    $self->{_cache}{$key} = "$prefix$self->{backend}::$class"->new(@_);
     
    return 1;
}
1;
__END__
=head1 AUTHORS
Chia-Liang Kao E<lt>clkao@clkao.org>
Autrijus Tang E<lt>autrijus@autrijus.org>
=head1 COPYRIGHT
Copyright 2001 by Autrijus Tang E<lt>autrijus@autrijus.org>,
                  Chia-Liang Kao E<lt>clkao@clkao.org>.
All rights reserved.  You can redistribute and/or modify
this module under the same terms as Perl itself.
=cut