|
Thema Script
Mittwoch, 30.5.2007, 13:18:43 Uhr
goto in Perl oder: Wie erzeuge ich Spaghetti-Code
Der Befehl goto ist vielen wahrscheinlich auch aus anderen Sprachen bekannt und erlaubt das Springen zu einer Codestelle im Script.
Allerdings: Der Befehl goto ist eigentlich DER Befehl, der für ineffiziente und unübersichtliche Programmierung steht.
Syntax
goto SPRUNGMARKE;
wobei die Sprungmarke als
Weiterlesen...
Freitag, 25.5.2007, 13:20:04 Uhr
LWP::Simple mit timeout-Funktion
Was hab ich mich heute geärgert, weil ein Script, das externe Seiten einliest, bei LWP::Simple immer 180 Sekunden wartet, falls die Seite nicht erreichbar ist.Bei LWP::UserAgent gibts ne timeout-Einstellung, aber bei LWP::Simple laut Doku nicht.
Also mal zum Beispiel ein Code mit LWP::Useragent
use LWP::UserAgent;
my $link='http://www.testmich.de';
$agent = LWP::UserAgent->new;
$agent->timeout(20);
$agent->agent('Mozilla/4.7 [en] (WinNT; I) [Netscape]');
my $request = HTTP::Request->new('GET',$link);
$request ->header( 'Referer' => 'http://www.google.de');
my $result = $agent->request($request);
$seiteninhalt= $result->content();
|
Weiterlesen...
Samstag, 12.5.2007, 19:45:17 Uhr
Zeitkontrolle eines Scriptes - times() in Perl
Die Funkton times() ermittel die Laufzeit eines Prozesses und, wenn vorhanden, seiner Kindprozesse. Dabei wird unterschieden zwischen einer "system time" und "user time".
Der Wert Usertime gibt den Zeitwert an, den der Prozess selbst gelaufen ist, die Systemtime den Zeitwert, den das Betriebssystem benötigt hat.
Als Summe beider Werte erhält man die tatsächlich verbrauchte CPU-Zeit.
Die gemessenen Zeiten basieren auf so genannten Uhrenticks. Die Anzahl der Uhrenticks pro Sekunde ist auf Unix-Systemen einstellbar (TICKSPERSEC in der Datei conf.h).
Weiterlesen...
Dienstag, 8.5.2007, 15:09:15 Uhr
Human Date - Menschliche Datumsangaben erkennen
Beim Stöbern im Internet habe ich eine interessante Problemstellung gefunden, die mich interessiert hat.
Das Problem besteht darin, daß Computer mit Zeitangaben wie "vor einem Jahr" oder "Morgen in einer Woche" nichts anfangen können.
Weiterlesen...
Donnerstag, 3.5.2007, 11:17:55 Uhr
Perl: grep, map and sort
Ich habe vor Jahren einmal im Netz diesen Artikel über Perl's grep, map und sort gefunden und habe ihn immer wieder mal als "Hilfestellung" bei komplexen Themen verwenden können.
Da der Originalartikel leider nicht mehr existiert, möchte ich ihn jetzt online stellen, da ich denke, daß er es wert ist, nicht verloren zu gehen.
Weiterlesen...
Freitag, 27.4.2007, 11:29:17 Uhr
Speedtest File::Find
Wie ich hier ja schon berichtet habe, schien mit das Modul File::Find zu der Zeit etwas unflexibel.Grund dafür war die Tatsache, daß ich keine Dateiendungen übergeben konnte bzw. nicht festlegen konnte, wie viele Ebenen durchsucht werden sollen bzw. nur die aktuelle Ebene oder inklusive Unterebene.
Dies ist zwar natürlich Möglich, aber leider nur per Umweg.
Der Aufruf von File::Find erfolgt ja per
Weiterlesen...
Donnerstag, 26.4.2007, 11:27:33 Uhr
Identische Dateien finden - Der Holzweg
Zum ursprünglichen Beitrag
Hier also der Code, der mich nicht weiter brachte.
use Digest::MD5 qw(md5);
use strict;
my %files=();
my %dateien;
my @nulllength=();
my @dateisize=();
my @dateien=get_all_files('c:/htdocs/',1,'.shtml');
print "Es wurden ".@dateien." Dateien gefunden\n";
## Dateilänge holen und merken
foreach (@dateien){
open (my $IN,'<'.$_);
my $dateilaenge=(stat($_))[7];
binmode ($IN);
read ($IN,my $key,100);
close $IN;
my $size="$dateilaenge|$key";
# Ist Hash-Element der Dateigröße schon vorhanden???
# Wenn nicht, dann Array anlegen, erster Wert ist die Dateigröße
# Übrigens : Hier kann man die Verwendung eines Hashes mit (aus?) Arrays sehen
push (@{$dateien{$size}},"$size") if (!defined @{$dateien{$size}});
push (@{$dateien{$size}},$_);
}
# Ab hir steht in [filename,filename,filename]
# jede Datei, aufgetielt nach Dateigroessen
@dateien=();
foreach (keys %dateien){
my @dats=@{$dateien{$_}};
# wenigstens 2 Filenamen müssen da sein, also @dats >= 3, da erster Eintrag die Dateilaenge
next if @dats < 3;
&get_checksum(@dats);
}
%dateien=();
print qq~Dateien mit Nulllaenge:\n~;
print join("\n",@nulllength);
print qq~\n\nIdentische Dateien:\n~;
foreach (keys %files){
print "$files{$_}\n\n" if (split('\n',$files{$_}) >1);
}
exit;
###################
# Parameter
# Startdir ohne abschließendes /, aktuelles Verzeichnis = .
# Unterverzeichnisse durchsuchen? 1: ja, 0: nein
# Dateitypen in form .txt.htm.html , also direkt hintereinander, aber nur wenn nötig
# ansonsten wird alles gezeigt
#############################################
sub get_all_files{
my $startdir=shift;
my $include_subdirs=shift;
my $endings=shift;
my %endings=();
$endings=~ s/\s//g;
my @endings=split('\.',$endings);
shift @endings;
my $endings=0;
$startdir=~ s/\/$//;
if (@endings != 0){
$endings=1; # wenn Endungen angegeben
foreach (@endings){
$endings{$_}=1;
}
}
@endings=();
my @dateien=();
push (my @all_directories,$startdir);
foreach my $akdir(@all_directories){
local *in;
opendir (in,$akdir);
my @all=readdir(in);
closedir in;
foreach my $akdatei (@all){ next if ($akdatei eq '..' || $akdatei eq '.');
if (-d "$akdir/$akdatei") {
if ($include_subdirs == 1){
push (@all_directories,"$akdir/$akdatei");
next;
}
} else {
if ($endings==0){
push (@dateien,"$akdir/$akdatei");
} else {
my @endung=split('\.',$akdatei);
my $endung=$endung[-1];
if ($endings{$endung} == 1){
push (@dateien,"$akdir/$akdatei");
}
}
}
}
}
return @dateien;
}
######################
# generiert Checksumme einer Datei
#############################################
sub get_checksum{
my ($dateiname,$dateilaenge);
my %tempfiles=(); # temporäre Files
my $data='';
$dateilaenge=shift;
($dateilaenge,my $dummy)=split('\|',$dateilaenge);
return if $dateilaenge > 64000000;
if ($dateilaenge == 0){ # Wenn Dateilaenge = 0, dann gleich alles ins Array und zurück
push (@nulllength,@_);
return;
}
my $firsthundret='';
foreach $dateiname (@_){
open (my $IN,'<'.$dateiname);
binmode($IN);
my $checksum = Digest::MD5->new->addfile(*$IN)->digest;
close $IN;
$files{$checksum}.="$dateiname\n";
}
}
|
Mittwoch, 25.4.2007, 11:15:37 Uhr
Identische Dateien auf dem Computer finden mit Perl
Vor kurzem stand ich vor dem Problem, daß auf einem von mir betreuten Webserver der Speicherplatz aufgebraucht war.
Nach etwas herumsuchen stellte ich dann fest, daß es daran lag, daß viel Speicherplatz verschleudert wurde, weil viele identische Dateien mehrmals vorhanden waren.
Was lag also näher, als ein kleines Perl-Programm zu schreiben, das doppelte (identische) Dateien findet?
Weiterlesen...
Freitag, 13.4.2007, 12:54:32 Uhr
Links finden - die Fortsetzung
Nachdem ich hier ja schon über meine "Feldversuche" bezüglich dem Finden von Links auf Webseiten berichtet habe, scheine ich nun schon recht weit gekommen zu sein.
Wer will kann sich ja mal die Ergebnisse ansehen und ein bißchen herumtesten.
Zum Linkchecker bitte hier klicken.
Donnerstag, 5.4.2007, 00:00:24 Uhr
Nochmal Dateien suchen - diesmal auch in Unterverzeichnissen
Ich hab ja hier schon ein Script vorgestellt, mit dem man bestimmte Dateien in einem Verzeichnis suchen kann.Und weil ich es grad aktuell gebraucht habe, hier eine Funktion, mit der man bestimmte oder auch alle Dateien in einem Ordner inklusive Unterordner suchen kann.
Aber Vorsicht
Wenn man die ganze Platte durchsuchen läßt, kann das schon mal länger dauern...
use strict;
my @dateien=get_all_files('../..',1,'.pl');
print join("\n",@dateien);
###################
# Parameter
# Startdir ohne abschließendes /, aktuelles Verzeichnis = .
# Unterverzeichnisse durchsuchen? 1: ja, 0: nein
# Dateitypen in form .txt.htm.html , also direkt hintereinander, aber nur wenn nötig
# ansonsten wird alles gezeigt
#############################################
sub get_all_files{
my $startdir=shift;
my $include_subdirs=shift;
my $endings=shift;
my %endings=();
$endings=~ s/\s//g;
my @endings=split('\.',$endings);
shift @endings;
my $endings=0;
$startdir=~ s/\/$//;
if (@endings != 0){
$endings=1; # wenn Endungen angegeben
foreach (@endings){$endings{$_}=1;}
}
@endings=();
my @dateien=();
push (my @all_directories,$startdir);
foreach my $akdir(@all_directories){
local *in;
opendir (in,$akdir);
my @all=readdir(in);
closedir in;
foreach my $akdatei (@all){ next if ($akdatei eq '..' || $akdatei eq '.');
if (-d "$akdir/$akdatei") {
if ($include_subdirs == 1){
push (@all_directories,"$akdir/$akdatei");
next;
}
} else {
if ($endings==0){
push (@dateien,"$akdir/$akdatei");
} else {
my @endung=split('\.',$akdatei);
my $endung=$endung[-1];
if ($endings{$endung} == 1){
push (@dateien,"$akdir/$akdatei");
}
}
}
}
}
return @dateien;
}
|
Weiterlesen...
|
RSS-Feed