Browse files and folders

#!/usr/bin/perl -w

use strict; #use warning, and strict

my $dir_root; #dir to start in

sub dir_read
{
#parse directory for directories and files

#local to this function
my @dir_list;
my @file_list;
my $dir_prefix = $_[0];

print "reading dir: ${dir_prefix}\n";

opendir(aDIR, $dir_prefix);
#read, add to array
while($_ = readdir(aDIR))
{
#if a dir
if(-d "${dir_prefix}/${_}")
{
#dont allow . or ..
if($_ ne "." && $_ ne "..")
{
#add to array
push(@dir_list, "${dir_prefix}/${_}");
}
}
#else a file
else
{
#filter any files you don't want
if( $_ ne "dirlist.pl")
{
push(@file_list, "${dir_prefix}/${_}");
}
}
}

closedir(aDIR);

#print dir and file list:
foreach $_ (@dir_list)
{
print "\tdir: ${_}\n";
}
foreach $_ (@file_list)
{
print "\tfile: ${_}\n";
}


#search lower dirs
foreach $_ (@dir_list)
{
&dir_read($_);
}
}


if(! $ARGV[0])
{
#print usage
print "Usage: perl dirlist.pl rootpath\n";
}
else
{
#check if path exists
$dir_root = $ARGV[0];
if( -d $dir_root)
{
#dir is ok
print "root directory: ${dir_root}\n";
}
else
{
#end
die("root directory: ${dir_root} does not exist!, stopped\n");
}

#read dir, and sub directories
&dir_read($dir_root);

print "done.\n";
}
CreateProcess
use Win32::Process;

Win32::Process::Create( $Win32processObj,
                        $ARGV[0],
                        "",
                        0,
                        NORMAL_PRIORITY_CLASS,
                        "." ) ||  die "Failed to create process.\n";

while ( !$Win32processObj->Wait( 1000 ) )
{
    sleep(1);
	print "waiting for process to finish\n";
}

$Win32processObj->GetExitCode( $exitcode );

    if (0 != $exitcode)
      {
        $rv = 1;
      }

print "Process Exit Code = $exitcode\n";
print "Return Value = $rv\n";

*************************************************

use Win32::Process;
Win32::Process::Create ($Win32processObj,
                        $ARGV[0],
                        "",
                        0,
                        NORMAL_PRIORITY_CLASS,
                        "." ) ||  die "Failed to create process.\n";;
                        
$pid = $Win32processObj-> GetProcessID();

if( $Win32processObj-> Wait(1)) 
{
	print "Process is done\n";
}
else
{
	print "Process is running as $pid\n";
}

 
Make Upper String

#!/usr/bin/perl
$str = "Something's rotten in the state of Denmark";
# returns "something's rotten in the state of denmark"
print lc($str);
print "\n";
# returns "SOMETHING'S ROTTEN IN THE STATE OF DENMARK"
print uc($str);
print "\n";
# returns "something's rotten in the state of Denmark"
print lcfirst($str);
print "\n";
# re-initialize for next bit of code
$str = "something's rotten in the state of Denmark";
# returns "Something's rotten in the state of Denmark"
print ucfirst($str);
print "\n";

 
Read File

open (LOGFILE, "c:\\log.txt") or die "Kan c:\\log.txt niet openen";
# Het "or die"-gedeelte wordt hieronder nog besproken

while ($line = <LOGFILE>)
{
  print $line;
}
close LOGFILE;
Read/write file

open(FILEREAD, "< c:\\log.txt");
open(FILEWRITE, "> c:\\rlog.txt");
$i=0;
while ($input = <FILEREAD>){
print FILEWRITE $input;
$i++;
}
close FILEWRITE;
close FILEREAD;
Replace Char/String

#!/usr/bin/perl
$string = "The name's Bond, James Bond";
# search for the character d
$string =~ /d/g;
# returns 15
print pos($string);
print "\n";

my $value = qw[w:\cada-nt/cada-nt-vob\TestLab\Cada-NT];
print "$value\n";
$value =~ s/w:/n:/g;
print "$value\n";

$Slash = "/";
$BackSlash = "\\";
$value =~ s/$Slash/$BackSlash/g;
print "$value\n";
Replace Char/String method

sub replace
{
  my $value = $_[0];
  $value =~ s/$_[1]/$_[2]/g;
  return $value;
}

my $x = qw[w:\cada-nt/cada-nt-vob\TestLab\Cada-NT];

$t = replace($x,"ca","kA");
print($t);
Replace slash/Backslash

sub replaceslash
{
  my $value = $_[0];
  $Slash = "/";
  $BackSlash = "\\";
  $value =~ s/$Slash/$BackSlash/g;
  return $value;
}

my $value = qw[w:\cada-nt/cada-nt-vob\TestLab\Cada-NT];
$new = replaceslash($value);
$value = replaceslash($value);

print "\n";
print $new;
print "\n$value";
Find string and give place

$string = "Woord1 Woord2 Woord3 Woord4";

#remove first 7 strings
$var = substr($string,7);
print ("\n");
print ($var);

