Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

babug_prg's scratchpad

by babug_prg (Friar)
on Sep 28, 2006 at 13:51 UTC ( #575354=scratchpad: print w/ replies, xml ) Need Help??

################################################################### # + # # Project Name : ErrorLog Creation Tool (ErrorLog.pm) + # # Version : 1.0 # # Developed : ArulkumaraN .A # # Guided : Vengadesan .P # # Completed : 25-Sep-2008 # + # # ################################################################### ###################################################################### +###### # # Please See the Documentation.... # ###################################################################### +###### package EasyQC::ErrorLog; use File::Basename; use Win32::OLE; use Win32; BEGIN { Win32::LoadLibrary("comctl32.dll") } use Win32::TieRegistry(Delimiter=>"/"); use Tie::IxHash; use URI::Escape; use strict; use 5.006; use warnings; our(@ISA, @EXPORT, $VERSION); require Exporter; @ISA = qw(Exporter); @EXPORT = qw(CreateErrorLog AddErrWarn GetLineCol GetLineCol1 ParseXML + CreateErrorLogfromParseContent GetErrorsFromParseContent CreateError +LogfromTxtLog ExitSub AddLabel AddSubLabel ErrorReturn CreateErrorLog +4ErrorReturn HtmlTableValidate OpenFile1 SaveFile1 AddFolderErr GetEd +itorInfo); $VERSION = "1.0"; my $linkcount=0; #------------------------------------------------------------------ ##### Usage : used to open file with single input mode ##### Syntax : OpenFile(<filewithpath>) ##### Output : return filecontent,filepath, filenamewithoutextenti +on sub OpenFile1 { ExitSub("File path required for OpenFile") if(not defined(@_) or n +ot defined($_[0])); ExitSub("File path required for OpenFile") if($_[0] eq ""); my $Noothers=0; my $flpath=shift; ExitSub("$flpath file not found") if(not -f $flpath); open(OPEN,"$flpath") or ExitSub("Unable to open $flpath"); my $flcontent=do {local $/;<OPEN>}; close OPEN; my $fname=basename("$flpath"); my $fpath=dirname("$flpath"); $fname=~s/^(.*)\.[^\.]*$/$1/i; #my ($fpath,$fname)=$flpath=~m/^(.*)[\\\/]([^\\\/]*)(?:\.[^\.\\\/] ++)$/i; $fpath=~s/\//\\/g; return $flcontent; } #------------------------------------------------------------------ #------------------------------------------------------------------ ##### Usage : used to save file ##### Syntax : SaveFile(<filewithpath>,<filecontent>) ##### Output : save file in given path sub SaveFile1 { ExitSub("File path required for SaveFile") if(not defined(@_) or n +ot defined($_[0])); ExitSub("File path required for SaveFile") if($_[0] eq ""); my $flpath=shift; ExitSub("File Content required for SaveFile") if(not defined(@_) o +r not defined($_[0])); ExitSub("File Content required for SaveFile") if($_[0] eq ""); my $flcontent=shift; open(OUT,">$flpath") or ExitSub("Unable to create $flpath"); print OUT $flcontent; close OUT; return 1; } #------------------------------------------------------------------ sub CreateErrorLog { my ($FileFullName, $Title, $Errors, $Warns, $tmNwEr1, $tmNwEr2) = +@_; my $openex="1"; $openex="0" if ($FileFullName=~s/\[NoOpen\]$//i); my @months=('January','February','March','April','May','June','Jul +y','August','September','October','November','December'); my ($sec,$min,$hour,$day,$month,$yr19,@rest) = localtime(time); my $time=sprintf("%02d",$hour).":".sprintf("%02d",$min).":".sprint +f("%02d",$sec); my $date= "$day $months[$month] ".($yr19+1900); my ($FatErr,$CMS,$FEcount,$CMScount)=("","",0,0); #eval {SetIEActivexEnable();}; eval {SetIEActivexEnable();}; if($@ ne "") { print "Unable to remove IE block\n"; } my $Fname = basename($FileFullName); my $Path = dirname($FileFullName); my $Content=<<HTMLOUT; <html><head><title>$Title</title></head> <script language="javascript"> function OpenApp(shelltxt) { var path = unescape(document.location); if(!(shelltxt.substr(1,1)==":" || shelltxt.substr(0,2)=="\ +\\\\\\\" || shelltxt.substr(0,2)=="//")) { var rootpath=path.substring(0,path.lastIndexOf('/')); + if(shelltxt.substr(0,1)=="\\\\" || shelltxt.substr(0,1 +)=="/") { shelltxt=shelltxt.substring(1); } if( rootpath.substring(0,8) == 'file:///') { rootpath= +rootpath.replace('file:///',''); } else { rootpath=rootpath.replac +e('file:',''); } rootpath=rootpath.replace(/\\//g,'\\\\'); shelltxt = rootpath + '\\\\' + shelltxt; } var myshell=new ActiveXObject("WScript.Shell"); myshell.Run("uedit32.exe \\""+shelltxt+"\\""); } </script> <body> <center><table border="0" width="90%" style="WORD-BREAK:BREAK- +ALL;"> <tr bgcolor="#C0C5B4"><td align="center"><font color="brown" s +ize="4" face="Arial black">Integra Software Services Pvt. Ltd.</font> +<br><font color="#373C2F" size="3" face="Arial"><b>Pondicherry, INDIA +.</b></font></td></tr> <tr><td> <p><br><font size="3" face="Verdana"><b>$Title</b></font> <br><br><table width="60%" border="1" cellpadding="3" cell +spacing="0"> <tr><th width="30%"/><th/></tr +> <tr><td>Customer</td><td><font + size="2" color="darkblue" face="Verdana">INTEGRA</font></td></tr> <tr><td>Project Name</td><td>< +font size="2" color="darkblue" face="Verdana">$Title</font></td></tr> <tr><td>File Name</td><td><fon +t size="2" color="darkblue" face="Verdana">$Fname</font></td></tr> <tr><td>Location</td><td><font + size="2" color="darkblue" face="Verdana">$Path</font></td></tr> <tr><td>Time</td><td><font siz +e="2" color="darkblue" face="Verdana">$time</font></td></tr> <tr><td>Date</td><td><font siz +e="2" color="darkblue" face="Verdana">$date</font></td></tr> </table> </td></tr> <tr><td><br></td></tr> <tr><td> [ERRORWARNINGHERE] </td></tr> </table></center> <hr size="3"> <center><font size="1" face="Verdana" color="blue">Copyright & +copy; 2005. All Rights Reserved. Integra Software Services, Pvt. Ltd. + INDIA.</font><br></center> </body> </html> HTMLOUT my $ErrWarnTxt=""; if(defined($tmNwEr1) and $tmNwEr1 ne "") { if($tmNwEr1=~s/^Fatal\://i) { $FatErr=$tmNwEr1; } elsif($tmNwEr1=~s/^CMS\://i) { $CMS=$tmNwEr1; } } if(defined($tmNwEr2) and $tmNwEr2 ne "") { if($tmNwEr2=~s/^Fatal\://i) { $FatErr=$tmNwEr2; } elsif($tmNwEr2=~s/^CMS\://i) { $CMS=$tmNwEr2; } } my $tmperrcount=WordCount($Errors,'<li>'); my $tmpwarncount=WordCount($Warns,'<li>'); $FEcount=WordCount($FatErr,'<li>') if($FatErr ne ""); $CMScount=WordCount($CMS,'<li>') if($CMS ne ""); $Errors=RemoveDuplication($Errors) if($Errors ne ""); $Warns=RemoveDuplication($Warns) if($Warns ne ""); $FatErr=RemoveDuplication($FatErr) if($FatErr ne ""); $CMS=RemoveDuplication($CMS) if($CMS ne ""); if($FatErr ne "") { $ErrWarnTxt.=FatErrfn($FatErr,$FEcount); } if($Errors ne "" and $Warns ne "") { $ErrWarnTxt.=Errors($Errors,$tmperrcount); $ErrWarnTxt.=Warns($Warns,$tmpwarncount); } elsif($Errors ne "") { $ErrWarnTxt.=Errors($Errors,$tmperrcount); $ErrWarnTxt.='<tr bgcolor="#C0C5B4"><td><font size="3" face="V +erdana" color="darkbrown"><b>Warnings:</b></font></td></tr><tr><td><f +ont size="2" color="green" face="Verdana">&nbsp;&nbsp;No warnings!!!< +/font></td></tr>'; } elsif($Warns ne "") { $ErrWarnTxt.='<tr bgcolor="#C0C5B4"><td><font size="3" face="V +erdana" color="darkbrown"><b>Errors:</b></font></td></tr><tr><td><fon +t size="2" color="green" face="Verdana">&nbsp;&nbsp;No Errors!!!</fon +t></td></tr>'; $ErrWarnTxt.=Warns($Warns,$tmpwarncount); } else { if($FatErr eq "" and $CMS eq "") { $ErrWarnTxt='<tr bgcolor="#C0C5B4"><td align="center"><fon +t size="5" face="Arial Black" color="green">File '."$Fname".' Error F +ree!!!</font></td></tr>'; } } if($CMS ne "") { $ErrWarnTxt.=CMSfn($CMS,$CMScount); } $ErrWarnTxt=~s/<li>(?:(?!<li>|<\/li>).)+<\/li>/AddLinks($&)/ige; $Content=~s/\[ERRORWARNINGHERE\]/$ErrWarnTxt/is; $FileFullName=~s/[\\\/]/\\\\/g; $Content=~s/FILENAMEHERE/$FileFullName/g; $Fname=~s/^(.*)\..*?$/$1/; $Path=~s/[\\\/]$//; my $removeablePath=$Path; $removeablePath=~s/[\\\/]/\\/g; $Content=~s/( href=\"|OpenApp\(\")\Q$removeablePath\E\\?\\?/$1/ig; $removeablePath=~s/\\/\\\\/g; $Content=~s/( href=\"|OpenApp\(\")\Q$removeablePath\E\\?\\?/$1/ig; #$Content=~s/\" \"\Q$removeablePath\E\\?\\?/\" \"/ig; $Content=~s/(\'OpenApp\(\"([^\"\'\]\)\\\/]*)\/[0-9]+\/[0-9]+\"\)\' +>)Edit<\/a>\]/$1$2<\/a>\]/ig; $Content=~s/(\'OpenApp\(\"[^\"\'\]\)]*[\\\/]([^\\\/\"]*)\/[0-9]+\/ +[0-9]+\"\)\'>)Edit<\/a>\]/$1$2<\/a>\]/ig; open(OUTFILE, ">$Path/$Fname\_err\.htm") or die "Unable to create +validation file"; print OUTFILE $Content; close OUTFILE; if ($openex eq "1") { my $ie; Win32::OLE::CreateObject("InternetExplorer.Application.1", $ie +) || die "CreateObject:$!"; $ie->{Visible} = 1; $ie->Navigate("$Path\\$Fname\_err\.htm"); } return; } sub CreateErrorLog4ErrorReturn { my ($FileFullName, $Title, $Errors) = @_; my $openex="1"; $openex="0" if ($FileFullName=~s/\[NoOpen\]$//i); my $customer="INTEGRA"; if($Title=~m/^ePub /i and $Title=~m/\#customer:\#.*?\#/i) { if($Title=~s/\#customer:\#(.*?)\#//i) { $customer=uc($1) if($1 ne "" and lc($1) ne "others"); } } my @months=('January','February','March','April','May','June','Jul +y','August','September','October','November','December'); my ($sec,$min,$hour,$day,$month,$yr19,@rest) = localtime(time); my $time=sprintf("%02d",$hour).":".sprintf("%02d",$min).":".sprint +f("%02d",$sec); my $date= "$day $months[$month] ".($yr19+1900); #my $openex=1; eval {SetIEActivexEnable();}; if($@ ne "") { print "Unable to remove IE block\n"; } my $Fname = basename($FileFullName); my $Path = dirname($FileFullName); $Errors=~s/<li>(?:(?!<li>|<\/li>).)+<\/li>/AddLinks($&)/ige; my $Content=<<HTMLOUT; <html><head><title>$Title</title></head> <script language="javascript"> function OpenApp(shelltxt) { var path = unescape(document.location); if(!(shelltxt.substr(1,1)==":" || shelltxt.substr(0,2)=="\ +\\\\\\\" || shelltxt.substr(0,2)=="//")) { var rootpath=path.substring(0,path.lastIndexOf('/')); + if(shelltxt.substr(0,1)=="\\\\" || shelltxt.substr(0,1 +)=="/") { shelltxt=shelltxt.substring(1); } if( rootpath.substring(0,8) == 'file:///') { rootpath= +rootpath.replace('file:///',''); } else { rootpath=rootpath.replac +e('file:',''); } rootpath=rootpath.replace(/\\//g,'\\\\'); shelltxt = rootpath + '\\\\' + shelltxt; } var myshell=new ActiveXObject("WScript.Shell"); myshell.Run("uedit32.exe \\""+shelltxt+"\\""); } </script> <body> <center><table border="0" width="90%" style="WORD-BREAK:BREAK- +ALL;"> <tr bgcolor="#7C9ACB"><td align="center"><font color="brown" s +ize="4" face="Arial black">Integra Software Services Pvt. Ltd.</font> +<br><font color="#373C2F" size="3" face="Arial"><b>Pondicherry, INDIA +.</b></font></td></tr> <tr><td> <p><br><font size="3" face="Verdana"><b>$Title</b></font> <br><br><table width="60%" border="1" cellpadding="3" cell +spacing="0"> <tr><th width="30%"/><th/></tr +> <tr><td>Customer</td><td><font + size="2" color="darkblue" face="Verdana">$customer</font></td></tr> <tr><td>Project Name</td><td>< +font size="2" color="darkblue" face="Verdana">$Title</font></td></tr> <tr><td>File Name</td><td><fon +t size="2" color="darkblue" face="Verdana">$Fname</font></td></tr> <tr><td>Location</td><td><font + size="2" color="darkblue" face="Verdana">$Path</font></td></tr> <tr><td>Time</td><td><font siz +e="2" color="darkblue" face="Verdana">$time</font></td></tr> <tr><td>Date</td><td><font siz +e="2" color="darkblue" face="Verdana">$date</font></td></tr> </table> </td></tr> <tr><td><br></td></tr> <tr><td> $Errors </td></tr> </table></center> <hr size="3"> <center><font size="1" face="Verdana" color="blue">Copyright & +copy; Integra Software Services Private Limited 2004</font><br></cent +er> </body> </html> HTMLOUT $Fname=~s/^(.*)\..*?$/$1/; $Path=~s/[\\\/]$//; my $removeablePath=$Path; $removeablePath=~s/[\\\/]/\\/g; $Content=~s/( href=\"|OpenApp\(\")\Q$removeablePath\E\\?\\?/$1/ig; $removeablePath=~s/\\/\\\\/g; $Content=~s/( href=\"|OpenApp\(\")\Q$removeablePath\E\\?\\?/$1/ig; $Content=~s/(\'OpenApp\(\"([^\"\'\]\)\\\/]*)\/[0-9]+\/[0-9]+\"\)\' +>)Edit<\/a>\]/$1$2<\/a>\]/ig; $Content=~s/(\'OpenApp\(\"[^\"\'\]\)]*[\\\/]([^\\\/\"]*)\/[0-9]+\/ +[0-9]+\"\)\'>)Edit<\/a>\]/$1$2<\/a>\]/ig; open(OUTFILE, ">$Path/$Fname\_err\.htm") or die "Unable to create +validation file"; print OUTFILE $Content; close OUTFILE; if ($openex eq "1") { my $ie; Win32::OLE::CreateObject("InternetExplorer.Application.1", $ie +) || die "CreateObject:$!"; $ie->{Visible} = 1; $ie->Navigate("$Path\\$Fname\_err\.htm"); } return; } sub ErrorReturn { my $Errors=shift; my $tmperrcount=WordCount($Errors,'<li>'); my $tmperrcount1=""; $Errors=RemoveDuplication($Errors) if($Errors ne ""); ($tmperrcount1, $Errors)=ErrorsRtn($Errors,$tmperrcount); return ($tmperrcount, $tmperrcount1, $Errors); } sub AddLinks { my $tmlkn=shift; $linkcount++; $tmlkn=~s/<li>/<li id="$linkcount">/i; $tmlkn=~s/ href="\#"/ href="\#$linkcount"/ig; return $tmlkn; } sub Errors { my $TmpErrs=shift; my $tmcount=shift; my $errcount=WordCount($TmpErrs,'<li>'); $TmpErrs='<tr bgcolor="#C0C5B4"><td><font size="3" face="Verdana" +color="darkbrown"><b>Errors: '."$errcount\($tmcount\)".'</b></font></ +td></tr><tr><td><font size="2" face="Verdana"><ol type="number">'.$Tm +pErrs.'</ol></font></td></tr>'; return $TmpErrs; } sub ErrorsRtn { my $TmpErrs=shift; my $tmcount=shift; my $errcount=WordCount($TmpErrs,'<li>'); $TmpErrs='<tr><td><font size="2" face="Verdana"><ol type="number"> +'.$TmpErrs.'</ol></font></td></tr>'; return $errcount,$TmpErrs; } sub Warns { my $TmpErrs=shift; my $tmcount=shift; my $errcount=WordCount($TmpErrs,'<li>'); $TmpErrs='<tr bgcolor="#C0C5B4"><td><font size="3" face="Verdana" +color="darkbrown"><b>Warnings: '."$errcount\($tmcount\)".'</b></font> +</td></tr><tr><td><font size="2" face="Verdana"><ol type="number">'.$ +TmpErrs.'</ol></font></td></tr>'; return $TmpErrs; } sub CMSfn { my $TmpErrs=shift; my $tmcount=shift; my $errcount=WordCount($TmpErrs,'<li>'); $TmpErrs='<tr bgcolor="#C0C5B4"><td><font size="3" face="Verdana" +color="darkbrown"><b>Check With Manuscript: '."$errcount\($tmcount\)" +.'</b></font></td></tr><tr><td><font size="2" face="Verdana"><ol type +="number">'.$TmpErrs.'</ol></font></td></tr>'; return $TmpErrs; } sub FatErrfn { my $TmpErrs=shift; my $tmcount=shift; my $errcount=WordCount($TmpErrs,'<li>'); $TmpErrs='<tr bgcolor="#C0C5B4"><td><font size="3" face="Verdana" +color="darkbrown"><b>Fatal Errors: '."$errcount\($tmcount\)".'</b></f +ont></td></tr><tr><td><font size="2" face="Verdana"><ol type="number" +>'.$TmpErrs.'</ol></font></td></tr>'; return $TmpErrs; } sub WordCount { my ($txt,$word)=@_; my $count=0; ++$count while($txt=~m/\Q$word\E/g); return $count; } sub GetEditorInfo { my $editor_info = "UE"; if(exists $Registry->{"LMachine/SOFTWARE/Microsoft/Windows/Current +Version/App Paths/UEDIT32.exe"}) { my $txt=$Registry->{"LMachine/SOFTWARE/Microsoft/Windows/Curre +ntVersion/App Paths/UEDIT32.exe"}; if(exists $Registry->{"LMachine/SOFTWARE/Microsoft/Windows/Cur +rentVersion/App Paths/UEDIT32.exe/Path"}) { $editor_info=$txt->GetValue("Path")."\\uedit32.exe"; $editor_info = "UE"; } else { $editor_info = $txt->GetValue(""); $editor_info = "UE"; } } elsif(exists $Registry->{"LMachine/SOFTWARE/Microsoft/Windows/Curr +entVersion/App Paths/notepad++.exe"}) { my $txt=$Registry->{"LMachine/SOFTWARE/Microsoft/Windows/Curre +ntVersion/App Paths/notepad++.exe"}; if(exists $Registry->{"LMachine/SOFTWARE/Microsoft/Windows/Cur +rentVersion/App Paths/notepad++.exe/Path"}) { $editor_info = $txt->GetValue("Path")."\\notepad++.exe"; $editor_info = "NP"; } else { $txt=$txt->GetValue(""); $editor_info = "NP"; } } return $editor_info; } sub SetIEActivexEnable1 { my $reg=$Registry->{"CUser/Software/Microsoft/Windows/CurrentVersi +on/Internet Settings/Zones/1/1201"}=[ pack("L",0), "REG_DWORD" ]; } sub SetIEActivexEnable { no warnings; my ($tmactivexsafe,$userie,$lclie,$lcle,$lclms,$lclwm)=("","",""," +","",""); my $reg=$Registry->{"CUser/Software/Microsoft/Windows/CurrentVersi +on/Internet Settings/Zones/1"}; $tmactivexsafe=hex($reg->GetValue("1201")); $reg->SetValue( "1201", pack("L",0), "REG_DWORD" ) if($tmactivexsa +fe ne "0"); if(exists $Registry->{"CUser/SOFTWARE/Microsoft/Internet Explorer/ +Main/FeatureControl/FEATURE_LOCALMACHINE_LOCKDOWN"}) { $reg=$Registry->{"CUser/SOFTWARE/Microsoft/Internet Explorer/M +ain/FeatureControl/FEATURE_LOCALMACHINE_LOCKDOWN"}; $userie=hex($reg->GetValue("iexplore.exe")); $reg->SetValue( "iexplore.exe", pack("L",0), "REG_DWORD" ) if( +$userie ne "0"); } else { $reg=$Registry->{"CUser/SOFTWARE/Microsoft/Internet Explorer/M +ain"}; $reg=$reg->CreateKey("FeatureControl/FEATURE_LOCALMACHINE_LOCK +DOWN"); $reg->SetValue( "iexplore.exe", pack("L",0), "REG_DWORD" ); } if(exists $Registry->{"LMachine/SOFTWARE/Microsoft/Internet Explor +er/Main/FeatureControl/FEATURE_LOCALMACHINE_LOCKDOWN"}) { $reg=$Registry->{"LMachine/SOFTWARE/Microsoft/Internet Explore +r/Main/FeatureControl/FEATURE_LOCALMACHINE_LOCKDOWN"}; $lclie=hex($reg->GetValue("iexplore.exe")); $lcle=hex($reg->GetValue("explorer.exe")); $lclms=hex($reg->GetValue("msimn.exe")); $lclwm=hex($reg->GetValue("wmplayer.exe")); $reg->SetValue( "iexplore.exe", pack("L",0), "REG_DWORD" ) if( +$lclie ne "0"); $reg->SetValue( "explorer.exe", pack("L",0), "REG_DWORD" ) if( +$lcle ne "0"); $reg->SetValue( "msimn.exe", pack("L",0), "REG_DWORD" ) if($lc +lms ne "0"); $reg->SetValue( "wmplayer.exe", pack("L",0), "REG_DWORD" ) if( +$lclwm ne "0"); } else { $reg=$Registry->{"LMachine/SOFTWARE/Microsoft/Internet Explore +r/Main"}; $reg=$reg->CreateKey("FeatureControl/FEATURE_LOCALMACHINE_LOCK +DOWN"); $reg->SetValue( "iexplore.exe", pack("L",0), "REG_DWORD" ); $reg->SetValue( "explorer.exe", pack("L",0), "REG_DWORD" ); $reg->SetValue( "msimn.exe", pack("L",0), "REG_DWORD" ); $reg->SetValue( "wmplayer.exe", pack("L",0), "REG_DWORD" ); } ### pubup-block disbled HKEY_LOCAL_MACHINE\Software\Microsoft\Inte +rnet Explorer\Main\FeatureControl\FEATURE_WEBOC_POPUPMANAGEMENT } sub AddFolderErr { my $tmmsg=shift; my $tmpath=shift; my $txt=""; if(-d $tmpath) { $txt="<li>$tmmsg\. \[<a href=\"$tmpath\">Open</a>\]</li>\n"; } else { $txt="<li>$tmmsg\.</li>\n"; } return $txt; } sub AddLabel { my $txt=shift; $txt="<tr bgcolor=\"#7C9ACB\"><td align=\"center\"><font size=\"3\ +" face=\"Verdana\" color=\"darkred\"><b>$txt</b></font></td></tr>\n<t +r><td/></tr>\n"; return $txt; } sub AddSubLabel { my $txt=shift; $txt="<tr bgcolor=\"#A4B9DB\"><td><font size=\"2\" face=\"Verdana\ +" color=\"darkblue\"><b>$txt</b></font></td></tr>\n<tr><td/></tr>\n"; return $txt; } sub AddSubSubLabel { my $txt=shift; $txt="<tr bgcolor=\"#C0C5B4\"><td><font size=\"2\" face=\"Verdana\ +" color=\"darkblue\">&nbsp;&nbsp;<b>$txt</b></font></td></tr>\n<tr><t +d/></tr>\n"; return $txt; } sub AddErrWarn { my ($txt,$line,$col,$tmfilename)=("",1,1,""); my ($line1,$col1,$tmfilename1)=(1,1,""); $txt=shift; $line=shift if(@_); $col=shift if(@_); $tmfilename=shift if(defined($_[0])); if(scalar(@_)==3) { $line1=shift if(@_); $col1=shift if(@_); $tmfilename1=shift if(defined($_[0])); } $txt=~s/&/&amp;/g; $txt=~s/</&lt;/g; $txt=~s/>/&gt;/g; $txt=~s/\s*\.?\s*$//; $txt=~s/&lt;(font color="[^\"]*")&gt;(.*?)&lt;\/font&gt;/<$1>$2<\/ +font>/ig; $txt="<li>$txt\. Line:<font color=\"red\">$line</font> Col:<font c +olor=\"red\">$col</font>\[<a href=\"#\" onclick='OpenApp(\"FILENAMEHE +RE/$line/$col\")'>Edit</a>\]</li>\n"; if($tmfilename ne "" and -f $tmfilename and $tmfilename1 ne "" and + -f $tmfilename1) { $tmfilename=~s/[\\\/]/\\\\/g; $tmfilename1=~s/[\\\/]/\\\\/g; $txt=~s/"FILENAMEHERE\/$line\/$col"/\"$tmfilename\/$line\/$col +\\\" \\\"$tmfilename1\/$line1\/$col1\"/; } elsif($tmfilename ne "" and -f $tmfilename) { $tmfilename=~s/[\\\/]/\\\\/g; $txt=~s/FILENAMEHERE/$tmfilename/; } return $txt; } sub RemoveDuplication { my $txt=shift; my %collect=(); tie %collect, "Tie::IxHash"; while($txt=~m/<li>(?:(?!<\/?li[ >]|$).)*<\/li>/ig) { my $tmtmptxt=$&; if($tmtmptxt=~m/<li>(.*?)\. (Line\:.*?)<\/li>/i) { if(!exists $collect{$1}) { $collect{$1}=$&; } else { $collect{$1}=substr($collect{$1},0,-5).", $2</li>"; } } else { $collect{$tmtmptxt}=$tmtmptxt; } } return join("\n",values %collect); } sub GetLineCol { my $tmtxt=shift; $tmtxt=~tr/\r/\n/; #$tmtxt=~s/\r/arul/g; my ($li,$cl)=(1,1); if($tmtxt=~m/\n/) { $li=$tmtxt=~tr/\n/\n/; my ($tmmt)=$tmtxt=~m/^.*\n([^\n]*)$/is; return $li+1,length($tmmt)+1; } else { return 1,length($tmtxt)+1; } } sub GetLineCol1 { my $tmtxt=shift; my ($li,$cl)=(1,1); if($tmtxt=~m/\n/) { $li=$tmtxt=~tr/\n/\n/; my ($tmmt)=$tmtxt=~m/^.*\n([^\n]*)$/is; return $li+1,length($tmmt)+1; } else { return 1,length($tmtxt)+1; } } ### txt error log to create online error log ### calling CreateErrorLogfromTxtLog(<log or txt...file with path>,<so +urce/xml file name>) sub CreateErrorLogfromTxtLog { if(scalar(@_) < 2 ) { Win32::MsgBox("Wrong no. of arguments TxtLog to ErrorLog",64," +ErrorLog"); return 1; } my $errfile=shift; my $xmlfile=shift; if(not -f "$errfile") { Win32::MsgBox("File $errfile not exist. please check",64,"Erro +rLog"); return 1; } if(not -f "$xmlfile") { Win32::MsgBox("File $xmlfile not exist. please check",64,"Erro +rLog"); return 1; } $xmlfile=~s/\//\\/g; my $tmpath=dirname($xmlfile); my $tmFileNoExt=basename($xmlfile); $tmFileNoExt=~s/^(.*)\..*?$//i; my ($tmErrors,$tmWarns,$tmCMS,$tmFErrs)=("","","",""); if(-f "$tmpath\\$tmFileNoExt\_err\.htm") { unlink "$tmpath\\$tmFileNoExt\_err\.htm"; } open(PARSE,"$errfile"); my $errContent = do{local $/; <PARSE>}; close PARSE; my $tmpTitle="Validation Tool"; $tmpTitle=$1 if($errContent=~m/(?: |\t)*(.*? Validation Tool) Ver( +?:sion)?/i); $tmpTitle=$1 if($errContent=~m/(?: |\t)*PROCESS(?: |\t)*\:(?: |\t) +*(.+?)\n/); # #if($errContent=~m/No\.? of Error\(?s?\)?(?: |\t)*\:(?: |\t)*0+\s +/i and $errContent=~m/No\.? of Fatal ?Error\(?s?\)?(?: |\t)*\:(?: |\t +)*0+\s/i and $errContent=~m/No\.? of Warning\(?s?\)?(?: |\t)*\:(?: |\ +t)*0+\s/i) # if($errContent=~m/(?:No\.?|Number) of Error\(?s?\)?(?: |\t)*\:(?: + |\t)*0+\s/i and $errContent=~m/(?:No\.?|Number) of Warning\(?s?\)?(? +: |\t)*\:(?: |\t)*0+\s/i) # { # if($errContent=~m/(?:No\.?|Number) of Fatal ?Err[or]*\(?s?\)? +/i and $errContent=~m/(?:No\.?|Number) of Check With Manuscript*\(?s? +\)?/i) # { # if($errContent=~m/(?:No\.?|Number) of Fatal ?Err[or]*\(?s +?\)?(?: |\t)*\:(?: |\t)*0+\s/i and $errContent=~m/(?:No\.?|Number) of + Check With Manuscript*\(?s?\)?(?: |\t)*\:(?: |\t)*0+\s/i) # { # CreateErrorLog("$xmlfile",$tmpTitle,"",""); # } # else # { # goto Cotu; # } # } # elsif($errContent=~m/(?:No\.?|Number) of Fatal ?Err[or]*\(?s? +\)?/i) # { # if($errContent=~m/(?:No\.?|Number) of Fatal ?Err[or]*\(?s +?\)?(?: |\t)*\:(?: |\t)*0+\s/i) # { # CreateErrorLog("$xmlfile",$tmpTitle,"",""); # } # else # { # goto Cotu; # } # } # elsif($errContent=~m/(?:No\.?|Number) of Check With Manuscrip +t*\(?s?\)?/i) # { # # if($errContent=~m/(?:No\.?|Number) of Check With Manuscri +pt*\(?s?\)?(?: |\t)*\:(?: |\t)*0+\s/i) # { # CreateErrorLog("$xmlfile",$tmpTitle,"",""); # } # else # { # goto Cotu; # } # } # else # { # CreateErrorLog("$xmlfile",$tmpTitle,"",""); # } # # } # #elsif($errContent=~m/No\.? of Error\(?s?\)?(?: |\t)*\:(?: |\t)*0 ++\s/i and $errContent!~m/No\.? of Fatal ?Error\(?s?\)?/i and $errCont +ent=~m/No\.? of Warning\(?s?\)?(?: |\t)*\:(?: |\t)*0+\s/i) # #{ # # CreateErrorLog("$xmlfile",$tmpTitle,"",""); # #} # else # { if($errContent!~m/(?:No\.?|Number) of (?:Err[or]*|War[nig]*|Fat[al +]* ?Err[or]*|Check With Manuscript)\(?s?\)?(?: |\t)*\:(?: |\t)*0*[1-9 +]/i) { #CreateErrorLog("$xmlfile",$tmpTitle,"",""); return 0; } else { $errContent=~s/[\n\r](?:\t| )*(line(?: no)?[\t ]*\:)/ $1/ig; $errContent=~s/\n\n+/\n/g; while($errContent=~m/^.*?$/igm) { my $tmerrContent=$&; my ($tmln,$tmcol)=(1,1); if($tmerrContent=~s/(\t| |\.|\:)line(?: ?no)?[\t ]*\:?[\t +]*([0-9]+)[\t ]+col[umn]*(?: ?no)?[\t ]*\:?[\t ]*([0-9]+)(?:\t| )*/$1 +/i) { ($tmln,$tmcol)=($2,$3); } if($tmerrContent=~m/^(?:\t| )*\(?[0-9]+\)?\.?[\t ]*(Err[or +]*|War[ning]*|Fatal ?Err[or]*|CMS)[\t ]*\:[\t ]*(.*?)$/i) { my ($etype,$econt)=($1,$2); $econt=~s/ *$//mg; $econt=~s/\. *\./\./g; if($etype=~m/Fat[al ]*Err[or]*/i) { $tmFErrs.=AddErrWarn($econt,$tmln,$tmcol); } elsif($etype=~m/Err[or]*/i) { $tmErrors.=AddErrWarn($econt,$tmln,$tmcol); } elsif($etype=~m/war/i) { $tmWarns.=AddErrWarn($econt,$tmln,$tmcol); } elsif($etype=~m/cms/i) { $tmCMS.=AddErrWarn($econt,$tmln,$tmcol); } } } if($tmErrors eq "" and $tmWarns eq "" and $tmFErrs eq "" and $ +tmCMS eq "") { Win32::MsgBox("Invalid error log format. Please Check inpu +t log",64,"ErrorLog"); return 1; } else { $tmCMS="CMS:$tmCMS" if($tmCMS ne ""); $tmFErrs="Fatal:$tmFErrs" if($tmFErrs ne ""); CreateErrorLog("$xmlfile",$tmpTitle,$tmErrors,$tmWarns,$tm +FErrs,$tmCMS); return 1; } } } ### parsed xml content to return Error list ### calling GetErrorsFromParseContent(<paredcontent>,<xmlfilenamewithp +ath>) sub GetErrorsFromParseContent { if(scalar(@_) < 2 ) { Win32::MsgBox("Wrong no. of arguments to create Error log for +Parse Content",64,"Parse Content"); return 1; } my $parseContent=shift; my $filename=shift; if($parseContent eq "") { Win32::MsgBox("Empty parse content found. Please check it",64, +"XML Parsing"); return ""; } $filename=~s/\//\\/g; my $Errors=""; if ($parseContent !~ m/\Q$filename\E is valid/i) { my $mytm="$filename"; $mytm=~s/\\/\//g; $parseContent=~s/^.*?\Q$mytm\E *//mgi; $parseContent=~s/ *(?:Fatal )?Error\: element content invalid\ +. *//ig; $parseContent=~s/ *(?:Fatal )?Error\: *//ig; $Errors.=AddErrWarn($3,$1,$2) while($parseContent=~m/^\[([0-9] ++)\:([0-9]+)\] \:(.*?)$/igm); return $Errors } else { return ""; } } ### parsed xml content to create error log ### calling CreateErrorLogfromParseContent(<parsedcontent>,<xmlfilenam +ewithpath>,<title>) sub CreateErrorLogfromParseContent { if(scalar(@_) < 3 ) { Win32::MsgBox("Wrong no. of arguments to create Error log for +Parse Content",64,"Parse Content"); return 1; } my $parseContent=shift; my $filename=shift; my $tmpTitle=shift; if($parseContent eq "") { Win32::MsgBox("Empty parse content found. Please check it",64, +"XML Parsing"); return 1; } $tmpTitle="XML Parsing" if ($tmpTitle eq ""); $filename=~s/\//\\/g; my $tmpath=dirname($filename); my $tmFileNoExt=basename($filename); $tmFileNoExt=~s/\.[^\.]*$//i; if(-f "$tmpath\\$tmFileNoExt\_err\.htm") { unlink "$tmpath\\$tmFileNoExt\_err\.htm"; } my $Errors=""; if ($parseContent !~ m/\Q$filename\E is valid/i) { my $mytm="$filename"; $mytm=~s/\\/\//g; $parseContent=~s/^.*?\Q$mytm\E *//mgi; $parseContent=~s/ *(?:Fatal )?Error\: element content invalid\ +. *//ig; $parseContent=~s/ *(?:Fatal )?Error\: *//ig; $Errors.=AddErrWarn($3,$1,$2) while($parseContent=~m/^\[([0-9] ++)\:([0-9]+)\] \:(.*?)$/igm); CreateErrorLog("$filename",$tmpTitle,$Errors,""); return 1; } else { if(-f "$tmpath\\$tmFileNoExt\_err\.htm") { unlink "$tmpath\\$tmFileNoExt\_err\.htm"; } return 0; } } ### parse xml file with xmlvalid.exe create error log ### calling ParseXML(<xmlfilewithpath>,<dtdwithpath>,<xmlvalidexewithp +ath>,<title>) sub ParseXML { if(scalar(@_) < 4 ) { Win32::MsgBox("Wrong no. of arguments in xml parsing",64,"XML +Parsing"); return 1; } my $file=shift; my $dtd=shift; my $xmlvalidpath=shift; my $tmpTitle=shift; if(not -f "$file") { Win32::MsgBox("Invalid or not exist file $file to parse. pleas +e check",64,"XML Parsing"); return 1; } if($dtd!~m/\.dtd$/i or not -f "$dtd") { Win32::MsgBox("Invalid or not exist dtd file $dtd to parse. pl +ease check",64,"XML Parsing"); return 1; } if($xmlvalidpath!~m/xmlvalid(?:\.exe)?$/i or not -f "$xmlvalidpath +") { Win32::MsgBox("Invalid or not exist xmlvalid.exe to parse. ple +ase check",64,"XML Parsing"); return 1; } $tmpTitle="XML Parsing" if ($tmpTitle eq ""); $file=~s/\//\\/g; my $tmpath=dirname($file); my $tmFileNoExt=basename($file); $tmFileNoExt=~s/\.[^\.]*$//i; if(-f "$tmpath\\$tmFileNoExt\_err\.htm") { unlink "$tmpath\\$tmFileNoExt\_err\.htm"; } my $tmp="\"$xmlvalidpath\" --dtd=\"$dtd\" \"$file\" >\"".dirname(" +$file")."\\parse_err.err\""; system($tmp); open(PARSE,dirname("$file")."\\parse_err.err"); my $parseFile = do{local $/; <PARSE>}; close PARSE; my $Errors=""; #unlink(dirname("$file")."\\parse_err.err"); if(not defined($parseFile) or $parseFile eq "") { Win32::MsgBox("Unable to parse file.",64,"XML Parsing"); return 1; } if ($parseFile !~ m/\Q$file\E is valid/i) { my $mytm="$file"; $mytm=~s/\\/\//g; $parseFile=~s/^\Q$mytm\E *//mgi; $parseFile=~s/ *(?:Fatal )?Error\: element content invalid\. * +//ig; $parseFile=~s/ *(?:Fatal )?Error\: *//ig; $Errors.=AddErrWarn($3,$1,$2) while($parseFile=~m/^\[([0-9]+)\ +:([0-9]+)\] \:(.*?)$/igm); $Errors.=AddErrWarn($4,$2,$3,$1) while($parseFile=~m/^((?:[a-z +]\:|\\\\|\/\/)(?:(?!\[[0-9]+\:[0-9]+\]|$).)*) \[([0-9]+)\:([0-9]+)\] +\:(.*?)$/igm); CreateErrorLog("$file",$tmpTitle,$Errors,""); return 1; } else { if(-f "$tmpath\\$tmFileNoExt\_err\.htm") { unlink "$tmpath\\$tmFileNoExt\_err\.htm"; } return 0; } } sub ExitSub { my $msg=shift; Win32::MsgBox($msg,64,"Quit"); exit; } # Check html table validation columns count sub HtmlTableValidate { my ($tmflwithpath,$pre,$tmtxt)=@_; my $tmpErr=""; #Row wise checking my @rows=$tmtxt=~m/(<tr(?: [^>\/]+)?>(?:(?!<\/?tr[ >]|$).)*<\/tr>| +<tr(?: [^>\/]+)?\/ *>)/isg; my %tblrows=(); my $rwi=1; foreach my $rw (@rows) { while($rw=~m/<t[dh](?: [^>]+)?>/ig) { my $tdtxt=$&; if($tdtxt=~m/ rowspan=/i and $tdtxt=~m/ colspan=/i) { my ($tmrwcnt)=$tdtxt=~m/ rowspan=[\'\"]([0-9]+)[\"\']/ +i; my ($tmcolcnt)=$tdtxt=~m/ colspan=[\'\"]([0-9]+)[\"\'] +/i; for(my $tmi=$rwi;$tmi<=($rwi+$tmrwcnt-1);$tmi++) { $tblrows{$tmi} += $tmcolcnt; } } elsif($tdtxt=~m/ rowspan=/i) { my ($tmrwcnt)=$tdtxt=~m/ rowspan=[\'\"]([0-9]+)[\"\']/ +i; for(my $tmi=$rwi;$tmi<=($rwi+$tmrwcnt-1);$tmi++) { $tblrows{$tmi} += 1; } } elsif($tdtxt=~m/ colspan=/i) { my ($tmcolcnt)=$tdtxt=~m/ colspan=[\'\"]([0-9]+)[\"\'] +/i; $tblrows{$rwi} += $tmcolcnt; } else { $tblrows{$rwi}++; } } $rwi++; } my %fintbl=(); foreach my $tmr (sort {$a <=>$b} keys %tblrows) { $fintbl{$tblrows{$tmr}}.="$tmr, "; } if(scalar(keys %fintbl)>1) { my $tdtxt=""; foreach my $tmr (sort {$a <=>$b} keys %fintbl) { $tdtxt.="<font color=\"green\">Row(s) ".substr($fintbl{$tm +r},0,-2)."</font> => <font color=\"green\">\"$tmr\"</font> columns, " +; } $tdtxt=substr($tdtxt,0,-2); $tmpErr.=AddErrWarn("Check table columns $tdtxt",GetLineCol("$ +pre"),"$tmflwithpath"); } return "$tmpErr"; } 1;
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (5)
As of 2014-07-13 16:39 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (250 votes), past polls