local-lib5/lib/perl5/URI/urn/isbn.pm

   1 package URI::urn::isbn;  # RFC 3187
   2
   3 require URI::urn;
   4 @ISA=qw(URI::urn);
   5
   6 use strict;
   7 use Carp qw(carp);
   8
   9 BEGIN {
  10     require Business::ISBN;
  11
  12     local $^W = 0; # don't warn about dev versions, perl5.004 style
  13     warn "Using Business::ISBN version " . Business::ISBN->VERSION .
  14         " which is deprecated.\nUpgrade to Business::ISBN version 2\n"
  15         if Business::ISBN->VERSION < 2;
  16     }
  17
  18 sub _isbn {
  19     my $nss = shift;
  20     $nss = $nss->nss if ref($nss);
  21     my $isbn = Business::ISBN->new($nss);
  22     $isbn = undef if $isbn && !$isbn->is_valid;
  23     return $isbn;
  24 }
  25
  26 sub _nss_isbn {
  27     my $self = shift;
  28     my $nss = $self->nss(@_);
  29     my $isbn = _isbn($nss);
  30     $isbn = $isbn->as_string if $isbn;
  31     return($nss, $isbn);
  32 }
  33
  34 sub isbn {
  35     my $self = shift;
  36     my $isbn;
  37     (undef, $isbn) = $self->_nss_isbn(@_);
  38     return $isbn;
  39 }
  40
  41 sub isbn_publisher_code {
  42     my $isbn = shift->_isbn || return undef;
  43     return $isbn->publisher_code;
  44 }
  45
  46 BEGIN {
  47 my $group_method = do {
  48     local $^W = 0; # don't warn about dev versions, perl5.004 style
  49     Business::ISBN->VERSION >= 2 ? 'group_code' : 'country_code';
  50     };
  51
  52 sub isbn_group_code {
  53     my $isbn = shift->_isbn || return undef;
  54     return $isbn->$group_method;
  55 }
  56 }
  57
  58 sub isbn_country_code {
  59     my $name = (caller(0))[3]; $name =~ s/.*:://;
  60     carp "$name is DEPRECATED. Use isbn_group_code instead";
  61
  62     no strict 'refs';
  63     &isbn_group_code;
  64 }
  65
  66 BEGIN {
  67 my $isbn13_method = do {
  68     local $^W = 0; # don't warn about dev versions, perl5.004 style
  69     Business::ISBN->VERSION >= 2 ? 'as_isbn13' : 'as_ean';
  70     };
  71
  72 sub isbn13 {
  73     my $isbn = shift->_isbn || return undef;
  74
  75     # Business::ISBN 1.x didn't put hyphens in the EAN, and it was just a string
  76     # Business::ISBN 2.0 doesn't do EAN, but it does ISBN-13 objects
  77     #   and it uses the hyphens, so call as_string with an empty anon array
  78     # or, adjust the test and features to say that it comes out with hyphens.
  79     my $thingy = $isbn->$isbn13_method;
  80     return eval { $thingy->can( 'as_string' ) } ? $thingy->as_string([]) : $thingy;
  81 }
  82 }
  83
  84 sub isbn_as_ean {
  85     my $name = (caller(0))[3]; $name =~ s/.*:://;
  86     carp "$name is DEPRECATED. Use isbn13 instead";
  87
  88     no strict 'refs';
  89     &isbn13;
  90 }
  91
  92 sub canonical {
  93     my $self = shift;
  94     my($nss, $isbn) = $self->_nss_isbn;
  95     my $new = $self->SUPER::canonical;
  96     return $new unless $nss && $isbn && $nss ne $isbn;
  97     $new = $new->clone if $new == $self;
  98     $new->nss($isbn);
  99     return $new;
 100 }
 101
 102 1;