Search This Blog

Showing posts with label perl. Show all posts
Showing posts with label perl. Show all posts

2013-12-23

how-to get disk space usage with perl regardless of the OS

use strict ; use warnings ;
use Filesys::DfPortable ;
use Sys::Filesystem ();
 
 
my $fs            = Sys::Filesystem->new();
my @filesystems   = $fs->filesystems();
my %hs            = () ;  # the sorted hash
my %hns           = () ;   # the non-sorted hash
 
 
for my $filesystem ( @filesystems ) {
   my $mount = $fs->mount_point($filesystem) ;
   my $ref = dfportable("$mount", (1024*1024)); # Display output in 1MB blocks
   if(defined($ref)) {
      $hns {$mount} = $ref->{per} . '*' . $ref->{bused} . '*' . $ref->{blocks}
                     . '*' . $ref->{bavail} . '*' . $ref->{bfree} ;
      $hs {$mount} = $ref->{per};
   } #eof if
 } #eof for
 
 
printf "%-15s %10s %10s %10s %10s %10s \n" , "Mount " , "Usage in % "
       , "Used MB " , "Total MB " , "Available MB " , "Free MB " ;
print '========================================================================' . "\n" ;
 
foreach my $key (reverse sort { ($hs{$a} <=> $hs{$b}) } keys %hs) {
    printf "%-15s %10d %10d %10d %10d %10d \n" , "$key" , split ('\*' , $hns{$key});
}
 
 
1 ;
 
__END__
 
=cut
Purpose:
OS independant mount points space usage
 
License: Free BSD
 
Requirements:
perl -MCPAN -e "install Filesys::DfPortable"
perl -MCPAN -e "install Sys::Filesystem"
 
VersionHistory:
1.0.0 -- 2013-12-23 15:28:07 -- ysg -- Initial creation with sorting
=pod

2013-05-27

how-to build a multithreaded perl from source as a non-root account

echo doc ensure you are logged in as the pmuser
cd ~ ; mkdir -p ~/.perl/

echo doc used the following url to download the source : http://www.cpan.org/src/README.html

echo doc dowload the latest perl source code
wget http://www.cpan.org/src/5.0/perl-5.18.0.tar.gz

echo doc uppack it
tar -xzf perl-5.18.0.tar.gz

echo doc go to the unpacked dir
cd perl-5.18.0

echo configure the builder script to build thread supporting perl binary
./Configure -Dusethreads -des -Dprefix=/<<a_home_dir>>/.perl/

echo doc run make
make

echo doc run make test
make test

echo doc run make install
make install

echo check that the perl IS NOT in the path
-bash-4.1$ which perl
/usr/bin/perl

echo doc now the pmuser has it's own fully fletched perl binary , which is different from the `hostname -s` 's own perl binary and does not break anything on the <<a_home_dir>> installation , sinche we will not vchang e the host dependant settings ...

echo doc but in order to be able to use it you would have to add the following to your calling shell:
export PATH=/<<a_home_dir>>/.perl/bin/:/<<a_home_dir>>/.perl/perl-5.18.0/:$PATH

echo doc now check once again
which perl
which cpan

2013-04-30

how-to generate "restore working file permissions script" for backup of your currently functioning environment

for file in `find ~/.ssh -type f `; do ls --time-style=long-iso -faZl $file | awk '{
    k = 0
    s = 0
    for( i = 0; i <= 8; i++ )
    {
        k += ( ( substr( $1, i+2, 1 ) ~ /[rwxst]/ ) * 2 ^( 8 - i ) )
    }
    j = 4
    for( i = 4; i <= 10; i += 3 )
    {
        s += ( ( substr( $1, i, 1 ) ~ /[stST]/ ) * j )
        j/=2
    }
    if ( k )
    {
        printf( "%0o%0o ", s, k )
    }
    print
}' | sort -n | perl -ne 's/\s+/ /g;@token=split(" ",$_);print "chmod $token[3]:$token[4] $token[9] \n";print "chmod " . "$token[0]" .  " $token[9]" .  "\n";' ; done ;  
 
#chmod username:None /home/username/.ssh/id_rsa
#chmod 0600 /home/username/.ssh/id_rsa
#chmod username:None /home/username/.ssh/id_rsa.pub
#chmod 0644 /home/username/.ssh/id_rsa.pub
#chmod username:None /home/username/.ssh/known_hosts
#chmod 0644 /home/username/.ssh/known_hosts
pre class=

2012-12-09

how-to add a host independant relative path to the @INC in perl

      BEGIN {
         # START add a host independant relative path to the @INC 
         my $cwd = "";
         # $1 is the basedir , $2 the dir separator , $3 the file name without the file ext , $4 the file ext
         $0 =~ m/^(.*)(\\|\/)(.*)\.([a-z]*)/;
         $cwd =~ s/\\/\//g;
         use Cwd 'abs_path';
         #resolve the run dir where this scripts is placed
         my $ScriptAbsolutPath = abs_path( $0 );
         #debug print "\$ScriptAbsolutPath is $ScriptAbsolutPath \n" ;
         $ScriptAbsolutPath =~ m/^(.*)(\\|\/)(.*)\.([a-z]*)/;
         # get the run of the current dir
         my $RunDir = $1;
         #change the \'s to /'s if we are on Windows
         $RunDir =~ s/\\/\//gi;
         # add the run dir 
         push( @INC, $RunDir);
         # split the string of the RunDir into parts , use the / as the delimiter
         my @DirParts = split( '/', $RunDir );
         # go 2 levels up from the cwd
         for ( my $count = 0; $count < 2; $count++ ) { pop @DirParts; }
         # resolve the product dir
         my $ProductDir = join( '/', @DirParts );
         # build the relative path for the lib dir 
         my $DirLibs = "$ProductDir/lib/perl/db" ; 
         # perldoc perlvar search for @INC
         push( @INC, $DirLibs) unless (grep {$_ eq $DirLibs} @INC) ; 
         #debug 
         print join ( "\ndir found in \@INC: \n" , @INC ) ;
         # STOP add a host independant relative path to the @INC 
      }   #eof BEGIN

2012-10-28

how-to emulate head and tail in perl

      #
      # Reads a file trims the top and the bottom of by passed num of lines
      # and return the string 
      # stolen from : http://stackoverflow.com/a/9330343/65706
      # usage :       
      # my $StrCatFile = $objFileHandler->ReadFileReturnTrimmedStrAtTopBottom ( 
      #       $FileToCat , $NumOfRowsToRemoveAtTop , $NumOfRowsToRemoveAtBottom) ; 
      sub ReadFileReturnTrimmedStrAtTopBottom {
 
         my $self = shift ; 
         my $file = shift ; 
         my $NumOfLinesToRemoveAtTop = shift ; 
         my $NumOfLinesToRemoveAtBottom = shift ; 
 
         my @cache ; 
         my $StrTmp = () ; 
         my $StrReturn = () ; 
         my $fh = () ; 
 
         open($fh, "<", "$file") or cluck (   "can't open file : $file for reading: $!" ) ;
         my $counter = 0;
         while (<$fh>) {
             if ($. >= $NumOfLinesToRemoveAtTop + 1) {
                 $StrTmp .= $_ ;
             }
         } 
         close $fh;
 
         my $sh = () ; 
         open( $sh, "<", \$StrTmp) or cluck(   "can't open string : $StrTmp for reading: $!" ) ;
         while(<$sh>) {
             push ( @cache, $_  ) ;
             $StrReturn .= shift @cache if @cache > $NumOfLinesToRemoveAtBottom;
         }
         close $sh ; 
         return $StrReturn ; 
      } 
      #eof ReadFileReturnTrimmedStrAtTopBottom
      #
pre

2012-07-24

src-dir-to-html



sfw/sh/doc/src-dir-to-html.sh



#!/bin/bash
# File: src-dir-to-html.sh v.1.3.0 docs at the end
umask 000 ;

# print the commands
set -x
# print each input line as well
set -v
# exit the script if any statement returns a non-true return value. gotcha !!!
# set -e


