lib/PublicInbox/NewsGroup.pm

   1 # Copyright (C) 2015 all contributors <meta@public-inbox.org>
   2 # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
   3 package PublicInbox::NewsGroup;
   4 use strict;
   5 use warnings;
   6 use fields qw(name git_dir address domain mm gcf search);
   7 use Scalar::Util qw(weaken);
   8 require Danga::Socket;
   9 require PublicInbox::Msgmap;
  10 require PublicInbox::GitCatFile;
  11
  12 sub new {
  13         my ($class, $name, $git_dir, $address) = @_;
  14         my $self = fields::new($class);
  15         $self->{name} = $name;
  16         $self->{domain} = ($address =~ /\@(\S+)\z/) ? $1 : 'localhost';
  17         $self->{git_dir} = $git_dir;
  18         $self->{address} = $address;
  19         $self;
  20 }
  21
  22 sub defer_weaken {
  23         my ($self, $field) = @_;
  24         Danga::Socket->AddTimer(30, sub { weaken($self->{$field}) });
  25 }
  26
  27 sub gcf {
  28         my ($self) = @_;
  29         $self->{gcf} ||= eval {
  30                 my $gcf = PublicInbox::GitCatFile->new($self->{git_dir});
  31
  32                 # git repos may be repacked and old packs unlinked
  33                 defer_weaken($self, 'gcf');
  34                 $gcf;
  35         };
  36 }
  37
  38 sub mm {
  39         my ($self) = @_;
  40         $self->{mm} ||= eval {
  41                 my $mm = PublicInbox::Msgmap->new($self->{git_dir});
  42
  43                 # may be needed if we run low on handles
  44                 defer_weaken($self, 'mm');
  45                 $mm;
  46         };
  47 }
  48
  49 sub search {
  50         my ($self) = @_;
  51         $self->{search} ||= eval {
  52                 require PublicInbox::Search;
  53                 my $search = PublicInbox::Search->new($self->{git_dir});
  54
  55                 # may be needed if we run low on handles
  56                 defer_weaken($self, 'search');
  57                 $search;
  58         };
  59 }
  60
  61 sub description {
  62         my ($self) = @_;
  63         open my $fh, '<', "$self->{git_dir}/description" or return '';
  64         my $desc = eval { local $/; <$fh> };
  65         chomp $desc;
  66         $desc =~ s/\s+/ /smg;
  67         $desc;
  68 }
  69
  70 sub update {
  71         my ($self, $new) = @_;
  72         $self->{address} = $new->{address};
  73         $self->{domain} = $new->{domain};
  74         if ($self->{git_dir} ne $new->{git_dir}) {
  75                 # new git_dir requires a new mm and gcf
  76                 $self->{mm} = $self->{gcf} = undef;
  77                 $self->{git_dir} = $new->{git_dir};
  78         }
  79 }
  80
  81 1;