File Coverage

blib/lib/Tie/Google.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Tie::Google;
2              
3             # ----------------------------------------------------------------------
4             # $Id: Google.pm,v 1.3 2003/04/01 14:48:34 dlc Exp $
5             # ----------------------------------------------------------------------
6             # Apparently, a few people thought this would be a neat idea.
7             # The initial email I recieved on the topic:
8             #
9             # From: Richard Soderberg
10             # Date: Thu, 13 Feb 2003 10:42:07 -0500
11             # To: darren@cpan.org
12             # Subject: Tie::Google?
13             #
14             # #perl found DBD::google recently. I thought I'd point out that there'd
15             # also be a great market for Tie::Google. =)
16             #
17             # my @results; tie @results, 'Tie::Google', $KEY, $saerch_string;
18             # do ... for my $result { grep { $_->{url} =~ /google.com/ } @results };
19             #
20             # - R.
21             #
22             # To which I cavalierly responded with something ridiculous, like "OK".
23              
24 4     4   88434 use strict;
  4         10  
  4         176  
25 4     4   21 use vars qw($VERSION $DEBUG $DEFAULT_BATCH_SIZE);
  4         7  
  4         324  
26              
27 4     4   22 use Carp qw(carp);
  4         13  
  4         348  
28 4     4   10432 use Symbol qw(gensym);
  4         4295  
  4         289  
29 4     4   7432 use Net::Google;
  0            
  0            