# set the variables from the $0.hostname.conf file which has ini like syntax
setVars(){

export PATH=/cygdrive/c/cygwin/bin/:$PATH
MyDir=`dirname $(readlink -f $0)`
cd "$MyDir"
# echo go up 4 times
for i in {1..5} ; do cd .. ; done ;
#echo print the pwd
ProductBaseDir=`pwd`
echo "ProductBaseDir is $ProductBaseDir \n\n"
Tmp="$MyDir/tmp/tmp.$$"
mkdir -p $Tmp #create the tmp dir if it does not exist
( set -o posix ; set ) >$Tmp/variables.before
MyName=`basename $0`
IniFile="$MyDir/$MyName.`hostname`.conf"
IniSection=MainSection
LogFile="$MyDir/$MyName.log"
# get the machine / host specific configuration
parseIniFile
#source $0
( set -o posix ; set ) >$Tmp/variables.after
wlog " Using the following vars :"
cmd="comm --nocheck-order -3 $Tmp/variables.before $Tmp/variables.after"
runCmdAndLog $cmd
rm -f $Tmp/variables.before $Tmp/variables.after
rm -f $Tmp/variables.before $Tmp/variables.before
}
#eof function setVars


# parse the ini like $0.hostname.conf and set the variables
parseIniFile(){
eval `sed -e 's/[[:space:]]*\=[[:space:]]*/=/g' \
-e 's/;.*$//' \
-e 's/[[:space:]]*$//' \
-e 's/^[[:space:]]*//' \
-e "s/^\(.*\)=\([^\"']*\)$/\1=\"\2\"/" \
< $IniFile \
| sed -n -e "/^\[$IniSection\]/,/^\s*\[/{/^[^;].*\=.*/p;}"`
}
#eof function parseIniFile


# run a command and log the call and its output to the LogFile
# usage: runCmdAndLog $cmd

runCmdAndLog(){
cmd="$*" ;
wlog " DEBUG running cmd : \"$cmd\""
Msg=$($cmd 2>&1)
[ $? -eq 0 ] || wlog "ERROR : Failed to run the following command \"$cmd\" with the following output \"$Msg\" !!!"
wlog " DEBUG : cmdoutput : \"$Msg\""
}
#eof function runCmdAndLog


# run a command on failure exit with message
# usage: runCmdOrExit $cmd


runCmdOrExit(){
cmd="$*" ;
wlog " DEBUG running cmd : \"$cmd\""
Msg=$($cmd 2>&1)
# if error occured during the execution exit with error
[ $? -eq 0 ] || Exit "ERROR : FATAL : Failed to run the following command \"$cmd\" with the following output \"$Msg\" !!!"
#if no error occured just log the message
wlog " DEBUG : cmdoutput : \"$Msg\""
}
#eof function runCmdOrExit


# echo pass params and print them to a log file
wlog(){
# check terminal if exists echo
test -t 1 && echo "`date +%Y.%m.%d-%H:%M:%S` [$$] $*"
# check LogFile and
test -z $LogFile || {
echo "`date +%Y.%m.%d-%H:%M:%S` [$$] $*" >> $LogFile
} #eof test
}
# eof function wlog


replicateSrcDirStructure(){
# go to the common root
cd $ProductVersionDir
# replicate the folder structure
find sfw -type d -exec mkdir -p docs/html/src/{} \;
}
#eof func replicateSrcDirStructure


createSfwSrcDocs(){

wlog " DEBUG START createSfwSrcDocs"
cd "$ProductVersionDir"
# foreach src file create its html file into the src html dir
find "sfw" -type f -exec perl $CodeToHtml {} docs/html/src/{}.html \;
cmd="find $ProductVersionDir/docs/html/src/perl/ -type f"
runCmdAndLog $cmd
wlog " DEBUG STOP createSfwSrcDocs"

}
#eof wlog " DEBUG createSfwSrcDocs"



# exit with passed status and message
Exit(){
ExitStatus=0
case $1 in
[0-9]) ExitStatus="$1"; shift 1;;
esac
Msg="$*"
test "$ExitStatus" = "0" || Msg=" ERROR: $Msg"
wlog " $Msg"
exit $ExitStatus
}
#eof function Exit


# the main function called
main(){
setVars
replicateSrcDirStructure
createSfwSrcDocs
Exit 0 "created the docs"
}
#eof function main


# Action !!!
main


#
# Purpose:
# to produce the html files our of the source files from the sfw dir into a replicated
# docs/html/src/sfw dir
# features:

# - prints the set in the script variables
# - separation of host specific vars into $0.`hostname`.conf file
# - wlog function for both xterm and log file printing

# - for loop examples with head removal and inline find and replace
#

# Requirements
# - cygwin , perl , sh , code2html by

# -
#

# VersionHistory:
# 1.4.0 --- 2012-07-24 17:33:29 --- ysg --- Initial creation of src-dir-to-html.sh

# 1.3.0 --- 2012-05-20 18:48:08 --- ysg --- replacing cmd with error output
# 1.2.4 --- 2012-05-02 20:41:11 --- ysg --- added for loop with pipes
# 1.1.0 --- ysg --- add runcmd with erro

# 1.0.0 --- ysg --- Initial creation of sh_stub
#
# EOF file:src-dir-to-html.sh



syntax highlighted by Code2HTML, v. 0.9.1


numberFormatter



sfw/tools/math/numberFormatter/numberFormatter.pl



use strict ;
use warnings ;

require 5.004;
use POSIX qw(locale_h);
# Get some of locale's numeric formatting parameters
my ($thousands_sep, $grouping) =
@{localeconv()}{'thousands_sep', 'grouping'};

# Apply defaults if values are missing
$thousands_sep = ' ' unless $thousands_sep;
# grouping and mon_grouping are packed lists
# of small integers (characters) telling the
# grouping (thousand_seps and mon_thousand_seps
# being the group dividers) of numbers and
# monetary quantities. The integers' meanings:
# 255 means no more grouping, 0 means repeat
# the previous grouping, 1-254 means use that
# as the current grouping. Grouping goes from
# right to left (low to high digits). In the
# below we cheat slightly by never using anything
# else than the first grouping (whatever that is).
my @grouping = () ;

if ($grouping) {
@grouping = unpack("C*", $grouping);
} else {
@grouping = (3);
}
# Format command line params for current locale
for (@ARGV) {
$_ = int; # Chop non-integer part
1 while
s/(\d)(\d{$grouping[0]}($|$thousands_sep))/$1$thousands_sep$2/;
print "$_ ";
}
print "\n";

#source:http://www.perlmonks.org/?node_id=11.1.8
# author:John M. Dlugosz



syntax highlighted by Code2HTML, v. 0.9.1


code2html sh wrapper for create a folder structure in html out of src project

#!/bin/bash
# File: create-perl-src-docs.sh v.1.3.0 docs at the end 
umask 000 ; 

# print the commands 
set -x
# print each input line as well
set -v
# exit the script if any statement returns a non-true return value. gotcha !!!
# set -e 


# set the variables from the $0.hostname.conf file which has ini like syntax
setVars(){
  export PATH=/cygdrive/c/cygwin/bin/:$PATH
  MyDir=`dirname $(readlink -f $0)`
    cd "$MyDir"
    # echo go up 4 times 
    for i in {1..5} ; do cd .. ; done ;
    #echo print the pwd
    ProductBaseDir=`pwd`
    echo "ProductBaseDir is $ProductBaseDir \n\n"
  Tmp="$MyDir/tmp/tmp.$$"
  mkdir -p $Tmp    #create the tmp dir if it does not exist 
  ( set -o posix ; set ) >$Tmp/variables.before 
  MyName=`basename $0`
  IniFile="$MyDir/$MyName.`hostname`.conf"
  IniSection=MainSection
  LogFile="$MyDir/$MyName.log"
  # get the machine / host specific configuration 
  parseIniFile
  #source $0
  ( set -o posix ; set ) >$Tmp/variables.after
  wlog " Using the following vars :"
  cmd="comm --nocheck-order -3 $Tmp/variables.before $Tmp/variables.after"
  runCmdAndLog $cmd
  rm -f $Tmp/variables.before $Tmp/variables.after
  rm -f $Tmp/variables.before $Tmp/variables.before 
}
#eof function setVars


# parse the ini like $0.hostname.conf and set the variables
parseIniFile(){
 eval `sed -e 's/[[:space:]]*\=[[:space:]]*/=/g' \
     -e 's/;.*$//' \
     -e 's/[[:space:]]*$//' \
     -e 's/^[[:space:]]*//' \
     -e "s/^\(.*\)=\([^\"']*\)$/\1=\"\2\"/" \
    < $IniFile \
     | sed -n -e "/^\[$IniSection\]/,/^\s*\[/{/^[^;].*\=.*/p;}"`
}
#eof function parseIniFile


# run a command and log the call and its output to the LogFile
# usage: runCmdAndLog $cmd
runCmdAndLog(){
    cmd="$*" ; 
    wlog " DEBUG running cmd : \"$cmd\""
    Msg=$($cmd 2>&1)
        [ $? -eq 0 ]  || wlog "ERROR : Failed to run the following command \"$cmd\" with the following output \"$Msg\" !!!"
    wlog " DEBUG : cmdoutput : \"$Msg\""
}
#eof function runCmdAndLog


