File Coverage

blib/lib/News/Newsrc.pm

Criterion	Covered	Total	%
statement	237	237	100.0
branch	115	124	92.7
condition	9	13	69.2
subroutine	40	40	100.0
pod	29	34	85.2
total	430	448	95.9

package News::Newsrc;

use 5;
use strict;
use Set::IntSpan;

$News::Newsrc::VERSION      = '1.11';
$Set::IntSpan::Empty_String = '';


sub new
{
    my ($class, $file, %options) = @_;

    my $newsrc = { group => {},
		   list  => [] };

    bless $newsrc, ref $class || $class;

    $newsrc->load($file) or $options{create} or die "Can't load $file: $!\n" if $file;

    return $newsrc;
}


sub load
{
    my($newsrc, $file) = @_;

    $file or $file = "$ENV{HOME}/.newsrc";
    $newsrc->{file } = $file;
    $newsrc->{group} = { };
    $newsrc->{list } = [ ];

    open(NEWSRC, $file) or return '';
    my $lines = [  ];          # whole file
    close(NEWSRC);

    eval { $newsrc->import_rc($lines) };
    $@ and die "News::Newsrc::load: file $file: $@";

    1
}


sub _scan    # Initializes a Newsrc object from a string.  Used for testing.
{
    my($newsrc, $lines) = @_;

    my @lines = split /\n/, $lines;
    $newsrc->import_rc(@lines);
}


sub import_rc
{
    my $newsrc = shift;
    my $lines = ref $_[0] ? $_[0] : [ @_ ];

    $newsrc->{group} = { };
    $newsrc->{list } = [ ];

    my $line_number = 1;
    for my $line (@$lines)
    {
	eval { $newsrc->parse($line) };
	$@ and die "News::Newsrc::import_rc: line $line_number: $@";

	$line_number++;
    }
}


sub parse   # parses a single line from a newsrc file
{
    my($newsrc, $line) = @_;

    $line =~ /\S/ or return;
    $line =~ s/\s//g;

    $line =~ /^ ([^!:]+) ([!:]) (.*) $/x or
	die "News::Newsrc::parse: Bad newsrc line: $line";

    my($name, $mark, $articles) = ($1, $2, $3);

    valid Set::IntSpan $articles or
	die "News::Newsrc::parse: Bad article list: $line";

    my $group = { name       => $name,
		  subscribed => $mark eq ':',
		  articles   => Set::IntSpan->new($articles) };

    $newsrc->{group}{$name} = $group;
    push(@{$newsrc->{list}}, $group);
}


sub save
{
    my $newsrc = shift;

    $newsrc->{file} or $newsrc->{file} = "$ENV{HOME}/.newsrc";
    $newsrc->save_as($newsrc->{file});
}


sub save_as
{
    my($newsrc, $file) = @_;

    -e $file and
	(rename($file, "$file.bak") or
	 die "News::Newsrc::save_as: Can't rename $file, $file.bak: $!\n");

    open(NEWSRC, "> $file") or
	die "News::Newsrc::save_as: Can't open $file: $!\n";

    $newsrc->{file} = $file;
    eval { $newsrc->format($file) };
    close NEWSRC;
    die $@ if $@;
}


sub format
{
    my($newsrc, $file) = @_;

    for my $group (@{$newsrc->{list}})
    {
	my $name     = $group->{name};
	my $sub      = $group->{subscribed} ? ':' : '!';
	my $articles = $group->{articles}->run_list;
	my $space    = $articles ? ' ' : '';
	print NEWSRC "$name$sub$space$articles\n" or
	    die "News::Newsrc::format: Can't write $file: $!\n";
    }
}


sub export_rc
{
    my $newsrc = shift;

    my @lines = map { my $group    = $_;
          	      my $name     = $group->{name};
	  	      my $sub      = $group->{subscribed} ? ':' : '!';
	  	      my $articles = $group->{articles}->run_list;
	  	      my $space    = $articles ? ' ' : '';
	  	      "$name$sub$space$articles\n" }  @{$newsrc->{list}};

    wantarray ? @lines : \@lines
}


