File Coverage

blib/lib/API/Octopart.pm
Criterion Covered Total %
statement 20 134 14.9
branch 0 40 0.0
condition 0 36 0.0
subroutine 7 17 41.1
pod 7 7 100.0
total 34 234 14.5


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3              
4             # This module is free software: you can redistribute it and/or modify it under
5             # the terms of the GNU General Public License as published by the Free Software
6             # Foundation, either version 3 of the License, or (at your option) any later
7             # version.
8             #
9             # This module is distributed in the hope that it will be useful, but WITHOUT ANY
10             # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
11             # PARTICULAR PURPOSE. See the GNU General Public License for more details.
12             #
13             # You should have received a copy of the GNU General Public License along with
14             # this module. If not, see .
15             #
16             # Copyright (C) 2022- eWheeler, Inc. L
17             # Originally written by Eric Wheeler, KJ7LNW
18             # All rights reserved.
19             #
20             # All tradmarks, product names, logos, and brands are property of their
21             # respective owners and no grant or license is provided thereof.
22             #
23              
24             package API::Octopart;
25             $VERSION = 1.001;
26              
27 1     1   55890 use 5.006;
  1         3  
28 1     1   7 use strict;
  1         2  
  1         31  
29 1     1   5 use warnings;
  1         1  
  1         28  
30              
31 1     1   541 use JSON;
  1         10091  
  1         4  
32 1     1   653 use LWP::UserAgent;
  1         38512  
  1         33  
33 1     1   7 use Digest::MD5 qw(md5_hex);
  1         2  
  1         43  
34              
35 1     1   500 use Data::Dumper;
  1         5665  
  1         1361  