# run a command on failure exit with message
# usage: runCmdOrExit $cmd

runCmdOrExit(){
    cmd="$*" ; 
    wlog " DEBUG running cmd : \"$cmd\""
    Msg=$($cmd 2>&1)
    # if error occured during the execution exit with error
    [ $? -eq 0 ] || Exit "ERROR : FATAL : Failed to run the following command \"$cmd\" with the following output \"$Msg\" !!!"
    #if no error occured just log the message
    wlog " DEBUG : cmdoutput : \"$Msg\""
}
#eof function runCmdOrExit


# echo pass params and print them to a log file
wlog(){
  # check terminal if exists echo 
  test -t 1 && echo "`date +%Y.%m.%d-%H:%M:%S` [$$] $*"
  # check LogFile and 
  test -z $LogFile || {
    echo "`date +%Y.%m.%d-%H:%M:%S` [$$] $*" >> $LogFile
  } #eof test
 } 
# eof function wlog 


replicateSrcDirStructure(){
  
  cd $ProductVersionDir
  find sfw -type d -exec mkdir -p docs/html/src/{} \;
  

}
#eof func replicateSrcDirStructure


createSfwSrcDocs(){

  wlog " DEBUG START createSfwSrcDocs"
  cd "$ProductVersionDir"
  find "sfw" -type f -exec perl $CodeToHtml {} docs/html/src/{}.html \;
  cmd="find $ProductVersionDir/docs/html/src/perl/ -type f"
  runCmdAndLog $cmd
  wlog " DEBUG STOP createSfwSrcDocs"

}
#eof wlog " DEBUG createSfwSrcDocs"



# exit with passed status and message
Exit(){
  ExitStatus=0
  case $1 in
   [0-9]) ExitStatus="$1"; shift 1;;
 esac
  Msg="$*"
  test "$ExitStatus" = "0" || Msg=" ERROR: $Msg"
  wlog " $Msg"
  exit $ExitStatus
}
#eof function Exit


# the main function called 
main(){
 setVars
  replicateSrcDirStructure
  createSfwSrcDocs  
  Exit 0 "created the docs"
  }
#eof function main


# Action !!!
main


#
# Purpose:
# to produce the html files our of the perl source files into a single directory
# features: 
# - prints the set in the script variables
# - separation of host specific vars into $0.`hostname`.conf file
# - wlog function for both xterm and log file printing
# - for loop examples with head removal and inline find and replace 
# 
# Requirements
# - cygwin , perl , sh , code2html by 
# - 
# EOF File:create-perl-src-docs.sh
# VersionHistory: 
# 1.4.0 --- 2012-07-24 17:33:29 --- ysg --- Initial creation of create-perl-src-docs.sh
# 1.3.0 --- 2012-05-20 18:48:08 --- ysg --- replacing cmd with error output
# 1.2.4 --- 2012-05-02 20:41:11 --- ysg --- added for loop with pipes 
# 1.1.0 --- ysg --- add runcmd with erro
# 1.0.0 --- ysg --- Initial creation of sh_stub


syntax highlighted by Code2HTML, v. 0.9.1

2012-07-23

how-to convert cygwin paths to windows paths

:: File:ToWindowsDir.cmd v.1.1.0 docs at the end
perl -e "use Win32::Clipboard ; $CLIP = Win32::Clipboard();$NEWCLIP=$CLIP->Get();$NEWCLIP=~s/\//\\/gi;$NEWCLIP=~s/\\cygdrive\\([a-zA-Z]{1})/$1:/gi;$CLIP->Set($NEWCLIP);"
 
 
:: Purpose:
:: change any / chars from your windows clipboard into \ chars 
:: replace any drive letter c: with /cygdrive/c
:: from your clipboard 
:: 
:: Requirements 
:: windows , perl , Win32::Clipboard module 
:: 
:: Usage: 
:: place this cmd file in your path 
:: double-click bat file or create a short cut of it , place on desktop 
:: right click the shortcut , Properties , Click on ShortCut key , press W , click ok
:: COPY some path from your explorer such as C:\Temp, Alt + U 
:: paste in cygwin as /cygwin/c/Temp
:: 
:: VersionHistory
:: 1.1.0 --- ysg --- ToWindowsDir
:: 0.2.0 -- ysg -- Adjusted to ANY letter
:: 0.1.0 -- ysg -- Initial creation
:: 
:: EOF file : ToWindowsDir.cmd

2012-07-19

perl cheat sheet v1.1.0

# file: PerlCheatSheet.pl v.1.1.0 docs at the end 
 
 # INSTALLING MODULES ON PERL 
perl -e -MCPAN "install GD" 
   
 ppm search module:name
 
 
#READ ALL ROWS OF A FILE TO ALIST 
open (INPUT, "<$inputfile") || print "could not open the file!\n";  @myfile = <INPUT>;close INPUT;
 
 
#FOREACH LINE OF THE FILE DO SOMETHING
foreach my $line ( @lineArray  ) 
{
   print "$line" ; 
} #eof foreach 
# END FOREACH LINE 
 
 
#GET A NICE TIME 
sub timestamp {
 #
 # Purpose: returns the time in yyyymmdd-format 
 #
 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); 
 #---- change 'month'- and 'year'-values to correct format ---- 
 $min = "0$min" if ($min < 10); 
 $hour = "0$hour" if ($hour < 10);
 $mon = $mon + 1;
 $mon = "0$mon" if ($mon < 10); 
 $year = $year + 1900;
 $mday = "0$mday" if ($mday < 10); 
 return "$year$mon$mday" . "_" . "$hour$min" . "_" . $sec; 
} #eof timestamp 
 
 
 
 # READ ALL ROWS TO LIST
open (FILE,$file);
 @rows = <FILE>;
close (FILE);
 
 
# GREP ALL ROWS CONTAINING 'MACHINE=' (TO A LIST)
@list = grep(/machine=/,@rows); 
 
# A NICE WAY TO CONCATENATE A STRING TO THE SAME STRING 
 #--- Collect agents from yesterday ------------------------------
 $sql = "select distinct(AgentName),LocationName from TransactionDetails td "; 
 $sql .= "inner join Applications ap on td.ApplicationID = ap.ApplicationID ";
 $sql .= "inner join Agents ag on td.AgentID = ag.AgentID ";
 $sql .= "inner join Locations lo on td.LocationID = lo.LocationID ";
 $sql .= "where ApplicationName like \'" . $APPLICATION . "\' and "; 
 $sql .= "StartTime between \'" . $DAY2 . "\' and \'" . $DAY1 . "\' "; 
 $sql .= "order by 1";
 # THE EQUIVALENT OF THE SET COMMAND TROUGH THE COMMAND PROMT 
 foreach $i (keys %ENV) 
 {
 print FH "$i : $ENV{$i} \n";
 }
 #accept a command line parameter 
 our $CycleScriptRun_pid = $ARGV[0] ; 
 
 
#========================================================== 
 #start a Windows process 
 use Win32 ; 
 use Win32::Process ; 
 
 my $DayCycle_path= $varHolder->{'BASEDIR'} . " DayCycle.exe" ;
 if( $varHolder->{VISIBLE_MODE} == 1)
 { Win32::Process::Create( $DayCycle_o, "$DayCycle_path", "" , 0, 
 CREATE_NEW_CONSOLE ,$varHolder->{'BASEDIR'}); } 
 else
 { Win32::Process::Create( $DayCycle_o, "$DayCycle_path", "" , 0,
 CREATE_NO_WINDOW ,$varHolder->{'BASEDIR'}); } 
 
 $DayCycle_pid = $DayCycle_o->GetProcessID() ; 
 #========================================================== 
#==========================================================
#Purpose : to tie a file 
 #============================= =============================
 use Tie::File ; 
 my @file_array = ();
 my $file = 'C:/Temp/folder/settings.txt' ; 
 tie @file_array , 'Tie::File', $file , memory => 100_000_000 or die "I cannot find the $file" ; 
 
 foreach (@file_array) #foreach line of the file 
 { s/$setting=(\d+)/$setting=$value/; 
 }
 untie @file_array ; 
 #==========================================================
 #========================================================== 
# create a nameless hash
#========================================================== 
 my $record = #one record for each cycle 
 {
 APP=> "$csAppName" , 
 SCRIPT=> "$psCurrentScript" , 
 STEP=> "$psCurrentStep" 
 } ;
#========================================================== 
#========================================================== 
 #simple  perl regex cheatsheet