sub _dump	# Formats a Newsrc object to a string.  Used for testing
{
    my $newsrc = shift;

    my $dump = '';
    for my $group (@{$newsrc->{list}})
    {
	my $name     = $group->{name};
	my $sub      = $group->{subscribed} ? ':' : '!';
	my $articles = $group->{articles}->run_list;
        $articles    = ' ' . $articles if $articles =~ /^\d/;
	$dump       .= "$name$sub$articles\n";
    }

    $dump
}


sub add_group
{
    my($newsrc, $name, %options) = @_;

    if ($newsrc->{group}{$name})
    {
	$options{replace} or return 0;
	$newsrc->del_group($name);
    }

    my $group = { name       => $name,
		  subscribed => 1,
		  articles   => Set::IntSpan->new };

    $newsrc->{group}{$name} = $group;
    $newsrc->_insert($group, %options);

    1
}


sub move_group
{
    my($newsrc, $name, %options) = @_;
    my $group = $newsrc->{group}{$name};
    $group or return 0;

    $newsrc->{list} = [ grep { $_->{name} ne $name } @{$newsrc->{list}} ];
    $newsrc->_insert($group, %options);
    1
}


sub Splice(\@$$@)
{
    my($array, $offset, $length, @list) = @_;

    $offset >  @$array and $offset =  @$array;
    $offset < -@$array and $offset = -@$array;
    splice @$array, $offset, $length, @list;
}


sub _insert
{
    my($newsrc, $group, %options) = @_;

    my $list = $newsrc->{list};

    my($where, $arg) = ('', '');
    $options{where} and $where = $options{where};
    ref $where and ($where, $arg) = @$where;

    for ($where)
    {
	/first/  and unshift @$list, $group;
	/last/   and push    @$list, $group;
	/^$/     and push    @$list, $group;	# default
	/alpha/  and Alpha   ($list, $group);
	/before/ and Before  ($list, $group, $arg);
	/after/  and After   ($list, $group, $arg);
	/number/ and Splice  @$list, $arg, 0, $group;
    }
}


