File Coverage

blib/lib/Digital/Driver.pm
Criterion Covered Total %
statement 44 47 93.6
branch 3 8 37.5
condition n/a
subroutine 13 13 100.0
pod 0 1 0.0
total 60 69 86.9


line stmt bran cond sub pod time code
1             package Digital::Driver;
2             our $AUTHORITY = 'cpan:GETTY';
3             # ABSTRACT: Module for new drivers
4             $Digital::Driver::VERSION = '0.003';
5 3     8   148776 use strict;
  3         24  
  3         87  
6 3     3   24 use warnings;
  3         10  
  3         87  
7 3     3   1044 use Package::Stash;
  3         16589  
  3         102  
8 3     3   18 use Carp qw( croak );
  3         6  
  3         134  
9 3     3   1463 use MooX ();
  3         34912  
  3         67  
10 3     3   19 use Import::Into;
  3         6  
  3         57  
11 3     3   917 use Digital ();
  3         10  
  3         1055  
12              
13             sub import {
14 3     3   33 my ( $class, @args ) = @_;
15 3         6 my $driver_role;
16 3         8 for (@args) {
17 0 0       0 if ($_ =~ m/^-(.+)/) {
18 0 0       0 croak $class.' already has a driver role' if $driver_role;
19 0         0 $driver_role = 'Digital::Role::'.$1;
20             }
21             }
22 3 50       12 $driver_role = 'Digital::Role' unless $driver_role;
23 3         11 my ( $caller ) = caller;
24 3         19 MooX->import::into($caller);
25 3         27032 $caller->can('with')->($driver_role);
26 3         21841 $class->install_helper($caller);
27 3         44 Digital->register_input($caller);
28             }
29              
30             sub install_helper {
31 3     3 0 10 my ( $class, $target ) = @_;
32 3         45 my $stash = Package::Stash->new($target);
33             $stash->add_symbol('&to', sub {
34 6     6   48 my ( $to, $coderef, $via ) = @_;
35 6         38 $target->can('has')->( $to,
36             is => 'lazy',
37             init_arg => undef,
38             );
39             $stash->add_symbol('&_build_'.$to, sub {
40 5     5   2810 my ( $self ) = @_;
41 5 100       70 my $value = defined $via ? $self->$via : $self->in;
42 5         42 return $coderef->($self,$value) for ($value);
43 6         4725 });
44 3         54 });
45             $stash->add_symbol('&overload_to', sub {
46 1     1   9 my ( $to, @args ) = @_;
47             overload->import::into($target,
48 5     5   2907 '0+', sub { shift->$to },
49 1         12 fallback => 1,
50             );
51 1         323 return $target->can('to')->($to, @args);
52 3         40 });
53             }
54              
55             1;
56              
57             __END__