/blog/perl


substr() in Perl
[149350 mal gelesen]
foreach in Perl
[127621 mal gelesen]
Arrays in Perl - Besonderheiten
[122820 mal gelesen]
split() in Perl - Zeichenketten teilen
[110641 mal gelesen]
open() - Dateien öffnen in Perl
[107519 mal gelesen]
grep - Listen durchsuchen in Perl
[92648 mal gelesen]
chomp() in Perl
[92396 mal gelesen]
push in Perl
[89349 mal gelesen]
sleep in Perl - Das aktuelle Script warten lassen
[74055 mal gelesen]
index() in Perl - Zeichenkette in Zeichenkette suchen
[57004 mal gelesen]


Arrays
Dateien
HTPC
Hashes
Leistungsoptimiert
PHP
Perl
RegEx
Schleifen
Script
Skalare
Sonstiges
System
Webserver
Zur Startseite


Donnerstag, 29.11.2007, 20:10:48 Uhr

Transform a website to unicode


While testing my scripts if they run under Vista, i found a little script, an indexer for webpages. After some years, i tried to make it ready for unicode.

After trying some Modules I did not found a good solution. The Problem ist: To change a website to UTF8, Perl has to know the encoding of the original Html-Code.

After hours of trying, I found this way to change any website (?) to utf8.

Here is the script:

#!/usr/bin/perl
print <<EOF;
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">

<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />\n\n
<title>Untitled Document</title>
</head>
<body>
EOF
use CGI::Carp "fatalsToBrowser";

use strict;
use utf8;
use HTML::Entities;

# loading a site from www

#my $string=lade_seite("http://www.livebet.gr/");
#my $string=lade_seite("http://www.imerisia.gr");
my $string=lade_seite("http://www.hidemail.de/blog");
#my $string=lade_seite("http://www.wsws.org/tr/2005/nov2005/turk-o16.shtml");
#my $string=lade_seite("http://www.hi.is/");
#my $string=lade_seite("http://www.stern.de/");


decode_entities($string);

# we want only lower-case
$string=lc($string);

# a is nothing more than a space for us
$string=~ s/\ \;/ /g;

#deleting <script>-areas
$string=~ s/<script.*?\/script>/\n/gis;

# getting the title from the page
$string =~ s/<title.*?>(.*?)<\/title.*?>//s;
my $title=$1;
$title="No Title" if $title eq '';

$string=~ s/.*?<body.*?>//gis; # cut from the head to the body, we want only the content

print "Title $title<br>";

# delete the html-tags
$string =~ s{ < (?: [^>'"] * | ".*?" | '.*?' ) + > }{ }gsx;

# decode the html-entities -> make ä from ä and so on


# replace signs like . with \n
$string=~ tr/ \(\)\.\-\{\}\[\]\?\`\´\'\+\*\#\_\:\;\,\|\<\>\!\"\§\$\%\&\/\\\t\r\©\€\µ\”\“\»\=\@\µ/\n/;

# delete x-\n's, we need only one \n
$string=~ s/\n+/\n/gs;

utf8::encode($string);

my %woerter=();

#count words longer than 1 character
grep {$woerter{$_}++ if length($_) >1} split(/\n/,$string);

# and show
foreach (sort(keys %woerter)){print "$_: $woerter{$_} mal<br>\n";}


open (out,">test.txt") || die ("fehler");
#binmode(out, ":utf8");
foreach (sort(keys %woerter)){print out "$_: $woerter{$_} mal<br>\n";}
close out;


#######################
#lädt eine Seite aus dem Internet
####################################
sub lade_seite{
use LWP::UserAgent;
use HTTP::Request;
use Encode;
my ($url) = @_;
print $url;
my $content; my $encoding;
my $request = HTTP::Request->new(GET => $url);
my $ua = LWP::UserAgent->new;
$ua->agent('User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.1.4) Gecko/20070515 Firefox/2.0.0.4');

my $response = $ua->request($request);

if($response->is_success) {
$content = $response->content;

$content=~ /charset\=(.*?)\"/;

my $charset=$1;
#print "<br>Charset: $charset<br>";

$charset="utf8" if $charset eq '' || $charset eq 'UTF-8';

$content=decode($charset,$content);

return $content; # Content zurück
} else {
return ;
}
}

################################################################
#entfernt aus einer Liste doppelte einträge
################################################################
sub del_double{
my %all=();
@all{@_}=1;
return (keys %all);
}



To test the script, click here. The script loads the startpage of this blog and shows it's results.
I tested this script (of course) with german, greek, turkish, hebrew, icelandic chars and japanic... and it seems, it works (beside: I can NOT read hebrew, iceland and japanic letters... but I thing they are right).

So, what does this script and how it works
The script reads a website via www and changes it to utf8. After that, it changes all the words (without HTML) to lowercase and shows, how many times every word appears. So far very easy... without utf8.

In utf8 everything is different. Using lc(word) can destroy letters, if they are not correctly changed.

The solution is the Encode->decode($charset,$content), where $charset is the given charset in the webpage. If no charset is given or the charset is UTF-8, the webpage is already utf8. If not, decode transfers the content to utf8.

A very hard way...


Thema: System Skalare Webserver Perl Script

Der Beitrag "Transform a website to unicode" wurde 5561 mal gelesen.

Kommentar schreiben  Druckansicht  Seitenanfang 
Beurteilen 






 Zufällige Beiträge im /blog/perl

sleep in Perl - Das aktuelle Script warten lassen

Wiederholungen finden mit regulären Ausdrücken

getc - Nächstes Zeichen aus Datei lesen

Gefälschte Mail von Google enthält Trojaner

reverse in Perl()

Die Perl-Blog-Software

Shift in Perl

Verknüpfung zu Flip 3D wiederherstellen

Systemvoraussetzungen für Windows Vista



0.0285630226135254 sec. to build



...Blogsoftware in pure Perl - Powered by a lot of Coffee...


SSD-Festplatte - Wassn das???
Die Transliteration - Nur ein Zeichen in einem Skalar ersetzen
Select - Case in Perl
Windows 7 XP Mode – Wo finde ich den XP-Modus unter Windows 7?
Mac-Adresse beim Apple Macintosh herausfinden
SGN-Funktion für Perl

Eigene IP herausfinden mit Perl
Epoche live in Datum umwandeln
Firefox 3 - Exe-Files downloaden


Gesamtverzeichnis
Februar 2010
Dezember 2009
Oktober 2009
Januar 2009
Dezember 2008
November 2008
September 2008
August 2008
Juli 2008
Juni 2008
Mai 2008
April 2008
Januar 2008
Dezember 2007
November 2007
Oktober 2007
September 2007
August 2007
Juni 2007
Mai 2007
April 2007
März 2007
Februar 2007
Januar 2007
Dezember 2006


Mister Wong

RSS-Feed

Heute ist der
1.10.2022

Es ist
12:23:55 Uhr

Ihre IP:
44.200.137.63

Blog-Einträge: 186

Die letzten 24 Stunden im Überblick


Gelesene Beiträge insgesamt:
4286462


Webseiten vergleichen
Kalender mit Feiertagen - 2028
Links finden und testen
Menschliche Datumsangaben
IP zu Domain herausfinden
Time live in Datum umwandeln
Perl für Windows



Impressum