# $File: //depot/libOurNet/BBS/lib/OurNet/BBS/MELIX/GroupGroup.pm $ $Author: autrijus $
# $Revision: #9 $ $Change: 3972 $ $DateTime: 2003/01/28 11:41:10 $
package OurNet::BBS::MELIX::GroupGroup;
use open IN => ':raw', OUT => ':raw';
use strict;
no warnings 'deprecated';
use fields qw/bbsroot group mtime _ego _hash/;
use OurNet::BBS::Base (
'$packstring' => 'LLLZ32Z80Z50Z9Z73',
'$packsize' => 256,
'@packlist' => [qw/time xmode xid id author nick date title/],
'$toplevel' => 'Class',
);
use constant GEM_FOLDER => 0x00010000;
use constant GEM_BOARD => 0x00020000;
use constant GEM_GOPHER => 0x00040000;
use constant GEM_HTTP => 0x00080000;
use constant GEM_EXTEND => 0x80000000;
sub readok { 1 }
sub writeok { 0 }
sub toplevel {
my $self = shift;
$toplevel = shift if @_;
return $toplevel;
}
sub refresh_meta {
my ($self, $key) = @_;
$self->{group} ||= $toplevel;
return $self->_refresh_meta;
}
sub _refresh_meta {
my $self = shift->ego;
my $file = "$self->{bbsroot}/gem/\@/\@$self->{group}";
return if $self->filestamp($file);
%{$self->{_hash}} = ();
my $GROUP;
open($GROUP, "<$file") or open ($GROUP, "+>>$file")
or warn("Cannot read group file $file: $!");
return if (stat($file))[7] % $packsize;
local $/ = \$packsize;
my (%entry, $buf);
my $recno = 0;
while (defined($buf = <$GROUP>)) {
@entry{@packlist} = unpack($packstring, $buf);
$entry{id} =~ s/^@//;
if ($entry{xmode} & GEM_BOARD) {
$self->{_hash}{$entry{id}} = $self->module('Board')->new(
$self->{bbsroot}, $entry{id},
) if -e "$self->{bbsroot}/brd/$entry{id}/.DIR";
}
elsif ($entry{xmode} & GEM_FOLDER) {
$self->{_hash}{$entry{id}} = $self->module('Group')->new({
bbsroot => $self->{bbsroot},
parent => $self->{group},
recno => $recno,
group => $entry{id},
map { $_ => $entry{$_} } @packlist,
}) if -e "$self->{bbsroot}/gem/\@/\@$entry{id}";
}
$recno++;
}
close $GROUP;
}
sub STORE {
my ($self, $key, $value) = @_;
$self = $self->ego;
$self->{group} ||= $toplevel;
# heuristic:
# - blessed refs are of their own type.
# - unblessed hashrefs are groups waiting to be built.
# = allows using ->{group} or the key for automatic creations.
# - non-refs means auto-detection; try board first.
if (!ref($value)) {
# deduction time
$value = (-e "$self->{bbsroot}/brd/$key/.DIR")
? $self->module('Board')->new($self->{bbsroot}, $key)
: (-e "$self->{bbsroot}/gem/\@/\@$key")
? $self->module('Group')->new($self->{bbsroot}, $key)
: die "doesn't exists such group or board $key: panic!";
}
elsif (ref($value) eq 'HASH') {
# create a new group here. yes. here.
$key ||= $value->{id}; $value->{id} ||= $key;
my $file = "$self->{bbsroot}/gem/\@/\@$key";
unless (-e $file) {
open(my $DIR, ">$file") or die "cannot open $file for writing";
close $DIR;
}
}
return if exists $self->{_hash}{$key}; # doesn't make sense yet
my $file = "$self->{bbsroot}/gem/\@/\@$self->{group}";
die "doesn't exists such group or board $key: panic!"
unless (-e "$self->{bbsroot}/gem/\@/\@$key" or
-e "$self->{bbsroot}/brd/$key/.DIR");
my %entry = (
xmode => ref($value) =~ /Board/ ? GEM_BOARD : GEM_FOLDER,
'time' => scalar CORE::time,
);
if ($entry{xmode} eq GEM_BOARD) {
$entry{author} = $value->{bm};
$entry{title} = $value->{title};
$entry{id} = $value->{id};
}
else {
$entry{author} = $value->{owner};
$entry{title} = $value->{title};
$entry{id} = '@'.$value->{id};
}
no warnings 'uninitialized';
open(my $DIR, "+>>$file")
or die "can't write DIR file for $self->{group}: $!";
print $DIR pack($packstring, @entry{@packlist});
close $DIR;
if (ref($value) eq 'HASH') {
# promote it to a Group object
$value = $self->module('Group')->new(
@{$self}{qw/bbsroot group/}, ((stat($file))[7] / $packsize) - 1,
$value->{id}, @entry{@packlist},
);
};
$self->{_hash}{$key} = $value;
}
1;
syntax highlighted by Code2HTML, v. 0.9.1