Perl

One Liners

 * http://www.catonmat.net/blog/perl-one-liners-explained-part-one
 * http://blog.ksplice.com/2010/05/top-10-perl-one-liner-tricks/
 * http://www.ibm.com/developerworks/linux/library/l-p101/
 * http://www.unixguide.net/unix/perl_oneliners.shtml

UNIX
find *.conf -exec perl -i.bak -pe 's/-tst.hostname.com/-uat.hostname.com/g;s/10\.50\.108\.200/10\.50\.108\.196/g' {} \;
 * search and replace

SCRIPTS
perl -i.bak -pe 's/{/\n{\n/g; s/}/\n}\n\n/g; s/,/,\n/g; s/;/;\n/g' tmp.css
 * compressed js


 * send an email
 * 1) !/usr/bin/perl

use Socket;

$from = 'serveradmin@domain.net'; $to  = 'test.user@domain.net';

send_mail( $from, $to, 'test', 'blah blah blah');

sub send_mail {

my $from = shift; my $to = shift; my $subject = shift; my $body = shift;

# Send the results

$smtp_server = 'mail.domain.net';

$body =~ s/\n\.[\r|\n]/\n. $1/g;

my $proto = getprotobyname('tcp'); socket(SERVER, AF_INET, SOCK_STREAM, $proto); my $iaddr = gethostbyname($smtp_server); my $port = getservbyname('smtp', 'tcp');

my $sin = sockaddr_in($port, $iaddr); my $sreply;

connect(SERVER, $sin); recv SERVER, $sreply, 512, 0; print "Connect $sreply\n";

send SERVER, "HELO domain.net\r\n", 0; recv SERVER, $sreply, 512, 0; print "Helo $sreply\n"; send SERVER, "MAIL From:<$from>\r\n", 0; recv SERVER, $sreply, 512, 0; print "Mail from $sreply\n";

@tos = split(/,/, $to); foreach $to ( @tos) { send SERVER, "RCPT To:<$to>\r\n", 0; recv SERVER, $sreply, 512, 0; print "RCPT TO $reply\n"; }

send SERVER, "DATA\r\n", 0; recv SERVER, $sreply, 512, 0; print "DATA $sreply\n";

send SERVER, "Subject: $subject\r\n", 0; send SERVER, "To: $to\n", 0; send SERVER, "From: $from\n", 0;

send SERVER, "\r\n$body\r\n", 0; send SERVER, ".\r\n", 0; recv SERVER, $sreply, 512, 0;

if ( $sreply =~ /Message received/i ) { print "Sent e-mail to $to\n"; } else { print "Failed to send e-mail to $to: $sreply\n"; }

send SERVER, "QUIT\r\n", 0; recv SERVER, $sreply, 512, 0;

close SERVER; }


 * http://www.google.com/search?q=perl+http+server
 * http://www.floodgap.com/httpi/
 * http://www.adp-gmbh.ch/perl/webserver/

webserver.pl use strict; use warnings;

use Socket; use IO::Select;

use threads; use threads::shared;

$| = 1;

use vars qw/ $port_listen /;
 * 1) The following variables should be set within init_webserver_extension

require "http_handler.pl"; init_webserver_extension;

local *S;

socket    (S, PF_INET  , SOCK_STREAM , getprotobyname('tcp')) or die "couldn't open socket: $!"; setsockopt (S, SOL_SOCKET, SO_REUSEADDR, 1); bind      (S, sockaddr_in($port_listen, INADDR_ANY)); listen    (S, 5)                                               or die "don't hear anything:  $!";

my $ss = IO::Select->new; $ss -> add (*S);

while(1) { my @connections_pending = $ss->can_read; foreach (@connections_pending) { my $fh; my $remote = accept($fh, $_);

my($port,$iaddr) = sockaddr_in($remote); my $peeraddress = inet_ntoa($iaddr);

my $t = threads->create(\&new_connection, $fh); $t->detach; } }

sub extract_vars { my $line = shift; my %vars;

foreach my $part (split '&', $line) { $part =~ /^(.*)=(.*)$/;

my $n = $1; my $v = $2; $n =~ s/%(..)/chr(hex($1))/eg; $v =~ s/%(..)/chr(hex($1))/eg; $vars{$n}=$v; }

return \%vars; }

sub new_connection { my $fh = shift;

binmode $fh;

my %req;

$req{HEADER}={};

my $request_line = <$fh>; my $first_line = "";

while ($request_line ne "\r\n") { unless ($request_line) { close $fh; }

chomp $request_line;

unless ($first_line) { $first_line = $request_line;

my @parts = split(" ", $first_line); if (@parts != 3) { close $fh; }

$req{METHOD} = $parts[0]; $req{OBJECT} = $parts[1]; }    else { my ($name, $value) = split(": ", $request_line); $name      = lc $name; $req{HEADER}{$name} = $value; }

$request_line = <$fh>; }

http_request_handler($fh, \%req);

close $fh; }

http_handler.pl sub http_request_handler { my $fh    =   shift; my $req_  =   shift;

my %req   =   %$req_;

my %header = %{$req{HEADER}};

print $fh "HTTP/1.0 200 OK\r\n"; print $fh "Server: adp perl webserver\r\n";

#print $fh "content-length: ... \r\n";

print $fh "\r\n";

print $fh " hello ";

print $fh "Method: $req{METHOD} "; print $fh "Object: $req{OBJECT} ";

foreach my $r (keys %header) { print $fh $r, " = ", $header{$r}, " "; } }

sub init_webserver_extension { $port_listen = 8888; }

1;