#remove all but the last 6 strings
$var = substr($string,-6);
print ("\n");
print ($var);

#remove last 7 strings
$var = substr($string,0,-7);
print ("\n");
print ($var);

#remove all but the first 7 strings
$var = substr($string,0,7);
print ("\n");
print ($var);

$var = index($string, "Woord");
print ("\n");
print ($var);

$var = index($string, "Woord",5);
print ("\n");
print ($var);

$var = rindex($string, "Woord");
print ("\n");
print ($var);
Time - print as string

($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
$atime, $mtime, $ctime, $blksize, $blocks) = stat("c:\\log.txt");

($sec, $min, $hr, $day, $month, $year, $day_Of_Week, $julianDate, $dst) = localtime($mtime);

use POSIX qw(strftime);
use Time::Local;
print "Modified time: ", strftime("%d/%m/%y", localtime($mtime)), "\n";
Advanced - Find WISE properties

use strict; #use warning, and strict

my $dir_root; #dir to start in
my $line;
my $R;
my $W;

sub wize
{
$R = "FALSE";
open (LOGFILE, $_[0]) or die "Kan $_[0] niet openen";

while ($line = <LOGFILE>)
{
if (lc($line) eq "optiontable=wise_options\n")
{
$R = "TRUE";
}
}
close LOGFILE;
return $R;
}

sub dir_read
{
#parse directory for directories and files

#local to this function
my @dir_list;
my @file_list;
my $dir_prefix = $_[0];

opendir(aDIR, $dir_prefix);
#read, add to array
while($_ = readdir(aDIR))
{
#if a dir
if(-d "${dir_prefix}/${_}")
{
#dont allow . or ..
if($_ ne "." && $_ ne ".."
&& $_ ne ".svn")
{
#add to array
push(@dir_list, "${dir_prefix}/${_}");
}
}
#else a file
else
{
#filter any files you don't want
if( $_ ne "dirlist.pl")
{
if ($_ eq "properties.txt")
{
push(@file_list, "${dir_prefix}/${_}");
}
}
}
}
closedir(aDIR);

#print dir and file list:
foreach $_ (@file_list)
{
$W = wize(${_});

if ($W eq "TRUE")
{
print "${_}\n";
}
}


#search lower dirs
foreach $_ (@dir_list)
{
&dir_read($_);
}
}

if(! $ARGV[0])
{
#print usage
print "Usage: perl dirlist.pl rootpath\n";
}
else
{
#check if path exists
$dir_root = $ARGV[0];
if( -d $dir_root)
{
#dir is ok
print "root directory: ${dir_root}\n";
}
else
{
#end
die("root directory: ${dir_root} does not exist!, stopped\n");
}

#read dir, and sub directories
&dir_read($dir_root);

print "done.\n";
}

 
Example find Gurus
#!/usr/bin/perl -w

use strict; #use warning, and strict

my $dir_root; #dir to start in

sub replaceslash
{
  my $value = $_[0];
  my $Slash = "/";
  my $BackSlash = "\\";
  my $value =~ s/$Slash/$BackSlash/g;
  return $value;
}


sub dir_read 
{
  #parse directory for directories and files

  #local to this function
  my @dir_list;
  my @file_list;
  my $dir_prefix = $_[0]; 

  #print "reading dir: ${dir_prefix}\n";

  opendir(aDIR, $dir_prefix);
  #read, add to array
  while($_ = readdir(aDIR))
  {
    #if a dir
    if(-d "${dir_prefix}/${_}")
    {
      #dont allow . or ..
      if($_ ne "." && $_ ne ".." && $_ ne ".svn")
      {
        #add to array
        push(@dir_list, "${dir_prefix}/${_}");
      }
    }
    #else a file
    else
    {
      #filter any files you don't want 
      my $str = $_;
      $str = lc($str);
      if( $str eq "properties.txt")
      {
        push(@file_list, "${dir_prefix}/${_}");
      }
     }
    }

    closedir(aDIR);

    #search lower dirs
    foreach $_ (@dir_list)
    {
      my $subsystem = $_;
      $subsystem = lc($subsystem);
      my $var = index($subsystem, "_v");
      if ($var > 0)
      {
          my $tail = "\\adm\\properties.txt";
          my $properties = "${_}${tail}";
          push(@file_list, $properties );
      }
      else
      {
        &dir_read($_);
      }
      
      #&dir_read($_);
    }
   
    foreach $_ (@file_list)
    {
      
      my $line;
      if (open (LOGFILE, $_))
      {
        while ($line = <LOGFILE>) 
        {
          my $string = $line;
          $string = lc($string);
          my $var = 0;
          $var = index($string, "gurus=");
          
          #print "$line - $var\n";
          
          if ($var eq 0)
          {
            print "\tFile: ${_}\n";
            open(FILEWRITE, ">> d:\\gurus.txt");   
            #my $new = replaceslash($_);
            print FILEWRITE $_;
            print FILEWRITE "\t";
            
            my $gurus = substr($string,6);
            print FILEWRITE $gurus;
            close FILEWRITE;
          }
        }
        close LOGFILE;
      }
    } 
  }


  if(! $ARGV[0])
  {
    #print usage
    print "Usage: perl dirlist.pl rootpath\n"; 
  }
  else 
  {
    #check if path exists
    $dir_root = $ARGV[0];
    if( -d $dir_root)
    {
      #dir is ok
      print "root directory: ${dir_root}\n";
    }
    else
    {
      #end
      die("root directory: ${dir_root} does not exist!, stopped\n");
    }

    #read dir, and sub directories
    &dir_read($dir_root);

    print "done.\n";
  }
 
