lib/Net/NNTP.pm

   1 # Net::NNTP.pm
   2 #
   3 # Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
   4 # reserved. This program is free software; you can redistribute it and/or
   5 # modify it under the same terms as Perl itself.
   6
   7 package Net::NNTP;
   8
   9 =head1 NAME
  10
  11 Net::NNTP - NNTP Client class
  12
  13 =head1 SYNOPSIS
  14
  15     use Net::NNTP;
  16
  17     $nntp = Net::NNTP->new("some.host.name");
  18     $nntp->quit;
  19
  20 =head1 DESCRIPTION
  21
  22 C<Net::NNTP> is a class implementing a simple NNTP client in Perl as described
  23 in RFC977. C<Net::NNTP> inherits its communication methods from C<Net::Cmd>
  24
  25 =head1 CONSTRUCTOR
  26
  27 =over 4
  28
  29 =item new ( [ HOST ] [, OPTIONS ])
  30
  31 This is the constructor for a new Net::NNTP object. C<HOST> is the
  32 name of the remote host to which a NNTP connection is required. If not
  33 given two environment variables are checked, first C<NNTPSERVER> then
  34 C<NEWSHOST>, if neither are set C<news> is used.
  35
  36 C<OPTIONS> are passed in a hash like fasion, using key and value pairs.
  37 Possible options are:
  38
  39 B<Timeout> - Maximum time, in seconds, to wait for a response from the
  40 NNTP server, a value of zero will cause all IO operations to block.
  41 (default: 120)
  42
  43 B<Debug> - Enable the printing of debugging information to STDERR
  44
  45 =back
  46
  47 =head1 METHODS
  48
  49 Unless otherwise stated all methods return either a I<true> or I<false>
  50 value, with I<true> meaning that the operation was a success. When a method
  51 states that it returns a value, falure will be returned as I<undef> or an
  52 empty list.
  53
  54 =over 4
  55
  56 =item article ( [ MSGID|MSGNUM ] )
  57
  58 Retreive the header, a blank line, then the body (text) of the
  59 specified article.
  60
  61 If no arguments are passed then the current aricle in the current
  62 newsgroup is returned.
  63
  64 C<MSGNUM> is a numeric id of an article in the
  65 current newsgroup, and will change the current article pointer.
  66 C<MSGID> is the message id of an article as
  67 shown in that article's header.  It is anticipated that the client
  68 will obtain the C<MSGID> from a list provided by the C<newnews>
  69 command, from references contained within another article, or from
  70 the message-id provided in the response to some other commands.
  71
  72 Returns a reference to an array containing the article.
  73
  74 =item body ( [ MSGID|MSGNUM ] )
  75
  76 Retreive the body (text) of the specified article.
  77
  78 Takes the same arguments as C<article>
  79
  80 Returns a reference to an array containing the body of the article.
  81
  82 =item head ( [ MSGID|MSGNUM ] )
  83
  84 Retreive the header of the specified article.
  85
  86 Takes the same arguments as C<article>
  87
  88 Returns a reference to an array containing the header of the article.
  89
  90 =item nntpstat ( [ MSGID|MSGNUM ] )
  91
  92 The C<nntpstat> command is similar to the C<article> command except that no
  93 text is returned.  When selecting by message number within a group,
  94 the C<nntpstat> command serves to set the "current article pointer" without
  95 sending text.
  96
  97 Using the C<nntpstat> command to
  98 select by message-id is valid but of questionable value, since a
  99 selection by message-id does B<not> alter the "current article pointer".
 100
 101 Returns the message-id of the "current article".
 102
 103 =item group ( [ GROUP ] )
 104
 105 Set and/or get the current group. If C<GROUP> is not given then information
 106 is returned on the current group.
 107
 108 In a scalar context it returns the group name.
 109
 110 In an array context the return value is a list containing, the number
 111 of articles in the group, the number of the first article, the number
 112 of the last article and the group name.
 113
 114 =item ihave ( MSGID [, MESSAGE ])
 115
 116 The C<ihave> command informs the server that the client has an article
 117 whose id is C<MSGID>.  If the server desires a copy of that
 118 article, and C<MESSAGE> has been given the it will be sent.
 119
 120 Returns I<true> if the server desires the article and C<MESSAGE> was
 121 successfully sent,if specified.
 122
 123 If C<MESSAGE> is not specified then the message must be sent using the
 124 C<datasend> and C<dataend> methods from L<Net::Cmd>
 125
 126 C<MESSAGE> can be either an array of lines or a reference to an array.
 127
 128 =item last ()
 129
 130 Set the "current article pointer" to the previous article in the current
 131 newsgroup.
 132
 133 Returns the message-id of the article.
 134
 135 =item date ()
 136
 137 Returns the date on the remote server. This date will be in a UNIX time
 138 format (seconds since 1970)
 139
 140 =item postok ()
 141
 142 C<postok> will return I<true> if the servers initial response indicated
 143 that it will allow posting.
 144
 145 =item authinfo ( USER, PASS )
 146
 147 =item list ()
 148
 149 Obtain information about all the active newsgroups. The results is a reference
 150 to a hash where the key is a group name and each value is a reference to an
 151 array. The elements in this array are:- the first article number in the group,
 152 the last article number in the group and any information flags about the group.
 153
 154 =item newgroups ( SINCE [, DISTRIBUTIONS ])
 155
 156 C<SINCE> is a time value and C<DISTRIBUTIONS> is either a distribution
 157 pattern or a reference to a list of distribution patterns.
 158 The result is the same as C<list>, but the
 159 groups return will be limited to those created after C<SINCE> and, if
 160 specified, in one of the distribution areas in C<DISTRIBUTIONS>.
 161
 162 =item newnews ( SINCE [, GROUPS [, DISTRIBUTIONS ]])
 163
 164 C<SINCE> is a time value. C<GROUPS> is either a group pattern or a reference
 165 to a list of group patterns. C<DISTRIBUTIONS> is either a distribution
 166 pattern or a reference to a list of distribution patterns.
 167
 168 Returns a reference to a list which contains the message-ids of all news posted
 169 after C<SINCE>, that are in a groups which matched C<GROUPS> and a
 170 distribution which matches C<DISTRIBUTIONS>.
 171
 172 =item next ()
 173
 174 Set the "current article pointer" to the next article in the current
 175 newsgroup.
 176
 177 Returns the message-id of the article.
 178
 179 =item post ( [ MESSAGE ] )
 180
 181 Post a new article to the news server. If C<MESSAGE> is specified and posting
 182 is allowed then the message will be sent.
 183
 184 If C<MESSAGE> is not specified then the message must be sent using the
 185 C<datasend> and C<dataend> methods from L<Net::Cmd>
 186
 187 C<MESSAGE> can be either an array of lines or a reference to an array.
 188
 189 =item slave ()
 190
 191 Tell the remote server that I am not a user client, but probably another
 192 news server.
 193
 194 =item quit ()
 195
 196 Quit the remote server and close the socket connection.
 197
 198 =back
 199
 200 =head2 Extension methods
 201
 202 These methods use commands that are not part of the RFC977 documentation. Some
 203 servers may not support all of them.
 204
 205 =over 4
 206
 207 =item newsgroups ( [ PATTERN ] )
 208
 209 Returns a reference to a hash where the keys are all the group names which
 210 match C<PATTERN>, or all of the groups if no pattern is specified, and
 211 each value contains the description text for the group.
 212
 213 =item distributions ()
 214
 215 Returns a reference to a hash where the keys are all the possible
 216 distribution names and the values are the distribution descriptions.
 217
 218 =item subscriptions ()
 219
 220 Returns a reference to a list which contains a list of groups which
 221 are reccomended for a new user to subscribe to.
 222
 223 =item overview_fmt ()
 224
 225 Returns a reference to an array which contain the names of the fields returnd
 226 by C<xover>.
 227
 228 =item active_times ()
 229
 230 Returns a reference to a hash where the keys are the group names and each
 231 value is a reference to an array containg the time the groups was created
 232 and an identifier, possibly an Email address, of the creator.
 233
 234 =item active ( [ PATTERN ] )
 235
 236 Similar to C<list> but only active groups that match the pattern are returned.
 237 C<PATTERN> can be a group pattern.
 238
 239 =item xgtitle ( PATTERN )
 240
 241 Returns a reference to a hash where the keys are all the group names which
 242 match C<PATTERN> and each value is the description text for the group.
 243
 244 =item xhdr ( HEADER, MESSAGE-RANGE )
 245
 246 Obtain the header field C<HEADER> for all the messages specified.
 247
 248 Returns a reference to a hash where the keys are the message numbers and
 249 each value contains the header for that message.
 250
 251 =item xover ( MESSAGE-RANGE )
 252
 253 Returns a reference to a hash where the keys are the message numbers and each
 254 value is a reference to an array which contains the overview fields for that
 255 message. The names of these fields can be obtained by calling C<overview_fmt>.
 256
 257 =item xpath ( MESSAGE-ID )
 258
 259 Returns the path name to the file on the server which contains the specified
 260 message.
 261
 262 =item xpat ( HEADER, PATTERN, MESSAGE-RANGE)
 263
 264 The result is the same as C<xhdr> except the is will be restricted to
 265 headers that match C<PATTERN>
 266
 267 =item xrover
 268
 269 =item listgroup
 270
 271 =item reader
 272
 273 =back
 274
 275 =head1 UNSUPPORTED
 276
 277 The following NNTP command are unsupported by the package, and there are
 278 no plans to do so.
 279
 280     AUTHINFO GENERIC
 281     XTHREAD
 282     XSEARCH
 283     XINDEX
 284
 285 =head1 DEFINITIONS
 286
 287 =over 4
 288
 289 =item MESSAGE-RANGE
 290
 291 C<MESSAGE-RANGE> is either a single message-id, a single mesage number, or
 292 two message numbers.
 293
 294 If C<MESSAGE-RANGE> is two message numbers and the second number in a
 295 range is less than or equal to the first then the range represents all
 296 messages in the group after the first message number.
 297
 298 =item PATTERN
 299
 300 The C<NNTP> protocol uses the C<WILDMAT> format for patterns.
 301 The WILDMAT format was first developed by Rich Salz based on
 302 the format used in the UNIX "find" command to articulate
 303 file names. It was developed to provide a uniform mechanism
 304 for matching patterns in the same manner that the UNIX shell
 305 matches filenames.
 306
 307 Patterns are implicitly anchored at the
 308 beginning and end of each string when testing for a match.
 309
 310 There are five pattern matching operations other than a strict
 311 one-to-one match between the pattern and the source to be
 312 checked for a match.
 313
 314 The first is an asterisk C<*> to match any sequence of zero or more
 315 characters.
 316
 317 The second is a question mark C<?> to match any single character. The
 318 third specifies a specific set of characters.
 319
 320 The set is specified as a list of characters, or as a range of characters
 321 where the beginning and end of the range are separated by a minus (or dash)
 322 character, or as any combination of lists and ranges. The dash can
 323 also be included in the set as a character it if is the beginning
 324 or end of the set. This set is enclosed in square brackets. The
 325 close square bracket C<]> may be used in a set if it is the first
 326 character in the set.
 327
 328 The fourth operation is the same as the
 329 logical not of the third operation and is specified the same
 330 way as the third with the addition of a caret character C<^> at
 331 the beginning of the test string just inside the open square
 332 bracket.
 333
 334 The final operation uses the backslash character to
 335 invalidate the special meaning of the a open square bracket C<[>,
 336 the asterisk, backslash or the question mark. Two backslashes in
 337 sequence will result in the evaluation of the backslash as a
 338 character with no special meaning.
 339
 340 =over 4
 341
 342 =item Examples
 343
 344 =item C<[^]-]>
 345
 346 matches any single character other than a close square
 347 bracket or a minus sign/dash.
 348
 349 =item C<*bdc>
 350
 351 matches any string that ends with the string "bdc"
 352 including the string "bdc" (without quotes).
 353
 354 =item C<[0-9a-zA-Z]>
 355
 356 matches any single printable alphanumeric ASCII character.
 357
 358 =item C<a??d>
 359
 360 matches any four character string which begins
 361 with a and ends with d.
 362
 363 =back
 364
 365 =back
 366
 367 =head1 SEE ALSO
 368
 369 L<Net::Cmd>
 370
 371 =head1 AUTHOR
 372
 373 Graham Barr <Graham.Barr@tiuk.ti.com>
 374
 375 =head1 REVISION
 376
 377 $Revision: 2.5 $
 378
 379 =head1 COPYRIGHT
 380
 381 Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
 382 software; you can redistribute it and/or modify it under the same terms
 383 as Perl itself.
 384
 385 =cut
 386
 387 use strict;
 388 use vars qw(@ISA $VERSION $debug);
 389 use IO::Socket;
 390 use Net::Cmd;
 391 use Carp;
 392
 393 $VERSION = sprintf("%d.%02d", q$Revision: 2.5 $ =~ /(\d+)\.(\d+)/);
 394 @ISA     = qw(Net::Cmd IO::Socket::INET);
 395
 396 sub new
 397 {
 398  my $self = shift;
 399  my $type = ref($self) || $self;
 400  my $host = shift if @_ % 2;
 401  my %arg  = @_;
 402
 403  $host ||= $ENV{NNTPSERVER} || $ENV{NEWSHOST} || "news";
 404
 405  my $obj = $type->SUPER::new(PeerAddr => $host,
 406                              PeerPort => $arg{Port} || 'nntp(119)',
 407                              Proto    => 'tcp',
 408                              Timeout  => defined $arg{Timeout}
 409                                                 ? $arg{Timeout}
 410                                                 : 120
 411                             ) or return undef;
 412
 413  ${*$obj}{'net_nntp_host'} = $host;
 414
 415  $obj->autoflush(1);
 416  $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
 417
 418  unless ($obj->response() == CMD_OK)
 419   {
 420    $obj->close();
 421    return undef;
 422   }
 423
 424  my $c = $obj->code;
 425  ${*$obj}{'net_nntp_post'} = $c >= 200 && $c <= 209 ? 1 : 0;
 426
 427  $obj;
 428 }
 429
 430 sub debug_text
 431 {
 432  my $nntp = shift;
 433  my $inout = shift;
 434  my $text = shift;
 435
 436  if(($nntp->code == 350 && $text =~ /^(\S+)/)
 437     || ($text =~ /^(authinfo\s+pass)/io))
 438   {
 439    $text = "$1 ....\n"
 440   }
 441
 442  $text;
 443 }
 444
 445 sub postok
 446 {
 447  @_ == 1 or croak 'usage: $nntp->postok()';
 448  my $nntp = shift;
 449  ${*$nntp}{'net_nntp_post'} || 0;
 450 }
 451
 452 sub article
 453 {
 454  @_ == 1 || @_ == 2 or croak 'usage: $nntp->article( MSGID )';
 455  my $nntp = shift;
 456
 457  $nntp->_ARTICLE(@_)
 458     ? $nntp->read_until_dot()
 459     : undef;
 460 }
 461
 462 sub authinfo
 463 {
 464  @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
 465  my($nntp,$user,$pass) = @_;
 466
 467  $nntp->_AUTHINFO("USER",$user) == CMD_MORE
 468     && $nntp->_AUTHINFO("PASS",$pass) == CMD_OK;
 469 }
 470
 471 sub authinfo_simple
 472 {
 473  @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
 474  my($nntp,$user,$pass) = @_;
 475
 476  $nntp->_AUTHINFO('SIMPLE') == CMD_MORE
 477     && $nntp->command($user,$pass)->response == CMD_OK;
 478 }
 479
 480 sub body
 481 {
 482  @_ == 1 || @_ == 2 or croak 'usage: $nntp->body( [ MSGID ] )';
 483  my $nntp = shift;
 484
 485  $nntp->_BODY(@_)
 486     ? $nntp->read_until_dot()
 487     : undef;
 488 }
 489
 490 sub head
 491 {
 492  @_ == 1 || @_ == 2 or croak 'usage: $nntp->head( [ MSGID ] )';
 493  my $nntp = shift;
 494
 495  $nntp->_HEAD(@_)
 496     ? $nntp->read_until_dot()
 497     : undef;
 498 }
 499
 500 sub nntpstat
 501 {
 502  @_ == 1 || @_ == 2 or croak 'usage: $nntp->nntpstat( [ MSGID ] )';
 503  my $nntp = shift;
 504
 505  $nntp->_STAT(@_) && $nntp->message =~ /(<[^>]+>)/o
 506     ? $1
 507     : undef;
 508 }
 509
 510
 511 sub group
 512 {
 513  @_ == 1 || @_ == 2 or croak 'usage: $nntp->group( [ GROUP ] )';
 514  my $nntp = shift;
 515  my $grp = ${*$nntp}{'net_nntp_group'} || undef;
 516
 517  return $grp
 518     unless(@_ || wantarray);
 519
 520  my $newgrp = shift;
 521
 522  return wantarray ? () : undef
 523         unless $nntp->_GROUP($newgrp || $grp || "")
 524                 && $nntp->message =~ /(\d+)\s+(\d+)\s+(\d+)\s+(\S+)/;
 525
 526  my($count,$first,$last,$group) = ($1,$2,$3,$4);
 527
 528  # group may be replied as '(current group)'
 529  $group = ${*$nntp}{'net_nntp_group'}
 530     if $group =~ /\(/;
 531
 532  ${*$nntp}{'net_nntp_group'} = $group;
 533
 534  wantarray
 535     ? ($count,$first,$last,$group)
 536     : $group;
 537 }
 538
 539 sub help
 540 {
 541  @_ == 1 or croak 'usage: $nntp->help()';
 542  my $nntp = shift;
 543
 544  $nntp->_HELP
 545     ? $nntp->read_until_dot
 546     : undef;
 547 }
 548
 549 sub ihave
 550 {
 551  @_ >= 2 or croak 'usage: $nntp->ihave( MESSAGE-ID [, MESSAGE ])';
 552  my $nntp = shift;
 553  my $mid = shift;
 554
 555  $nntp->_IHAVE($mid) && $nntp->datasend(@_)
 556     ? @_ == 0 || $nntp->dataend
 557     : undef;
 558 }
 559
 560 sub last
 561 {
 562  @_ == 1 or croak 'usage: $nntp->last()';
 563  my $nntp = shift;
 564
 565  $nntp->_LAST && $nntp->message =~ /(<[^>]+>)/o
 566     ? $1
 567     : undef;
 568 }
 569
 570 sub list
 571 {
 572  @_ == 1 or croak 'usage: $nntp->list()';
 573  my $nntp = shift;
 574
 575  $nntp->_LIST
 576     ? $nntp->_grouplist
 577     : undef;
 578 }
 579
 580 sub newgroups
 581 {
 582  @_ >= 2 or croak 'usage: $nntp->newgroups( SINCE [, DISTRIBUTIONS ])';
 583  my $nntp = shift;
 584  my $time = _timestr(shift);
 585  my $dist = shift || "";
 586
 587  $dist = join(",", @{$dist})
 588     if ref($dist);
 589
 590  $nntp->_NEWGROUPS($time,$dist)
 591     ? $nntp->_grouplist
 592     : undef;
 593 }
 594
 595 sub newnews
 596 {
 597  @_ >= 3 or croak 'usage: $nntp->newnews( SINCE [, GROUPS [, DISTRIBUTIONS ]])';
 598  my $nntp = shift;
 599  my $time = _timestr(shift);
 600  my $grp  = @_ ? shift : $nntp->group;
 601  my $dist = shift || "";
 602
 603  $grp ||= "*";
 604  $grp = join(",", @{$grp})
 605     if ref($grp);
 606
 607  $dist = join(",", @{$dist})
 608     if ref($dist);
 609
 610  $nntp->_NEWNEWS($grp,$time,$dist)
 611     ? $nntp->_articlelist
 612     : undef;
 613 }
 614
 615 sub next
 616 {
 617  @_ == 1 or croak 'usage: $nntp->next()';
 618  my $nntp = shift;
 619
 620  $nntp->_NEXT && $nntp->message =~ /(<[^>]+>)/o
 621     ? $1
 622     : undef;
 623 }
 624
 625 sub post
 626 {
 627  @_ >= 1 or croak 'usage: $nntp->post( [ MESSAGE ] )';
 628  my $nntp = shift;
 629
 630  $nntp->_POST() && $nntp->datasend(@_)
 631     ? @_ == 0 || $nntp->dataend
 632     : undef;
 633 }
 634
 635 sub quit
 636 {
 637  @_ == 1 or croak 'usage: $nntp->quit()';
 638  my $nntp = shift;
 639
 640  $nntp->_QUIT && $nntp->SUPER::close;
 641 }
 642
 643 sub slave
 644 {
 645  @_ == 1 or croak 'usage: $nntp->slave()';
 646  my $nntp = shift;
 647
 648  $nntp->_SLAVE;
 649 }
 650
 651 ##
 652 ## The following methods are not implemented by all servers
 653 ##
 654
 655 sub active
 656 {
 657  @_ == 1 || @_ == 2 or croak 'usage: $nntp->active( [ PATTERN ] )';
 658  my $nntp = shift;
 659
 660  $nntp->_LIST('ACTIVE',@_)
 661     ? $nntp->_grouplist
 662     : undef;
 663 }
 664
 665 sub active_times
 666 {
 667  @_ == 1 or croak 'usage: $nntp->active_times()';
 668  my $nntp = shift;
 669
 670  $nntp->_LIST('ACTIVE.TIMES')
 671     ? $nntp->_grouplist
 672     : undef;
 673 }
 674
 675 sub distributions
 676 {
 677  @_ == 1 or croak 'usage: $nntp->distributions()';
 678  my $nntp = shift;
 679
 680  $nntp->_LIST('DISTRIBUTIONS')
 681     ? $nntp->_description
 682     : undef;
 683 }
 684
 685 sub distribution_patterns
 686 {
 687  @_ == 1 or croak 'usage: $nntp->distributions()';
 688  my $nntp = shift;
 689
 690  my $arr;
 691  local $_;
 692
 693  $nntp->_LIST('DISTRIB.PATS') && ($arr = $nntp->read_until_dot)
 694     ? [grep { /^\d/ && (chomp, $_ = [ split /:/ ]) } @$arr]
 695     : undef;
 696 }
 697
 698 sub newsgroups
 699 {
 700  @_ == 1 || @_ == 2 or croak 'usage: $nntp->newsgroups( [ PATTERN ] )';
 701  my $nntp = shift;
 702
 703  $nntp->_LIST('NEWSGROUPS',@_)
 704     ? $nntp->_description
 705     : undef;
 706 }
 707
 708 sub overview_fmt
 709 {
 710  @_ == 1 or croak 'usage: $nntp->overview_fmt()';
 711  my $nntp = shift;
 712
 713  $nntp->_LIST('OVERVIEW.FMT')
 714      ? $nntp->_articlelist
 715      : undef;
 716 }
 717
 718 sub subscriptions
 719 {
 720  @_ == 1 or croak 'usage: $nntp->subscriptions()';
 721  my $nntp = shift;
 722
 723  $nntp->_LIST('SUBSCRIPTIONS')
 724     ? $nntp->_articlelist
 725     : undef;
 726 }
 727
 728 sub listgroup
 729 {
 730  @_ == 1 || @_ == 2 or croak 'usage: $nntp->listgroup( [ GROUP ] )';
 731  my $nntp = shift;
 732
 733  $nntp->_LISTGROUP(@_)
 734     ? $nntp->_articlelist
 735     : undef;
 736 }
 737
 738 sub reader
 739 {
 740  @_ == 1 or croak 'usage: $nntp->reader()';
 741  my $nntp = shift;
 742
 743  $nntp->_MODE('READER');
 744 }
 745
 746 sub xgtitle
 747 {
 748  @_ == 1 || @_ == 2 or croak 'usage: $nntp->xgtitle( [ PATTERN ] )';
 749  my $nntp = shift;
 750
 751  $nntp->_XGTITLE(@_)
 752     ? $nntp->_description
 753     : undef;
 754 }
 755
 756 sub xhdr
 757 {
 758  @_ >= 2 && @_ <= 4 or croak 'usage: $nntp->xhdr( HEADER, [ MESSAGE-ID | MESSAGE_NUM [, MESSAGE-NUM ]] )';
 759  my($nntp,$hdr,$first) = splice(@_,0,3);
 760
 761  my $arg = "$first";
 762
 763  if(@_)
 764   {
 765    my $last = shift;
 766
 767    $arg .= "-";
 768    $arg .= "$last"
 769         if(defined $last && $last > $first);
 770   }
 771
 772  $nntp->_XHDR($hdr, $arg)
 773     ? $nntp->_description
 774     : undef;
 775 }
 776
 777 sub xover
 778 {
 779  @_ == 2 || @_ == 3 or croak 'usage: $nntp->xover( RANGE )';
 780  my($nntp,$first) = splice(@_,0,2);
 781
 782  my $arg = "$first";
 783
 784  if(@_)
 785   {
 786    my $last = shift;
 787    $arg .= "-";
 788    $arg .= "$last"
 789         if(defined $last && $last > $first);
 790   }
 791
 792  $nntp->_XOVER($arg)
 793     ? $nntp->_fieldlist
 794     : undef;
 795 }
 796
 797 sub xpat
 798 {
 799  @_ == 4 || @_ == 5 or croak '$nntp->xpat( HEADER, PATTERN, RANGE )';
 800  my($nntp,$hdr,$pat,$first) = splice(@_,0,4);
 801
 802  my $arg = "$first";
 803
 804  if(@_)
 805   {
 806    my $last = shift;
 807    $arg .= "-";
 808    $arg .= "$last"
 809         if(defined $last && $last > $first);
 810   }
 811
 812  $pat = join(" ", @$pat)
 813     if ref($pat);
 814
 815  $nntp->_XPAT($hdr,$arg,$pat)
 816     ? $nntp->_description
 817     : undef;
 818 }
 819
 820 sub xpath
 821 {
 822  @_ == 2 or croak 'usage: $nntp->xpath( MESSAGE-ID )';
 823  my($nntp,$mid) = @_;
 824
 825  return undef
 826         unless $nntp->_XPATH($mid);
 827
 828  my $m; ($m = $nntp->message) =~ s/^\d+\s+//o;
 829  my @p = split /\s+/, $m;
 830
 831  wantarray ? @p : $p[0];
 832 }
 833
 834 sub xrover
 835 {
 836  @_ == 2 || @_ == 3 or croak 'usage: $nntp->xrover( RANGE )';
 837  my($nntp,$first) = splice(@_,0,2);
 838
 839  my $arg = "$first";
 840
 841  if(@_)
 842   {
 843    my $last = shift;
 844
 845    $arg .= "-";
 846    $arg .= "$last"
 847         if(defined $last && $last > $first);
 848   }
 849
 850  $nntp->_XROVER($arg)
 851     ? $nntp->_fieldlist
 852     : undef;
 853 }
 854
 855 sub date
 856 {
 857  @_ == 1 or croak 'usage: $nntp->date()';
 858  my $nntp = shift;
 859
 860  $nntp->_DATE && $nntp->message =~ /(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/
 861     ? timegm($6,$5,$4,$3,$2-1,$1)
 862     : undef;
 863 }
 864
 865
 866 ##
 867 ## Private subroutines
 868 ##
 869
 870 sub _timestr
 871 {
 872  my $time = shift;
 873  my @g = reverse((gmtime($time))[0..5]);
 874  $g[1] += 1;
 875  $g[0] %= 100;
 876  sprintf "%02d%02d%02d %02d%02d%02d GMT", @g;
 877 }
 878
 879 sub _grouplist
 880 {
 881  my $nntp = shift;
 882  my $arr = $nntp->read_until_dot or
 883     return undef;
 884
 885  my $hash = {};
 886  my $ln;
 887
 888  foreach $ln (@$arr)
 889   {
 890    my @a = split(/[\s\n]+/,$ln);
 891    $hash->{$a[0]} = [ @a[1,2,3] ];
 892   }
 893
 894  $hash;
 895 }
 896
 897 sub _fieldlist
 898 {
 899  my $nntp = shift;
 900  my $arr = $nntp->read_until_dot or
 901     return undef;
 902
 903  my $hash = {};
 904  my $ln;
 905
 906  foreach $ln (@$arr)
 907   {
 908    my @a = split(/[\t\n]/,$ln);
 909    $hash->{$a[0]} = @a[1,2,3];
 910   }
 911
 912  $hash;
 913 }
 914
 915 sub _articlelist
 916 {
 917  my $nntp = shift;
 918  my $arr = $nntp->read_until_dot;
 919
 920  chomp(@$arr)
 921     if $arr;
 922
 923  $arr;
 924 }
 925
 926 sub _description
 927 {
 928  my $nntp = shift;
 929  my $arr = $nntp->read_until_dot or
 930     return undef;
 931
 932  my $hash = {};
 933  my $ln;
 934
 935  foreach $ln (@$arr)
 936   {
 937    chomp($ln);
 938
 939    $hash->{$1} = $ln
 940     if $ln =~ s/^\s*(\S+)\s*//o;
 941   }
 942
 943  $hash;
 944
 945 }
 946
 947 ##
 948 ## The commands
 949 ##
 950
 951 sub _ARTICLE   { shift->command('ARTICLE',@_)->response == CMD_OK }
 952 sub _AUTHINFO  { shift->command('AUTHINFO',@_)->response }
 953 sub _BODY      { shift->command('BODY',@_)->response == CMD_OK }
 954 sub _DATE      { shift->command('DATE')->response == CMD_INFO }
 955 sub _GROUP     { shift->command('GROUP',@_)->response == CMD_OK }
 956 sub _HEAD      { shift->command('HEAD',@_)->response == CMD_OK }
 957 sub _HELP      { shift->command('HELP',@_)->response == CMD_INFO }
 958 sub _IHAVE     { shift->command('IHAVE',@_)->response == CMD_MORE }
 959 sub _LAST      { shift->command('LAST')->response == CMD_OK }
 960 sub _LIST      { shift->command('LIST',@_)->response == CMD_OK }
 961 sub _LISTGROUP { shift->command('LISTGROUP',@_)->response == CMD_OK }
 962 sub _NEWGROUPS { shift->command('NEWGROUPS',@_)->response == CMD_OK }
 963 sub _NEWNEWS   { shift->command('NEWNEWS',@_)->response == CMD_OK }
 964 sub _NEXT      { shift->command('NEXT')->response == CMD_OK }
 965 sub _POST      { shift->command('POST',@_)->response == CMD_OK }
 966 sub _QUIT      { shift->command('QUIT',@_)->response == CMD_OK }
 967 sub _SLAVE     { shift->command('SLAVE',@_)->response == CMD_OK }
 968 sub _STAT      { shift->command('STAT',@_)->response == CMD_OK }
 969 sub _MODE      { shift->command('MODE',@_)->response == CMD_OK }
 970 sub _XGTITLE   { shift->command('XGTITLE',@_)->response == CMD_OK }
 971 sub _XHDR      { shift->command('XHDR',@_)->response == CMD_OK }
 972 sub _XPAT      { shift->command('XPAT',@_)->response == CMD_OK }
 973 sub _XPATH     { shift->command('XPATH',@_)->response == CMD_OK }
 974 sub _XOVER     { shift->command('XOVER',@_)->response == CMD_OK }
 975 sub _XROVER    { shift->command('XROVER',@_)->response == CMD_OK }
 976 sub _XTHREAD   { shift->unsupported }
 977 sub _XSEARCH   { shift->unsupported }
 978 sub _XINDEX    { shift->unsupported }
 979
 980 ##
 981 ## IO/perl methods
 982 ##
 983
 984 sub close
 985 {
 986  my $nntp = shift;
 987
 988  ref($nntp)
 989     && defined fileno($nntp)
 990     && $nntp->quit;
 991 }
 992
 993 sub DESTROY { shift->close }
 994
 995
 996 1;