Durch Nutzung dieser Webseite stimmen Sie dem Einsatz von Cookies und Werbung zu. Weitere Informationen



KnowHow 10.3 ''Perl ''
 Stand: 18.05.2017 16:35:46

Inhalt | Suche | Homepage | Kontakt | Impressum

- Durch Anklicken im Inhaltsverzeichnis kann direkt zum Thema gesprungen werden.
- Begriffe auf dieser Seite können mit Ihrer Browser-Funktion ''Bearbeiten -> Suchen'' oder mit den Tasten [Strg]-[F] gesucht werden.
- Des weiteren gibt es noch eine Suchfunktion über alles.
- Es sind mehr Informationen verfügbar, als hier angegeben. Falls Sie etwas vermissen, scheuen Sie sich nicht nachzufragen, wir antworten gerne.




10.3.1 ActivePerl


10.3.1.1 Nützliche Funktionen


# --- Text ausgeben ---
print "hallo\n";


# --- Datei lesen ---
if (open(FILEHANDLE,"$filename")) # Datei zum Lesen öffnen
{
@filedata = <FILEHANDLE>; # Datei auslesen
$linecount = $#filedata; # Anzahl der Zeilen
$linestring = $filedata[$linenumber]; # eine Zeile der Datei
close(FILEHANDLE); # Datei schließen
}
else { print "Error: can not open file\n"; }


# --- Daten erzeugen und Daten anhängen ---
if (open(FILEHANDLE,">$filename"))
{
print FILEHANDLE "hallo\n"; # Daten anhängen
close(FILEHANDLE); # Datei schließen
}
else { print "Error: can not create file\n"; }


# --- Datei Daten anhängen ---
if (open(FILEHANDLE,">>$filename"))
{
print FILEHANDLE "hallo\n"; # Daten anhängen
close(FILEHANDLE);
}
else { print "Error: can not append file\n"; }


# --- Datei löschen ---
if (!unlink($filename)) { print "Error: can not delete file\n"; }


# --- Länge eine Strings ---
$stringlength = length($string);


# --- Substring suchen ---
$position = index($string,$substring);
# ist kleiner 0, falls $substring nicht enthalten


# --- Substring suchen unabhängig von Groß- und Kleinschreibung (case-insensitive) ---
$position = index(uc $string, uc $substring);
# ist kleiner 0, falls $substring nicht enthalten


# --- Teil eines Strings extrahieren ---
$substring = substr($string,$position,$length);


# --- Warteschleife ---
sleep($sleepseconds);


# --- Array sortieren
@name = sort @name;


# --- Array sortieren unabhängig von Groß- und Kleinschreibung (case-insensitive)
@name = sort { uc($a) cmp uc($b) } @name;

Achtung: $a und b$ dürfen dabei nicht als Variablen definiert und verwendet werden!

-> https://www.ostc.de/howtos/perl-sorting-HOWTO.txt


# --- aktuelles Datum und Zeit ---
($sec, $min, $hour, $day, $mon, $year) = (localtime(time))[0,1,2,3,4,5];
$mon = $mon + 1;
$year = $year + 1900;


# --- Datei-Liste einer Directory ---
@fileliste = glob("*");


# --- Directory wechseln ---
use Cwd; # spezielle Directory-Funktionen einbinden
$directory = cwd; # aktuelles Verzeichnis
chdir($dirname); # in das Verzeichnis $dirname wechseln
chdir('..'); # eine Verzeichnis-Ebene höher wechseln


# --- Zeit und Datum einer Datei ändern ---
use Time::Local; # spezielle Zeit-Funktionen einbinden
$seccount = timelocal($sec,$min,$hour,$day,$month-1,$year); # seconds since 01.01.1970
utime($seccount,$seccount,$filename); Zeit und Datum einer Datei ändern
# month 0...11 for Jan...Dec
# year 0...35 for 2000...2035, from 38...99 for 1938...1999
# Probleme von WinXP:
# - Datum kleiner als 01.01.1970 kann nicht als Attribut eingetragen werden
# - Datum 01.01.1980 mit der Zeit 00:00:00 kann nicht als Attribut eingetragen werden
# - Datum kleiner als 01.01.1980 kann nicht als Attribut angezeigt werden