#========================================================== 
Operators
m// 'Match' operator
s/// 'Substitute' operator 
tr/// 'Translate' operator 
 
# Special Characters
. Any single character escept newline n
b Between word and non-word chars, ie: /bcat/b/ matches "cat" but not "scat" 
B NOT between word and non-word chars 
w Word character 
 W Non-word character
d Digit
D Non-digit
s White-space
S Non-white-space
 
# Assertions (Position Definers)
^ Start of the string
 $ End of the string
 
# Quantifiers (Numbers Of Characters) 
 n* Zero or more of 'n'
n+ One or more of 'n'
n? A possible 'n'
 
n{2} Exactly 2 of 'n'
n{2, } At least 2 (or more) of 'n' 
n{2,4} From 2 to 4 of 'n'
 
 # Groupings
() Parenthesis to group expressions
(n/sitebuilder/regex/images/1/a) Either 'n' or 'a'
Character Classes
[1-6] A number between 1 and 6 
[c-h] A lower case character between c and h 
 [D-M] An upper case character between D and M
[^a-z] Absence of lower case character between a and z
[_a-zA-Z] An underscore or any letter of the alphabet
 
 Useful  Perl  Snippets
$mystring =~ s/^s*(.*?)s*$/$1/; Trim leading and trailing whitespace from $mystring 
 $mystring =~ tr/A-Z/a-z/; Convert $mystring to all lower case
 $mystring =~ tr/a-z/A-Z/; Convert $mystring to all upper case 
tr/a-zA-Z//s; Compress character runs, eg: bookkeeper -> bokeper
tr/a-zA-Z/ /cs; Convert non-alpha characters to a single space 
 
 
#=============================================================
#Install a perl module from behind a firewalll using ppm
#=============================================================
Example with Compress-Bzip2 
 
1. Download tar package from the nearest cpan mirror to C:\Temp\TEMP folder (could be other also ; ) 
2. Create Compress-Bzip2.ppd type of file , containging the following: 
 
<?xml version="1.0" encoding="UTF-8"?> 
 <SOFTPKG NAME="Compress-Bzip2" VERSION="2,2,09"> 
<TITLE>Compress-Bzip2</TITLE>
<ABSTRACT>Blah</ABSTRACT>
<AUTHOR>Somebody</AUTHOR>
<IMPLEMENTATION> 
<CODEBASE HREF="file:///C|/Temp/TEMP/Compress-Bzip2-2.09.tar.gz "></CODEBASE>
<INSTALL></INSTALL>
<UNINSTALL></UNINSTALL>
</IMPLEMENTATION>
</SOFTPKG> 
 
Attention: . Name and codebase NOT C:\ BUT file:///C|
 
 3. Open Dos prompt into the C:\Temp\TEMP (or whichever you prevered in the beginning) 
 4. Run the command : 
 ppm rep add downloadedTars C:\Temp\A_DOWNLOADS\downloaded _perlmodules 
 In order to add the folder to the list of your current ppm repositories 
 
5. ppm install Compress-Bzip2
 In order to install the module from the local folder 
 
6. ppm rep delete myNewRepository 
 In order to remove the repository from the ppm 
#Add company's servers to thte local ppm's repository 
ppm rep add linox1 http://linox.company.com/mirror/cpan/
ppm rep add linox2  ftp://linux.company.com/mirror/cpan/
 
 
#sleep for less than second in Windows 
 use Win32 ; 
 Win32::sleep ($time_in_milliseconds);
 
#=================================================================== 
 #throw proper errro messages while checking the file size 
 use File::stat qw(:FIELDS);
#create the obj wrapper for getting the file attributes 
 my $st =stat($file) or croak ( "No $stdout : $!"); #die will shut down the program !!!! 
 # get the file size 
 my $size = $st->size();
$stat_obj =stat($stdout) or die "No $stdout: $!";
#throw proper errro messages ^^^^
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
 $atime,$mtime,$ctime,$blksize,$blocks) 
 = stat($filename);
#===================================================================
 
#================================================================
 
#get the computername of a computer 
 $computername = $ENV{COMPUTERNAME} ; 
 #get the username of the a Windows computer
$userName = $ENV{USERNAME} ; 
 #get the name of the currrent executing script and ints pid 
 print $0 , $$ ; 
 #=========================================================== ======== 
 #The textpad settings for jump to error for perl scripts File 1 Register 2
^.+at (.+) line ([0-9]+)[.,]?
exec *.pl *.pm *.cgi /s /b do  perl -wc 
 
#=========================================================== ===== 
 
#===================================================================
#======== Exctract only the name of a file witout the long path 
 #=================================================================== 
 
 my ($keijo) = "c:\\homo\\urpo\\neste\\kekvo.exe";
 @homo = split(/\\/,$keijo);
 $jee = pop(@homo);
 #The same thing 
 $file=~m/^.*(\\|\/)(.*)/; # strip the remote path and keep the filename
 my $name = $2; 
 
#===================================================================
#=================================================================== 
#PRINT TILL THE END OF A LABLE 
 #============================= ====================================== 
 print <<END_HTML;
 
 <html> <head> 
 <title>thanks!</title> 
 </head> 
 
 <body> 
 <p>thanks for uploading your photo!</p> 
 
 <p>your photo:</p> 
 <img src="/upload/$filename" border="0"> 
 
 </body> </html> 
 
END_HTML
# IMPORTANT !!!! IF THERE ARE SPACES IN THE PREVIOUS LINE == SYNTAX ERROR 
 
#=================================================================== 
 
#check for file existance and other attributes 
 $readfile="myfile.cgi";
 
if ( (-e $readfile) && (-r $readfile) ) 
 { 
 #proceed with your code
}
 
#================================================================= 
 #how to check my perl installed modules
#perldoc perllocal OR 
 #ppm install ExtUtils::Installed save and run this one 
 #source  http://www.cpan.org/misc/cpan-faq.html#How_installed_modules 
 
use ExtUtils::Installed;
my $instmod = ExtUtils::Installed->new();
 foreach my $module ($instmod->modules()) 
 {
 my $version = $instmod->version($module) || "???"; 
 print "$module -- $version\n"; 
 }
 #=================================================================
 
#How to check version of a module on Windows XP
 perl  -le "use CGI; print $CGI::VERSION"
 
#change the @INC withing a perl script 
 #Is Mail::Sendmail installed correctly? (Can you run a script with just "use Mail::Sendmail;"?) Check your @INC on your web server, and copy Sendmail.pm to a Mail subdirectory of one of the dirs. in your @INC. If you have not access to any of these, add the directory in a BEGIN block: 
 #BEGIN{ unshift @INC, '/absolute/path/to/my/personal/perl_lib'; } and copy Sendmail.pm to /absolute/path/to/my/personal/perl_lib/Mail/Sendmail.pm. 
 
 
local( $/, *FILE ) ; 
open (FILE , $sessionFile ) or 
die "Cannot find $sessionFile !!! " ; 
$fileString = <FILE>; #slurp the whole file into one string !!! 
close FILE ; 
 
use Encode ; 
my $fileByteStream = decode('windows-1251', $fileString );
my $UTFSream = encode('UTF-8', $fileByteStream);
 
print "Read the whole directory for specific types of files " ; 
$dh = DirHandle->new($path) or die "Can't open $path : $!\n";
@files = grep { /\.[ch]$/i } $dh->read();
 
# START FOREACH LINE 
#SET HERE THE PATH TO THE FILE 
my $inputfile='DD61_STG_OMDW.vwFactUserRegistration.txt' ; 
 
#READ ALL ROWS OF A FILE TO ALIST 
open (INPUT, "<$inputfile") || print "could not open the file!\n"; 
my @lineArray = <INPUT>;
close INPUT;
 
 
   #how-to print key values in hashes 
   while( my ($key, $value) = each %$refHash) 
   {
      print "\n key: $key, value: $value.\n";
   }
 
#<<DOC_END;
The purpose of the script is ... 
DOC_END
 
use Time::Local ; 
# get a nicely formated time 
my $timestamp = strftime("%d/%m/%y %H:%M:%S", localtime());
 
# how-to install modules from the cpan
perl -MCPAN -e 'install HTML::Template' 
perl -MCPAN -e "install PAR::Packer" 
 
# perl defined or operator
$IniFile //= "$ProductVersionDir/conf/$HostName/ini/run-$EnvironmentName.$HostName.ini";
 
