File Coverage

blib/lib/MetaStore/Links.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package MetaStore::Links;
2              
3             =head1 NAME
4              
5             MetaStore::Links - Class for links collections.
6              
7             =head1 SYNOPSIS
8              
9             use MetaStore::Links;
10              
11              
12             =head1 DESCRIPTION
13              
14             Class for links collections.
15              
16             =head1 METHODS
17              
18             =cut
19              
20 1     1   588653 use MetaStore::Item;
  0            
  0            
21             use Data::Dumper;
22             use strict;
23             use warnings;
24              
25             our @ISA = qw( MetaStore::Item );
26             our $VERSION = '0.01';
27              
28             =head2 types
29              
30             Return list for current types
31             =cut
32              
33             sub types {
34             return [ keys %{ $_[0]->attr } ];
35             }
36              
37             =head2 by_type ( $link_type )
38              
39             Get ids list for type
40              
41             =cut
42              
43             sub by_type {
44             my $self = shift;
45             my $type = shift;
46             my $attr = $self->attr;
47             my @res = ();
48             if ( defined $type ) {
49             @res = @{ $attr->{$type} || [] } if exists $attr->{$type};
50             }
51             else {
52             my %uniq;
53             foreach my $key ( sort { $a <=> $b } keys %$attr ) {
54             push @res, grep { !$uniq{$_}++ } @{ $self->by_type($key) };
55             }
56             }
57             \@res;
58             }
59              
60             =head2 add_by_type ( , item_id1[, item_id2[, item_id3]])
61              
62             Add items by type.
63              
64             =cut
65              
66             sub add_by_type {
67             my $self = shift;
68             my $type = shift;
69             return unless defined $type;
70             my %uniq;
71             my @res = ();
72             my $attr = $self->attr;
73             @res = grep { !$uniq{$_}++ } @{ $self->by_type($type) }, @_;
74             $attr->{$type} = \@res;
75             \@res;
76             }
77              
78             =head2 delete_by_type ( $type[, item_id1[, item_id2[,item_id3]]])
79              
80             Delete ids list , by type. Return result state of list;
81              
82             =cut
83              
84             sub delete_by_type {
85             my $self = shift;
86             my $type = shift;
87             my $ids = $self->by_type($type);
88             return $ids unless ( scalar @_ );
89             my %uniq;
90             @uniq{@_} = ();
91             $self->set_by_type( $type, grep { !exists $uniq{$_} } @$ids );
92             }
93              
94             =head2 set_by_type( $type[, item_id1[, item_id2[,item_id3]]])
95              
96             Set new list for $type. Set empty list unless got item_ids.
97              
98             =cut
99              
100             sub set_by_type {
101             my $self = shift;
102             my $type = shift;
103             return [] unless defined $type;
104             unless ( scalar @_ ) {
105             delete $self->attr->{$type};
106             $self->by_type($type);
107             }
108             else {
109              
110             #clear list for type
111             $self->set_by_type($type);
112             $self->add_by_type( $type, @_ );
113             }
114             }
115              
116             =head2 empty
117              
118             Empty all links
119              
120             =cut
121              
122             sub empty {
123             my $self = shift;
124             %{ $self->attr } = ();
125             return $self->by_type;
126             }
127              
128             1;
129             __END__