News-Newsrc-1.11/0000755000076400007640000000000012133103757012635 5ustar swmcdswmcdNews-Newsrc-1.11/Makefile.PL0000644000076400007640000000064210373650451014613 0ustar swmcdswmcduse ExtUtils::MakeMaker; WriteMakefile(NAME => 'News::Newsrc', VERSION_FROM => 'Newsrc.pm', # finds $VERSION DISTNAME => 'News-Newsrc', ($] >= 5.005 ? (ABSTRACT => 'Manages newsrc files', AUTHOR => 'Steven McDougall (swmcd@world.std.com)') : ()), dist => {COMPRESS => 'gzip', SUFFIX => 'gz'}, PREREQ_PM => { Set::IntSpan => 1.07 }, ); News-Newsrc-1.11/README0000644000076400007640000000152712127435603013523 0ustar swmcdswmcdNews::Newsrc - manage newsrc files DESCRIPTION News::Newsrc manages newsrc files, of the style alt.foo: 1-21,28,31-34 alt.bar! 3,5,9-2900,2902 Methods are provided for - reading and writing newsrc files - adding and removing newsgroups - changing the order of newsgroups - subscribing and unsubscribing from newsgroups - testing whether groups exist and are subscribed - marking and unmarking articles - testing whether articles are marked - returning lists of newsgroups - returning lists of articles PREREQUISITES Perl5 Set::IntSpan HOW TO BUILD AND INSTALL perl Makefile.PL make make test make install TODO Nothing planned. Send suggestions, bugs, etc. to swmcd@world.std.com COPYRIGHT Copyright 1996-2013 by Steven McDougall. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. News-Newsrc-1.11/t/0000755000076400007640000000000012133103757013100 5ustar swmcdswmcdNews-Newsrc-1.11/t/use-int.t0000644000076400007640000000074212133103746014652 0ustar swmcdswmcd# -*- perl -*- use strict; use Config; BEGIN { $Set::IntSpan::integer = 1 } use News::Newsrc 1.10; my $N = 1; sub Not { print "not " } sub OK { print "ok ", $N++, " @_\n" } print "1..1\n"; my $rc = new News::Newsrc; $rc->mark_range('a', 1_000_000_000_000, 1_000_000_000_100); for my $i (0..100) { mark $rc 'a', 2e12+$i; } if ($Config{ivsize}==4) { $rc->get_articles('a') eq '1000000000100' or Not; OK 'no integer'; } else { OK '# SKIP not a 32-bit platform'; } News-Newsrc-1.11/t/no-int.t0000644000076400007640000000061212127435603014471 0ustar swmcdswmcd# -*- perl -*- use strict; use News::Newsrc 1.10; my $N = 1; sub Not { print "not " } sub OK { print "ok ", $N++, " @_\n" } print "1..1\n"; my $rc = new News::Newsrc; $rc->mark_range('a', 1_000_000_000_000, 1_000_000_000_100); for my $i (0..100) { mark $rc 'a', 2e12+$i; } $rc->get_articles('a') eq '1000000000000-1000000000100,2000000000000-2000000000100' or Not; OK 'no integer'; News-Newsrc-1.11/t/Newsrc.t0000644000076400007640000003130010727135500014521 0ustar swmcdswmcd# -*- perl -*- # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN {print "1..125\n";} END {print "not ok 1\n" unless $loaded;} use News::Newsrc; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): my $N = 1; sub Not{ print "not " }; sub OK { print "ok ", ++$N, "\n" } #GLOBALS my $Verbose; my @Test_files = qw(t/newsrc t/.newsrc t/newsrc.bak t/.newsrc.bak); $ENV{HOME} = 't'; test_new (); test_load (); test_load_errs (); test_save (); test_save_bak (); test_save_load (); test_save_as (); test_import (); test_export (); test_groups (); test_subscription(); test_where (); test_moves (); test_adds (); test_marks (); test_predicates (); test_lists (); test_get_articles(); test_set_articles(); unlink @Test_files; sub test_new { print "#new\n"; new News::Newsrc; OK; new News::Newsrc "t/fodder"; OK; unlink "t/no_file"; eval { new News::Newsrc "t/no_file" }; $@ =~ m(Can't load t/no_file:) or Not; OK; my $no_file = new News::Newsrc "t/no_file", create => 1; OK; $no_file->save; new News::Newsrc "t/no_file"; OK; } sub test_load { print "#load\n"; my @test = (["t/.newsrc", "a: 1,3\n\n", "" , 1 , "a: 1,3\n" ], ["t/newsrc" , "b! 1-10\n ", "t/newsrc" , 1 , "b! 1-10\n"], ["" , "" , "t/newsrc.bak", "", "" ]); my $t; my $rc = new News::Newsrc; unlink @Test_files; for $t (@test) { my($write_file, $contents, $load_file, $e_return, $e_dump) = @$t; write_file($write_file, $contents); my $return = $rc->load($load_file); my $dump = $rc->_dump(); printf("#%-12s %s -> %s: %s\n", "load($load_file)", $contents, $return, $dump); $return eq $e_return and $dump eq $e_dump or Not; OK; } } sub test_load_errs { print "#load errors\n"; my @test = ([ 't/.newsrc', 'a' , 'Bad newsrc line' ], [ 't/.newsrc', 'a: 10-1', 'Bad article list']); my $t; my $rc = new News::Newsrc; unlink @Test_files; for $t (@test) { my($file, $contents, $error) = @$t; write_file($file, $contents); my $return = eval { $rc->load() }; printf("#%-12s %-10s -> %s %s", "load", $contents, defined $return ? 't' : 'f', $@); not $return and $@ =~ /$error/ or Not; OK; } } sub test_save { print "#save\n"; unlink @Test_files; my $rc = new News::Newsrc; my $scan ="a: 1,3\n"; $rc->_scan($scan); $rc->save(); my $read = read_file('t/.newsrc'); printf("#%-12s %20s -> %s", "save", $scan, $read); $scan eq $read or Not; OK; } sub test_save_bak { print "#save_bak\n"; unlink @Test_files; my $rc = new News::Newsrc; $rc->save(); my $result = defined -e 't/.newsrc.bak' ? 1 : 0; printf("#%-12s %-20s -> %d\n", "save", "", $result); $result and Not; OK; $rc->save(); $result = defined -e 't/.newsrc.bak' ? 1 : 0; printf("#%-12s %-20s -> %d\n", "save", "", $result); $result or Not; OK; } sub test_save_load { print "#save_load\n"; my $rc = new News::Newsrc; write_file('t/newsrc', ''); $rc->load('t/newsrc'); unlink @Test_files; $rc->save(); my $result = defined -e 't/newsrc' ? 1 : 0; printf("#%-12s %-20s -> %d\n", "save", "", $result); $result or Not; OK; } sub test_save_as { print "#save_as\n"; my $rc = new News::Newsrc; unlink @Test_files; $rc->save_as('t/newsrc'); my $result = defined -e 't/newsrc' ? 1 : 0; printf("#%-12s %-20s -> %d\n", "save", "", $result); $result or Not; OK; unlink @Test_files; $rc->save(); $result = defined -e 't/newsrc' ? 1 : 0; printf("#%-12s %-20s -> %d\n", "save", "", $result); $result or Not; OK; } sub test_import { print "#import\n"; my $lines = <import_rc(@lines); $rc->_dump eq $lines or Not; OK; $rc->import_rc(\@lines); $rc->_dump eq $lines or Not; OK; } sub test_export { print "#export\n"; my $contents = <_scan($contents); my @lines = $rc->export_rc; join('', @lines) eq $contents or Not; OK; my $lines = $rc->export_rc; join('', @$lines) eq $contents or Not; OK; } sub test_groups { print "#groups\n"; my @test = (["add_group('a') ", "a:\n" , 1], ["add_group('b') ", "a:\nb:\n" , 1], ["add_group('c') ", "a:\nb:\nc:\n", 1], ["add_group('c') ", "a:\nb:\nc:\n", 0], ["add_group('c', replace=>1)", "a:\nb:\nc:\n", 1], ["del_group('b') ", "a:\nc:\n" , 1], ["del_group('x') ", "a:\nc:\n" , 0]); my $rc = new News::Newsrc; my $t; for $t (@test) { my($op, $eDump, $eReturn) = @$t; my $return = eval "\$rc->$op"; my $dump = $rc->_dump(); print "#$op\n$dump, $return\n"; $dump eq $eDump and $return == $eReturn or Not; OK; } } sub test_subscription { print "#subscription\n"; my @test = (["unsubscribe('a')", "a!\nc:\n"], ["subscribe('a') ", "a:\nc:\n"], ["subscribe('d') ", "a:\nc:\nd:\n"], ["unsubscribe('e')", "a:\nc:\nd:\ne!\n"]); my $rc = new News::Newsrc; $rc->add_group("a"); $rc->add_group("c"); my $t; for $t (@test) { my($op, $expected) = @$t; eval "\$rc->$op"; my $result = $rc->_dump(); print "#$op\n$result"; $result eq $expected or Not; OK; } } sub test_where { print "#where\n"; my $test = <'first' a e h 'z',where=>'last' a e h z 'g',where=>'alpha' a e g h z 'f',where=>[number=>2] a e f g h z 'r',where=>[number=>-1] a e f g h r z 'p',where=>[before=>'r'] a e f g h p r z 't',where=>[after=>'r'] a e f g h p r t z 'w',where=>[number=>100] a e f g h p r t z w 'x',where=>[before=>'b'] a e f g h p r t z w x 'y',where=>[after=>'b'] a e f g h p r t z w x y TEST my $rc = new News::Newsrc; for (split(/\n/, $test)) { my($op, @groups) = split; eval "\$rc->add_group($op)"; my $result = $rc->_dump; my $expected = join(":\n", @groups, ''); print "#$op\n$result"; $result eq $expected or Not; OK; } } sub test_moves { print "#moves\n"; my @groups = qw(a b d e f g c); my $test = <'alpha' a b c d e f g 'a',where=>'alpha' a b c d e f g 'g',where=>'alpha' a b c d e f g 'b' a c d e f g b 'c',where=>'first' c a d e f g b 'g',where=>'last' c a d e f b g 'f',where=>[number=>2] c a f d e b g 'e',where=>[number=>-1] c a f d b e g 'g',where=>[before=>'b'] c a f d g b e 'a',where=>[after=>'d'] c f d a g b e 'd',where=>[number=>-100] d c f a g b e 'f',where=>[before=>'x'] d c a g b e f 'c',where=>[after=>'x'] d a g b e f c TEST my $rc = new News::Newsrc; my $group; for $group (@groups) { $rc->add_group($group) } for (split(/\n/, $test)) { my($op, @groups) = split; eval "\$rc->move_group($op)"; my $result = $rc->_dump; my $expected = join(":\n", @groups, ''); print "#$op\n$result"; $result eq $expected or Not; OK; } } sub test_adds { print "#adds\n"; my @test = (['add_group' , [] ], ['subscribe' , [] ], ['unsubscribe' , [] ], ['mark' , [1] ], ['mark_list' , [[1]]], ['mark_range' , [1,1]], ['unmark' , [1] ], ['unmark_list' , [[1]]], ['unmark_range' , [1,1]], ['marked_articles' , [] ], ['unmarked_articles', [1,1]], ['get_articles' , [] ], ['set_articles' , [1] ]); my $rc = new News::Newsrc; my $group = 'a'; my $test; for $test (@test) { my($method, $args) = @$test; $rc->$method($group++, @$args, where=>'first'); } my $result = join(' ', $rc->groups); my $expected = join(' ', reverse 'a'..'m'); $result eq $expected or Not; OK; print "#$result\n"; } sub test_marks { print "#marks\n"; my @test1 = (["mark ('a', 1 )", "a: 1\nb:\nc:\n" ], ["mark ('b', 4 )", "a: 1\nb: 4\nc:\n" ], ["mark_list ('c', [1,3,5])", "a: 1\nb: 4\nc: 1,3,5\n" ], ["mark_list ('b', [1..10])", "a: 1\nb: 1-10\nc: 1,3,5\n" ], ["mark_range ('a', 3, 5 )", "a: 1,3-5\nb: 1-10\nc: 1,3,5\n" ], ["unmark ('a', 3 )", "a: 1,4-5\nb: 1-10\nc: 1,3,5\n" ], ["unmark_list ('b', [3..5] )", "a: 1,4-5\nb: 1-2,6-10\nc: 1,3,5\n"], ["unmark_range('c', 5, 10 )", "a: 1,4-5\nb: 1-2,6-10\nc: 1,3\n" ]); my $r1 = $test1[-1]->[1]; my @test2 = (["mark ('d', 1 )", $r1 . "d: 1\n"], ["mark_list ('e', [1,2])", $r1 . "d: 1\ne: 1-2\n"], ["mark_range ('f', 3, 5 )", $r1 . "d: 1\ne: 1-2\nf: 3-5\n"]); my $r2 = $test2[-1]->[1]; my @test3 = (["unmark ('g', 1 )", $r2 . "g:\n"], ["unmark_list ('h', [1,2])", $r2 . "g:\nh:\n"], ["unmark_range('i', 3, 5 )", $r2 . "g:\nh:\ni:\n"]); my $rc = new News::Newsrc; $rc->add_group('a'); $rc->add_group('b'); $rc->add_group('c'); my $t; for $t (@test1, @test2, @test3) { my($op, $expected) = @$t; eval "\$rc->$op"; my $result = $rc->_dump(); print "#$op\n$result"; $result eq $expected or Not; OK; } } sub test_predicates { print "#predicates\n"; my @test = (["exists", ['a' ], 1], ["exists", ['b' ], 1], ["exists", ['e' ], 0], ["subscribed", ['a' ], 1], ["subscribed", ['b' ], 0], ["subscribed", ['e' ], 0], ["marked", ['a', 1 ], 1], ["marked", ['a', 6 ], 0], ["marked", ['b', 4 ], 1], ["marked", ['c', 25], 0], ["marked", ['e', 1 ], 0], ["exists", ['e' ], 0]); my $rc = new News::Newsrc; $rc->load("t/fodder"); my $t; for $t (@test) { my($op, $args, $expected) = @$t; my $result = $rc->$op(@$args); print "#$op(@$args) -> $result\n"; ($result xor $expected) and Not; OK; } } sub test_lists { print "#lists\n"; my $rc = new News::Newsrc; $rc->load("t/fodder"); my $n = $rc->num_groups; print "#num_groups -> $n\n"; $n==5 or Not; OK; my @test = (["groups ", "c a f b d"], ["sub_groups ", "c a d" ], ["unsub_groups ", "f b" ], ["marked_articles ('a') ", "1 2 3 4 5"], ["marked_articles ('x') ", "" ], ["unmarked_articles('a', 1, 9)", "6 7 8 9" ], ["unmarked_articles('y', 3, 5)", "3 4 5" ]); my $t; for $t (@test) { my($op, $expected) = @$t; my @result = eval "\$rc->$op"; my $result = join(' ', @result); print "#$op -> $result\n"; $result eq $expected or Not; OK; } $rc->load("t/fodder"); for $t (@test) { my($op, $expected) = @$t; my $result = eval "\$rc->$op"; $result = join(' ', @$result); print "#$op -> $result\n"; $result eq $expected or Not; OK; } } sub test_get_articles { print "#get_articles\n"; my $get = <load("t/fodder"); for (split(/\n/, $get)) { my($group, $expected) = (split, ''); my $result = $rc->get_articles($group); print "#$group -> $result\n"; $result eq $expected or Not; OK; } } sub test_set_articles { print "#set_articles\n"; my $set = <load("t/fodder"); for (split(/\n/, $set)) { my($group, $expected) = (split, ''); my $ok = $rc->set_articles($group, $expected); print "#$group -> $ok\n"; $ok or Not; OK; my $result = $rc->get_articles($group); print "#$group -> $result\n"; $result eq $expected or Not; OK; $ok = $rc->set_articles($group, '----'); print "#$group -> $ok\n"; $ok and Not; OK; $result = $rc->get_articles($group); print "#$group -> $result\n"; $result eq $expected or Not; OK; } } sub write_file { my($name, $contents) = @_; $name or return; open(FILE, "> $name") or die "Can't open $name: $!\n"; print FILE $contents; close FILE; } sub read_file { my($name) = @_; open(FILE, "$name") or die "Can't open $name: $!\n"; my $contents = join('', ); close FILE; $contents; } News-Newsrc-1.11/t/fodder0000644000076400007640000000005710373647647014307 0ustar swmcdswmcdc: 20-21,33,38 a: 1-5 f! b! 3-8,15,20 d: 1,3,7 News-Newsrc-1.11/MANIFEST0000644000076400007640000000025012133103757013763 0ustar swmcdswmcdChanges MANIFEST Makefile.PL Newsrc.pm README t/Newsrc.t t/fodder t/no-int.t t/use-int.t META.yml Module meta-data (added by MakeMaker) News-Newsrc-1.11/Changes0000644000076400007640000000222512133103544014123 0ustar swmcdswmcdRevision history for Perl extension News::Newsrc 1.11 2013 Apr 15 - unit test fix 1.10 2013 Apr 04 - no use integer 1.09 2007 Dec 09 - added create => 1 option to new() - dropped dependencies on specific versions of Perl and Set::IntSpan - cleaned up some warnings 1.08 2001 Mar 16 - added PREREQ_PM key to Makefile.PL - added $file parameter to new() 1.07 1998 Dec 21 - added imort_rc and export_rc - added VERSION_FROM, DISTNAME, ABSTRACT, AUTHOR, and dist keys to Makefile.PL 1.06 Mon Jan 5 1998 - runs clean under Windows NT 1.05 Mon Sept 22 1997 - run clean under 5.004_03 1.04 Thu July 3 1997 - runs clean under 5.004 - documentation fixes 1.03 Mon March 31 12:00:00 1997 - preserve newsgroup order - added move_group() - added %options to methods - added num_groups() - added get_articles() and set_articles() 1.02 Mon Aug 26 12:00:00 1996 - ignore blank lines in newsrc files - use MakeMaker - runs clean under -w - move test code to t/*.t - documentation fixes 1.01 Thu Feb 22 20:08:26 1996 - made Newsrc an Exporter - documentation fixes 0.01 Mon Jan 29 12:45:05 1996 - original version News-Newsrc-1.11/META.yml0000644000076400007640000000105012133103757014102 0ustar swmcdswmcd--- #YAML:1.0 name: News-Newsrc version: 1.11 abstract: Manages newsrc files author: - Steven McDougall (swmcd@world.std.com) license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Set::IntSpan: 1.07 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.57_05 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 News-Newsrc-1.11/Newsrc.pm0000644000076400007640000006362212133103575014443 0ustar swmcdswmcdpackage 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__ =head1 NAME News::Newsrc - manage newsrc files =head1 SYNOPSIS use News::Newsrc; $newsrc = new News::Newsrc; $newsrc = new News::Newsrc $file; $newsrc = new News::Newsrc $file, create => 1; $ok = $newsrc->load; $ok = $newsrc->load ( $file); $newsrc->import_rc ( @lines); $newsrc->import_rc (\@lines); $newsrc->save; $newsrc->save_as ($file); @lines = $newsrc->export_rc; $ok = $newsrc-> add_group ($group, %options); $ok = $newsrc->move_group ($group, %options); $ok = $newsrc-> del_group ($group); $newsrc-> subscribe ($group, %options); $newsrc->unsubscribe ($group, %options); $newsrc->mark ($group, $article , %options); $newsrc->mark_list ($group, \@articles, %options); $newsrc->mark_range ($group, $from, $to, %options); $newsrc->unmark ($group, $article , %options); $newsrc->unmark_list ($group, \@articles, %options); $newsrc->unmark_range ($group, $from, $to, %options); ... if $newsrc->exists ($group); ... if $newsrc->subscribed ($group); ... if $newsrc->marked ($group, $article); $n = $newsrc-> num_groups; @groups = $newsrc-> groups; @groups = $newsrc-> sub_groups; @groups = $newsrc->unsub_groups; @articles = $newsrc-> marked_articles($group, %options); @articles = $newsrc->unmarked_articles($group, $from, $to, %options); $articles = $newsrc->get_articles ($group, %options); $ok = $newsrc->set_articles ($group, $articles, %options); =head1 REQUIRES Perl 5.6.0, Set::IntSpan 1.17 =head1 EXPORTS Nothing =head1 DESCRIPTION C manages newsrc files, of the style alt.foo: 1-21,28,31-34 alt.bar! 3,5,9-2900,2902 Methods are provided for =over 4 =item * reading and writing newsrc files =item * adding and removing newsgroups =item * changing the order of newsgroups =item * subscribing and unsubscribing from newsgroups =item * testing whether groups exist and are subscribed =item * marking and unmarking articles =item * testing whether articles are marked =item * returning lists of newsgroups =item * returning lists of articles =back =head1 NEWSRC FILES A newsrc file is an ASCII file that lists newsgroups and article numbers. Each line of a newsrc file describes a single newsgroup. Each line is divided into three fields: a I, a I and an I
. Lines containing only whitespace are ignored. Whitespace within a line is ignored. =over 4 =item Group The I is the name of the newsgroup. A group name may not contain colons (:) or exclamation points (!). Group names must be unique within a newsrc file. The group name is required. =item Subscription mark The I is either a colon (:), for subscribed groups, or an exclamation point (!), for unsubscribed groups. The subscription mark is required. =item Article list The I
is a comma-separated list of positive integers. The integers must be listed in increasing order. Runs of consecutive integers may be abbreviated a-b, where a is the first integer in the run and b is the last. The article list may be empty. =back =head1 NEWSGROUP ORDER C preserves the order of newsgroups in a newsrc file: if a file is loaded and then saved, the newsgroup order will be unchanged. Methods that add or move newsgroups affect the newsgroup order. By default, these methods put newsgroups at the end of the newsrc file. Other locations may be specified by passing an I<%options> hash with a C key to the method. Recognized locations are: =over 4 =item C => C<'first'> Put the newsgroup first. =item C => C<'last'> Put the newsgroup last. =item C => C<'alpha'> Put the newsgroup in alphabetical order. If the other newsgroups are not sorted alphabetically, put the group at an arbitrary location. =item C => [ C => I<$group> ] Put the group immediately before I<$group>. If I<$group> does not exist, put the group last. =item C => [ C => I<$group> ] Put the group immediately after I<$group>. If I<$group> does not exist, put the group last. =item C => [ C => I<$n> ] Put the group at position I<$n> in the group list. Indices are zero-based. Negative indices count backwards from the end of the list. =back =head1 METHODS =over 4 =item I<$newsrc> = C C =item I<$newsrc> = C C I<$file>, I<%options> Creates and returns a C object. If I<$file> is specified, C loads the newsgroups in I<$file> into the object. Subsequent calls to C will write to I<$file>. If I<$file> exists and the load fails, C Cs. If I<$file> doesn't exist and the C<< create => 1 >> option is supplied in I<%options>, then C doesn't load any newsgroups. If I<$file> doesn't exist and the C<< create => 1 >> option is not supplied in I<%options>, then C dies. =item I<$ok> = I<$newsrc>->C =item I<$ok> = I<$newsrc>->C(I<$file>) Loads the newsgroups in I<$file> into I<$newsrc>. If I<$file> is omitted, reads F<$ENV{HOME}/.newsrc>. Any existing data in I<$newsrc> is discarded. Returns true on success. If I<$file> can't be opened, C discards existing data from I<$newsrc> and returns null. If I<$file> contains invalid lines, C will C. When this happens, the state of I<$newsrc> is undefined. =item I<$newsrc>->C(I<@lines>) =item I<$newsrc>->C([I<@lines>]) Imports the newsgroups in I<@lines> into I<$newsrc>. Any existing data in I<$newsrc> is discarded. Each line in I<@lines> describes a single newsgroup, and must have the format described in L<"NEWSRC FILES">. If I<@lines> contains invalid lines, C will C. When this happens, the state of I<$newsrc> is undefined. C accepts either an array or an array reference. =item I<$newsrc>->C Writes the contents of I<$newsrc> back to the file from which it was Ced. If C has not been called, writes to F<$ENV{HOME}/.newsrc>. In either case, if the destination I exists, it is renamed to IC<.bak>. C will C if there is an error writing the file. =item I<$newsrc>->C(I<$file>) Writes the contents of I<$newsrc> to I<$file>. If I<$file> exists, it is renamed to I<$file>C<.bak>. Subsequent calls to C will write to I<$file>. C will C if there is an error writing the file. =item I<@lines> = I<$newsrc>->C Returns the contents of I<$newsrc> as a list of lines. Each line describes a single newsgroup, and has the format described in L<"NEWSRC FILES">. In scalar context, returns an array reference. =item I<$ok> = I<$newsrc>->C(I<$group>, I<%options>) Adds I<$group> to the list of newsgroups in I<$newsrc>. I<$group> is initially subscribed. The article list for I<$group> is initially empty. By default, I<$group> is added to the end of the list of newsgroups. Other locations may be specified in I<%options>; see L<"NEWSGROUP ORDER"> for details. By default, C does nothing if I<$group> already exists. If the C => C<1> option is provided, then C will delete I<$group> if it exists, and then add it. C returns true iff I<$group> was added. =item I<$ok> = I<$newsrc>->C(I<$group>, I<%options>) Changes the position of I<$group> in I<$newsrc> according to I<%options>. See L<"NEWSGROUP ORDER"> for details. If I<$group> does not exist, C does nothing and returns false. Otherwise, it returns true. =item I<$ok> = I<$newsrc>->C(I<$group>) If I<$group> exists in I<$newsrc>, C removes it and returns true. The article list for I<$group> is lost. If I<$group> does not exist in I<$newsrc>, C does nothing and returns false. =item I<$newsrc>->C(I<$group>, I<%options>) Subscribes to I<$group>. I<$group> will be created if it does not exist. Its location may be specified in I<%options>; see L<"NEWSGROUP ORDER"> for details. =item I<$newsrc>->C(I<$group>, I<%options>) Unsubscribes from I<$group>. I<$group> will be created if it does not exist. Its location may be specified in I<%options>; see L<"NEWSGROUP ORDER"> for details. =item I<$newsrc>->C(I<$group>, I<$article>, I<%options>) Adds I<$article> to the article list for I<$group>. I<$group> will be created if it does not exist. Its location may be specified in I<%options>; see L<"NEWSGROUP ORDER"> for details. =item I<$newsrc>->C(I<$group>, I<\@articles>, I<%options>) Adds I<@articles> to the article list for I<$group>. I<$group> will be created if it does not exist. Its location may be specified in I<%options>; see L<"NEWSGROUP ORDER"> for details. =item I<$newsrc>->C(I<$group>, I<$from>, I<$to>, I<%options>) Adds all the articles from I<$from> to I<$to>, inclusive, to the article list for I<$group>. I<$group> will be created if it does not exist. Its location may be specified in I<%options>; see L<"NEWSGROUP ORDER"> for details. =item I<$newsrc>->C(I<$group>, I<$article>, I<%options>) Removes I<$article> from the article list for I<$group>. I<$group> will be created if it does not exist. Its location may be specified in I<%options>; see L<"NEWSGROUP ORDER"> for details. =item I<$newsrc>->C(I<$group>, I<\@articles>, I<%options>) Removes I<@articles> from the article list for I<$group>. I<$group> will be created if it does not exist. Its location may be specified in I<%options>; see L<"NEWSGROUP ORDER"> for details. =item I<$newsrc>->C(I<$group>, I<$from>, I<$to>, I<%options>) Removes all the articles from I<$from> to I<$to>, inclusive, from the article list for I<$group>. I<$group> will be created if it does not exist. Its location may be specified in I<%options>; see L<"NEWSGROUP ORDER"> for details. =item I<$newsrc>->C(I<$group>) Returns true iff I<$group> exists in I<$newsrc>. =item I<$newsrc>->C(I<$group>) Returns true iff I<$group> exists and is subscribed. =item I<$newsrc>->C(I<$group>, I<$article>) Returns true iff I<$group> exists and its article list contains I<$article>. =item I<$n> = I<$newsrc>->C Returns the number of groups in I<$newsrc>. =item I<@groups> = I<$newsrc>->C Returns the list of groups in I<$newsrc>, in newsrc order. In scalar context, returns an array reference. =item I<@groups> = I<$newsrc>->C Returns the list of subscribed groups in I<$newsrc>, in newsrc order. In scalar context, returns an array reference. =item I<@groups> = I<$newsrc>->C Returns the list of unsubscribed groups in I<$newsrc>, in newsrc order. In scalar context, returns an array reference. =item I<@articles> = I<$newsrc>->C(I<$group>) Returns the list of articles in the article list for I<$group>. In scalar context, returns an array reference. I<$group> will be created if it does not exist. Its location may be specified in I<%options>; see L<"NEWSGROUP ORDER"> for details. =item I<@articles> = I<$newsrc>->C(I<$group>, I<$from>, I<$to>, I<%options>) Returns the list of articles from I<$from> to I<$to>, inclusive, that do B appear in the article list for I<$group>. In scalar context, returns an array reference. I<$group> will be created if it does not exist. Its location may be specified in I<%options>; see L<"NEWSGROUP ORDER"> for details. =item I<$articles> = I<$newsrc>->C(I<$group>, I<%options>) Returns the article list for I<$group> as a string, in the format described in L<"NEWSRC FILES">. I<$group> will be created if it does not exist. Its location may be specified in I<%options>; see L<"NEWSGROUP ORDER"> for details. If you plan to do any nontrivial processing on the article list, consider converting it to a C object: $articles = Set::IntSpan->new($newsrc->get_articles('alt.foo')) =item I<$ok> = I<$newsrc>->C(I<$group>, I<$articles>, I<%options>) Sets the article list for $group. Any existing article list is lost. I<$articles> is a string, as described in L<"NEWSRC FILES">. I<$group> will be created if it does not exist. Its location may be specified in I<%options>; see L<"NEWSGROUP ORDER"> for details. If I<$articles> does not have the format described in L<"NEWSRC FILES">, C does nothing and returns false. Otherwise, it returns true. =back =head1 DIAGNOSTICS =over 4 =item Bad newsrc line A line in the newsrc file does not have the format described in L<"NEWSRC FILES">. =item Bad article list The article list for a newsgroup does not have the format described in L<"NEWSRC FILES">. =item News::Newsrc::save_as: Can't rename $file, $file.bak: $! =item News::Newsrc::save_as: Can't open $file: $! =item News::Newsrc::format: Can't write $file: $! =back =head1 NOTES =head2 Error Handling "Don't test for errors that you can't handle." C returns null if it can't open the newsrc file, and dies if the newsrc file contains invalid data. This isn't as schizophrenic as it seems. There are several ways a program could handle an open failure on the newsrc file. It could prompt the user to reenter the file name. It could assume that the user doesn't have a newsrc file yet. If it doesn't want to handle the error, it could go ahead and die. On the other hand, it is very difficult for a program to do anything sensible if the newsrc file opens successfully and then turns out to contain invalid data. Was there a disk error? Is the file corrupt? Did the user accidentally specify his kill file instead of his newsrc file? And what are you going to do about it? Rather than try to handle an error like this, it's probably better to die and let the user sort things out. By the same rational, C and C die on failure. Programs that must retain control can use eval{...} to protect calls that may die. For example, Perl/Tk runs all callbacks inside an eval{...}. If a callback dies, Perl/Tk regains control and displays $@ in a dialog box. The user can then decide whether to continue or quit from the program. =head2 C/C I was going to call these methods C and C, but C turns out not to be a good name for a method, because C also calls C, and expects different semantics. I added the C<_rc> suffix to C to avoid this conflict. It's reasonably short and somewhat mnemonic (the module manages newsI files). I added the same suffix to C for symmetry. =head2 use integer Up until version 1.09, C specified C. As of 2012, users are reporting newsgroups with article numbers above 0x7fffffff, which break the underlying C module on 32-bit processors. Version 1.10 removes the C from C. This extends the usable range of C to (typically) 9e15, which ought to be enough, even for usenet. If you want C back, either for performance, or because you are somehow dependent on its semantics, write BEGIN { $Set::IntSpan::integer = 1 } use News::Newsrc; See C for more information. =head1 ACKNOWLEDGMENTS =over 4 =item * Neil Bowers =item * Matthew Darwin =item * Philip Hallstrom =item * M. Hedlund =item * Bruce J. Keeler =item * Chris Leach =item * Abhijit Menon-Sen =item * J.B. Nicholson-Owens =item * Lars Balker Rasmussen =item * Nicholas Redgrave =item * Mike Stok =item * Bennett Todd =item * Larry W. Virden =item * Chris Szurgot =back =head1 AUTHOR Steven McDougall, swmcd@world.std.com =head1 SEE ALSO perl(1), Set::IntSpan =head1 COPYRIGHT Copyright 1996-2013 by Steven McDougall. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut