Αναζήτηση στο www.whitepages.gr ( ήταν: Re: Ελληνικά στο Wine)
Christos Nouskas
nouskas at freemail.gr
Sun May 27 01:54:27 EEST 2007
Αλέξανδρος Διαμαντίδης wrote:
> Λοιπόν, ορίστε ένα σκριπτάκι για να βρίσκετε πληροφορίες για κάποιο
> τηλέφωνο από τη γραμμή εντολών:
>
> #!/bin/sh
> wget -O- -q --post-data=x_tel=$1 http://www.whitepages.gr/resultsX.asp
> |\ iconv -f iso-8859-7 | perl -nwe 's/ / /g;
> /<td class="text-black".*<b>(.*)<\/b>/
> and print "Name: $1\n" and $found=1;
> if ((/<div align="left">/ and $found==1) .. /<\/div>/)
> { s/<[^>]+>//g;
> s/^\s+//;
> s/\s+$//;
> /[^\s]/ and print "Address: $_\n"; }
> /<div align="center"><b>(.*)<br><\/b>/
> and print "Number: $1\n\n" and $found=0;'
>
> Το καλείτε με όρισμα έναν δεκαψήφιο αριθμό τηλεφώνου και με λίγη τύχη
> επιστρέφει ονοματεπώνυμο και διεύθυνση.
>
> Βέβαια ο σωστός τρόπος εξαγωγής πληροφοριών από ιστοσελίδες είναι με
> κάποιον HTML parser, αλλά δεν ξέρω από αυτά... Το παραπάνω σκριπτάκι
> είναι «quick and dirty» όπως λένε, και φυσικά μόλις ο ΟΤΕ αλλάξει λίγο
> την HTML του www.whitepages.gr θα σταματήσει να δουλεύει.
Ορίστε κι ένα perlόσκριπτο για πιο καμμένους, ίσως λίγο πιο ανθεκτικό σε
μικροαλλαγές της HTML του site. Καλείται με όρισμα τον δεκαψήφιο αριθμό.
Παρακαλώ να λείπουν τα σχόλια για -w switches, use strict και ποιότητα
του κώδικα εν γένει - το πράμα δουλεύει :p
=======================================
#!/usr/bin/perl
use LWP::UserAgent;
use HTML::Form;
use Locale::Recode;
sub otes {
my ($tel)=@_;
print "$tel: ";
my $ua = LWP::UserAgent->new;
$ua->agent("BigBrother/666");
my $response=$ua->get("http://www.whitepages.gr");
if ($response->is_success) {
my $form = HTML::Form->parse($response);
$form->value("x_tel"=>$tel);
my $response = $ua->request($form->click());
if ($response->is_success) {
my $respage=$response->content;
$respage =~ s/<(?:[^>\'"]*|([\'"]).*?\\1)*>//gs;
$respage =~ s/<.+?>//g;
$respage =~ s/\ \;/ /g;
$respage =~ tr/\r\n\t\(\)/ /s;
$respage =~ tr/ / /s;
$respage =~ m/.+-->\s(.+\s\d{5}\s).*/s;
return($1);
} else {
return("Error 9823475 - core dumped");
}
}
return("Error 6487524325 - deleting /home directory");
}
my $result=otes($ARGV[0]);
# Όσοι δεν έχουν utf8 terminals να σχολιάσουν τις 2 επόμενες γραμμές
my $cd=Locale::Recode->new (from => 'ISO-8859-7', to => 'UTF-8');
$cd->recode($result);
print "$result\n";
=======================================
--
##### # #####
####### "We are Pentium of Borg. Division is futile.
##### # ##### You will be approximated."
More information about the Linux-greek-users
mailing list