Example DBI
use DBI;
$sqlstatement = "select * from [table]";

#open connection to Access database
$dbh = DBI->connect('dbi:ODBC:driver=microsoft access driver (*.mdb);dbq=[DBPATH]', [USERNAME], [PASSWORD]);

#prepare and execute SQL statement

$sth = $dbh->prepare($sqlstatement);
$sth->execute
  || die "Could not execute SQL statement ... maybe invalid?";

#output database results

while ( @row = $sth->fetchrow_array() )
{
  print "@row\n";
}
 
Example DBX (email file
use Mail::Transport::Dbx;

my $dbx = eval { Mail::Transport::Dbx->new("Inbox.dbx") };
die $@ if $@;

# more convenient
for my $msg ( $dbx->emails )
{
  print $msg->subject . "\n";

}
 
Example DBX to XML

use strict;

use Mail::Transport::Dbx;
use Data::Dumper;
use XML::TreePP;

my $dbx = eval { Mail::Transport::Dbx->new("inbox.dbx") };
die $@ if $@;

my $data;
if ( -e "data.xml" )
{
  $data = _XMLtoHash("data.xml");
}

my %arr;
# more convenient
for my $msg ( $dbx->emails )
{
  my $id = "ID".$msg->msgid;
  if ($msg->msgid =~ /^<(\w+)\@?.*>/)
  {
    $id = "ID".$1;
  }
  
  if ( !defined $data->{$id} )
  {
    my %new = parseBody($msg->body);
    %arr->{$id} = {%new};
  }
  else
  {
    my %new = %{$data->{$id}};
    %arr->{$id} = {%new};
  }
}

_hashToXML(\%arr, "data.xml");

sub parseBody
{
  my $body = shift;
  my @body = split("\n", $body);
  
  my %out;
  my $item;
  foreach my $line (@body)
  {
    chomp($line);
    $line =~ s/\n//sg;
    $line =~ s/\r//sg;
    if ($line =~ /^\[(.+)]: (.+)/)
    {
      $item = $1;
      $line = $2;
    }
    if ($line =~ /^\[END\]/)
    {
      $item = "";
    }
    
    if ($item ne "")
    {
      if (%out->{$item} ne "")
      {
        %out->{$item} .= "
";
      }
      %out->{$item} .= $line;
    }
  }
  return %out;
}

sub _hashToXML
{
  my $dataHashRef   = shift;
  my $xmlFilename   = shift;

  my %hashToWrite = ( 'Config' => $dataHashRef );

  my $tpp = XML::TreePP->new();

  my $xml = $tpp->write($dataHashRef);

  if ( open( my $xmlFileHandle, '>:raw', $xmlFilename ) )
  {
    print $xmlFileHandle $tpp->write( \%hashToWrite );
    close $xmlFileHandle;
  }
  return 1;
}

sub _XMLtoHash
{
  my $xmlFilename = shift;
  my %readHash    = ();
  my $tpp         = XML::TreePP->new();

  if ( -e $xmlFilename )
  {
    if ( open( my $fileHandle, '<:raw', $xmlFilename ) )
    {
      #-------------
      # Read file
      #-------------
      my $inputString;
      read( $fileHandle, $inputString, -s $xmlFilename );

      close $fileHandle;

      my $tempReadHashRef = $tpp->parse($inputString);

      #-------------
      # Analyse hash
      #-------------
      my %tempReadHash = %$tempReadHashRef;

      if ( ref( $tempReadHash{'Config'} ) eq 'HASH' )
      {
        %readHash = %{ $tempReadHash{'Config'} };
      }
    }
  }
  return \%readHash;
}
Example OO

use Class::Struct;

struct Breed =>
{
name => '$',
cross => '$',
};

struct Cat =>
[
name => '$',
kittens => '@',
markings => '%',
breed => 'Breed',
];


my $cat = Cat->new( name => 'Socks',
kittens => ['Monica', 'Kenneth'],
markings => { socks=>1, blaze=>"white" },
breed => Breed->new(name=>'short-hair', cross=>1)
#or: breed => {name=>'short-hair', cross=>1},
);

print "Once a cat called ", $cat->name, "\n";
print "(which was a ", $cat->breed->name, ")\n";
print "(cross ", $cat->breed->cross, ")\n";
print "(markings ", $cat->markings->blaze, ")\n";
print "had two kittens: ", join(' and ', @{$cat->kittens}), "\n";