# --- Funktion ---
sub funktionname
{
local($parameter1, $paramter2) = @_; # Parameter lesen
return ($returnvalue);
}


# --- Ausgang ---
exit(0); # Ausgang ohne Fehler
exit(1); # Ausgang mit Fehler




10.3.1.2 Perl symbolische Konstante

use constant MWST => "test";
print MWST;



10.3.1.3 Hash

Ein Hash kann man als Array bezeichnen, welches statt einem Zahlen-Index Schlüsselnamen (Keys) verwendet.

%Land = (Name       => "LName",
         Hauptstadt => "HName",
         Einwohner  => $Einwohner);

print $Land{'Einwohner'};      # gibt Wert des Elements mit Schlüssel Einwohner aus
$Land{'Name'} = "AndererName"; # ändert Wert des Elements mit Schlüssel Name
$LaengeHash = keys(%Land);     # Länge des Hashes
@HashKeys   = keys(%Land);     # erzeugt Array mit Hashschlüsseln (hat aber zufällige Reihenfolge!)
@HashValues = values(%Land);   # erzeugt Array mit Hashwerten

Da die Hashschlüssel zufällig angeordnet werden, ist es besser vorher ein Array mit den Keys zu definieren,
dann kann man auf den Key und die Daten auch per Index zugreifen:
my @key = ("Name","Hauptstadt","Einwohner");
my @dat = ("LName","HName",$Einwohner);
my %Land;
for ($i = 0; $i < @key; $i++)
  {
  $Land{$key[$i]} = $dat[$i];
  }



10.3.1.4 Pointer / Referenzen

@array = ("Hallo",12,4);
$array_ptr = \@array; #erzeugt Pointer/Referenz auf Array @array

print $ref_array; #gibt Speicherort von @array (z.B. ARRAY(0x168274c)) aus
$ElementInhalt = $ref_array->[1]; # Inhalt eines Elements



10.3.1.5 FTP Upload

use Net::FTP;
$ftp = Net::FTP->new($FTP_host);
$ftp->login($FTP_user,$FTP_pass);
$ftp->cwd($FTP_dir);
$ftp->put("$path/$filename");
$ftp->quit;



10.3.1.6 FTP Verzeichnis erstellen

$ftp->mkdir($FTP_dir);



10.3.1.7 Reguläre Ausdrücke


# --- html-Steuerzeichen CR LF durch <br> ersetzen ---
$text_br =~ s/\r\n/<br>/g;

# --- html-Steuerzeichen <br> durch CR LF ersetzen ---
$text_lf =~ s/<br>/\r\n/g;

# --- html-Steuerzeichen < durch < ersetzen ---
$string =~ s/</</g;

# --- 2 Leerzeichen durch html-Code "  " ersetzen ---
$text =~ s/ /  /g;

# --- Zeichen | durch , ersetzen ---
$string =~ s/\|/,/g;

# --- Leerzeichen entfernen ---
$string =~ s/ //g;

# --- Großbuchstaben durch Kleinbuchstaben ersetzen ---
$string =~ s/([A-Z])/lc($1)/eg;

# --- nur die Zeichen a...z, A...Z, äöüßÄÖÜ, 0...9, "_", "-" zulassen ---
$string =~ s/[^a-zA-ZäöüßÄÖÜ0-9_-]//g;

# --- Prüfen auf erlaubte Zeichen ---
if ($string !~ /^[a-zA-ZäöüßÄÖÜ0-9_-]*$/ )



10.3.1.8 Parameter / Argumente in Perl auslesen

Aufruf perl perlscript.pl wert1 wert2

$i = 0;
foreach (@ARGV)
  {
  $parameter[$i++] = $_;
  }




