File Coverage

blib/lib/VIC/PIC/Any.pm
Criterion Covered Total %
statement 54 80 67.5
branch 12 26 46.1
condition n/a
subroutine 13 16 81.2
pod 1 8 12.5
total 80 130 61.5


line stmt bran cond sub pod time code
1             package VIC::PIC::Any;
2 34     34   741 use strict;
  34         44  
  34         892  
3 34     34   117 use warnings;
  34         36  
  34         623  
4 34     34   112 use Carp;
  34         42  
  34         2499  
5              
6             our $VERSION = '0.31';
7             $VERSION = eval $VERSION;
8              
9 34     34   11960 use VIC::PIC::Gpsim;
  34         1413  
  34         1911  
10              
11             # use this to map various PICs to their classes
12             # allows for the same class to be used for different pics
13 34         2573 use constant PICS => {
14             # PIC12
15             P12F683 => 'P12F683',
16             # PIC16
17             P16F690 => 'P16F690',
18             P16F631 => 'P16F631',
19             P16F677 => 'P16F677',
20             P16F685 => 'P16F685',
21             P16F687 => 'P16F687',
22             P16F689 => 'P16F689',
23             P16F627A => 'P16F627A',
24             P16F628A => 'P16F628A',
25             P16F648A => 'P16F648A',
26             # PIC18
27             P18F242 => 'P18F242',
28             P18F252 => 'P18F252',
29             P18F442 => 'P18F442',
30             P18F452 => 'P18F452',
31             P18F13K50 => 'P18F13K50',
32             P18F14K50 => 'P18F14K50',
33             P18LF13K50 => 'P18LF13K50',
34             P18LF14K50 => 'P18LF14K50',
35 34     34   205 };
  34         42  
36              
37 34         1384 use constant PICREGEX => {
38             # PIC18
39 34     34   140 };
  34         41  
40              
41 34         20711 use constant SIMS => {
42             gpsim => 'Gpsim',
43 34     34   121 };
  34         46  
44              
45             sub _get_pic_type {
46 70     70   111 my $type = shift;
47 70         220 $type =~ s/^PIC/P/gi;
48 70         212 my $ctype = PICS->{uc $type};
49 70 100       219 unless (defined $ctype) {
50 1         2 foreach my $regex (keys %{+PICREGEX}) {
  1         4  
51 0 0       0 if ($type =~ $regex) {
52 0         0 $ctype = PICREGEX->{$regex};
53 0         0 last;
54             }
55             }
56             }
57 70         124 return $ctype;
58             }
59              
60             sub new {
61 51     51 1 50072 my ($class, $type) = @_;
62 51 50       261 if (uc $type eq 'ANY') {
63 0         0 die "You need to specify the type of the chip on the commandline to use 'Any'\n";
64 0         0 return;
65             }
66 51         179 my $ctype = &_get_pic_type($type);
67 51 50       150 return unless defined $ctype;
68 51         374 $class =~ s/::Any/::$ctype/g;
69 51 50       4246 eval "require $class;" or croak "Unable to load $class: $@";
70 51         579 return $class->new(type => lc $ctype);
71             }
72              
73             sub new_simulator {
74 36     36 0 1934 my ($class, %hh) = @_;
75 36         69 my $stype = 'Gpsim';
76 36 100       127 if (exists $hh{type}) {
77 3         10 $stype = SIMS->{lc $hh{type}};
78 3 50       11 unless (defined $stype) {
79 0         0 carp "No simulator of type $hh{type}";
80 0         0 return;
81             }
82             }
83 36         238 $class =~ s/::Any/::$stype/g;
84 36         104 $hh{type} = lc $stype;
85 36         270 return $class->new(%hh);
86             }
87              
88             sub supported_chips {
89 2     2 0 4063 my @chips = sort(keys %{+PICS});
  2         28  
90 2         5 push @chips, sort(values %{+PICREGEX});
  2         5  
91 2 50       9 return wantarray ? @chips : \@chips;
92             }
93              
94             sub supported_simulators {
95 2     2 0 3866 my @sims = sort(keys %{+SIMS});
  2         12  
96 2 50       12 return wantarray ? @sims : \@sims;
97             }
98              
99             sub is_simulator_supported {
100 0     0 0 0 my $ss = shift;
101 0         0 my @sims = &supported_simulators();
102 0 0       0 return (grep {/$ss/} @sims) ? 1 : 0;
  0         0  
103             }
104              
105             sub is_chip_supported {
106 19     19 0 20 my $chip = shift;
107 19         60 my $ret = &_get_pic_type(uc $chip);
108 19 100       77 return (defined $ret) ? 1 : 0;
109             }
110              
111             sub list_chip_features {
112 0     0 0   my $chip = shift;
113 0           my $ctype = &_get_pic_type($chip);
114 0 0         unless (defined $ctype) {
115 0           carp "Chip $chip is not supported\n";
116 0           return;
117             }
118 0           my $obj = __PACKAGE__->new($chip);
119 0           my $roles = $obj->list_roles();
120             return {
121 0           roles => $roles,
122             memory => $obj->memory,
123             };
124             }
125              
126             sub print_pinout {
127 0     0 0   my $chip = shift;
128 0           my $ctype = &_get_pic_type($chip);
129 0 0         unless (defined $ctype) {
130 0           carp "Chip $chip is not supported\n";
131 0           return;
132             }
133 0           my $obj = __PACKAGE__->new($chip);
134 0           return $obj->print_pinout;
135             }
136              
137             1;
138              
139             =encoding utf8
140              
141             =head1 NAME
142              
143             VIC::PIC::Any
144              
145             =head1 SYNOPSIS
146              
147             A wrapper class that returns the appropriate object for the given PIC
148             microcontroller name. This is used internally by VIC.
149              
150             =head1 DESCRIPTION
151              
152             =over
153              
154             =item B
155              
156             Returns an object for the given microcontroller name such as 'P16F690'.
157              
158             =back
159              
160             =head1 AUTHOR
161              
162             Vikas N Kumar
163              
164             =head1 COPYRIGHT
165              
166             Copyright (c) 2014. Vikas N Kumar
167              
168             This program is free software; you can redistribute it and/or modify it
169             under the same terms as Perl itself.
170              
171             See http://www.perl.com/perl/misc/Artistic.html
172              
173             =cut