summaryrefslogtreecommitdiff
path: root/bom/arrow2pricing.pl
blob: d269a8f754aa5249b0ad6dc4bf737f6f393f2336 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
#!/usr/bin/perl
#
# bom/arrow2pricing.pl - Obtain stock and pricing for Arrow parts
#
# Written 2014, 2016 by Werner Almesberger
# Copyright 2014, 2016 by Werner Almesberger
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#

require "cache.pl";


$TAG = "ARROW";
$URL_BASE = "http://components.arrow.com/part/detail/";


sub prices
{
	local ($url) = @_;

	$url =~ s/\&/\&/g;
	open(PIPE, "wget -O - '$url' |") || die "$url: $!";
	my $p  = join("", <PIPE>);
	close PIPE;

	my $entry = '"minqty":"([^"]+)","price":"\$([^"]+)"';

	my @p = ();
	
	while ($p =~ /$entry/s) {
		local ($b, $u) = ($1, $2);

		$b =~ tr/,//d;
		$u =~ tr/,//d;

		push(@p, $b, $u);
		$p = $';
	}

	return @p;
}


sub retrieve
{
	local ($name) = @_;

	my $url = $URL_BASE . $name;
	open(PIPE, "wget -O - '$url' |") || die "$url: $!";
	my $page = join("", <PIPE>);
	close PIPE;

	return $page;
}


sub lookup
{
	local ($page) = @_;
	local $t, $p;

	my $qty = 'class="li_inv"[^>]*>(\d+)';
	my $price1 = 'class="li_price"[^>]*>\s*\$([0-9.]*)';
	my $priceq = 'class="li_price".*?title="([^"]*)"';

	my @p = undef;

	if ($page =~ /$qty/s) {
		($t = $1) =~ tr/,//d;
		push(@p, $t);
	} else {
		push(@p, 0);
	}

	if ($page =~ /$price1/s) {
		push(@p, 1, $1);
	} else {
		die unless $page =~ /$priceq/s;
		push(@p, &prices($1));
	}
	die unless $page =~ /$price/s;
	$p = $1;

	my $d = "";

	if ($page =~ /<h4>\s*([^<]*)\s*</s && $1 ne "1") {
		$d = $1;
		$d =~ s/\s+/ /gs;
	}

	unshift(@p, $d);

	return @p;
}


&main;