File Coverage

blib/lib/Gnus/Newsrc.pm

Criterion	Covered	Total	%
statement	53	58	91.3
branch	16	22	72.7
condition	2	3	66.6
subroutine	8	12	66.6
pod	9	9	100.0
total	88	104	84.6

package Gnus::Newsrc;

=head1 NAME

Gnus::Newsrc - parse ~/.newsrc.eld files

=head1 SYNOPSIS

  $newsrc = Gnus::Newsrc->new;
  ($level, $read, $marks, $server, $group_para) =
     @{$newsrc->alist_hash->{"comp.lang.perl.misc"}};

=head1 DESCRIPTION

The C objects represents the content of the ~/newsrc.eld
files that the Gnus newsreader use to store away its state.

The following methods are provided:

=over 4

=cut

use strict;
use vars qw($VERSION);

$VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);

use Lisp::Reader qw(lisp_read);



=item $newsrc = Gnus::Newsrc->new( [$filename] )

The object constructor takes an optional filename as argument.  The
file defaults to F<~/.newsrc.eld>.  It will read and parse the file
and return a reference to a C object.  The constructor
will croak if the file can't be found or can't be parsed.

=cut

sub new
{
    my($class, $file) = @_;
    $file = "$ENV{HOME}/.newsrc.eld" unless defined $file;
    local($/) = undef;  #slurp;
    open(LISP, $file) || die "Can't open $file: $!";
    my $lisp = ;
    close(LISP);

    local $Lisp::Reader::SYMBOLS_AS_STRINGS = 1;  # gives quicker parsing
    my $form = lisp_read($lisp);

    my $self = bless {}, $class;

    for (@$form) {
	my($one,$two,$three) = @$_;
	#print join(" - ", map {$_->name} $one, $two), "\n";
	if ($one eq "setq") {
	    if (ref($three) eq "ARRAY") {
		my $first = $three->[0];
		if ($first eq "quote") {
		    $three = $three->[1];
		}
	    }
	    $self->{$two} = $three;
	} else {
	    warn "$_ does not start with (setq symbo ...)\n";
	}
    }

    # make the 'gnus-newsrc-alist' into a more perl suitable structure
    for (@{$self->{'gnus-newsrc-alist'}}) {
	my($group, $level, $read, $marks, $server, $para) = @$_;

	for ($read, $marks, $para) {
	    $_ = [] unless defined;
	}
	$_->[2] = join(",", map {ref($_)?"$_->[0]-$_->[1]":$_} @$read);
	$_->[3] = @$marks ?
                     { map {shift(@$_) =>
		            join(",", map {ref($_)?"$_->[0]-$_->[1]":$_}@$_)}
                      @$marks
                     }
                  : undef;
	$_->[5] = @$para ? { map { $_->[0] => $_->[1] } @$para } : undef;

	# trim trailing undef values
	pop(@$_) until defined($_->[-1]) || @$_ == 0;
    }

    $self;
}



=item $newsrc->file_version

Return the version number found in the file
I<(gnus-newsrc-file-version)>.  The version number is a string like
C<"Gnus v5.5">.

=cut

sub file_version
{
    shift->{"gnus-newsrc-file-version"};
}



=item $newsrc->last_checked_date

Returns a string like C<"Sat Oct 18 14:05:53 1997">
I<(gnus-newsrc-last-checked-date)>.

=cut

sub last_checked_date
{
    shift->{"gnus-newsrc-last-checked-date"};
}



=item $newsrc->alist

Returns a reference to an array that will have one element for each
active newsgroup I<(gnus-newsrc-alist)>.  Each element is a array with
the following values:

   $group_name
   $group_level
   $read_articles
   \%marks
   \@server
   \%group_parameters

The C<$read_articles> and C<%marks> values is a string of integer
ranges, and it is suitable for initializing a C objects.

=cut

sub alist
{
    shift->{"gnus-newsrc-alist"};
}



=item $newsrc->alist_hash

Returns a reference to a hash indexed by group names.  The hash values
are the same as the C elements, but the C<$group_name> is
missing.

=cut

sub alist_hash
{
    my $self = shift;
    unless ($self->{'_alist_hash'}) {
	my %ahash;
	$self->{'_alist_hash'} = \%ahash;
	for (@{$self->alist}) {
	    my @groupinfo = @$_;
	    my $group = shift @groupinfo;
	    $ahash{$group} = \@groupinfo;
	}
    }
    $self->{'_alist_hash'};
}



=item $newsrc->server_alist

I<(gnus-server-alist)>.

=cut

sub server_alist
{
    shift->{"gnus-server-alist"};

}



=item $newsrc->killed_list

A reference to an array that contains all the killed newsgroups I<(gnus-killed-list)>.

=cut

sub killed_list
{
    shift->{"gnus-killed-list"};
}



=item $newsrc->zombie_list

A reference to an array that contains all zombie newsgroups
I<(gnus-zombie-list)>.

=cut

sub zombie_list
{
    shift->{"gnus-zombie-list"};
}



=item $newsrc->format_specs

=cut

sub format_specs
{
    shift->{"gnus-format-specs"};
}


1;
__END__