File Coverage

blib/lib/LaTeX/TikZ/Mod/Pattern.pm
Criterion Covered Total %
statement 42 43 97.6
branch 7 10 70.0
condition n/a
subroutine 9 10 90.0
pod 5 6 83.3
total 63 69 91.3


line stmt bran cond sub pod time code
1             package LaTeX::TikZ::Mod::Pattern;
2              
3 10     10   56 use strict;
  10         23  
  10         326  
4 10     10   55 use warnings;
  10         19  
  10         428  
5              
6             =head1 NAME
7              
8             LaTeX::TikZ::Mod::Pattern - A modifier that fills a closed path with a pattern.
9              
10             =head1 VERSION
11              
12             Version 0.02
13              
14             =cut
15              
16             our $VERSION = '0.02';
17              
18 10     10   53 use LaTeX::TikZ::Interface;
  10         22  
  10         192  
19              
20 10     10   107 use Any::Moose;
  10         26  
  10         81  
21              
22             =head1 RELATIONSHIPS
23              
24             This class consumes the L<LaTeX::TikZ::Mod> role, and as such implements the L</tag>, L</covers>, L</declare> and L</apply> methods.
25              
26             =cut
27              
28             with 'LaTeX::TikZ::Mod';
29              
30             =head1 ATTRIBUTES
31              
32             =head2 C<template>
33              
34             =cut
35              
36             has 'template' => (
37             is => 'ro',
38             isa => 'ArrayRef[Str]',
39             required => 1,
40             );
41              
42             has '_cache' => (
43             is => 'ro',
44             isa => 'HashRef',
45             init_arg => undef,
46             default => sub { +{ } },
47             );
48              
49             =head1 METHODS
50              
51             =head2 C<name>
52              
53             =cut
54              
55             sub name {
56 10     10 1 15 my ($pat, $tikz) = @_;
57              
58 10         43 my $cache = $pat->_cache->{$tikz->id};
59 10 50       38 confess('Template not yet declared') unless defined $cache;
60              
61 10         64 $cache->[0];
62             }
63              
64             my $id = 'a';
65              
66             my %handlers = (
67             name => sub { $_[0]->name($_[1]) },
68             width => sub { sprintf '%0.1fpt', $_[1]->thickness($_[2]) },
69             );
70              
71             =head2 C<tag>
72              
73             =cut
74              
75 4     4 1 13 sub tag { ref $_[0] }
76              
77             =head2 C<covers>
78              
79             =cut
80              
81 0     0 1 0 sub covers { 0 }
82              
83             =head2 C<declare>
84              
85             =cut
86              
87             sub declare {
88 7     7 1 9 my ($pat, $tikz) = @_;
89              
90 7         24 my $tikz_id = $tikz->id;
91 7         41 my $cache = $pat->_cache->{$tikz_id};
92 7 100       20 return @{$cache->[1]} if defined $cache;
  4         30  
93              
94 3         15 $cache = $pat->_cache->{$tikz_id} = [ ];
95 3         13 $cache->[0] = 'pat' . $id++;
96              
97 3         4 my $template = [ map $_, @{$pat->template} ];
  3         28  
98             s!#([^#]+)#!
99 34         113 my ($command, @opts) = split /=/, $1, 2;
100 34 100       130 @opts = split /,/, $opts[0] if @opts;
101 34         92 $handlers{lc $command}->($pat, $tikz, @opts);
102 3         33 !ge for @$template;
103 3         6 $cache->[1] = $template;
104              
105 3         24 return @$template;
106             }
107              
108             =head2 C<apply>
109              
110             =cut
111              
112 7     7 1 23 sub apply { 'fill', 'pattern=' . $_[0]->name($_[1]) }
113              
114             LaTeX::TikZ::Interface->register(
115             pattern => sub {
116 3     3 0 167 my $class = shift;
117              
118 3         14 my %args = @_;
119 3 50       17 if (exists $args{class}) {
120 3         8 $class = delete $args{class};
121 3 50       26 $class = __PACKAGE__ . '::' . $class unless $class =~ /::/;
122 3         20 (my $pm = $class) =~ s{::}{/}g;
123 3         7 $pm .= '.pm';
124 3         1608 require $pm;
125             }
126              
127 3         32 $class->new(%args);
128             },
129             );
130              
131             __PACKAGE__->meta->make_immutable;
132              
133             =head1 SEE ALSO
134              
135             L<LaTeX::TikZ>, L<LaTeX::TikZ::Mod>.
136              
137             =head1 AUTHOR
138              
139             Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
140              
141             You can contact me by mail or on C<irc.perl.org> (vincent).
142              
143             =head1 BUGS
144              
145             Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
146             I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
147              
148             =head1 SUPPORT
149              
150             You can find documentation for this module with the perldoc command.
151              
152             perldoc LaTeX::TikZ
153              
154             =head1 COPYRIGHT & LICENSE
155              
156             Copyright 2010 Vincent Pit, all rights reserved.
157              
158             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
159              
160             =cut
161              
162             1; # End of LaTeX::TikZ::Mod::Pattern