##################################################
## START install perl modules by tar.gz
##################################################
# go to where you did download the modules tar
cd /path/to/module
# unzip 
gzip -d *.tar.gz
# untar verbosely 
tar xvf *.tar
# check the dirs created 
for dir in `find \`pwd\` -maxdepth 1 -type d ` ; do echo cd $dir ; done ;
# go to the first dir which was created from the untar operation
for dir in `find \`pwd\` -maxdepth 1 -type d ` ; do cd $dir ; done ;
# create the make file 
perl Makefile.PL
# run make 
make
# optionally test 
make test 
# optionally create the make html 
make html 
# install 
make install
##################################################
## STOP install perl modules by tar.gz
##################################################
 
 
 
# Purpose
# the pur
# VersionHistory: 
# 1.1.0 --- 2012-07-19 19:33:45 --- ysg --- Added module installation instructions 
# 1.0.0 --- 2012-06-18 09:01:29 --- ysg --- Initial version 
 
 
 
# eof: file:PerlCheatSheet.pl
   
   

how-to install perl modules from tar.gz packages on Linux , Unix , cygwin if cpan install is not an option

##################################################
## START install perl modules by tar.gz
##################################################
# go to where you did download the modules tar
cd /path/to/module
# unzip 
gzip -d *.tar.gz
# untar verbosely 
tar xvf *.tar
# check the dirs created 
for dir in `find \`pwd\` -maxdepth 1 -type d ` ; do echo cd $dir ; done ;
# go to the first dir which was created from the untar operation
for dir in `find \`pwd\` -maxdepth 1 -type d ` ; do cd $dir ; done ;
# create the make file 
perl Makefile.PL
# run make 
make
# optionally test 
make test 
# optionally create the make html 
make html 
# install 
make install
##################################################
## STOP install perl modules by tar.gz
##################################################

2012-07-09

how-to draw rounded corner rectangle with perl and GD

# builds a rounded filled rectangle by the coordinates of the left upper , 
# righ down corner , radius and color object
sub AddRoundedRectangleToImg { 
   
   my $self = shift ; 
   my $refObjImg = shift ; 
   my $objImg = $$refObjImg ; 
   my $x1 = shift ; 
   my $y1 = shift ;    
   my $x2 = shift ; 
   my $y2 = shift ;    
   my $radius = shift ; 
   my $objColor = shift ; 
 
   #$objImg ->filledRectangle ( $x1 + 400, $y1, $x2 + 400, $y2, $colorBrown);
   $objImg->filledRectangle ( $x1 , $y1+ $radius , $x2 , $y2 - $radius , $objColor);
   $objImg->filledRectangle ( $x1 + $radius , $y1  , $x2 - $radius , $y2 , $objColor );
   my $diameter = $radius*2;
      
   # build the corners   
   $objImg ->filledArc( $x1+$radius, $y1+$radius, $diameter, $diameter, 0 , 360 ,  $objColor);
   $objImg ->filledArc( $x1+$radius, $y2-$radius, $diameter, $diameter, 0 , 360 , $objColor);
   $objImg ->filledArc( $x2-$radius, $y2-$radius, $diameter, $diameter, 0 , 360 , $objColor);
   $objImg ->filledArc( $x2-$radius, $y1+$radius, $diameter, $diameter, 0 , 360 , $objColor);
   
   return \$objImg ; 
} 

2012-05-06

how-to convert csv to confluence wiki with perl

package CsvToWiki; 
my $VERSION='1.0.0' ; 
use strict ; use warnings ; use Exporter; 
my @ISA = qw(AutoLoader Exporter);
my @EXPORT = qw( RunCsvToWiki );
 
BEGIN {     
    #add the scripts dir to the INC
    $0 =~ m/^(.*)(\\|\/)(.*)\.([a-z]*)/; 
    push ( @INC , $1) ;     
    
} #eof sub
 
use Configurator ; use Logger ; use FileHandler ; 
 
 
#    anonymous hash !!!
our ( $confHolder , $confHolderOfObj , $objLogger , $MyBareName , $objConfigurator)= () ; 
our ( $objFileHandler , $RunDir ) = () ; 
our ( $FileCsvInput , $FolderOutput , $HtmlPageSize ) = () ; 
 
our ( $CsvFileSeparator  , $TokenStart , $TokenStop  , $LineStart  , $LineStop )  = () ; 
our ( $BareFileCsvInput , $FileOutput , $StrToWriteStart , $StrToWriteStop , $Pager ) = () ; 
our ( $DirCsvInput  , $DirCsvOutput , $RegexFilterForCsvToWikiSourceFiles) = () ; 
 
 
our (  $EnvironmentName  , $ProductBaseDir , $ProductVersionDir , $HostName ) = () ; 
our (  $ConfDir  ) = () ; 
our ( $FileConfig ) = () ; 
 
 
# -----------------------------------------------------------------------------
# Initialize the object with the minimum data it will need to operate 
# -----------------------------------------------------------------------------
sub Initialize {
 
    my $self = shift ; 
    
    $objLogger = new Logger (\$confHolder) ; 
    $objFileHandler = new FileHandler ( \$confHolder ) ; 
 
    my $ActionName = ref ( $self ) ; 
    my $msg = "\$ActionName is $ActionName" ; 
    $objLogger->LogDebugMsg     ( "$msg" ) ; 
    $objLogger->LogDebugMsg ( "The \$ActionName is $ActionName " ) ; 
    $EnvironmentName = $confHolder->{'EnvironmentName'} ; 
    $ProductBaseDir = $confHolder->{'ProductBaseDir'} ; 
    $ProductVersionDir = $confHolder->{'ProductVersionDir'} ; 
    $HostName= $confHolder->{'HostName'} ; 
    $ConfDir = "$ProductVersionDir/conf/$HostName/ini" ; 
    $FileConfig = "$ConfDir/$EnvironmentName" . '.' . "$ActionName" . '.' . "$HostName" . '.ini' ; 
    $objLogger->LogDebugMsg ( "\$FileConfig is $FileConfig " ) ; 
    my $objConfigurator = clone Configurator($FileConfig , $confHolder); 
    # get the hash having the vars 
    $confHolderOfObj = $objConfigurator->getConfHolder () ; 
 
 
        #get it from the conf 
        $DirCsvInput = $confHolderOfObj->{'DirCsvInput'} || "$ProductVersionDir/docs/excel" ; 
        
        #get it from the conf 
        $DirCsvOutput = $confHolderOfObj->{'DirCsvOutput'} || "$ProductVersionDir/docs/csv" ;  ; 
        $objFileHandler->MkDir ( $DirCsvOutput ) unless ( -d $DirCsvOutput ); 
        
        
        #v1.3.0 ysg --- Add
        my ($RefFilesAndDirs , $RefDirsToProcess , $RefFilesToProcess ) = 
        $objFileHandler->ReadDirRecursivelyReturnArrays ( $DirCsvOutput , '(.*?)\.html') ; 
        my @FilesAndDirs = @$RefFilesAndDirs ; 
        my @DirsToProcess = @$RefDirsToProcess ; 
        my @FilesToProcess = @$RefFilesToProcess ; 
 
        foreach my $FileHtmlOldOutput ( @FilesToProcess ) { 
            $objLogger->LogDebugMsg ( 
                                    "CsvToWiki->Initialize: unlink \$FileHtmlOldOutput $FileHtmlOldOutput" ); 
            unlink ( $FileHtmlOldOutput ) ; 
            }
            
        $RegexFilterForCsvToWikiSourceFiles = 
                                    $confHolderOfObj->{'RegexFilterForCsvToWikiSourceFiles'} || '^.*\.csv' ; 
        # set a default page size if not defined
        $HtmlPageSize = $confHolderOfObj->{'HtmlPageSize'} || 20; 
 
        $CsvFileSeparator = chr(    $confHolderOfObj->{'CsvFileSeparator'}) || chr(44) ; 
        
        $TokenStart = ''  ; 
        $TokenStop = '|' ; 
        $LineStart = '||' ; 
        $LineStop = ' ' . "\n" ; 
        $StrToWriteStart = '{table-plus:autoTotal=true|autoNumber=true|sortColumn=2|sortIcon=true|columnTypes=S,I,I}' . "\n" ; 
        $StrToWriteStop = '{table-plus}' . "\n" ; 
        $Pager = '' ; 
 
} #eof sub
# =============================================================================
# START OO
 
 
#sourcF:\\\\\\http://www.netalive.org/tinkering/serious-perl/#oop_constructors
sub new {
    
    my $class = shift ;        # Class name is in the first parameter
    $confHolder = ${ shift @_ } if ( @_ )  ; 
    
    my $self = { };  # Anonymous hash reference holds instance attributes
    
    bless($self, $class);          # Say: $self is a $class
        $self->Initialize() ;    
    return $self;
} #eof const 
 
 
sub AUTOLOAD {
 
    my $self = shift ; 
    no strict 'refs'; 
    my $name = our $AUTOLOAD;
    *$AUTOLOAD = sub { 
    my $msg = () ; 
    $msg .= "BOOM! BOOM! BOOM! \n RunTime Error !!!\n" ; 
    $msg .= "Undefined Function $name(@_)\n" ;
    cluck(  "$self , $msg" ) ; 
    };
    goto &$AUTOLOAD;    # Restart the new routine.
}    
 
 
    sub get    {
    
        my $self = shift;
        my $name = shift;
        return $self->{$name};
    } #eof sub get 
 
 
    sub set    {
    
        my $self = shift;
        my $name = shift;
        my $value = shift;
        $self->{$name}=$value;
    } #eof sub set 
 
 
    sub dumpFields        {
        my $self = shift ; 
        my $strFields = () ; 
        foreach my $key (keys %$self)        {
            $strFields .= "$key = $self->{$key}\n";
        }
        
        return $strFields ; 
    } #eof sub dumpFields 
 
 
