|
|
Note: The archives category content is an automatically generated focus channel and does not neccessarily reflect the opinions of this blog. No responsibility is taken for the external links presented here, follow at your own discretion. The archives content is never scraped from sites - but an abstract obtained from search engines.
Category: 'perl-coding-specialist'
Tuesday, June 5th, 2007
| Problem |
Solution |
Example |
Reference |
Recommended |
Debugging in Perl is very extensive, this demo is very basic! Check the reference for further instruction. You can manipulate PERLDB_OPTS variable, to force some debugging - then just pass through a -d option to your perl script. Also system debugging is at the reference tab.
|
|
| Problem |
Solution |
Example |
Reference |
Recommended |
export PERLDB_OPTS="NonStop frame=1 AutoTrace" perl -d -pi'.bak' -e 's/unix/UNIX/g' *htm* Output: Package -e. 0: BEGIN { require 'perl5db.pl' };LINE: while () { 1: s/unix/UNIX/g 0: BEGIN { require 'perl5db.pl' };LINE: while () { 1: s/unix/UNIX/g 0: BEGIN { require 'perl5db.pl' };LINE: while () { 1: s/unix/UNIX/g 0: BEGIN { require 'perl5db.pl' };LINE: while () { 1: s/unix/UNIX/g 0: BEGIN { require 'perl5db.pl' };LINE: while () { 1: s/unix/UNIX/g 0: BEGIN { require 'perl5db.pl' };LINE: while () { 1: s/unix/UNIX/g 0: BEGIN { require 'perl5db.pl' };LINE: while () { 1: s/unix/UNIX/g 0: BEGIN { require 'perl5db.pl' };LINE: while () { 1: s/unix/UNIX/g 0: BEGIN { require 'perl5db.pl' };LINE: while () { 1: s/unix/UNIX/g 0: BEGIN { require 'perl5db.pl' };LINE: while () { 1: s/unix/UNIX/g 0: BEGIN { require 'perl5db.pl' };LINE: while () { 1: s/unix/UNIX/g 0: BEGIN { require 'perl5db.pl' };LINE: while () { 1: s/unix/UNIX/g 0: BEGIN { require 'perl5db.pl' };LINE: while () { entering Config::DESTROY entering IO::Handle::DESTROY entering IO::Handle::DESTROY
|
No Comments »
Monday, June 4th, 2007
| Problem |
Solution |
Example |
Reference |
Recommended |
Another use bit of socket programming, courtesy of Perl! Extremely useful bit of Perl, which can be used with the other post on this site, to confirm network connectivity (port scanner). This code (see example tab) will listen on a port (although be careful it is over 1024, unless you are running as root/admin).
|
|
| Problem |
Solution |
Example |
Reference |
Recommended |
perl -MIO::Socket -e '$srv=IO::Socket::INET-> new(LocalPort=>$ARGV[0],Type=>SOCK_STREAM,Reuse=>1,Listen=>5) or die "Failed trying to listen on $ARGV[0]\n";while($cl=$srv->accept()) { while() { print } } close($socket);' port Can also use it as a cheap chat service! Everything gets echo'd through - so just telnet host port and type away! Also see my port scan code at the reference tab.
|
1 Comment »
Sunday, June 3rd, 2007
| Problem |
Solution |
Example |
Reference |
Recommended |
You want to test a network port, on a remote system - over TCP/IP. Maybe this is a new setup, or you want confirmation it is working. Perhaps the firewall rules have just been changed!
|
|
| Problem |
Solution |
Example |
Reference |
Recommended |
A nice small bit of Perl code that I’ve used thousands of times! In fact I’m running it in most of my production environments, as a check that the a process is not only running - but also responding. Yep, you could just use telnet - but some systems have that taken off for security. Additionally it is n’t as easy to program telnet - I know, I know - you can with expect.
|
|
| Problem |
Solution |
Example |
Reference |
Recommended |
Here is just a one liner, but you can easily incorporate this into a script. perl -MIO::Socket -e '$socket=IO::Socket::INET-> new(Proto=>tcp,PeerAddr=>$ARGV[0],PeerPort=>$ARGV[1]); if($@) { print "Failed: $@\n" } else { print "Succeed\n"; }' host port
|
1 Comment »
Sunday, June 3rd, 2007
| Problem |
Solution |
Example |
Reference |
Recommended |
I wanted to upload a delimited field to mysql db, but hit the problem that the file contained nearly 3000 rows and no schema on the required size of each field. Therefore I needed to traverse the file and calculate the length of each field. Then at the end, print the largest field found for each column.
|
|
| Problem |
Solution |
Example |
Reference |
Recommended |
Perl to the rescue! Pretty easy in Perl, after scratching my head attempting with awk. Anyway the code is under the example tab. I’m using the pipe symbol as a delimiter “|” - so just substitute this with your delimiter, cat your file and pipe it through this script. In the example I show how you can manipulate the file, to produce pipe delimited fields too.
|
|
| Problem |
Solution |
Example |
Reference |
Recommended |
This is how to run the script. Basically you just need to pipe your output through find largest. cat yourfile | ./find_largest.pl Here is the code. #!/usr/bin/perl@highest=(); while( < STDIN > ) { @thisline=split(/\|/); for($i=0;$i<=$#thisline;$i++) { $thislength=length($thisline[$i]); if($thislength > $highest[$i]) { $highest[$i]=$thislength; } } } print(join("|",@highest)."\n"); exit(0); __END__ So for example, if I want to find the largest fields in one of my web logs - for crunching into a db: - First off I only want lines starting with a space, then a number.
- Next I need to replace all multiple spaces between fields, with 1 space.
- Then I replace the spaces between each field, with a pipe.
- Lastly I pump it through find_largest.pl - which gives me the largest sized field
[marcus@bree]/var/log/httpd% grep "^ [0-9]" access_log.tools \ | sed -e 's/ / /g' -e 's/ /|/g' | \ ~/Perl_Bin/find_largest.pl |14|1|1|21|6|5|103|9|3|5
|
1 Comment »
Saturday, May 26th, 2007
| Problem |
Solution |
Example |
Reference |
Recommended |
I wrote this some time ago, to traverse predefined outlook mail folders, saving items with given subject to text. Requires WIN32:OLE perl module (which comes with activeperl by default). Hardcoded is the upload and uploaded mail folders. Also a subject that contains - pattern: upload. I used one outlook rule to move items from a specific source, with this subject into upload.
|
|
| Problem |
Solution |
Example |
Reference |
Recommended |
Here is the code - if you have any dramas with it, leave a comment. #!perl use Win32::OLE qw(in with); use Win32::OLE::Const 'Microsoft Outlook'; # Connect to a running version of Outlook eval { $Outlook = Win32::OLE->GetActiveObject('Outlook.Application') }; die "Outlook not installed" if $@; # If that fails start up Outlook unless(defined $Outlook) { $Outlook = Win32::OLE->new('Outlook.Application', 'Quit') or die "Opps, cannot start Outlook"; } # This appears to return a ref to the object $namespace = $Outlook->GetNamespace('MAPI'); $thisFolder=$namespace->Folders("Mailbox - mailboxna")-> Folders('upload'); $toFolder=$namespace->Folders("Mailbox - mailboxna")-> Folders('uploaded'); # Workaround to be able to extract key/value pairs %thisHash=%{$thisFolder}; $name=$thisHash{'Name'}; # This is the number of items in designated folder $count=$thisHash{'Items'}{'Count'}; open(LOGFH,">> ol_save_to_text.log") or die("cannot open log file\n"); # Drop out if there are no mail items in this folder if($count > 0) { print LOGFH "Count: $count for $name\n"; $filename='yourname'; open(FH,"> $filename") or die ("cannot open $filename\n"); for($i=1;$i<=$count;$i++) { print LOGFH "Count: $count\n"; $oItems=$thisFolder->Items(1); %thisItem=%{$oItems}; $subject=$thisItem{'Subject'}; if($subject =~ /pattern: upload/) { print LOGFH "$i: $subject\n"; $body=$thisItem{'Body'}; print FH "$body"; $oItems->Move($toFolder); } else { $nonitem+=1; } $oItems->Move($toFolder); } } else { print LOGFH "No Files to Process\n"; } close(LOGFH); 1;
|
No Comments »
Saturday, May 26th, 2007
| Problem |
Solution |
Example |
Reference |
Recommended |
Beautiful for parse HTML and either extracted (screen scraping) content or performing actions based on results. See the examples tab for this simple script, demonstrating the libcurl API for Perl.
|
|
| Problem |
Solution |
Example |
Reference |
Recommended |
#!/usr/bin/perl $url="http://perl.coding-school.com/"; # set your url here $|++; use Curl::easy; # Init the curl session my $curl= Curl::easy::init() or die "curl init failed!\n err: $!\n"; sub body_callback { my ($chunk,$context)=@_; push @{$context}, $chunk; return length($chunk); } Curl::easy::setopt ($curl, CURLOPT_PROXY, $proxy) if($proxy); Curl::easy::setopt ($curl, CURLOPT_PROXYPORT, $proxyport) if($proxyport); Curl::easy::setopt ($curl, CURLOPT_SSL_VERIFYHOST, 0); Curl::easy::setopt ($curl, CURLOPT_SSL_VERIFYPEER, 0); Curl::easy::setopt ($curl, CURLOPT_URL, $url); Curl::easy::setopt ($curl, CURLOPT_WRITEFUNCTION, \&body_callback); my @body; Curl::easy::setopt ($curl, CURLOPT_FILE, \@body); Curl::easy::setopt ($curl, CURLOPT_ERRORBUFFER, "errbuf"); if (Curl::easy::perform ($curl) != 0) { print "Failed : $errbuf\n"; }; Curl::easy::cleanup($curl); # Separate each line into one element in array @lines=(); foreach (@body) { push(@lines,split('\n', $_, 9999)); } foreach (@lines) { # just to demonstrate it works! if(/icons/) { print("$_\n"); } } exit(0); Here is a demo screen shot of this code using perl and libcurl. 
|
No Comments »
|