File Coverage

lib/Transmission/AttributeRole.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             # ex:ts=4:sw=4:sts=4:et
2             package Transmission::AttributeRole;
3             # See Transmission::Client for copyright statement.
4              
5             =head1 NAME
6              
7             Transmission::AttributeRole - For Torrent and Client
8              
9             =head1 DESCRIPTION
10              
11             This role is used by L<Transmission::Client> and L<Transmission::Torrent>.
12             It requires the consuming class to provide the method C<read_all()>.
13              
14             =cut
15              
16 1     1   619 use Moose::Role;
  0            
  0            
17              
18             =head1 ATTRIBUTES
19              
20             =head2 client
21              
22             $obj = $self->client;
23              
24             Returns a L<Transmission::Client> object.
25              
26             =cut
27              
28             has client => (
29             is => 'ro',
30             isa => 'Object',
31             handles => { client_error => 'error' },
32             );
33              
34             =head2 lazy_write
35              
36             $bool = $self->lazy_write;
37             $self->lazy_write($bool);
38              
39             Will prevent writeable attributes from sending a request to Transmission.
40             L</write_all()> can then later be used to sync data.
41              
42             =cut
43              
44             has lazy_write => (
45             is => 'rw',
46             isa => 'Bool',
47             default => 0,
48             );
49              
50             =head2 eager_read
51              
52             $bool = $self->eager_read;
53              
54             Setting this attribute in constructor forces L</read_all()> to be called.
55             This will again populate all (or most) attributes right after the object is
56             constructed (if Transmission answers the request).
57              
58             =cut
59              
60             has eager_read => (
61             is => 'ro',
62             isa => 'Bool',
63             default => 0,
64             trigger => sub { $_[0]->read_all if($_[1]) },
65             );
66              
67             # this method name exists to prove a point - not to be readable...
68             sub _convert {
69             if(ref $_[1] eq 'HASH') {
70             for my $camel (keys %{ $_[1] }) {
71             my $key = $_[2]->($camel);
72              
73             if(ref $_[1]->{$camel} eq 'HASH') {
74             __PACKAGE__->_convert($_[1]->{$camel}, $_[2]);
75             }
76              
77             $_[1]->{$key} = delete $_[1]->{$camel};
78             }
79             }
80             else {
81             return $_[2]->($_[1]);
82             }
83             }
84              
85             sub _camel2Normal {
86             $_[0]->_convert( $_[1], sub {
87             local $_ = $_[0];
88             tr/-/_/;
89             s/([A-Z]+)/{ "_" .lc($1) }/ge;
90             return $_;
91             } );
92             }
93             sub _normal2Camel {
94             $_[0]->_convert( $_[1], sub {
95             local $_ = $_[0];
96             tr/_/-/;
97             s/_(\w)/{ uc($1) }/ge; # wild guess...
98             return $_;
99             } );
100             }
101              
102             =head1 LICENSE
103              
104             =head1 AUTHOR
105              
106             See L<Transmission::Client>
107              
108             =cut
109              
110             1;