lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130

package Data::MultiValued::AttributeTrait::TagsAndRanges; 
{
  $Data::MultiValued::AttributeTrait::TagsAndRanges::VERSION = '0.0.7_1';
}
{
  $Data::MultiValued::AttributeTrait::TagsAndRanges::DIST = 'Data-MultiValued';
}
use Moose::Role;
use namespace::autoclean;
use Data::MultiValued::TagsAndRanges;
with 'Data::MultiValued::AttributeTrait';
 
# ABSTRACT: attribute traits for attributes holding tagged and ranged values 
 
 
sub multivalue_storage_class { 'Data::MultiValued::TagsAndRanges' };
sub opts_to_pass_set { qw(from to tag) }
sub opts_to_pass_get { qw(at tag) }
 
require Data::MultiValued::AttributeTrait::Tags;
 
sub all_tags {
    my ($self,$instance) = @_;
    return $self->Data::MultiValued::AttributeTrait::Tags::all_tags($instance);
}
 
sub all_tags_and_ranges {
    my ($self,$instance) = @_;
 
    my $storage = $self->get_full_storage($instance);
    return unless $storage;
 
    my @tags = $self->all_tags($instance);
 
    my @tags_and_ranges;
    for my $tag (@tags) {
        my @these_ranges = $storage->_storage
            ->get({tag=>$tag})->all_ranges;
        push @tags_and_ranges,[$tag, \@these_ranges];
    }
 
    return @tags_and_ranges;
}
 
package Moose::Meta::Attribute::Custom::Trait::MultiValued::TagsAndRanges; 
{
  $Moose::Meta::Attribute::Custom::Trait::MultiValued::TagsAndRanges::VERSION = '0.0.7_1';
}
{
  $Moose::Meta::Attribute::Custom::Trait::MultiValued::TagsAndRanges::DIST = 'Data-MultiValued';
}{
sub register_implementation { 'Data::MultiValued::AttributeTrait::TagsAndRanges' }
}
 
1;
 
__END__
 
=pod
 
=encoding utf-8
 
=head1 NAME
 
Data::MultiValued::AttributeTrait::TagsAndRanges - attribute traits for attributes holding tagged and ranged values
 
=head1 VERSION
 
version 0.0.7_1
 
=head1 SYNOPSIS
 
  package My::Class;
  use Moose;
  use Data::MultiValued::AttributeTrait::TagsAndRanges;
 
  has stuff => (
    is => 'rw',
    isa => 'Int',
    traits => ['MultiValued::TagsAndRanges'],
    predicate => 'has_stuff',
    multi_accessor => 'stuff_tagged',
    multi_predicate => 'has_stuff_tagged',
  );
 
=head1 DESCRIPTION
 
This role consumes L<Data::MultiValued::AttributeTrait> and
specialises it to use L<Data::MultiValued::TagsAndRanges> as multi-value
storage:
 
=head2 C<multivalue_storage_class>
 
Returns C<'Data::MultiValued::TagsAndRanges'>.
 
=head2 C<opts_to_pass_set>
 
Returns C<('tag', 'from', 'to')>.
 
=head2 C<opts_to_pass_get>
 
Returns C<('tag', 'at')>.
 
=head2 C<all_tags_and_ranges>
 
  my @tags_and_ranges = $obj->meta->get_attribute('my_attr')
     ->all_tags_and_ranges($obj);
 
Returns a list of 2-element arrayrefs. The first element of each
arrayref is a tag (possibly C<undef>), the second element is an
arrayref of 2-element arrayrefs, each arrayref describing the extremes
of a range. Something like:
 
   [
    [ 'x', [ [undef,10], [10,20], [20,undef] ] ],
    [ undef, [ [undef,undef] ] ],
   ],
 
=head1 AUTHOR
 
Gianni Ceccarelli <dakkar@thenautilus.net>
 
=head1 COPYRIGHT AND LICENSE
 
This software is copyright (c) 2011 by Net-a-Porter.com.
 
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
 
=cut