home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _4b3410a9e5e6f0dd5eb24308060b1d0b < prev    next >
Encoding:
Text File  |  2004-06-01  |  1.2 KB  |  59 lines
  1. package URI::urn::isbn;  # RFC 3187
  2.  
  3. require URI::urn;
  4. @ISA=qw(URI::urn);
  5.  
  6. use strict;
  7. use Business::ISBN ();
  8.  
  9.  
  10. sub _isbn {
  11.     my $nss = shift;
  12.     $nss = $nss->nss if ref($nss);
  13.     my $isbn = Business::ISBN->new($nss);
  14.     $isbn = undef if $isbn && !$isbn->is_valid;
  15.     return $isbn;
  16. }
  17.  
  18. sub _nss_isbn {
  19.     my $self = shift;
  20.     my $nss = $self->nss(@_);
  21.     my $isbn = _isbn($nss);
  22.     $isbn = $isbn->as_string if $isbn;
  23.     return($nss, $isbn);
  24. }
  25.  
  26. sub isbn {
  27.     my $self = shift;
  28.     my $isbn;
  29.     (undef, $isbn) = $self->_nss_isbn(@_);
  30.     return $isbn;
  31. }
  32.  
  33. sub isbn_publisher_code {
  34.     my $isbn = shift->_isbn || return undef;
  35.     return $isbn->publisher_code;
  36. }
  37.  
  38. sub isbn_country_code {
  39.     my $isbn = shift->_isbn || return undef;
  40.     return $isbn->country_code;
  41. }
  42.  
  43. sub isbn_as_ean {
  44.     my $isbn = shift->_isbn || return undef;
  45.     return $isbn->as_ean;
  46. }
  47.  
  48. sub canonical {
  49.     my $self = shift;
  50.     my($nss, $isbn) = $self->_nss_isbn;
  51.     my $new = $self->SUPER::canonical;
  52.     return $new unless $nss && $isbn && $nss ne $isbn;
  53.     $new = $new->clone if $new == $self;
  54.     $new->nss($isbn);
  55.     return $new;
  56. }
  57.  
  58. 1;
  59.