Open-ILS/src/perlmods/lib/OpenILS/Utils/TagURI.pm

   1 use strict;
   2 use warnings;
   3
   4 =over
   5
   6 use Data::Dumper;
   7
   8 sub test_parser {
   9     my $t = shift;
  10     print "$t\n" . Dumper( OpenILS::Utils::TagURI->new( $t ) ) . "\n\n";
  11 }
  12
  13 test_parser('TAG::stuff');
  14 test_parser('tag::stuff');
  15 test_parser('tag:open-ils.org:U2@acn/59521');
  16 test_parser('tag:fulfillment2.esilibrary.com,2010:U2@bre/6866[1,2]');
  17 test_parser('tag:x:U2@bre/6866[1,2]{bre,auri}/br1/2');
  18 test_parser('tag:x:U2@bre/6866{bre,auri}/br1/2');
  19 test_parser('tag:x:U2@bre/6866{bre,auri}');
  20 test_parser('tag:x:U2@bre/6866/br1/2/some/extra/data');
  21 test_parser('tag:x:U2@bre/6866/br1/2');
  22 test_parser('tag:x:U2@bre/6866/br1');
  23 test_parser('tag:x:biblio-record_entry/6866');
  24
  25 =cut
  26
  27 package OpenILS::Utils::TagURI;
  28
  29 our $AUTOLOAD;
  30 sub DESTROY { } # keeps AUTOLOAD from catching inherent DESTROY calls
  31
  32 sub AUTOLOAD {
  33     my $obj = shift;
  34     (my $field = $AUTOLOAD) =~ s/^.*://o;
  35
  36     if (@_) {
  37         return $obj->{$field} = shift;
  38     } else {
  39         return $obj->{$field};
  40     }
  41
  42 }
  43
  44
  45 sub new {
  46     my $class = shift;
  47     my $tag = shift;
  48     $class = ref($class) || $class;
  49
  50     my $self = bless {} => $class;
  51     $self->parse($tag) if ($tag);
  52
  53     return $self;
  54 }
  55
  56 sub parse {
  57     my $self = shift;
  58     $self = $self->new() unless (ref($self));
  59
  60     my $tag = shift;
  61     my $version = 1;
  62
  63     (warn("!! invalid tag uri: $tag\n") && return undef) unless ($tag =~ s/^tag:(?:([^:,]*),?([^:]*))://); # valid?
  64     my ($host, $validity) = ($1, $2);
  65     $self->host($host);
  66     $self->validity($validity);
  67
  68     my ($classname, $id, $paging, $inc, $loc, $depth, $mods) = ($1, $2, $3, $4, $5, $6, $7)
  69         if ($tag =~ /^
  70                         ([^\/]+)            # classname
  71                         (?:\/([^[\/]+?)     # id
  72                           (?:\[([^]]+)\])?  # paging
  73                           (?:\{([^}]+)\})?  # includes
  74                           (?:\/(\w+))?      # location
  75                           (?:\/(\w+))?      # depth
  76                           (?:\/(.+))?       # pathinfo
  77                         )?
  78                     $/x);
  79
  80     (warn("!! missing class ($classname) or id ($id) in uri: $tag\n") && return undef) if (!defined($classname) && !defined($id));
  81
  82     if (!defined($id)) {
  83         $version = -1;
  84         $self->data($classname);
  85     } else {
  86         if ($classname =~ /^U2\@/) {
  87             $classname =~ s/^U2\@//;
  88             $version = 2;
  89         }
  90
  91         $self->classname($classname);
  92         $self->id($id);
  93         $self->paging(($paging ? [ map { s/^\s*//; s/\s*$//; $_ } split(',', $paging) ] : []));
  94         $self->includes(($inc? [ map { s/^\s*//; s/\s*$//; $_ } split(',', $inc) ] : []));
  95         $self->org($loc);
  96         $self->depth($depth);
  97         $self->pathinfo($mods);
  98     }
  99
 100     $self->version($version);
 101     return $self;
 102 }
 103
 104 sub toURI {
 105     my $class = shift;
 106     my $parts = shift || {};
 107
 108     my $self = ref($class) ? $class : $class->new;
 109
 110     $self->$_($$parts{$_}) for keys %$parts;
 111     return undef unless (defined($self->classname) && defined($self->id));
 112
 113     my $tag = 'tag:';
 114
 115     if ($self->host) {
 116         $tag .= $self->host;
 117         $tag .= ',' . $self->validity if ($self->validity);
 118     }
 119
 120     $tag .= ':';
 121
 122     $tag .= 'U2@' if ($self->version == 2);
 123     $tag .= $self->classname . '/' . $self->id;
 124     $tag .= '['. join(',', @{ $self->paging }) . ']' if defined($self->paging);
 125     $tag .= '{'. join(',', @{ $self->includes }) . '}' if defined($self->includes);
 126     $tag .= '/' . $self->location if defined($self->location);
 127     $tag .= '/' . $self->depth if defined($self->depth);
 128     $tag .= '/' . $self->pathinfo if defined($self->pathinfo);
 129
 130     return $tag;
 131 }
 132
 133 1;