sub Alpha
{
    my($list, $group, $before) = @_;
    my $name = $group->{name};

    for my $i (0..$#$list)
    {
	if ($name lt $list->[$i]{name})
	{
	    splice @$list, $i, 0, $group;
	    return;
	}
    }

    push @$list, $group;
}


sub Before
{
    my($list, $group, $before) = @_;
    my $name = $group->{name};

    for my $i (0..$#$list)
    {
	if ($list->[$i]{name} eq $before)
	{
	    splice @$list, $i, 0, $group;
	    return;
	}
    }

    push @$list, $group;
}


sub After
{
    my($list, $group, $after) = @_;
    my $name = $group->{name};

    for my $i (0..$#$list)
    {
	if ($list->[$i]{name} eq $after)
	{
	    splice @$list, $i+1, 0, $group;
	    return;
	}
    }

    push @$list, $group;
}


sub del_group
{
    my($newsrc, $name) = @_;

    $newsrc->{group}{$name} or return 0;

    delete $newsrc->{group}{$name};
    $newsrc->{list} = [ grep { $_->{name} ne $name } @{$newsrc->{list}} ];

    1
}


sub subscribe
{
    my($newsrc, $name, %options) = @_;
    $newsrc->{group}{$name} or $newsrc->add_group($name, %options);
    $newsrc->{group}{$name}{subscribed} = 1;
}


sub unsubscribe
{
    my($newsrc, $name, %options) = @_;
    $newsrc->{group}{$name} or $newsrc->add_group($name, %options);
    $newsrc->{group}{$name}{subscribed} = 0;
}


sub mark
{
    my($newsrc, $name, $article, %options) = @_;
    $newsrc->{group}{$name} or $newsrc->add_group($name, %options);
    $newsrc->{group}{$name}{articles}->insert($article);
}


sub mark_list
{
    my($newsrc, $name, $list, %options) = @_;
    $newsrc->{group}{$name} or $newsrc->add_group($name, %options);
    my $group = $newsrc->{group}{$name};
    my $articles = union { $group->{articles} } $list;
    $group->{articles} = $articles;
}


sub mark_range
{
    my($newsrc, $name, $from, $to, %options) = @_;
    $newsrc->{group}{$name} or $newsrc->add_group($name, %options);
    my $group = $newsrc->{group}{$name};
    my $range = new Set::IntSpan "$from-$to";
    my $articles = union { $group->{articles} } $range;
    $group->{articles} = $articles;
}


sub unmark
{
    my($newsrc, $name, $article, %options) = @_;
    $newsrc->{group}{$name} or $newsrc->add_group($name, %options);
    $newsrc->{group}{$name}{articles}->remove($article);
}


sub unmark_list
{
    my($newsrc, $name, $list, %options) = @_;
    $newsrc->{group}{$name} or $newsrc->add_group($name, %options);
    my $group = $newsrc->{group}{$name};
    my $articles = diff { $group->{articles} } $list;
    $group->{articles} = $articles;
}


sub unmark_range
{
    my($newsrc, $name, $from, $to, %options) = @_;
    $newsrc->{group}{$name} or $newsrc->add_group($name, %options);
    my $group = $newsrc->{group}{$name};
    my $range = new Set::IntSpan "$from-$to";
    my $articles = diff { $group->{articles} } $range;
    $group->{articles} = $articles;
}


sub exists
{
    my($newsrc, $name) = @_;
    $newsrc->{group}{$name} ? 1 : ''
}


sub subscribed
{
    my($newsrc, $name) = @_;
    $newsrc->exists($name) and $newsrc->{group}{$name}{subscribed}
}


sub marked
{
    my($newsrc, $name, $article) = @_;

    $newsrc->exists($name) and
	member {  $newsrc->{group}{$name}{articles} } $article
}


sub num_groups
{
    my $newsrc = shift;
    my $list = $newsrc->{list};
    scalar @$list
}


sub groups
{
    my $newsrc = shift;
    my $list = $newsrc->{list};
    my @list = map { $_->{name} } @$list;
    wantarray ? @list : \@list;
}


sub sub_groups
{
    my $newsrc = shift;
    my $list = $newsrc->{list};
    my @list = map { $_->{name} } grep { $_->{'subscribed'} } @$list;
    wantarray ? @list : \@list;
}


sub unsub_groups
{
    my $newsrc = shift;
    my $list = $newsrc->{list};
    my @list = map { $_->{name} } grep { not $_->{'subscribed'} } @$list;
    wantarray ? @list : \@list;
}


sub marked_articles
{
    my($newsrc, $name, %options) = @_;
    $newsrc->{group}{$name} or $newsrc->add_group($name, %options);
    my @marked = elements { $newsrc->{group}{$name}{articles} };
    wantarray ? @marked : \@marked
}


sub unmarked_articles
{
    my($newsrc, $name, $from, $to, %options) = @_;
    $newsrc->{group}{$name} or $newsrc->add_group($name, %options);
    my $range = new Set::IntSpan "$from-$to";
    my $unmarked = diff $range $newsrc->{group}{$name}{articles};
    my @unmarked = elements $unmarked;
    wantarray ? @unmarked : \@unmarked
}

sub get_articles
{
    my($newsrc, $name, %options) = @_;
    $newsrc->{group}{$name} or $newsrc->add_group($name, %options);
    $newsrc->{group}{$name}{articles}->run_list;
}


sub set_articles
{
    my($newsrc, $name, $articles, %options) = @_;

    valid Set::IntSpan $articles or return 0;
    my $set = new Set::IntSpan $articles;
    finite $set or return 0;
    my $min = $set->min;
    defined $min and $min < 0 and return 0;

    $newsrc->{group}{$name} or $newsrc->add_group($name, %options);
    $newsrc->{group}{$name}{articles} = $set;
    1
}

1

__END__