10.3.1.9 HTML in Perl erzeugen

Ein Beispiel für einen Perl-Code mit ausführbarem HTML-Code auf Apache-Servern. Dabei ist die erste Zeile als Kenner für den Perl-Code notwendig (das Verzeichnis muss natürlich an den installierten Ort der perl.exe angepasst werden). Die zweite Zeile ist für die Erkennung des HTML-Codes wichtig, sonst würde der HTML-Code nicht ausgeführt, sondern nur als Text ausgegeben werden. Der Apache-Server zeichnet in dem Fall im error.log folgenden Fehler auf: "(9)Bad file descriptor: don't know how to spawn child process"

#!c:/Perl/bin/perl.exe
print "Content-type:text/html\n\n";
print "
<html>
<head>
<title>HTML Code in Perl erzeugen</title>
</head>
<body>
Test Test Test
</body>
</html>
";



10.3.1.10 Parameterübergabe HTML an Perl, Methode "URL-Parameter"

HTML-Code "test.htm" Parameter schreiben (1)

<html>
<head></head>
<body>
<a HREF=test.pl?parameter1=$wert1¶meter2=$wert2> Parameter senden </a>
</body>
</html>

HTML-Code "test.htm" Parameter schreiben (2)

<html>
<head></head>
<META HTTP-EQUIV='REFRESH' CONTENT='0; URL=test.pl?parameter1=$wert1¶meter2=$wert2'>
<body>
</body>
</html>

CGI-Perl-Script "test.pl" Paramter auslesen

use CGI;
$query=new CGI;
$parameter1=$q->param('parameter1');
$parameter2=$q->param('parameter2');


10.3.1.11 Parameterübergabe HTML an Perl, Methode "Formular"

Funktioniert in noch ungeklärten Fällen nicht immer.

HTML-Code "test.htm" Parameter schreiben

<html>
<head></head>
<body>
<form name=formname1 action='test.pl' method=post onSubmit='return CheckForm(this)'>
<input type=hidden name=paramter1 value='$wert1'>
<input type=hidden name=paramter2 value='$wert2'>
<input type=submit value='Parameter senden'>
</FORM>
</body>
</html>

CGI-Perl-Script "test.pl" Paramter auslesen (1)

($paramter1, $paramter2) = @_;

CGI-Perl-Script "test.pl" Paramter auslesen (2)

&parse_form_data(*form_data);
if (defined($form_data{paramter1})) { $paramter1 = $form_data{paramter1}; } else { $paramter1 = "unbekannt"; }
if (defined($form_data{paramter2})) { $paramter2 = $form_data{paramter2}; } else { $paramter2 = "unbekannt"; }

#------------
sub parse_form_data
{
local(*FORM_DATA) = @_;
local($request_method, $query_string, @key_value_pairs, $key_value, $key, $value);
$request_method = $ENV{'REQUEST_METHOD'};

if( $request_method eq "GET" )
  { $query_string = $ENV{'QUERY_STRING'}; }

elsif ( $request_method eq "POST" )
  { read(STDIN, $query_string, $ENV{'CONTENT_LENGTH'}); }
else
  { &return_error(500,"Server Error","Server uses not supported method"); }
@key_value_pairs = split(/&/, $query_string);
foreach $key_value (@key_value_pairs)
  {
  ($key, $value) = split(/=/, $key_value);
  $key =~ tr/+/ /;
  $value =~ tr/+/ /;
  $key =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex($1))/eg;
  $value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex($1))/eg;
  if (defined($FORM_DATA{$key}))
   { $FORM_DATA{$key} = join("\0", $FORM_DATA{$key}, $value); }
  else
   { $FORM_DATA{$key} = $value; }
  }
}

