Perl

Removing existing perl modules

#!/usr/bin/perl

#uninstall perl modules

use ExtUtils::Packlist;

use ExtUtils::Installed; 

$ARGV[0] or die "Usage: $0 Module::Name\n";

my $mod = $ARGV[0];

my $inst = ExtUtils::Installed->new();

foreach my $item (sort($inst->files($mod))) {  

         print "removing $item\n";

         unlink $item;

         } 

my $packfile = $inst->packlist($mod)->packlist_file();

print "removing $packfile\n";

unlink $packfile;

This would be ran as# perl uninstall.pl Date::Manip


Searching compressed files with perl

If you ever want to search a compressed file using perl this is one way you can incorporate zcat as a filehandle. There are a couple of modules out there for example PerlIO::gzip which seems to work pretty well except I was testing it against bluecoat logs and it seems to have problems with the headers. Also none of the options seemed to decompress past that either. So, I tried using this method and it works great…

#!/usr/local/bin/perl

my $file = "whatever.gz";

my $querystring = "what I'm looking for";

open(ZCAT,"-|") || exec "/bin/zcat",$file;

   while (<ZCAT>)  { 

                if ($_ =~ $searchstring)  {  

                           $i++;

                           $querystring = $_;

                           print $querystring;

                           }

                   }

This is a very fast way to search your compressed files.


Using perl with mysql

Here is an example of how to use perl to communicate with a mysql database using the DBI module. This example shows an insert to a table with 3 fields:

#!/usr/bin/perl

use DBI;
use strict;
use warnings;
# Database settings
my $database = "database";
my $username = "username";
my $password = 'password';
my $table = "items";
# Connect to database
my $dbh = DBI->connect("dbi:mysql:database=$database;host=localhost;user=$username;password=$password") or die "Couldn't connect to database: $DBI::errstr\n";
#### DB ENTRY
# Insert matches into table
my $sth = $dbh->prepare("INSERT INTO $table VALUES (0,'$value','$value2')") or die "Couldn't prepare statement: $dbh->errstr\n";
$sth->execute() or die "Couldn't execute query 'sql': $DBI::errstr\n";

The 0 is inserted as the first variable in this table because the field is an auto incrementing value that we want mysql to number.


Perl, mysql and bulk loading using DBI module

I was working on trying to optimize inserting data into one of my mysql databases today and came across a method for loading large amounts of data quickly. I was working on parsing through some logs and inserting the important pieces into a mysql database for reporting purposes. The logs, when put in the database amount to about 50 million rows of data, and what I was doing beforehand was a single prepare and execute statement for each line…which wasn’t very efficient. So, I did some research and found that it is much more efficient to send several entries to the database at a time to create less overhead. I found that this combined with turning off indexing beforehand and then turning it back on when I completing the logs increased the speed to at least 1/3rd of the time as before (still need to benchmark it), but quite a noticeable improvement.
Here is some code to show how to do it:

#!/usr/bin/perl

use strict;

use DBI;

my $database = whatever;

my $username = user;

my $password = password;

my $table = table_name;

my $count=0;                  # Count for database insert

my $max_rows=20000;           # Count for bulk insert

my $base_query = qq{INSERT INTO $table VALUES };

my $bulk_query = $base_query;

# Connect to database

my $dbh = DBI->connect("dbi:mysql:database=$database;host=localhost;user=$username;password=$password") or die "Couldn't connect to database: $DBI::errstr\n";

# Turn off Indexes for the insert operation, and then turn it on after run is complete

$sth = $dbh->prepare("ALTER TABLE $table DISABLE KEYS") or die "Couldn't prepare statement: $dbh->errstr\n";

$sth->execute() or die "Couldn't execute query 'sql': $DBI::errstr\n";

 while (<FILE>)  {

                      $count++;

                      my @values = (0,"$name","$ip","$date");  #whatever values you load up from a file, I didn't go to detail

                      $bulk_query .= "," if ($count>1);            # Use the comma after the first entry

                      $bulk_query .="("

                                       . join(",", map { $dbh->quote($_) } @values )    

                                       . ")";

                      # Insert into database x rows at at time

                      if ($count > $max_rows)  {

                             print "$count reached\n";

                             $dbh->do($bulk_query)

                             or die "You have an error ($DBI::errstr)";

                             $bulk_query = $base_query;

                             $count = 0;                                 # Return the count to 0

                             }

                     }
&lastdbentry;

# Turn Indexes back on

$sth = $dbh->prepare("ALTER TABLE $table ENABLE KEYS") or die "Couldn't prepare statement: $dbh->errstr\n";

$sth->execute() or die "Couldn't execute query 'sql': $DBI::errstr\n";

# Left over entries
sub lastdbentry  {
	# Put the remaining entries in database
        if ($count != 0)  {
                print "$count lines left over, inserting into database\n";
                $dbh->do($bulk_query)
                or die "something wrong ($DBI::errstr)";
                }
}

Check directory of files for changes using md5sum

Here is a script I set up the other day to monitor for files being altered. If there is a change ever so slight md5 hashes are one of the best methods to detect it. This script stores a list of md5 hashes for the files requested ( using the -c ) option and will check against it (using the -s option) for changes, if there is a change it will send an email to alert whoever you want. Here is the script…