sub DESTROY {
 
    my $self = shift;
    #debug print "the DESTRUCTOR is called  \n" ; 
    return ; 
} 
 
 
# STOP OO
# =============================================================================
 
sub RunCsvToWiki {
    
    my $self = shift ; 
    my $msg = () ; 
    $msg = "CFPoint24    OK    Convert the csv files from the $DirCsvInput dir to html files in the $DirCsvOutput dir"  ;
    $objLogger->LogInfoMsg ( $msg ) ; 
    
    my ($RefFilesAndDirs , $RefDirsToProcess , $RefFilesToProcess ) = 
    $objFileHandler->ReadDirRecursivelyReturnArrays ( $DirCsvInput , $RegexFilterForCsvToWikiSourceFiles) ; 
    my @FilesAndDirs = @$RefFilesAndDirs ; 
    my @DirsToProcess = @$RefDirsToProcess ; 
    my @FilesToProcess = @$RefFilesToProcess ; 
 
 
    foreach my $FileToProcess ( @FilesToProcess ) {
    
        $objLogger->LogDebugMsg ( "csv \$FileToProcess is $FileToProcess " ) ; 
        #read the input metadata file 
        my $RefRowsFileInput = $objFileHandler->ReadFileReturnArray ( $FileToProcess ) ; 
        my @RowsFileInput = @$RefRowsFileInput; 
        $objLogger->LogDebugMsg ( "\@RowsFileInput is @RowsFileInput " ) ; 
        #FOREACH LINE OF THE FILE DO SOMETHING
        my $OldTableName = '' ; 
        my $ColList = '' ; 
        my $StrOutput = '' ; 
        my $rowCounter= 0 ; 
        my $PageStartLine = 0 ; 
        
        $Pager = '<table><tr>' ; 
        
        # start with 1 
        for ( my $rowCounter = 1 ; $rowCounter <= $#RowsFileInput ; 
                                            $rowCounter=$rowCounter + 1)                                     {
                
                if ( $rowCounter % $HtmlPageSize == 0 
                                || $rowCounter == $#RowsFileInput )     {
 
                    # $1 should produce the full path till the last \ or /
                    # $2 should produce the BareName without the .extension
                    # $3 should produce the file extension after the last dot
                    $FileToProcess =~m/^(.*)(\\|\/)(.*)(\..*)/; # strip the remote path and keep the filename
                    my $LinkName = $3 ; 
                    # use human readable 
                    my $StartItemNumberInPage = $rowCounter  ; 
                    $StartItemNumberInPage = $rowCounter - $HtmlPageSize +1 unless ( $rowCounter == $#RowsFileInput) ; 
                    $StartItemNumberInPage = $rowCounter - ($rowCounter % $HtmlPageSize ) if ( $rowCounter == $#RowsFileInput) ; 
                    my $EndItemNumberInPage = $rowCounter ;  
                    $LinkName = $LinkName . '.' . "$StartItemNumberInPage"   . '-' . "$EndItemNumberInPage"  . '.html' ; 
 
                    $Pager .= '<td>' . '<a href="' . $LinkName   . "\">" . 
                    "$StartItemNumberInPage" . '-' . "$EndItemNumberInPage"  . "</a></td>" ;   
                    
                    #            print "\$Pager is $Pager " ; 
                    $objLogger->LogDebugMsg (  "\$LinkName is $LinkName " ) ; 
                    $objLogger->LogDebugMsg (  "\$rowCounter is $rowCounter " ) ; 
                    $objLogger->LogDebugMsg (  "\$#RowsFileInput is $#RowsFileInput " ) ; 
                }
        } #eof for
        $Pager .= '</tr></table>' ; 
        $Pager = "" ; 
        
        $rowCounter = 0 ; 
        
        foreach my $line ( @RowsFileInput  ) {
        
            $objLogger->LogDebugMsg ( "\$line is $line " ) ; 
            chop($line ) ; 
            my @tokens= split( "$CsvFileSeparator" , $line ) ; 
            $line = '' ; 
            
            if ( $rowCounter == 0 ) {
                $TokenStop = '||' ;  
            } else {
                $TokenStop = '|' ;   
                }
                
            foreach my $token ( @tokens)     {
            
                $token = GenerateToken ( $token )  ;
                $line = $line . $token ; 
            }
            
            $line = GenerateLine ( $line , $rowCounter ) ;         
            $rowCounter++ ;
            $StrOutput = $StrOutput . $line ; 
    
            if ( $rowCounter % $HtmlPageSize == 0 || $rowCounter == $#RowsFileInput)     {
 
                    $FileToProcess =~m/^(.*)(\\|\/)(.*)(\..*)/; # strip the remote path and keep the filename
                    my $LinkName = $3 ; 
                    # use human readable numbers start with 1 not 0
                    
                    my $StartItemNumberInPage = 0 ; 
                    $StartItemNumberInPage    = $rowCounter - $HtmlPageSize +1 unless $rowCounter == $#RowsFileInput ; 
                    $StartItemNumberInPage    = $rowCounter - ( $rowCounter % $HtmlPageSize ) if ( $rowCounter == $#RowsFileInput ) ; 
                    my $EndItemNumberInPage = $rowCounter ;  
                                        
                    $LinkName = $LinkName . '.' . "$StartItemNumberInPage"  . '-' . $rowCounter   . '.html' ; 
                    $FileOutput = "$DirCsvOutput" . '/' . "$LinkName" ;
                    WriteFile ( $FileOutput , $StrOutput , $PageStartLine ) ; 
                    $objLogger->LogDebugMsg ( "\$StrOutput is $StrOutput" ) ; 
                    $StrOutput = '' ; 
                    $PageStartLine = $PageStartLine + $HtmlPageSize ; 
                }
                #debug $objLogger->LogDebugMsg ( "\$StrOutput is $StrOutput" ) ; 
        } #eof foreach line
        # END FOREACH LINE 
    
    } #eof foreach $FileToProcess 
    
    $Pager = ""; 
} #eof sub ExecuteRunCommand 
 
 
sub GenerateToken    {
 
    my $token = shift ; 
    $token = $TokenStart . $token . $TokenStop ;     
}    # eof sub GenerateToken
 
 
sub GenerateLine    {
 
    my $line = shift ; 
    my $rowCounter = shift ; 
    
    if ( $rowCounter % 2 != 0 ) 
        { $line = $LineStart . $line . $LineStop ; }
    else 
        {        $line = $LineStart . $line . $LineStop ; }
    
    return $line ; 
} # eof sub GenerateLine
 
 
sub trim        {
 
    $_[0]=~s/^\s+//;
    $_[0]=~s/\s+$//;
    return $_[0];
}
 
#eof sub trim 
 
 
sub WriteFile    {
    
    my $FileToWrite = shift ; 
    my $StrToWrite = shift ; 
        my $PageStartSize = shift ; 
        
        my $head .= 
'<html>
<head>
<title>tables</title>
  <style type="text/css">
    table tbody tr td {
      background-color: #eee;
    }
    table tr.odd  td {
      background-color: #fff;
    }
  </style>
</head><body>
' ; 
 
$StrToWrite = $head . $Pager . $StrToWriteStart . $StrToWrite .  $StrToWriteStop;   
$StrToWrite .= $Pager . '</body></html>' ; 
 
 
#$LinkName = $LinkName . '.' . $rowCounter . '-' . ( $rowCounter + $HtmlPageSize ) . '.html' ; 
$objFileHandler->PrintToFile ( $FileToWrite , $StrToWrite ) ; 
 
    
} #eof sub WriteToFile 
 
 
1 ; 
 
__END__
 
 
# VersionHistory:
# 1.0.0 --- 2011.12.25 - 20:13:19 --- Changed default conf dir
# 1.4.0 --- 2011.08.13 16:54:07 --- Added Control Flow documentation 
# 1.3.0 --- 2011.07.14 20:34:44 --- Added clean of html files 
# 1.2.1 --- 2011.07.06 11:05:05 --- Removed FilF:\\\\\\:Find 
# 1.0.0 --- 2011.07.06 10:26:59 --- ysg --- Added RegexFilterForCsvToWikiSourceFiles , full proof Initialize 
# 1.0.001.0.01_222618 --- Yordan Georgiev --- Generates Select All with full [] column list from Table
# 1.0.601.0.04_1.0.65 --- Yordan Georgiev --- REnamed to NiceHtmlTableGenerator.1.0.pl -- added css and a nice ttable
#hint: add to some rows : color:#FF0000; red or style="color:#009900" green to underline some colors
 
# [r1c1link alias|r1c1 pagetitle|r1c1 tip]
# RowNum    WorkFlowName    SubObjectType    SubObjectName    LogPageId    FolderId    ImaticaFolderName    WorkFlowId    WorkFlowLastUpdateTime    SubObjectInstanceId    PageId
# PageId = =G2&"-"&B2&"-"&C2&"-"&D2
# LogId = = "[etl-log-"&K2&"]"
# 
pre

File:ctagsPerlFilter.pl v.1.1.0 --- a textpad utility for searching perl packages and subs and jumping to them

# File:ctagsPerlFilter.pl v.1.0.0 docs at the end 
use strict ; use warnings ; 
 
package ctagsPerlFilter ; 
use Carp qw(cluck);
 
 
our ( $StrFileCtags , $FileCtags , $FileSourceCode , $DirSourceCode ) = () ; 
our ( $FileNameSourceCode ) = () ; 
our ( $Filter ) = () ; 
our ( @RowsFileCtags , @FilteredRowsFileCtags ) = () ; 
our ( @SubRoutines , $StrSubRoutines ) = () ; 
 
# -----------------------------------------------------------------------------
# Initials the global vars from the cmd
# -----------------------------------------------------------------------------
sub Initialize { 
 
   $FileSourceCode = $ARGV[0] ; 
   $Filter =  $ARGV[1] ; 
   $FileSourceCode =~ m/^(.*)(\\|\/)(.*)/; 
   $FileNameSourceCode = "$3" ; 
   $DirSourceCode = "$1" ; 
   $FileCtags = "$DirSourceCode/tags" ; 
}
#eof sub Initialize
 
# -----------------------------------------------------------------------------
# filters the build ctags file from the 
# -----------------------------------------------------------------------------
sub filterCtagsFile { 
 
   my $RefFileCtags = ReadFileReturnArray ( $FileCtags ) ; 
   @RowsFileCtags = @$RefFileCtags ; 
   #filter only the file name to query for
   @FilteredRowsFileCtags = grep(/$Filter/, @RowsFileCtags); 
   #filter for subroutines 
   @FilteredRowsFileCtags = grep(/$Filter/, @FilteredRowsFileCtags); 
   
   # go trough the filtered rows 
   foreach my $row ( @FilteredRowsFileCtags ) { 
      my @rowTokens = split ( '\s+' , $row ) ; 
      my $SubRoutineName = $rowTokens[0] ; 
      my $SrcFile = $rowTokens[1] ; 
      $SrcFile =~ s/\.\\//g ; 
      $SrcFile = "$DirSourceCode\\$SrcFile" ; 
      
      
      my $PackageName = $rowTokens[1] ; 
      # leave only the package name , remove the path and the file extension 
      no warnings ; 
      $PackageName =~ s/^(.*)(\\|\/)(.*)(\.)([a-z]*)/$3/; use warnings ; 
      my $LineNumber = $rowTokens[2] ; 
      $LineNumber =~ s/^(\D*)(\d*)(\D*)$/$2/g ; 
      # build the printable array 
      push ( @SubRoutines , "$PackageName\.$SubRoutineName $LineNumber $SrcFile" ) ; 
   } #eof foreach 
     
     #sort the array     
    @SubRoutines = sort { lc($a) cmp lc($b) } @SubRoutines   ; # alphabetical sort 
    #build the printable string 
    $StrSubRoutines = join ( "\n" , @SubRoutines ) ; 
 
} #eof sub filterCtagsFile
 
 
# -----------------------------------------------------------------------------
# Reads a file returns a sting out of it
# -----------------------------------------------------------------------------
sub ReadFileReturnString {
 
   my $FileToRead = shift ; 
 
   my $ErrorMsg = "can not read \$FileToRead $FileToRead !!! "; 
   cluck ( "$ErrorMsg   $! !!!" )       unless ( (-e $FileToRead) && (-f $FileToRead) && (-r $FileToRead) ) ; 
   return $ErrorMsg                       unless ( (-e $FileToRead) && (-f $FileToRead) && (-r $FileToRead) ) ;
   #debug print " readFileReturnString \$FileToRead is $FileToRead \n" ; 
   #todo: detect whether the file is utf8 encoded 
 
   #how-to slurp file
   my $string = (); 
   local $/=undef;
 
   open FILE, "$FileToRead " or cluck ( "Couldn't open \$FileToRead $FileToRead : $!" ) ; 
   $string = <FILE>;
   close FILE;
 
   return $string ; 
 
} #eof sub readFileReturnString 
 
 
# -----------------------------------------------------------------------------
# Read a file and return an array
# -----------------------------------------------------------------------------
sub ReadFileReturnArray {
 
   my $file = shift ;
   unless ( defined $file ) {
      cluck  ( "undefined file $file !!! $! \n\n" ) ; 
      return ; 
   }
   
   #READ ALL ROWS OF A FILE TO ALIST 
    open (INPUT, "<$file") || cluck  ( "could not open the file $file !!! $! \n\n"   ) ; 
       my @ArrFile =<INPUT> ;
    close INPUT;
   
   return \@ArrFile ; 
} #eof sub 
 
 
# -----------------------------------------------------------------------------
# the main entry point of the script - captures fatal erros 
# if any and opens the fatal errors file 
# -----------------------------------------------------------------------------
sub main { 
 
    #check for runtime errors 
    eval { 
         Initialize();
         filterCtagsFile();
         print STDOUT "$StrSubRoutines" ; 
    };
 
    #Trap run-time erros in the whole perl application and print them to FatalErrorsLog.log in cd
    if ( $@ )           {      
         cluck $@ ;
         #provide time for the user to grasp !!!
         sleep 2 ; 
         open  (  F , ">>FatalErrorsLog.log" );
         print    F $@ ; 
         print F localtime(time) . "\n";
         close F ; 
         #open the fatal erros file 
         `FatalErrorsLog.log` ; 
   } #eof if  errors found      
   
} 
#eof sub main 
 
 
# Action !!!
main();
 
1 ; 
 
=head1 NAME
 
ctagsPerlFilter
 
=head1 SYNOPSIS
 
this scripts assumes that you have run 
ctags.exe -R -n --fields=+i+K+S+l+m+a on your directory 
 
perl ctagsPerlFilter.pl <<FullFilePath>> <<SelectedWordToSearchFor>>
 
This is the registry setting for the tool ( change the path in the Parameters value t) 
 
Windows Registry Editor Version 5.00
 
 
[HKEY_CURRENT_USER\Software\Helios\TextPad 5\Tools\11]
"Properties"=hex:01,00,00,00,61,80,00,00,f8,4b,00,00
"MenuText"="cmd /c perl $FileName $Sel "
"Command"="cmd.exe"
"Parameters"="perl F:\\morphus\\morphus.1.2.1.dev.ysg\\conf\\HOSTNAME\\textpad\\perl\\ctagsPerlFilter.pl $File $SelWord"
"Folder"="$FileDir"
"RE"="(.+)[ ]([0-9]+)[ ](.*)"
 
 
=head1 DESCRIPTION
 
An intellisence like functionality to filter the subroutines and package names from a ctags db file
 
Requirements: 
perl ; ) 
ctags 
 
=head2 EXPORT
 
 
=head1 SEE ALSO
 
perldoc perlvars
 
No mailing list for this module
 
=head1 AUTHOR
 
yordan.georgiev@gmail.com
 
=head1 COPYRIGHT AND LICENSE
 
Copyright (C) 2011 Yordan Georgiev
 
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.1 or,
at your option, any later version of Perl 5 you may have available.
 
VersionHistory: 
1.1.0 --- 2012-05-06 11:10:06 --- ysg --- Added registry settings 
1.0.0 --- 2012-05-05 21:12:13  --- ysg --- Initial version
 
=cut

Labels

perl (41) Cheat Sheet (25) how-to (24) windows (14) sql server 2008 (13) linux (12) oracle (12) sql (12) Unix (11) cmd windows batch (10) mssql (10) cmd (9) script (9) textpad (9) netezza (8) sql server 2005 (8) cygwin (7) meta data mssql (7) metadata (7) bash (6) code generation (6) Informatica (5) cheatsheet (5) energy (5) tsql (5) utilities (5) excel (4) future (4) generic (4) git cheat sheet (4) html (4) perl modules (4) programs (4) settings (4) sh (4) shortcuts (4) поуки (4) принципи (4) Focus Fusion (3) Solaris (3) cool programs (3) development (3) economy (3) example (3) freeware (3) fusion (3) logging (3) morphus (3) mssql 2005 (3) nuclear (3) nz (3) parse (3) python (3) sftp (3) sofware development (3) source (3) sqlplus (3) table (3) vim (3) .Net (2) C# (2) China (2) GUI (2) Google (2) GoogleCL (2) Solaris Unix (2) architecture (2) ascii (2) awk (2) batch (2) cas (2) chrome extensions (2) code2html (2) columns (2) configuration (2) conversion (2) duplicates (2) excel shortcuts (2) export (2) file (2) free programs (2) informatica sql repository (2) linux cheat sheet (2) mssql 2008 (2) mysql (2) next big future (2) nsis (2) nz netezza cheat sheet (2) nzsql (2) ora (2) prediction (2) publish (2) release management (2) report (2) security (2) single-click (2) sqlserver 2005 (2) sqlserver 2008 (2) src (2) ssh (2) template (2) tools (2) vba (2) video (2) xlt (2) xml (2) youtube videos (2) *nix (1) .vimrc (1) .virmrc vim settings configs (1) BSD license (1) Bulgaria (1) Dallas (1) Database role (1) Dense plasma focus (1) Deployment (1) ERP (1) ExcelToHtml (1) GD (1) GDP (1) HP-UX (1) Hosting (1) IDEA (1) INC (1) IT general (1) ITIL management bullshit-management (1) IZarc (1) Java Web Start (1) JavaScript anchor html jquery (1) Khan Academy (1) LINUX UNIX BASH AND CYGWIN TIPS AND TRICKS (1) Linux Unix rpm cpio build install configure (1) Linux git source build .configure make (1) ListBox (1) MIT HYDROGEN VIRUS (1) OO (1) Obama (1) PowerShell (1) Run-time (1) SDL (1) SIWA (1) SOX (1) Scala (1) Services (1) Stacks (1) SubSonic (1) TED (1) abstractions (1) ansible hosts linux bash (1) ansible linux deployment how-to (1) ansible yum pip python (1) apache (1) apache 2.2 (1) application life cycle (1) architecture input output (1) archive (1) arguments (1) avatar (1) aws cheat sheet cli (1) aws cli (1) aws cli amazon cheat sheet (1) aws elb (1) backup (1) bash Linux open-ssh ssh ssh_server ssh_client public-private key authentication (1) bash perl search and replace (1) bash stub (1) bin (1) biofuels (1) biology (1) books (1) browser (1) bubblesort (1) bugs (1) build (1) byte (1) cas_sql_dev (1) chennai (1) chrome (1) class (1) claut (1) cmdow (1) code generation sqlserver (1) command (1) command line (1) conf (1) confluence (1) console (1) convert (1) cool programs windows free freeware (1) copy paste (1) copy-paste (1) csv (1) ctags (1) current local time (1) cygwin X11 port-forwarding mintty xclock Linux Unix X (1) cygwin bash how-to tips_n_tricks (1) cygwin conf how-to (1) data (1) data types (1) db2 cheat sheet (1) db2 starter ibm bash Linux (1) debt (1) diagram (1) dictionaries (1) digital (1) disk (1) disk space (1) documentation (1) dos (1) dubai (1) e-cars (1) electric cars (1) electricity (1) emulate (1) errors (1) exponents (1) export workflow (1) extract (1) fast export (1) fexp (1) file extension (1) file permissions (1) findtag (1) firewall (1) for loop (1) freaky (1) functions (1) fusion research (1) german (1) git gitlab issues handling system (1) google cli (1) google code (1) google command line interface (1) gpg (1) ha (1) head (1) helsinki (1) history (1) hop or flop (1) host-independant (1) how-to Windows cmd time date datetime (1) ibm db2 cognos installation example db deployment provisioning (1) ideas (1) image (1) informatica oracle sql (1) informatica repo sql workflows sessions file source dir (1) informatica source files etl (1) install (1) isg-pub issue-tracker architecture (1) it management best practices (1) java (1) jump to (1) keyboard shortcuts (1) ksh (1) level (1) linkedin (1) linux bash ansible hosts (1) linux bash commands (1) linux bash how-to shell expansion (1) linux bash shell grep xargs (1) linux bash tips and t ricks (1) linux bash unix cygwin cheatsheet (1) linux bash user accounts password (1) linux bash xargs space (1) linux cheat-sheet (1) linux cheatsheet cheat-sheet revised how-to (1) linux how-to non-root vim (1) linux ssh hosts parallel subshell bash oneliner (1) london (1) make (1) me (1) metacolumn (1) metadata functions (1) metaphonre (1) method (1) model (1) movie (1) multithreaded (1) mysql cheat sheet (1) mysql how-to table datatypes (1) n900 (1) nano (1) neteza (1) netezza bash linux nps (1) netezza nps (1) netezza nps nzsql (1) netezza nz Linux bash (1) netezza nz bash linux (1) netezza nz nzsql sql (1) netezza nzsql database db sizes (1) non-password (1) nord pol (1) nps backup nzsql schema (1) number formatting (1) nz db size (1) nz table count rows (1) nzsql date timestamp compare bigint to_date to_char now (1) on-lier (1) one-liners (1) one-to-many (1) oneliners (1) open (1) open source (1) openrowset (1) openssl (1) oracle PL/SQL (1) oracle Perl perl (1) oracle installation usability (1) oracle number formatting format-model ora-sql oracle (1) oracle templates create table (1) oracle trigger generic autoincrement (1) oracle vbox virtual box cheat sheet (1) oracle virtual box cheat sheet (1) outlook (1) parser (1) password (1) paths (1) perl @INC compile-time run-time (1) perl disk usage administration Linux Unix (1) perl modules configuration management (1) permissions (1) php (1) picasa (1) platform (1) postgreSQL how-to (1) powerShell cmd cygwin mintty.exe terminal (1) ppm (1) predictions (1) prices (1) principles (1) productivity (1) project (1) prompt (1) proxy account (1) public private key (1) publishing (1) putty (1) qt (1) read file (1) registry (1) relationship (1) repository (1) rm (1) scala ScalaFmt (1) scp (1) scripts (1) scsi (1) search and replace (1) sed (1) sendEmail (1) sh stub (1) shortcuts Windows sql developer Oracle (1) sidebar (1) silicon (1) smells (1) smtp (1) software development (1) software procurement (1) sofware (1) sort (1) sql script (1) sql_dev (1) sqlcmd (1) sqlite (1) sqlite3 (1) sshd (1) sshd cygwin (1) stackoverflow (1) stored procedure (1) stub (1) stupidity (1) subroutines (1) svn (1) sysinternals (1) system design (1) tail (1) tar (1) temp table (1) templates (1) teradata (1) terminal (1) test (1) testing (1) theory (1) thorium (1) time (1) tip (1) title (1) tmux .tmux.conf configuration (1) tmux efficiency bash (1) tool (1) ui code prototyping tips and tricks (1) umask Linux Unix bash file permissions chmod (1) url (1) urls (1) user (1) utility (1) utils (1) vb (1) vbox virtual box cheat sheet (1) vim perl regex bash search for string (1) vim recursively hacks (1) vim starter (1) vim-cheat-sheet vim cheat-sheet (1) vimeo (1) visual stuio (1) warsaw (1) wiki (1) wikipedia (1) window (1) windows 7 (1) windows 8 (1) windows programs (1) windows reinstall (1) windows utility batch perl space Windows::Clipboard (1) wisdoms (1) workflow (1) worth-reading (1) wrapper (1) xp_cmdshell (1) xslt (1) youtube (1)

Blog Archive

Translate with Google Translate

My Blog List