lib/SGN/SiteFeatures/CrossReference.pm

   1 package SGN::SiteFeatures::CrossReference;
   2 use Moose;
   3 use namespace::autoclean;
   4
   5 use MooseX::Types::URI 'Uri';
   6
   7 has 'url' => ( documentation => <<'',
   8 the absolute or relative URL where the full resource can be accessed, e.g. /unigenes/search.pl?q=SGN-U12
   9
  10     is  => 'ro',
  11     isa => Uri,
  12     required => 1,
  13     coerce => 1,
  14    );
  15
  16
  17 has 'text' => ( documentation => <<'',
  18 a short text description of the contents of the resource referenced, for example "6 SGN Unigenes"
  19
  20     is  => 'ro',
  21     isa => 'Str',
  22     required => 1,
  23    );
  24
  25
  26 has 'is_empty' => ( documentation => <<'',
  27 true if the cross reference is empty, may be used as a rendering hint
  28
  29     is  => 'ro',
  30     isa => 'Bool',
  31     default => 0,
  32    );
  33
  34 has 'feature' => ( documentation => <<'',
  35 the site feature object this cross reference points to
  36
  37     is => 'ro',
  38     required => 1,
  39    );
  40
  41 has 'renderings' => ( documentation => <<'',
  42 2-level hashref of suggested renderings, keyed first by content type, then rendering hint
  43
  44    is      => 'ro',
  45    isa     => 'HashRef',
  46    default => sub { +{} },
  47  );
  48
  49 sub TO_JSON {
  50     my ( $self ) = @_;
  51     no strict 'refs';
  52     return {
  53         feature => $self->feature->feature_name,
  54         map { $_ => $self->$_() }
  55         qw( url is_empty text renderings )
  56     };
  57 }
  58
  59 sub cr_cmp {
  60     my ( $a, $b ) = @_;
  61     no warnings 'uninitialized';
  62     return
  63         $a->feature->feature_name cmp $b->feature->feature_name
  64      || $a->is_empty <=> $b->is_empty
  65      || $a->text cmp $b->text
  66      || $a->url.'' cmp $b->url.'';
  67 }
  68
  69 sub cr_eq {
  70     my ( $a, $b ) = @_;
  71
  72     no warnings 'uninitialized';
  73     return !($a->is_empty xor $b->is_empty)
  74         && $a->text eq $b->text
  75         && $a->url.'' eq $b->url.''
  76         && $a->feature->feature_name eq $b->feature->feature_name;
  77 }
  78
  79 sub uniq {
  80     my %seen;
  81     grep !$seen{ _uniq_str($_) }++, @_;
  82 }
  83 sub _uniq_str {
  84     my ( $self ) = @_;
  85     return join ',', (
  86         $self->feature->feature_name,
  87         $self->url,
  88         $self->text,
  89        );
  90 }
  91
  92 { no warnings 'once';
  93   *distinct = \&uniq;
  94 }
  95
  96
  97 1;
  98
  99
 100