#!/usr/bin/perl
use strict;
use warnings;
die "Usage: You must enter an option of -c for create or -s for scan" unless defined$ARGV[0];
die "Usage: -c create md5file -s scan for changes." unless $ARGV[0] =~ "-c|-s";
my @files1 = `find /somewebdirectory/*.php`;
my @files2 = `find /someotherwebdirectory/*.php -maxdepth 1`;
my @files3 = `find /yetanotherdirectory/*.txt`;
my @files = (@files1, @files2, @files3);
my $sysname = `/bin/uname -n`;
chomp $sysname;
my $email = 'youremail@yoursite.com';
my $files;
my @stored;
my $stored = "/fullpathto/stored_md5s";           # Make sure to use full path if using cron
my $warning = " ";
my $inc = 0;
   if ($ARGV[0] =~ "-c")  {                               # -c for stored_md5 file creation or overwrite

       unlink $stored;

       open STORED,">>$stored";

       foreach $files(@files)  {

           my $md5sum = `md5sum $files`;

           print STORED "$md5sum";

           }

       close STORED;

       print "New md5sum file created as $stored\n";

       }

   elsif ($ARGV[0] =~ "-s")  {                            # -s to scan the files for changes

       open STORED,"$stored";

       @stored = <STORED>;

       close STORED;

       foreach $files(@files)  {

           my $md5sum = `md5sum $files`;

           chomp $md5sum;

           my @pieces = split("  ",$md5sum);

           my $n = $#stored;

           foreach(@stored) {

               chomp;

               my @stored_parts = split("  ",$_);

               if ($stored_parts[1] =~ $pieces[1]) {

                   $inc = 1;

                   if ($stored_parts[0] !~ $pieces[0]) {

                       $warning .= "Warning...$pieces[1] has been changed\n";

                       print "Warning...$pieces[1] has been changed\n";

                       }

                   }

               elsif ( ($inc == 0) ) {

                   if (!$n--)  {

                       $warning .= "Warning...$pieces[1] is a new file\n";

                       print "Warning...$pieces[1] is a new file\n";

                       }

                   }

               $inc = 0;

               }

           }

           if ($warning =~ /^\s$/)  {

               print "All seems well for the directories checked\n";

           }

           else  {

               print "Sending Email alert\n";

               &mailer;

               }

       }

#Subroutine for Mail, notifies on warning and critical levels.

sub mailer {

         open(MAIL, "|/usr/sbin/sendmail -t") or die "Cannot open sendmail!: $!";

         print MAIL "To: $email\n";

         print MAIL "From: $sysname\n";

         print MAIL "Subject: Warning Files have been changed\n\n";

         print MAIL "$warning";

         print MAIL "~" x 75, "\n","~" x 75,"\n","From system: $sysname";

         close(MAIL);

}

So, to use it, just set up the directories with the file extensions you are monitoring with the find commands for the @file<num> arrays. You can add as many as you like just make sure you tuck it into the @files array as well. Change the email address to one that you’ll recieve and run it with ./checkdir.pl -c to create the stored_md5s file. The file will contain entries like this:

f04249fa5a516b2f3a739c37124facac /somewhere/directory/index.php
184302cdf176b0e4691eb0b75582c899 /anotherdirectory/template.php

Then you can run a ./checkdir.pl -s to scan for changes, if it finds a changed file (or a new one) it will send an email. You can rebuild the hash file with the -c option, and use cron to automate.


Simple find and replace against multiple files using perl

Here is a simple script I use when I have to make changes on multiple files that works pretty good. It uses the module File::Find. The way to use it is to change the $find variable to whatever it is you want to change, and change the $replace variable with what you want to replace it with. Give it a directory to work in with the $startdir variable, and last of all tell it the file type to match. This is great if you have oh say a hundred files that need a link or image or anything else for that matter changed.

#!/usr/bin/perl
#replace.pl find and replace on multiple files with the same extension in a directory
use strict;
use warnings;
use File::Find;
my $startdir = '/var/www/html/';
my $find = '/templates';
my $replace = 'templates';
my $doctype = 'php';
print qq~Finding "$find" and replacing it with "$replace"\n~;
find(
sub{
return unless (/\.$doctype$/i);
local @ARGV = $_;
local $^I = '.bac';
while( <> ){
if( s/$find/$replace/ig ) {
print;
}
else {
print;
}
}
}, $startdir);
print "All done";

perl one liner to rename multiple files in a directory

Say you want to rename a bunch of files in a directory that have a common naming convention to something else…this is a quick script to do just that for you…

perl -e 'my @ls = `ls -1`;foreach (@ls) {chomp; if (/file/) 
{my $change = $_;$change =~ s/(fileS+)/this$1/g; `mv $_ $change`;}}'

so this would take a bunch of files (in the current directory) and if they had the word file in the name this would prepend the name “this” on the front.   For example:
file1.log
file2.log
would be changed to
thisfile1.log
thisfile2.log
and so on…

This is a very powerful way to change the names of many files in a directory quickly and with complete control using regular expression.


Case insensitive matching

Using regular expression to match on a word that you may or may not know the case can be solved by using the letter i after a closing delimiter.

$text = “Kramer”;
if ($text =~ /kramer/i;) {
print “matched”;
}


Translations

Translations are useful for converting single characters to something else found in a string. If you wanted to change certain letters to upper case in a string you could do this…

$text = “south pole”;

$text =~ tr/[s,p]/[S,P]/;

which would give “South Pole”;


Beginning and end of string

If you need to find the beginning or end (or entire string) then using the beginning of line (^) or/and end of line ($) matches will be useful.

$text = “This is a sentence”;

if ($text =~ /^This/) {
print “Matches”;
}

if ($text =~ /sentence$/) {
print “Matches”;
}

or the whole thing…

if ($text =~ /^This is a sentence$/) {
print “Matches”;
}

These are also known as anchors.


Copyright © 1996-2010 Script Hat. All rights reserved.
Jarrah theme by Templates Next | Powered by WordPress