File Coverage

blib/lib/Metabrik/Lookup/Alexa.pm
Criterion Covered Total %
statement 9 66 13.6
branch 0 38 0.0
condition n/a
subroutine 3 9 33.3
pod 1 6 16.6
total 13 119 10.9


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # lookup::alexa Brik
5             #
6             package Metabrik::Lookup::Alexa;
7 1     1   607 use strict;
  1         2  
  1         29  
8 1     1   6 use warnings;
  1         1  
  1         32  
9              
10 1     1   5 use base qw(Metabrik::Client::Www);
  1         1  
  1         481  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable top million 1m) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             datadir => [ qw(datadir) ],
20             url => [ qw(url) ],
21             input => [ qw(file) ],
22             _loaded => [ qw(INTERNAL) ],
23             },
24             attributes_default => {
25             url => 'http://s3.amazonaws.com/alexa-static/top-1m.csv.zip',
26             input => 'top-1m.csv', # Stored in datadir by default
27             },
28             commands => {
29             update => [ ],
30             load => [ qw(input|OPTIONAL) ],
31             from_string => [ qw(domain) ],
32             from_pattern => [ qw(domain) ],
33             list_from_pattern => [ qw(domain) ],
34             },
35             require_modules => {
36             'Metabrik::File::Compress' => [ ],
37             'Metabrik::File::Csv' => [ ],
38             },
39             };
40             }
41              
42             sub update {
43 0     0 0   my $self = shift;
44              
45 0           my $datadir = $self->datadir;
46 0           my $url = $self->url;
47 0           my $outfile_zip = $datadir.'/alexa-top1m.csv.zip';
48 0           my $outfile_csv = $datadir.'/alexa-top1m.csv';
49              
50 0 0         my $files = $self->mirror($url, $outfile_zip) or return;
51              
52 0           my @updated = ();
53 0 0         if (@$files > 0) { # Update was available
54 0 0         my $fc = Metabrik::File::Compress->new_from_brik_init($self) or return;
55 0           for my $file (@$files) {
56 0 0         my $uncompressed = $fc->uncompress($file, $outfile_csv, $datadir) or next;
57 0           push @updated, @$uncompressed;
58             }
59             }
60              
61 0           return \@updated;
62             }
63              
64             sub load {
65 0     0 0   my $self = shift;
66 0           my ($input) = @_;
67              
68             # If not provided, we use the default from datadir
69 0 0         if (! defined($input)) {
70 0           $input = $self->datadir.'/'.$self->input;
71             }
72 0 0         $self->brik_help_run_file_not_found('load', $input) or return;
73              
74 0 0         my $fc = Metabrik::File::Csv->new_from_brik_init($self) or return;
75 0           $fc->separator(',');
76 0           $fc->first_line_is_header(0);
77              
78 0           return $fc->read($input);
79             }
80              
81             sub from_string {
82 0     0 0   my $self = shift;
83 0           my ($domain) = @_;
84              
85 0 0         $self->brik_help_run_undef_arg('from_string', $domain) or return;
86              
87 0           my $data = $self->_loaded;
88 0 0         if (! defined($data)) {
89 0 0         $data = $self->load or return;
90 0           $self->_loaded($data);
91             }
92              
93 0           for my $this (@$data) {
94 0 0         if ($this->[1] eq $domain) {
95 0           return 1;
96             }
97             }
98              
99 0           return 0;
100             }
101              
102             sub from_pattern {
103 0     0 0   my $self = shift;
104 0           my ($domain) = @_;
105              
106 0 0         $self->brik_help_run_undef_arg('from_pattern', $domain) or return;
107              
108 0           my $data = $self->_loaded;
109 0 0         if (! defined($data)) {
110 0 0         $data = $self->load or return;
111 0           $self->_loaded($data);
112             }
113              
114 0           for my $this (@$data) {
115 0 0         if ($this->[1] =~ m{$domain}i) {
116 0           return 1;
117             }
118             }
119              
120 0           return 0;
121             }
122              
123             sub list_from_pattern {
124 0     0 0   my $self = shift;
125 0           my ($domain) = @_;
126              
127 0 0         $self->brik_help_run_undef_arg('list_from_pattern', $domain) or return;
128              
129 0           my $data = $self->_loaded;
130 0 0         if (! defined($data)) {
131 0 0         $data = $self->load or return;
132 0           $self->_loaded($data);
133             }
134              
135 0           my @list = ();
136 0           for my $this (@$data) {
137 0 0         if ($this->[1] =~ m{$domain}i) {
138 0           push @list, $this->[1];
139             }
140             }
141              
142 0           return \@list;
143             }
144              
145             1;
146              
147             __END__