30              
31             # Offsets into the array-based object
32             sub KEY() { 0 } # The user's API key
33             sub TYPE() { 1 } # The tie type: SCALAR, ARRAY, HASH
34             sub QUERY() { 2 } # The query terms
35             sub OPTIONS() { 3 } # Options tied in
36             sub DATA() { 4 } # Search results
37             sub GOOGLE() { 5 } # Net::Google instance
38              
39             # Tie types that we support and have to differentiate between
40             sub SCALAR() { 0 }
41             sub ARRAY() { 1 }
42             sub HASH() { 2 }
43              
44             $VERSION = 0.03;
45             $DEFAULT_BATCH_SIZE = 10 unless defined $DEFAULT_BATCH_SIZE;
46             $DEBUG = 0 unless defined $DEBUG;
47              
48             # tie constructors
49             sub TIESCALAR { return shift->new(SCALAR, @_) }
50             sub TIEARRAY { return shift->new(ARRAY, @_) }
51             sub TIEHASH { return shift->new(HASH, @_) }
52              
53             # ----------------------------------------------------------------------
54             # new($TYPE, $KEY, $query)
55             #
56             # Create a new Tie::Google instance. This method should never be
57             # called by outside facing code, only by the TIEFOO methods.
58             #
59             # A Tie::Google instance maintains a few pieces of information:
60             #
61             # 0. The API key of the user
62             #
63             # 1. The type of tie (SCALAR, ARRAY, HASH)
64             #
65             # 2. The query
66             #
67             # 3. Options passed in
68             #
69             # 4. The results of the query.
70             #
71             # 5. The Net::Google instace, created with the API key (item 0)
72             #
73             # The interesting things happen here in new. new must be passed a
74             # type, a key, and a query. If the user is tieing a scalar ("I feel
75             # lucky"), then we are only interested in the first element returned
76             # by the search; if the user is tieing an array, then we want all of
77             # the elements; if the user is tieing a hash, then we want all of the
78             # elements of a number of searches. My "solution" (heh heh heh) is to
79             # store all data in a hashref, indexed into the instance as DATA; if
80             # the user is tieing an array or scalar (Tie::Google treats them
81             # identically), then we store the results in the key named $KEY, so
82             # that we can treat all types of ties consistently; otherwise, search
83             # results are keyed by query.
84             # ----------------------------------------------------------------------
85             sub new {
86             my ($class, $type, $KEY, $query, $options) = @_;
87             $options = { } unless defined $options && ref($options) eq 'HASH';
88             my $self = bless [ $KEY, $type, $query, $options, { }, undef, ] => $class;
89              
90             # Is $KEY actually a file?
91             # I do this in DBD::google as well; perhaps there I should submit
92             # a patch to Aaron so that Net::Google can do this directly.
93             if (-e $KEY) {
94             my $fh = gensym;
95             open $fh, $KEY or die "Can't open keyfile $KEY for reading: $!";
96             chomp($KEY = <$fh>);
97             close $fh or die "Can't close keyfile $KEY: $!";
98              
99             $self->[KEY] = $KEY;
100             }
101              
102             # Set some reasonable defaults search boundaries, and instantiate
103             # the Net::Google instance.
104             $options->{'starts_at'} = 0 unless defined $options->{'starts_at'};
105             $options->{'max_results'} ||= $DEFAULT_BATCH_SIZE;
106              
107             $self->[GOOGLE] = Net::Google->new(key => $self->[KEY],
108             debug => $options->{'debug'} || 0);
109              
110             # * If called from TIEHASH, then store the results keyed by
111             # search terms, otherwise keyed by $KEY
112             #
113             # * If called from TIESCALAR, we only want the first result.
114             #
115             # $self->[OPTIONS] contains starts_at and max_results.
116             #
117             if ($type == HASH) {
118             $self->do_search($query, $query,
119             $self->[OPTIONS]->{'starts_at'},
120             $self->[OPTIONS]->{'max_results'});
121             }
122             elsif ($type == SCALAR) {
123             $self->do_search($KEY, $query, 0, 1);
124             }
125             else {
126             $self->do_search($KEY, $query,
127             $self->[OPTIONS]->{'starts_at'},
128             $self->[OPTIONS]->{'max_results'});
129             }
130              
131             return $self;
132             }
133              
134             # ----------------------------------------------------------------------
135             # do_search($store_as, $query)
136             #
137             # This is where all the Net::Google magic has to happen.
138             #
139             # do_search will use Net::Google to search for $query, and store the
140             # results in $self->[DATA]->{$store_as}.
141             # ----------------------------------------------------------------------
142             sub do_search {
143             my ($self, $store_as, $query, $start, $num) = @_;
144              
145             # Preparation for the search
146             #
147             # do_search can conceivably be invoked with one argument,
148             # in which case we use it both as search term and key into the
149             # DATA hash.
150             #
151             # $start and $num will be taken from OPTIONS->{'starts_at'} and
152             # OPTIONS->{'max_results'}, respectively, if they are not
153             # provided.
154             return unless $store_as;
155             $query ||= $store_as;
156              
157             $start = $self->[OPTIONS]->{'starts_at'}
158             unless defined $start;
159              
160             $num ||= $self->[OPTIONS]->{'max_results'};
161              
162             # The search
163             my $search = $self->[GOOGLE]->search(%{ $self->[OPTIONS] });
164             $search->query($query);
165             $search->starts_at($start);
166             $search->max_results($num);
167             $self->[DATA]->{$store_as} = [
168             map {
169             +{ title => $_->title(),
170             URL => $_->URL(),
171             snippet => $_->snippet(),
172             cachedSize => $_->cachedSize(),
173             directoryTitle => $_->directoryTitle(),
174             summary => $_->summary(),
175             hostName => $_->hostName(),
176             directoryCategory => $_->directoryCategory(),
177             }
178             } @{ $search->results }
179             ];
180             }
181              
182             # ----------------------------------------------------------------------
183             # is_scalar(), is_array(), is_hash()
184             #
185             # Utility methods; is the object a tied scalar, tied array, or tied hash?
186             # ----------------------------------------------------------------------
187             sub is_scalar { shift->[TYPE] == SCALAR }
188             sub is_array { shift->[TYPE] == ARRAY }
189             sub is_hash { shift->[TYPE] == HASH }
190              
191             # ----------------------------------------------------------------------
192             # FETCH() # scalar
193             # FETCH($int) # array
194             # FETCH($key) # hash
195             #
196             # In the case of a tied scalar or a tied array, the search should
197             # already have been performed. In the case of a tied hash, that might
198             # not necessarily be the case, so we might have to do a search.
199             #
200             # Needed by tied scalar, tied hash, and tied array implementations.
201             # ----------------------------------------------------------------------
202             sub FETCH {
203             my ($self, $index) = @_;
204             $index = 0 unless defined $index;
205              
206             if ($self->is_hash) {
207             $self->do_search($index, $index)
208             unless exists $self->[DATA]->{$index};
209              
210             return $self->[DATA]->{$index};
211             }
212              
213             return $self->[DATA]->{$self->[KEY]}->[$index];
214              
215             }
216              
217             # ----------------------------------------------------------------------
218             # EXISTS($item)
219             #
220             # Returns true if this item exists in the instances search results:
221             #
222             # tie %g, "Tie::Google", $KEY, "perl";
223             # print exists $g{"perl"};
224             #
225             # tie @g, "Tie::Google", $KEY, "perl";
226             # print exists $g[2]; # does this work?
227             #
228             # Needed for tied hash and tied array implementation.
229             # ----------------------------------------------------------------------
230             sub EXISTS {
231             my ($self, $index) = @_;
232              
233             return exists $self->[DATA]->{$index}
234             if $self->is_hash;
235              
236             return exists $self->[DATA]->{$self->[KEY]}->[$index];
237              
238             }
239              
240             # ----------------------------------------------------------------------
241             # CLEAR()
242             #
243             # Clears out the search results:
244             #
245             # tie @g, "Tie::Google", $KEY, "perl";
246             # @g = ();
247             #
248             # tie %g, "Tie::Google", $KEY, "perl";
249             # print $g{"apache"};
250             # print $g{"python"};
251             # %g = ();
252             #
253             # Needed by the tied hash and tied array interfaces.
254             # ----------------------------------------------------------------------
255             sub CLEAR {
256             my $self = shift;
257              
258             return %{$self->[DATA]} = ()
259             if $self->is_hash;
260              
261             return @{$self->[DATA]->{$self->[KEY]}} = ();
262             }
263              
264             # ----------------------------------------------------------------------
265             # FIRSTKEY()
266             #
267             # Needed for each(%g). This implementation is taken from Tie::Hash.
268             #
269             # NOTE: This only iterates over keys that are _already defined_! It
270             # _does not_ attempt to iterate over all of Google, or anything silly
271             # like that. Although that would be great fun...
272             #
273             # Needed for tied hash implementation.
274             # ----------------------------------------------------------------------
275             sub FIRSTKEY {
276             my $self = shift;
277             my $a = scalar keys %{$self->[DATA]};
278             each %{$self->[DATA]}
279             }
280              
281             # ----------------------------------------------------------------------
282             # NEXTKEY()
283             #
284             # Needed for each(%g). This implementation is taken from Tie::Hash.
285             #
286             # See NOTE for FIRSTKEY.
287             #
288             # Needed for tied hash implementation.
289             # ----------------------------------------------------------------------
290             sub NEXTKEY {
291             my $self = shift;
292             each %{$self->[DATA]}
293             }
294              
295             # ----------------------------------------------------------------------
296             # DELETE($index)
297             #
298             # Remove an item from the search results list.
299             #
300             # Needed for tied hash and tied array implementation.
301             # ----------------------------------------------------------------------
302             sub DELETE {
303             my ($self, $index) = @_;
304              
305             return delete $self->[DATA]->{$index}
306             if $self->is_hash;
307              
308             return delete $self->[DATA]->{$self->[KEY]}->{$index}
309             if $self->is_array;
310             }
311              
312             # ----------------------------------------------------------------------
313             # STORE($index, $value)
314             #
315             # Anyone calling this method either misunderstands Google or is
316             # intentionally attempting to push the limits of this module.
317             #
318             # Nothing should be able to store anything here, right?
319             #
320             # NOTE: This means that these instances are effectively static once
321             # they are initialized!
322             #
323             # Needed for tied scalar, tied array, and tied hash implementations.
324             # ----------------------------------------------------------------------
325             sub STORE { carp("Misguided attempt to modify Google's database") }
326              
327             # ----------------------------------------------------------------------
328             # STORESIZE($count)
329             #
330             # Called when the user does:
331             #
332             # $#g = 100;
333             #
334             # If $count > current number of elements, then extend the search.
335             # If $count < current number of elements, then drop some.
336             #
337             # Needed for tied array implementation.
338             # ----------------------------------------------------------------------
339             sub STORESIZE {
340             my ($self, $count) = @_;
341             my $arr = $self->[DATA]->{$self->[KEY]};
342             my $cur_total = scalar @$arr;
343              
344             if ($count > $cur_total) {
345             $self->do_search($self->[KEY], $self->[QUERY], 0, $count);
346             }
347             elsif ($count == $cur_total) {
348             # la la la...
349             }
350             else {
351             pop @$arr while @$arr > $count;
352             }
353              
354             return $self->FETCHSIZE();
355             }
356              
357             # ----------------------------------------------------------------------
358             # FETCHSIZE()
359             #
360             # Needed for tied array implementation.
361             # ----------------------------------------------------------------------
362             sub FETCHSIZE {
363             my $self = shift;
364             scalar @{$self->[DATA]->{$self->[KEY]}};
365             }
366              
367             # ----------------------------------------------------------------------
368             # EXTEND($size)
369             #
370             # Called when the user does:
371             #
372             # @g = 100;
373             #
374             # Needed for tied array implementation.
375             #
376             # XXX This implementation might not be right.
377             # ----------------------------------------------------------------------
378             sub EXTEND {
379             shift->STORESIZE(@_)
380             }
381              
382             # ----------------------------------------------------------------------
383             # PUSH($item)
384             #
385             # Needed for tied array implementation.
386             # ----------------------------------------------------------------------
387             sub PUSH {
388             carp "Can't add results to Google's database -- do it the old " .
389             "fashioned way, please!";
390             }
391              
392             # ----------------------------------------------------------------------
393             # POP()
394             #
395             # Removes the last search result from the list of results, and
396             # returns it.
397             #
398             # Needed for tied array implementation.
399             # ----------------------------------------------------------------------
400             sub POP {
401             my $self = shift;
402             pop @{$self->[DATA]->{$self->[KEY]}};
403             }
404              
405             # ----------------------------------------------------------------------
406             # SHIFT()
407             #
408             # Needed for tied array implementation.
409             # ----------------------------------------------------------------------
410             sub SHIFT {
411             my $self = shift;
412             shift @{$self->[DATA]->{$self->[KEY]}};
413             }
414              
415             # ----------------------------------------------------------------------
416             # UNSHIFT($item)
417             #
418             # Needed for tied array implementation.
419             # ----------------------------------------------------------------------
420             sub UNSHIFT {
421             carp "Trying to stick your results into the head of Google's ".
422             "list, eh? Shame on you!";
423             }
424              
425             # ----------------------------------------------------------------------
426             # SPLICE($offset, $limit, @list)
427             #
428             # Needed for tied array implementation.
429             # ----------------------------------------------------------------------
430             sub SPLICE {
431             my ($self, $offset, $limit) = @_;
432             my $arr = $self->[DATA]->{$self->[KEY]};
433              
434             if (@_ > 3) {
435             carp "Can't modify search results this way. Please stuff ".
436             "Google the old fashioned way.";
437             return;
438             }
439              
440             splice @$arr, $offset, $limit;
441             }
442              
443             # ----------------------------------------------------------------------
444             # DESTROY()
445             #
446             #
447             # Needed by the tied hash, tied array, and tied scalar interfaces.
448             # ----------------------------------------------------------------------
449             sub DESTROY { }
450              
451             1;
452              
453             __END__