#------------
sub ReadParse
{
local (*in) = @_ if @_;
local ($i, $key, $val);
# Read in text
if (&MethGet)
  {
  $in = $ENV{'QUERY_STRING'};
  }
elsif (&MethPost)
  {
  read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
  }
@in = split(/[&;]/,$in);
foreach $i (0 .. $#in)
  {
  # Convert plus's to spaces
  $in[$i] =~ s/\+/ /g;
  # Split into key and value.
  ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
  # Convert %XX from hex numbers to alphanumeric
  $key =~ s/%(..)/pack("c",hex($1))/ge;
  $val =~ s/%(..)/pack("c",hex($1))/ge;
  # Associate key and value
  $in{$key} .= "~" if (defined($in{$key})); # '~' is the multiple separator
  $in{$key} .= $val;
  }
return scalar(@in);
}
#------------
sub MethGet
{
local ($it);
$it = $ENV{'REQUEST_METHOD'};
if ($it =~ /GET/) { return '1'; }
return '0';
}
#------------
sub MethPost
{
local ($it);
$it = $ENV{'REQUEST_METHOD'};
if ($it =~ /POST/) { return '1'; }
return '0';
}
#------------




10.3.1.12 ActivePerl-Script zur Versendung einer Email

#!c:/Perl/bin/perl.exe

# ActivePerl-Script unter Windows zur Versendung einer Email mit Authentifizierung am SMTP-Server
#
# In Perl müssen besondere Pakete wie Mail extra installiert werden:
# Im Programm-Paket von ActivePerl den "Perl Package Manager (PPM)" aufrufen
# -> View -> All Packages
# "SMTP-Server", "NEt-SMTP_auth" suchen und mit rechter Maustaste auswählen
# grünen Pfeil zur Installation anklicken

# (C) Axel Burgermeister, 20.09.2010

use strict;
use Net::SMTP;
# hierzu mit dem Tool "ActivePerl - Perl Package Manager (PPM)" das Package "SMTP-Server" installieren!

my $ServerName = "smtp.server.de"; # hier den SMTP-Servernamen eintragen
my $ServerAccount = 'email@address.de'; # hier den Account-Namen eintragen, das ist meisten die eigene Email-Adresse
my $ServerPwd = "*******"; # hier das Password eintragen
# AT-Zeichen @ entweder so schreiben \@ oder statt " nur ' verwenden

my $from_adr    = 'email@address.de';
my $to_adr      = 'email@address.de';
my $cc_adr      = "";
my $bcc_adr     = "";

my $from_name   = 'Axel';
my $to_name     = 'Axel';
my $cc_name     = "";
my $bcc_name    = "";

my $subject     = "Test-Mail";
my $text        = "Hallo Hallo";

#--------

my $message = "From: $from_name\nTo: $to_name\nCc: $cc_name\nBcc: $bcc_name\nSubject: $subject\n\n$text\n\n";

print "Content-type: text/html","\n\n";
print "
<html>
  <head>
  <title>Mail</title>
  </head>
  <body>
  ";

my $smtp = Net::SMTP->new($ServerName, Hello => "1und1.de",  Timeout => 60, Debug => 1);
  die "*** Couldn't connect to server" unless $smtp;

print "Server connection opened<br>";

if ( !$smtp->auth($ServerAccount, $ServerPwd) )
  {
  print "*** authentication failed or not needed<br>";
  }

if ( !$smtp->mail( $from_adr ) )
  {
  print "*** from address not accepted<br>";
  exit 1;
  }

if (!$smtp->to( $to_adr ) )
  {
  print "*** to address not accepted<br>";
  exit 1;
  }

if ($cc_adr != "")
  {
  if (!$smtp->cc( $cc_adr ) )
    {
    print "*** cc address not accepted<br>";
    exit 1;
    }
  }

if ($bcc_adr != "")
  {
  if (!$smtp->bcc( $bcc_adr ) )
    {
    print "*** bcc address not accepted<br>";
    exit 1;
    }
  }

print "Server variables checked<br>";

$smtp->data();
$smtp->datasend($message);
$smtp->dataend();
$smtp->quit;

print "Finished sending email<br>";

print "
  <br><br>
  </body>
</html>
  ";



10.3.1.13 Öffentliche IP-Adresse der Fritzbox per Perl-Skript auslesen

Perl-Skript

#!c:/Perl/bin/perl.exe
my $ipaddr = get_server_IP();
print "oeffentliche IP-Adresse: $ipaddr \n";
sleep(10);
exit (0);

sub get_server_IP {  # return ($ipaddr);
# Öffentliche IP-Adresse der Fritzbox ohne externe Hilfe auslesen
# (sonst kann man nur über externe Server oder umständliche Wege die Addresse erhalten)
# Code speziell für die Fritzbox 7270 mit der Firmware-Version 74.05.05
# (C) Axel Burgermeister, 17-Feb-2012

# Modul für Internet-Seiten laden
# Timeout 180 sec lässt sich nur durch Nutzung und Vererbung von LWP::Useragent ändern
use LWP::Simple qw ($ua head get);
$ua->timeout(30); # Timeout = 30 sec

# URL der Fritzbox-Seite, auf der die aktuelle IP-Adresse angezeigt wird
my $fritzboxurl = 'http://fritz.box/home/home.lua';

# HTML-Seite auslesen und in String-Variable speichern
# my $htmlhead = head($fritzboxurl);
my $htmlcontents = get($fritzboxurl);

# Check Timeout
if (!$htmlcontents)
{
  return ("timeout");
}

# Schlüsseltext "IP-Adresse: " im HTML-Code suchen
# Beispiel Code-Zeile: ... <div id='ipv4_info'>verbunden seit 16.02.2012, 23:55 Uhr, Internet, IP-Adresse: 88.65.214.42</div> ...
my $ipaddrpos = index($htmlcontents,"IP-Adresse: ") + 12;

# IP-Adresse bis zum Zeichen "<" aus dem HTML-Code extrahieren
my $ipaddr = substr($htmlcontents,$ipaddrpos,20);
($ipaddr) = split(/</,$ipaddr);

return $ipaddr;
}



10.3.1.14 Perl-Skript als Hintergrundprozess (Daemon) ohne Fenster ausführen

1. Möglichkeit: Nutzung von WPERL im CMD-Kommando unter Windows:
wperl perlscript.pl

2. Möglichkeit: Nutzung von Win32::Process im Perl-Code:
use strict;
use Win32;
use Win32::Process;

Win32::Process::Create(
  $Win32::Process::Create::ProcessObj,
  'C:\\perl\\bin\\perl.exe',
  'perl perlscript.pl',
  0,
  DETACHED_PROCESS,
  ".")
  or die print_error();

sub print_error()
  {
  return Win32::FormatMessage(Win32::GetLastError());
  }

Die Fenster können geschlossen werden, der Child-Prozess läuft im Hintergrund
bis zum Script-Ende weiter oder bis er von Hand im Taskmanager gestoppt wird.
Mit einer Endlosschleife mit Pausen im Script lassen sich auch gut Scheduler entwickeln.


10.3.1.15 EXIF-Daten auslesen

use Image::ExifTool qw(ImageInfo);
my @tagList;
my $exifTool;
my $data;
my $exif;
@tagList = ('-ThumbnailImage', '-Directory'); # not to print
$exifTool = new Image::ExifTool;
$exifTool->Options(Duplicates => 0);  # supress duplicates
$data = $exifTool->ImageInfo("bild.jpg", \@tagList);
foreach $exif (sort keys %$data)
{
  print($exif.":".$data{$exif});
}


Quelle: http://www.inspire-world.de/board/showthread.php?p=97870



10.3.2 Formatierte Ausgabe

Zahl $value formatieren und ausgeben, Beispiel mit 2 Nachkommastellen:
$string = sprintf("%.2f",$value);
print $string;


Besucher seit 30.01.2003:

© 2013 Burgermeister  | Home | Main Server | Mirror Server | Kontakt | Impressum | Datenschutz