36              
37             =head1 NAME
38              
39             API::Octopart - Simple inteface for querying part status across vendors at octopart.com.
40              
41             =head1 SYNOPSIS
42              
43             my $o = API::Octopart->new(
44             token => 'abcdefg-your-octopart-token-here',
45             cache => "$ENV{HOME}/.octopart/cache",
46             include_specs => 1,
47             ua_debug => 1,
48             );
49              
50             # Query part stock:
51             my %opts = (
52             currency => 'USD',
53             max_moq => 100,
54             min_qty => 10,
55             max_price => 4,
56             #mfg => 'Murata',
57             );
58             print Dumper $o->get_part_stock_detail('RC0805FR-0710KL', %opts);
59             print Dumper $o->get_part_stock_detail('GQM1555C2DR90BB01D', %opts);
60              
61             =head1 METHODS
62              
63             =over 4
64              
65             =item * $o = API::Octopart->new(%opts) - Returns new Octopart object.
66              
67             Object Options (%opt):
68              
69             =over 4
70              
71             =item * token => 'abcdefg-your-octopart-token-here',
72              
73             This is your Octopart API token. You could do something like this to read the token from a file:
74              
75             token => (sub { my $t = `cat ~/.octopart/token`; chomp $t; return $t})->(),
76              
77             =item * include_specs => 1
78              
79             If you have a PRO account then you can include product specs:
80              
81             =item * cache => "$ENV{HOME}/.octopart/cache"
82              
83             An optional (but recommended) cache directory to minimize requests to Octopart:
84              
85             =item * ua_debug => 1
86              
87             User Agent debugging. This is very verbose and provides API communication details.
88              
89             =back
90            
91             =cut
92              
93             sub new
94             {
95 0     0 1   my ($class, %args) = @_;
96              
97 0           $args{api_queries} = 0;
98              
99 0 0         die "An Octopart API token is required." if (!$args{token});
100              
101 0           return bless(\%args, $class);
102             }
103              
104             =item * $o->has_stock($part, %opts) - Returns the number of items in stock
105              
106             $part: The model number of the part
107              
108             %opts: Optional filters. No defaults are specified, it will return all unless limited.
109              
110             =over 4
111              
112             =item * min_qty => - Minimum stock quantity, per seller.
113              
114             If a sellerhas fewer than min_qty parts in stock then the seller will be excluded.
115              
116             =item * max_moq => - Maximum "minimum order quantity"
117              
118             This is the max MOQ you will accept as being in
119             stock. For example, a 5000-part reel might be more
120             than you want for prototyping so set this to 10 or
121             100.
122              
123             =item * seller => - Seller's name (regular expression)
124              
125             This is a regular expression so something like
126             'Mouser|Digi-key' is valid.
127              
128             =item * mfg => - Manufacturer name (regular expression)
129              
130             Specifying the mfg name is useful if your part model
131             number is similar to those of other manufacturers.
132              
133             =item * currency => - eg, 'USD' for US dollars
134              
135             Defaults to include all currencies
136              
137             =back
138              
139             =cut
140              
141             sub has_stock
142             {
143 0     0 1   my ($self, $part, %opts) = @_;
144              
145 0           my $parts = $self->get_part_stock_detail($part, %opts);
146              
147 0           my $stock = 0;
148 0           foreach my $p (@$parts)
149             {
150 0           foreach my $s (values(%{ $p->{sellers} }))
  0            
151             {
152             $stock += $s->{stock}
153 0           }
154             }
155              
156 0           return $stock;
157             }
158              
159              
160             =item * $o->get_part_stock($part, %opts) - Returns a simple stock structure
161              
162             $part, %opts: same as has_stock().
163              
164             Returns the following structure:
165              
166             {
167             'Mouser' => {
168             'moq_price' => '0.2',
169             'moq' => 1,
170             'stock' => 24071
171             },
172             'Digi-Key' => {
173             'moq_price' => '0.2',
174             'moq' => 1,
175             'stock' => 10000
176             }
177             };
178              
179             =cut
180              
181             sub get_part_stock
182             {
183 0     0 1   my ($self, $part, %opts) = @_;
184              
185 0           my $results = $self->get_part_stock_detail($part, %opts);
186              
187 0           my %ret;
188 0           foreach my $result (@$results)
189             {
190 0           my $sellers = $result->{sellers};
191 0           foreach my $s (keys %$sellers)
192             {
193 0           $ret{$s} = $sellers->{$s};
194 0           delete $ret{$s}->{price_tier};
195             }
196             }
197              
198 0           return \%ret;
199             }
200              
201             =item * $o->get_part_stock_detail($part, %opts) - Returns a stock detail structure
202              
203             $part, %opts: same as has_stock().
204              
205             Returns a structure like this:
206              
207             [
208             {
209             'mfg' => 'Yageo',
210             'sellers' => {
211             'Digi-Key' => {
212             'moq' => 1,
213             'moq_price' => '0.1',
214             'price_tier' => {
215             '1' => '0.1',
216             '10' => '0.042',
217             '100' => '0.017',
218             '1000' => '0.00762',
219             '2500' => '0.00661',
220             '5000' => '0.00546'
221             },
222             'stock' => 4041192
223             },
224             ...
225             },
226             'specs' => {
227             'case_package' => '0805',
228             'composition' => 'Thick Film',
229             'contactplating' => 'Tin',
230             'leadfree' => 'Lead Free',
231             'length' => '2mm',
232             'numberofpins' => '2',
233             'radiationhardening' => 'No',
234             'reachsvhc' => 'No SVHC',
235             'resistance' =>
236             "10k\x{ce}\x{a9}", # <- That is an Ohm symbol
237             'rohs' => 'Compliant',
238             'tolerance' => '1%',
239             'voltagerating_dc_' => '150V',
240             'width' => '1.25mm',
241             ...
242             }
243             },
244             ...
245             ]
246              
247             =cut
248              
249             sub get_part_stock_detail
250             {
251 0     0 1   my ($self, $part, %opts) = @_;
252              
253 0           my $p = $self->query_part_detail($part);
254              
255 0           return $self->_parse_part_stock($p, %opts);
256             }
257              
258              
259             =item * $o->octo_query($q) - Queries the Octopart API
260              
261             Return the JSON response structure as a perl ARRAY/HASH given a query meeting Octopart's
262             API specification.
263              
264             =cut
265              
266             sub octo_query
267             {
268 0     0 1   my ($self, $q) = @_;
269 0           my $part = shift;
270              
271              
272 0           my $content;
273              
274 0           my $h = md5_hex($q);
275 0           my $hashfile = "$self->{cache}/$h.query";
276              
277 0 0 0       if ($self->{cache} && -e $hashfile)
278             {
279 0 0         system('mkdir', '-p', $self->{cache}) if (! -d $self->{cache});
280              
281              
282 0 0         if ($self->{ua_debug})
283             {
284 0           print STDERR "Reading from cache file: $hashfile\n";
285             }
286              
287 0 0         if (open(my $in, $hashfile))
288             {
289 0           local $/;
290 0           $content = <$in>;
291 0           close($in);
292             }
293             else
294             {
295 0           die "$hashfile: $!";
296             }
297             }
298             else
299             {
300 0           my $ua = LWP::UserAgent->new( agent => 'mdf-perl/1.0', keep_alive => 3);
301              
302 0           $self->{api_queries}++;
303              
304 0 0         if ($self->{ua_debug})
305             {
306             $ua->add_handler(
307             "request_send",
308             sub {
309 0     0     my $msg = shift; # HTTP::Request
310 0           print STDERR "SEND >> \n"
311             . $msg->headers->as_string . "\n"
312             . "\n";
313 0           return;
314             }
315 0           );
316              
317             $ua->add_handler(
318             "response_done",
319             sub {
320 0     0     my $msg = shift; # HTTP::Response
321 0           print STDERR "RECV << \n"
322             . $msg->headers->as_string . "\n"
323             . $msg->status_line . "\n"
324             . "\n";
325 0           return;
326             }
327 0           );
328             }
329              
330             my $req = HTTP::Request->new('POST' => 'https://octopart.com/api/v4/endpoint',
331             HTTP::Headers->new(
332             'Host' => 'octopart.com',
333             'Content-Type' => 'application/json',
334             'Accept' => 'application/json',
335             'Accept-Encoding' => 'gzip, deflate',
336             'token' => $self->{token},
337 0           'DNT' => 1,
338             'Origin' => 'https://octopart.com',
339             ),
340             encode_json( { query => $q }));
341              
342 0           my $response = $ua->request($req);
343              
344 0 0         if (!$response->is_success) {
345 0           die $response->status_line;
346             }
347              
348 0           $content = $response->decoded_content;
349              
350 0 0         if ($self->{cache})
351             {
352 0 0         open(my $out, ">", $hashfile) or die "$hashfile: $!";
353 0           print $out $content;
354 0           close($out);
355             }
356             }
357              
358 0           my $j = from_json($content);
359              
360 0 0         if ($j->{errors})
361             {
362 0           my %errors;
363 0           foreach my $e (@{ $j->{errors} })
  0            
364             {
365 0           $errors{$e->{message}}++;
366             }
367 0           die "Octopart: " . join("\n", keys(%errors)) . "\n";
368             }
369              
370 0 0         if ($self->{ua_debug})
371             {
372 0           print Dumper $j;
373             }
374              
375 0           return $j;
376             }
377              
378              
379             =item * $o->octo_query_count() - Return the number of API calls so far.
380             =cut
381              
382             sub octo_query_count
383             {
384 0     0 1   my $self = shift;
385 0           return $self->{api_queries};
386             }
387              
388             =item * $o->query_part_detail($part)
389              
390             Return the JSON response structure as a perl ARRAY/HASH given a part search term
391             shown as "$part". This function calls $o->octo_query() with a query from Octopart's
392             "Basic Example" so you can easily lookup a specific part number. The has_stock()
393             and get_part_stock_detail() methods use this query internally.
394              
395             =cut
396              
397             sub query_part_detail
398             {
399 0     0 1   my ($self, $part) = @_;
400              
401             # Specs require a pro account:
402 0           my $specs = '';
403 0 0         if ($self->{include_specs})
404             {
405 0           $specs = q(
406             specs {
407             units
408             value
409             display_value
410             attribute {
411             id
412             name
413             shortname
414             group
415             }
416             }
417             );
418             }
419              
420 0           return $self->octo_query( qq(
421             query {
422             search(q: "$part", limit: 3) {
423             results {
424             part {
425             manufacturer {
426             name
427             }
428             mpn
429             $specs
430             # Brokers are non-authorized dealers. See: https://octopart.com/authorized
431             sellers(include_brokers: false) {
432             company {
433             name
434             }
435             offers {
436             click_url
437             inventory_level
438             prices {
439             price
440             currency
441             quantity
442             }
443             }
444             }
445             }
446             }
447             }
448             }
449             ));
450             }
451              
452             our %_valid_filter_opts = ( map { $_ => 1 } (qw/currency max_moq min_qty max_price mfg seller/) );
453             sub _parse_part_stock
454             {
455 0     0     my ($self, $resp, %opts) = @_;
456              
457 0           foreach my $o (keys %opts)
458             {
459 0 0         die "invalid filter option: '$o'" if (!$_valid_filter_opts{$o});
460             }
461              
462 0           my @results;
463 0           foreach my $r (@{ $resp->{data}{search}{results} })
  0            
464             {
465 0           $r = $r->{part};
466 0           my %part;
467              
468 0           $part{mfg} = $r->{manufacturer}{name};
469              
470 0 0         if (defined $r->{specs})
471             {
472             $part{specs} = {
473             # Try to map first by shortname, then by unit, then by value if
474             # the former are undefined:
475             map {
476             defined($_->{attribute}{shortname})
477             ? ($_->{attribute}{shortname} => $_->{value} . "$_->{units}")
478             : (
479             $_->{units}
480             ? ($_->{units} => $_->{value})
481 0 0         : ($_->{value} => 'true')
    0          
482             )
483 0           } @{ $r->{specs} }
  0            
484             },
485             }
486              
487             # Seller stock and MOQ pricing:
488 0           my %ss;
489 0           foreach my $s (@{ $r->{sellers} })
  0            
490             {
491 0           foreach my $o (@{ $s->{offers} })
  0            
492             {
493 0           $ss{$s->{company}{name}}{stock} = $o->{inventory_level};
494 0           foreach my $p (@{ $o->{prices} })
  0            
495             {
496 0 0 0       next if (defined($opts{currency}) && $p->{currency} ne $opts{currency});
497              
498 0           my $moq = $p->{quantity};
499 0           my $price = $p->{price};
500              
501 0           $ss{$s->{company}{name}}{price_tier}{$p->{quantity}} = $price;
502              
503             # Find the minimum order quantity and the MOQ price:
504 0 0 0       if (!defined($ss{$s->{company}{name}}{moq}) ||
505             $ss{$s->{company}{name}}{moq} > $moq)
506             {
507 0           $ss{$s->{company}{name}}{moq} = $moq;
508 0           $ss{$s->{company}{name}}{moq_price} = $price;
509             }
510             }
511             }
512             }
513              
514 0           $part{sellers} = \%ss;
515              
516 0           push @results, \%part;
517             }
518              
519             # Delete sellers that do not meet the constraints and
520             # add matching results to @ret:
521 0           my @ret;
522 0           foreach my $r (@results)
523             {
524 0 0 0       next if (defined($opts{mfg}) && $r->{mfg} !~ /$opts{mfg}/i);
525              
526 0           foreach my $s (keys %{ $r->{sellers} })
  0            
527             {
528 0 0 0       if (!defined($r->{sellers}{$s}{price_tier})
      0        
      0        
      0        
      0        
      0        
      0        
      0        
529             || (defined($opts{min_qty}) && $r->{sellers}{$s}{stock} < $opts{min_qty})
530             || (defined($opts{max_price}) && $r->{sellers}{$s}{moq_price} > $opts{max_price})
531             || (defined($opts{max_moq}) && $r->{sellers}{$s}{moq} > $opts{max_moq}
532             || defined($opts{seller}) && $s !~ /$opts{seller}/i)
533             )
534             {
535 0           delete $r->{sellers}{$s};
536             }
537             }
538              
539 0           push @ret, $r;
540             }
541              
542 0           return \@ret;
543             }
544              
545             =back
546              
547             =head1 SEE ALSO
548              
549             L, L
550              
551             =head1 ATTRIBUTION
552              
553             Octopart is a registered trademark and brand of Octopart, Inc. All tradmarks,
554             product names, logos, and brands are property of their respective owners and no
555             grant or license is provided thereof.
556              
557             The copyright below applies to this software module; the copyright holder is
558             unaffiliated with Octopart, Inc.
559              
560             =head1 AUTHOR
561              
562             Originally written at eWheeler, Inc. dba Linux Global by Eric Wheeler
563             to facilitate optimization of RF matching components, but only for
564             components that are available for purchase at electronic component
565             vendors (of course!) L
566              
567             =head1 COPYRIGHT
568              
569             Copyright (C) 2022 eWheeler, Inc. dba Linux Global
570             L
571              
572             This module is free software: you can redistribute it and/or modify it under
573             the terms of the GNU General Public License as published by the Free Software
574             Foundation, either version 3 of the License, or (at your option) any later
575             version.
576              
577             This module is distributed in the hope that it will be useful, but WITHOUT ANY
578             WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
579             PARTICULAR PURPOSE. See the GNU General Public License for more details.
580              
581             You should have received a copy of the GNU General Public License along with
582             this module. If not, see .
583              
584             =cut
585              
586             1;