This is Bavaria, Germany!
.pl ---> e:\programme\perl\bin\perl.exe "%s" "%s"
print "Content-Type: text/html\n\n"; print "Hello, you made it run";
There is a nice place to see this at http://www.geocities.com/SiliconValley/Park/8312/perlis.htm
You can find an FAQ for IIS and related things at http://www.15Seconds.com/faq/
You get UTF8-characters when transferring data via XML. You recognize strange double-characters in your documents.
use Encode;
my $your_string = get_string_from_xml();
Encode::from_to(
$your_string,
'utf8', 'iso-8859-1');
}
You have to change codes when gettings Latin1-text to be shown in a browser:
use HTML::Entities; my $with_german_umlauts = 'Räder, Rübensack, weiß'; print encode_entities($with_german_umlauts) . "\n"; # gives: Räder, Rübensack, weiß
sub umlautstring2html {
# change umlauts in a string into the right codes of HTML
# defined in ISO 8879, only what I need for the moment
my ($x) = @_;
# german Umlaute
$x =~ s/ä/\ä/g;
$x =~ s/ö/\ö/g;
$x =~ s/ü/\ü/g;
$x =~ s/Ä/\Ä/g;
$x =~ s/Ö/\Ö/g;
$x =~ s/Ü/\Ü/g;
$x =~ s/ß/\ß/g;
# french
$x =~ s/ò/\&\\#242;/g;
$x =~ s/ó/\&\\#243;/g;
$x =~ s/ô/\&\\#244;/g;
#
$x =~ s/\&/\&/g; # Ampersand
$x =~ s/\>/\>/g; # >
$x =~ s/\</\</g; # <
$x =~ s/©/\©/g; # Copyright
return $x;
}
When you get data from your bank they often use fixed length records. You usually
# file: fixread.pl
#
( $FALSE, $TRUE ) = ( 0, 1 );
$debug = $FALSE;
# Take this file to see this program run
# just delete ## at each line and write this
# to the file "accounts.txt":
##ThisIsTheHeaderFromYourBank.Band:Bank Of America
##1234567890Richard Lippmann 76250000
##2345454660Astrid Windigman 76250000
##9999911111Robert Cowers 76250000
# Description of fixed length data:
# header: 50 bytes
# 10 bytes account-number
# 19 bytes account-ame
# 8 bytes bank-id
# _fqn means "fully qualified name"
$input_fqn = "accounts.txt";
#
$recordlength = 38;
# Define record for unpack
# A=ASCII, A10 10 Bytes Ascii
# A10A19: 10 Bytes Ascii, then 19 Bytes ASCII and so on
$template = "A10A19A8";
# begin with filehandling
open( FH, $input_fqn ) || die "Could not open $input_fqn\\n";
# overjump header with seek, the header is not interesting for me
seek( FH, 50, 0 );
until ( eof(FH) ) {
# read a $recordlength bytes,
# result of reading the file is in $record
# result of read is the number of bytes read
read( FH, $record, $recordlength ) == $recordlength
or die "wrong recordlength\\n";
print "Record is $record\\n--\\n" if $debug;
#
# seperate fields according to the template
@fields = unpack( $template, $record );
#
print "=== Record is ===\\n";
print "account-nr is: $fields[0]<--\n";
print "account-name is: $fields[1]<--\n";
print "bank-id is : $fields[2]<--\n";
}
close FH;
print "End of $0\\n";
A module is doing the deal:
#!/usr/bin/perl use strict; use warnings; use Term::ReadKey; print "Password:"; ReadMode 'noecho'; my $password = ReadLine(0); print "\n"; chomp($password); ReadMode 'normal';
A subroutine checks creates the digital fingerprints of the file:
use strict;
use Digest::MD5;
my $fi = 'e:\temp\x.log';
unlink $fi;
foreach my $i ( 1 .. 10 ) {
open( FI, ">>$fi" );
print FI $i;
close FI;
printf "Checksum is: %s\n", &file_checksum($fi);
}
exit;
sub file_checksum {
my ($file) = @_;
if ( -e $file ) {
open( FILE, $file );
binmode(FILE);
my $ctx = Digest::MD5->new;
$ctx->addfile(*FILE);
close FILE;
return $ctx->b64digest;
}
else {
return 0;
}
}
perl -i -pe 'tr/\015//d' yourprogram.pl
#!/usr/bin/perl use strict; use warnings; use URI::URL; my $url = 'http://lena.franken.de/users/lisa/horshack/index.html'; my $u = URI::URL->new($url); printf "host ist %s\\n", $u->host(); # gives "lena.franken.de"
You need this when developing modules which change frequently and have new routines which are available the first time with a certain version number.
package Customer::Remote; use strict; use warnings; # Return version of this *.pm # In your own module "use mymodul.pm 1.03;" # sub-version-number is with two numbers (x.xx) use Exporter; our $VERSION = '0.03'; our @EXPORT = qw(); our @EXPORT_OK = qw(); our %EXPORT_TAGS = (); ...
Call the module with:
use Customer::Remote 1.01;
If the module version is smaller the programm dies.
use Win32::AdminMisc;
use Win32::NetAdmin;
print "--- network\n";
my $machine = Win32::NodeName;
print "nodename: $machine\n";
print "--- ram\n";
my %mem = Win32::AdminMisc::GetMemoryInfo();
print "ramtotal: $mem{RAMTotal}\n";
print "pagetotal: $mem{PageTotal}\n";
print "--- processor\n";
my %processor = Win32::AdminMisc::GetProcessorInfo();
print "processortype: $processor{ProcessorType}\n";
print "--- os\n";
my %os = Win32::AdminMisc::GetWinVersion();
print "platform: $os{Platform}\n";
print "major: $os{Major}\n";
# $os{CSD} is "Service Pack 3"
$os{ServicePack} = $os{CSD};
$os{ServicePack} =~ s/^(.*) (\d+)$/$2/;
print "sp: $os{ServicePack}\n";
Output is something like this:
--- network nodename: LISA --- ram ramtotal: 133615616 pagetotal: 265822208 --- processor processortype: 586 --- os platform: Win32_NT major: 4 sp: 4
This is nice for executing in a loginscript and writing the data into a logfile and getting alarmed if drivespace gets low.
# free space on drives
use Win32::AdminMisc;
use Win32::NetAdmin;
printf "# %s;%s;%s\n", "date", "computername", "drivespace";
printf "%s;%s;%s\n", heute(), $ENV{'computername'}, drivespace();
sub heute {
my ( $sek, $min, $std, $mtag, $mon, $jahr, $wtag, $jtag, $isdt ) =
localtime(time);
return sprintf( "%02d.%02d.%04d", $mtag, 1 + $mon, 1900 + $jahr );
}
sub drivespace {
my $info;
# which drives are available, possible parameters are:
# DRIVE_REMOTE
# DRIVE_FIXED
# DRIVE_CDROM
# DRIVE_REMOVABLE
my @drives = Win32::AdminMisc::GetDrives(DRIVE_FIXED);
foreach my $drive ( sort @drives ) {
my ( $total, $free ) = Win32::AdminMisc::GetDriveSpace($drive);
$drive =~ s/:\\\\$//;
$free = int( $free / ( 1024 * 1024 ) );
$total = int( $total / ( 1024 * 1024 ) );
my $prozent = int( 100 * $free / $total );
push( @info,
"drive=$drive free=${free}MB total=${total}MB percentfree=${prozent}%"
);
}
return join( ",", @info );
}
You get this as result:
D:\daten\perl\misc> perl D:\daten\perl\misc\free_drivespace2.pl # date;computername;drivespace 17.09.2000;LISA;drive=C free=194MB total=297MB prozentfrei=65%,drive=D free=654MB total=2008MB percentfree=32%
A profiler show how much time your code spends in each subroutine. Needed if code needs to long to execute and you don't know where it needs that long time.
Install it:
perl -MCPAN -eshell > install Devel::NYTProf
Use it in your program:
#!/usr/bin/perl -d:NYTProf ...
Output is written to file nytprof.out which nobody wants to read. You have to format it with a helperprogram:
www-data> nytprofhtml [... html-file are written to new directory ./nytprof]
Maybe you need this directive in your apache-config to view the file in your web-browser:
Alias /cgi-bin/xxxx/nytprof /var/www/ap1/cgi-bin/xxxx/nytprof
<Directory "/var/www/ap1/cgi-bin/xxxx/nytprof">
Options Indexes FollowSymLinks
</Directory>
#!/usr/bin/perl
use strict;
use warnings;
use Net::SNMP;
my ( $session, $error ) = Net::SNMP->session(
-hostname => 'somehost.local',
-version => 1,
-community => 'public'
);
if ( !defined $session ) {
printf "ERROR: %s.\n", $error;
exit 1;
}
my $oid = '1.3.6.1.2.1.2.2.1.10.3';
my $result = $session->get_request( -varbindlist => [$oid], );
if ( !defined $result ) {
printf "ERROR: %s.\n", $session->error();
$session->close();
}
printf "result = %s\n", $result->{$oid};