Converting Edifact to XML Using Java - Sample Implementation

Here is a sample implementation of Java implementation of converting from Edifact format to XML and vice versa. Conversion from XML to Edifact is straight forward while the opposite is not. Great thing is that this code will work irrespective of how many messages are there at any level.
You can download(for educational purpose only) this implementation here.
For comments pl email me at ddn.job --at-the-rate g-mail.com.

Here is the description of how the attachment is composed and code created:

-------------------------------------------------------------------
Directory: DB
This contains formatted file containing necessary information for converting from Edifact to XML
and vice versa
CODELT: Coded data elements
COMPT: Composite data elements
ELEMT: Simple elements
SEGMT: Segment descriptions
These have been generated by the perl formatting programs in PerlDBCreate. These files' contents are from
UN 2001B directory and from the 2001B service directory and code lists. These need to be downloaded
separately from the unece.org and gefeg.com websites for PerlDBCreate inputs.
---------------------------------------------------------------
Directory: PerlDBCreate
This contains perl formatting programs especially changed for Y2001B directories.
For different directories create new programs in new directory and let the main perl program
BuildEdifactDB.pl call the programs in it.
When BuildEdifactDB.pl is run it creates the files in DB directory which will act as input
for the programs in Parser directory.
---------------------------------------------------------------------
Directory: Parser
This contains all the source to:
1) Load edifact infomation in data structures (src\BuildEdifactDirectory)
2) Format Edifact to XML (src)
A) Parse the input Edifact document
B) Convert into XML
3) Format XML to Edifact (src\XMLtoEdifactConversion)
For Format Edifact to XML (2) the starting class is Main.java.
It first defines the Edifact message structure in terms of trees/nodes and child/parents.
Please be very careful because debugging will be difficult if any link is invalid or broken.
The it calls BuildEdifactDirectory to load the Edifact data structures.
Next it reads the inputs file and parses it with the parser. If unexpected input is seen then
it emits an error.
It should be noted that the output XML document looks like this:
<?xml version="1.0" encoding="UTF-8"?>
<root>
<segment name='interchange.header'>
<composite name='syntax.identifier'>
<element name='syntax.identifier'>UNOA</element>
<element name='syntax.version.number'>3</element>
</composite>
<composite name='interchange.sender'>
<element name='interchange.sender.identification'>5400141000009</element>
<element name='identification.code.qualifier' uncl="Not Found">14</element>
</composite>
........
If the element is UNCL/UNSL the uncl attribute will contain the code list description.
If not description is found then it'll contain "Not Found"
Although all odd elements are coded but I'm not sure whether the code list description of
all such odd elements will be found. I've tried to ask this question from UN but they could not
clarify it.
Groups always start with <group> and end with </group> tag
Also I've taken care to convert all the xml reserved characters to & equivalents so that
no problem will arise.
-------------------------------------------------------------------------------
Directory: Parser/XML
Contains the XML DTD and XSD of output xml file generated by parser for validation.
-------------------------------------------------------------------------------
Directory: "Edifact e-mail conversations"
These mail exchanges contain some of my Edifact queries and answers if any. At this time of leaving I'm clear about
90% of Edifact.
-------------------------------------------------------------------------------
Directory : EDI_Sample
This I'd received from Abhijit and I was running my code on this input only. I've already created the tree
structure for this input only. However these input/doc are not correct and are partial only.
The word doc describing the *.edi input file does not correlate with the input. So correct file needs to be given.
----------------------------------------------------------------------------------
Directory: SampleOutput
Contains the output generated from the input *.edi file present in the EDI_Sample directory mentioned above.
Just like input edifact file, this file is unformatted one. This software will not generated formatted xml because
when formatting preceding/trailing blank spaces may be added/removed. But Edifact allows only trailing blanks spaces
to be removed. This will create problem when converting formatted XML document back to Edifact.
-----------------------------------------------------------------------------------
File: Parser\src\BuildEdifactDirectory\EdifactConstants.java
No constant has been hardcoded except for in EdifactConstants.java. For example if non default segment separator is
used in Edifact then it must be changed in this file. All hard codings must be done only in this file.

---------------------------------------------------------------------------------------
Process to Run ( Only for Edifact to XML)
1) Download the required Edifact directories
2) Create a new directory( say 2002C) name in PerlDBCreate and copy all the programs in 2001B
3) Change all the programs so that all the elementes are correctly extracted in all the files as
discussed in DB directory above
4) Create the files as in DB directory and update their parent directory in EdifactConstants.DATABASE_PATH
constant
4) Create correct parse tree describing the Edifact format in Main.java. Note that we can describe
any sort of tree so the edifact file can contain even multiple messages to any level. However groups
in Edifact file must be implicit(default) ones as in the sample input file given. Explicit group
handling needs to be added.
5) Review EdifactConstants.java file for Edifact constants
6) Change the input Edifact file path in EdifactFile class
7) Execute Main.java
---------------------------------------------------------------------------------------
Other Issues
1) This software is not optimized for production use. For example there are some place where I've created new String where
StringBuffer should have been used for faster manipulation.
2) Also the MessageParser's errors when non-matching input needs to be made useful/meaningful messages.
3) This software in no way does any sort of Edifact format-verification.
---------------------------------------------------------------------------------------

SUGGESTIONS
1) Use XMLSpy/XMLPad etc to xml editing and manipulation
2) For generating PDF documents use the only standard XML-FO and don't use the non-standard itext library.
3) For xml-fo formatter download the free apache executable

How to Get Forum Change Alerts by Email

I've a couple of forums(Mybb and PHPBB) but for new forums we are always quite eager to respond/moderate new posts. I searched all options so that in case of new posts I get notified automatically. I even tried http://www.Watchthatpage.com but did not work out.
I was wasting lot of time in visiting my forums for new posts. Ultimately I've written a php script which is executed by crontab every hour on my web hosting. This is a crude custom made script and I'm sure it'll not work with your forum. But you can make similar to this. It's a grate relief for me now! I get an email alert whenever there is new post!

How I'm doing is after reading the html code of page, I trim some content based on regular expression. Then I convert to text using html2text class and again I trim some content based on regular expression.
We need to remove any current times at least.

Download class.html2text.inc from here.
License : As per GNU GPL.

<?php
if(!checkruntime()) //don't run in the night times
{
exit(0); //not a time to run
}
require_once('class.html2text.inc');
define ('MYBB','mybb');
define ('PG', 'pg');
define ('EC', 'emile-coue');
$sites = array(
PG => array("creditcardpaymentgateways.in"),
MYBB => array("indianworkingwoman.org","indiaconsumercomplaints.org"),
EC => array("emile-coue.org"),
);
//Applied in html. This part is RETAINED
$reghtmlRetained = array(
EC => array('{<table.*?</table>}si'),
);
//This is applied in the text. This part is removed
$reg = array(

MYBB => array('/Current time:.*?\b[AP]M\b/i',
'/^.*Latest posts\s+Topic/s',
'/\s+Most views\s+.*/s',
'/[0-9][0-9][:-][0-9][0-9]/',
'/Today|Yesterday/',
),
PG=> array('/It is currently.*?\b[ap]m\b/i',
//'/[?]sid=[0-9a-z]+/i',
'/sid=[0-9a-z]+(#p[0-9]+)?/i',
'/[*] Delete all board cookies .*/s'

),
EC=> array('/It is currently.*?\b[ap]m\b/i',
//'/[?]sid=[0-9a-z]+/i',
'/sid=[0-9a-z]+(#p[0-9]+)?/i',
'/\s+Who Is Online\s+.*/s',
'/Discuss about any auto suggestion methods, their comparison.*/s',

)
);

chdir('/home/premg/www/nov/all/forumcomp');
foreach($sites as $key =>$sitearr)
{
foreach($sitearr as $site)
{
$site1 = "http://forum.$site";
$ch = curl_init();
$timeout = 5;
curl_setopt($ch,CURLOPT_URL,$site1);
curl_setopt($ch,CURLOPT_RETURNTRANSFER,1);
curl_setopt($ch,CURLOPT_CONNECTTIMEOUT,$timeout);
curl_setopt($ch,CURLOPT_USERAGENT,'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.1.13) Gecko/20080311 Firefox/2.0.0.13');
$data = curl_exec($ch);
curl_close($ch);
$content = $data;

assert(strlen($content)>500);


if(isset($reghtmlRetained[$key]))
{
foreach($reghtmlRetained[$key] as $pat)
{
//print "$content\n";
$matches = array();
$ret = preg_match_all($pat,$content,$matches,PREG_SET_ORDER);
assert($ret > 0);

$content = "";

for($i=0;$i<$ret;++$i)
{
$content .= $matches[$i][0];
}
}
}

$h2t = new html2text($content);
$content = $h2t->get_text();

if(isset($reg[$key]))
{
foreach($reg[$key] as $pat)
{
$content = preg_replace($pat,'',$content);
// print "new pat strlen=".strlen($content)."\n";
}
}

//get the old content
$oldtext = file_get_contents($site);

if($oldtext != $content) //send email
{
send_email('preggup189456@gmail.com', $site);
//now write this new content

//rename the old one to .old
$tofile = "$site.old.txt";
unlink($tofile);
rename("$site", $tofile );

assert(file_put_contents($site, $content));

}

}

}
function send_email($email,$site)
{
print "sending email for $site ...\n";
$subject = "Content $site changed";
$body = "Click <a href=\"http://forum.$site\">here</a> to see.";
mail($email,$subject,$body);
return;
}

function checkruntime()
{
$dt = (gmdate("Hi"));
$hr = (int)($dt/100);
$min = gmdate("Hi") - $hr*100;

$hr += $min/60.0;

//convert to indian time
$hr += 5.5;

if($hr > 23)
{
$hr = $hr - 24;
}

if( ($hr >= 0 and $hr < 7) or (int)$hr == 23 )
{
return false;
}
else
{
return true;
}
}

Copy Directory Structure using Perl utility

Do you have a directory and want to create a replica of the directory structure but without it's file contents? Then this is the utility that let you do it.



#!/usr/bin/perl -w
use strict;

use File::Find;
use File::Path;

my %files;

#CORRECT USAGE
#my $ROOT_DIR="F:/NOT TO BE BACKED UP";
#my $RELATIVE_PATH_UNDER_ROOT_DIR="INSTALL";      #That is I want the directory structure of $ROOT_DIR/$RELATIVE_PATH_UNDER_ROOT_DIR created new at $NEW_ROOT/$RELATIVE_PATH_UNDER_ROOT_DIR
#my $NEW_ROOT="F:/Anurag";

my $ROOT_DIR="F:/STATIC/Anurag";
my $RELATIVE_PATH_UNDER_ROOT_DIR="personal";      #That is I want the directory structure of $ROOT_DIR/$RELATIVE_PATH_UNDER_ROOT_DIR created new at $NEW_ROOT/$RELATIVE_PATH_UNDER_ROOT_DIR
my $NEW_ROOT="F:/Anurag";


sub mySub
{

        my $dir=$File::Find::dir;
       
        $dir=~s{^$ROOT_DIR}{$NEW_ROOT};
       
$files{$dir}++};

sub loadFiles {


       
find( \&mySub, "$ROOT_DIR/$RELATIVE_PATH_UNDER_ROOT_DIR");    #custom subroutine find, parse $dir

}





die "$NEW_ROOT is not directory"  if( ! -d  $NEW_ROOT);

die "$ROOT_DIR/$RELATIVE_PATH_UNDER_ROOT_DIR is not directory" if ( ! -d "$ROOT_DIR/$RELATIVE_PATH_UNDER_ROOT_DIR" );

loadFiles();

my $dirs = keys %files;
my $created=0;


foreach my $key (keys %files)
{
if( ! -d $key)
{
   
    if( scalar( mkpath($key)) <= 0)   #Add error checking here
    {
        print STDERR "Failed to create directory: $key!\n";
    }
    else
    {
        ++$created;
    }
}

   
}

#map { print "$_\n"; } sort keys %files;



print "Total dirs created=$created out of $dirs","\n";

Backlink Checker - Check Your Existing Backlinks with Perl Script

If you have a list of url's which contains backlinks to your single site and you want to know the complete statistics of how many total backlinks exist, pages exist, total dofollow links, total nofollow links etc, then you can use this small perl script to do just that.

Input

A file containing single url on each line make sure that it contains no empty lines, partial url's etc. How this script takes care of empty lines which don't contain urls

Website url which you want to check for. All the url's in the input file are expected to contain backlink to your site mentioned in this.

To mention these two options define them here:

my $url_to_check="http://www.indiacustomercare.com";
my $file_containing_backlinks= "<m:/anurag/tmp/197B.txt";

Output

A sample shortened output looks like:

Out of 13792 links total unique=13752 and total duplicate=40
Printing STATS
Total Existing web pages, but containing no link to your site => 5
Total existing Web Page URLs which you purchased(which may/may not contain backlinks to your site) => 9
Total found backlinks to your site(multiple backlinks to your site in the same web page are counted as 1) => 4
Total web pages urls which you had purchased and exist no more(may have disappeared later) => 4
 
PRINTING VERBOSE REPORT
 
--------------------------------------------------
Existing Web Page URLs which you purchased(which may/may not contain backlinks to your site)
--------------------------------------------------
1) http://dinnerwareforsale.net/blue-floral
2) http://nike-adidas-puma.com/how-to-constructively-criticize-a-friends-fashion-sense
3) http://blog.avlmoving.com/2010/07/packing-for-the-road
4) http://64kbyte.homeip.net/wordpress/?p=74
5) http://livingwell.wellness-studio1.com/2011/03/11/watch-watch-me-tone-week-215
6) http://iphone-case.org/iphone_news/apple/iphone-4-dissed-by-consumer-reports
7) http://iphone-case.org/iphone_news/new/%E2%98%BAnew-limera1n-jailbreak-4-2-1-untethered-iphone-4-3gs-ipod-touch-4g-3g-ipad%E2%98%BA
8) http://www.watchmenfansite.com/door-speakers
9) http://www.a-ressaca.com/?p=663
 
--------------------------------------------------
List of existing web pages which you purchased, but not containing ANY backlinks to your site
--------------------------------------------------
1) http://64kbyte.homeip.net/wordpress/?p=74
2) http://blog.avlmoving.com/2010/07/packing-for-the-road
3) http://livingwell.wellness-studio1.com/2011/03/11/watch-watch-me-tone-week-215
4) http://nike-adidas-puma.com/how-to-constructively-criticize-a-friends-fashion-sense
5) http://www.watchmenfansite.com/door-speakers
 
--------------------------------------------------
List of existing web pages which you purchased, containing atleast one backlink to your site(with nofollow/dofollow)
--------------------------------------------------
1) http://dinnerwareforsale.net/blue-floral
2) http://iphone-case.org/iphone_news/apple/iphone-4-dissed-by-consumer-reports
3) http://iphone-case.org/iphone_news/new/%E2%98%BAnew-limera1n-jailbreak-4-2-1-untethered-iphone-4-3gs-ipod-touch-4g-3g-ipad%E2%98%BA
4) http://www.a-ressaca.com/?p=663
 
--------------------------------------------------
Report of backlinks to your site from an existing web page link which you purchased
--------------------------------------------------
1) http://64kbyte.homeip.net/wordpress/?p=74  valid links=0  nofollow=0  dofollow=0
2) http://blog.avlmoving.com/2010/07/packing-for-the-road  valid links=0  nofollow=0  dofollow=0
3) http://dinnerwareforsale.net/blue-floral  valid links=1  nofollow=1  dofollow=0
4) http://iphone-case.org/iphone_news/apple/iphone-4-dissed-by-consumer-reports  valid links=1  nofollow=1  dofollow=0
5) http://iphone-case.org/iphone_news/new/%E2%98%BAnew-limera1n-jailbreak-4-2-1-untethered-iphone-4-3gs-ipod-touch-4g-3g-ipad%E2%98%BA  valid links=1  nofollow=1  dofollow=0
6) http://livingwell.wellness-studio1.com/2011/03/11/watch-watch-me-tone-week-215  valid links=0  nofollow=0  dofollow=0
7) http://nike-adidas-puma.com/how-to-constructively-criticize-a-friends-fashion-sense  valid links=0  nofollow=0  dofollow=0
8) http://www.a-ressaca.com/?p=663  valid links=1  nofollow=1  dofollow=0
9) http://www.watchmenfansite.com/door-speakers  valid links=0  nofollow=0  dofollow=0
 
--------------------------------------------------
Those web pages urls which you had purchased and exist no more(with error codes)
--------------------------------------------------
1) [500] ->  http://www.luvrulz.com/perfume-3-4
2) [500] ->  http://www.onthehookfishing.com/fishing-nets
3) [500] ->  http://www.onthehookfishing.com/making-fishing-lures-spinners
4) [500] ->  http://www.shopping-servant.com/index.php/2011/03/my-first-colour-shape-snap

How to Run

Save this script in myscript.pl and run it like: perl myscript.pl > outfile.txt

It shows current url sequence no/total urls and time left in minutes:

processing 1/13752 time left in min=0

processing 2/13752 time left in min=3437.5

processing 3/13752 time left in min=2367.88333333333

processing 4/13752 time left in min=1833.06666666667

The Perl Script

#!/usr/bin/perl -w
#This code automatically picks and formats all address from the company url only and not from any files.
use strict;

#@Author Anurag Gupta
#@License GNU GPL License
use LWP::UserAgent;
use HTML::Element;
use HTML::TreeBuilder;
sub trim($) {
my $string = shift;
$string =~ s/^\s+//;
$string =~ s/\s+$//;
return $string;
}
my %links; #map of each link to array(no of valid links, no of nofollow)
my $url_to_check="http://www.indiacustomercare.com";
my $file_containing_backlinks= "<m:/anurag/tmp/197B.txt";
$url_to_check=~s{/$}{};  #strip the last /
$url_to_check=lc($url_to_check); #change to lower case
 
my @links;
{
my $FP;
open $FP, $file_containing_backlinks or die "Failed to open the input links file";
#open $FP, "<f:/tmp/links.txt";

(@links)=(<$FP>);

}
map { chomp; $_=trim($_); }  @links;
@links=grep {m{/};} @links;
my @unique= keys %{{map {$_=>1} @links}};

print "Out of ",scalar(@links)," links total unique=",scalar(@unique)," and total duplicate=",$#links-$#unique,"\n";

@links = @unique;
my $i=0;

my %logdata;
my %longlogdata; #The data containing lot of information
my @nonexistingpages;

my $starttime=time;
foreach my $link (@links)
{
my $currtime=time;

my $timeleft= (($currtime-$starttime)/($i+1)*(scalar(@links)-($i+1)));


#=last if($i==1000);
++$i;
print STDERR "processing $i/",scalar(@links)," time left in min=",$timeleft/60,"\n";

my $agent = LWP::UserAgent->new(env_proxy => 1,keep_alive => 1, timeout => 30, agent => "Mozilla/4.76 [en] (Win98; U)");
my $header = HTTP::Request->new(GET => $link);
my $request = HTTP::Request->new('GET', $link, $header);
my $response = $agent->request($request);

if ($response->is_success){

my $content = $response->decoded_content;
my $root = HTML::TreeBuilder->new_from_content($content);
$root->warn(1);

my @info=(0,0);

traversehtml($root,\@info);

$links{$link}=\@info;

push @{$longlogdata{"Existing Web Page URLs which you purchased(which may/may not contain backlinks to your site)"}},$link;

}
else
{
#print $response->code."\n";
push @{$longlogdata{"Those web pages urls which you had purchased and exist no more(with error codes)"}},"[".$response->code."] ->  $link\n"; 

++$logdata{"Total web pages urls which you had purchased and exist no more(may have disappeared later)"};


}
}
if( ! exists $longlogdata{"Existing Web Page URLs which you purchased(which may/may not contain backlinks to your site)"} )
{
die "No existing pages were found to be accessible!";
}

foreach my $link ( sort @{$longlogdata{"Existing Web Page URLs which you purchased(which may/may not contain backlinks to your site)"}})
{
my @info =   @{$links{$link}};

my $dofollow = $info[0]-$info[1];

push @{$longlogdata{"Report of backlinks to your site from an existing web page link which you purchased"}}, "$link  valid links=$info[0]  nofollow=$info[1]  dofollow=$dofollow\n";

++$logdata{"Total existing Web Page URLs which you purchased(which may/may not contain backlinks to your site)"};

if($info[0]>0)
{
++$logdata{"Total found backlinks to your site(multiple backlinks to your site in the same web page are counted as 1)"};
push @{$longlogdata{"List of existing web pages which you purchased, containing atleast one backlink to your site(with nofollow/dofollow)"}},$link;
}
else
{
++$logdata{"Total Existing web pages, but containing no link to your site"};
push @{$longlogdata{"List of existing web pages which you purchased, but not containing ANY backlinks to your site"}},$link;
}

if($dofollow>0)
{
++$logdata{"Total dofollow links to your site(multiple dofollow backlinks to your site in the same web page are counted as 1)"};
push @{$longlogdata{"List of existing web pages which you purchased, containing DOFOLLOW links to your site"}},$link;
}
}

print "Printing STATS\n";

map { print "$_ => $logdata{$_}\n\n" } sort keys %logdata;


print "\n\nPRINTING VERBOSE REPORT\n";


foreach my $key (sort keys %longlogdata)
{

print "\n\n\n","-" x50,"\n";
print "$key\n";
print "-" x50,"\n";
my $i=0;
foreach my $item (@{$longlogdata{$key}})
{
++$i;
print "\t$i) $item\n";
}

}


sub traversehtml
{
my $node=$_[0];
my $info=$_[1];


if(ref(\$node) eq "SCALAR")
{
return;
}
elsif ( ($node->tag() eq "a"))
{
my $href=$node->attr('href');
if( $href and $href=~m{^$url_to_check}i) #defined
{
++$info->[0];

my $rel=$node->attr("rel");

if($rel and (lc($rel) =~m{\bnofollow\b}))
{
++$info->[1]; 
}
}
}

my @h = $node->content_list();

foreach my $item (@h)
{

if(ref(\$item) ne "SCALAR")  {traversehtml($item,$info); } #skip scalar items
} 



}

Sort HTML Tables rows using perl script

Do you have a table and you want to quickly sort it based on first cell values?
This script does just that.

Input:

1. File containing only table elements ( remove everything else)
2. First column must be serial number so this will be ignored and only second column will be compared rest all also will be ignored

The Perl Script

#Mandatory: first column must be serial number so this will be ignored and only second column will be compared rest all also will be ignored
#Also keep only tables in the html file

#This assumes
# any html file containing tables which may have tbody. But th must be used to denote the culumn header.
use strict;
use feature "switch";

use Common;

use HTML::Element;

use HTML::TreeBuilder;

my $filename="F:/tmp/t1.html";

my $reverse=1;

my $toc;

sub autoincrement
{

my $table=$_[0];

#see if tboday is present
my @children=$table->content_list();

foreach my $item (@children)
{
if($item->tag() eq "tbody")
{
$table = $item;
last;
}

}




my @unsortedrows = grep { $_->tag() eq "tr" and (($_->content_list())[0]->tag() eq "td")} $table->content_list();

my @sortedrows = sort { uc(($a->content_list())[1]->as_trimmed_text()) cmp uc(($b->content_list())[1]->as_trimmed_text())} @unsortedrows;

@sortedrows = reverse @sortedrows if $reverse;


my $parent=$sortedrows[0]->parent();

for(my $i=0;$i<@unsortedrows;++$i)
{
$unsortedrows[$i]->detach();

}


for(my $i=0;$i<@sortedrows;++$i)
{
$parent->push_content($sortedrows[$i]);
}



}

die "File $filename not found" if !-r $filename;

my $tree = HTML::TreeBuilder->new();

$tree->parse_file($filename);


my @h = $tree->content_list();


my @all_elements=$h[1]->content_list();

foreach my $item (@all_elements)
{

autoincrement($item) if ref(\$item) ne "SCALAR" and $item->tag() eq "table";

}


my @list1=$tree->content_list();

my @list2=$list1[1]->content_list();

foreach my $table (@list2)
{
print $table->as_HTML();
}

# Finally:

 

Autoincrement an html table serial numbers using Perl script

This perl script will append a new column along with the table with each row serial number incrementing from 1.

Input: 1) A file containing single table. This should not be further nested one and also should not contain colspan or rowspan

Script:

#!/usr/bin/perl -w

#This assumes

# any html file containing tables which may have tbody. This code only adds single column and does not change anything else.

use strict;

use feature "switch";

use Common;

use HTML::Element;

use HTML::TreeBuilder;

my $filename="F:/tmp/t1.html";

my $toc;

sub autoincrement

{

my $table=$_[0];



#see if tboday is present

my @children=$table->content_list();



foreach my $item (@children)

{

if($item->tag() eq "tbody")

{

$table = $item;

last;

}



}







my @rows = grep { $_->tag() eq "tr" } $table->content_list();



#First row is header row

my HTML::Element $th = HTML::Element->new('th');

$th->push_content("SNo.");

$rows[0]->unshift_content($th);

for(my $i=1;$i<@rows;++$i)

{

my HTML::Element $td = HTML::Element->new('td');

$td->push_content($i);

$rows[$i]->unshift_content($td);



}







}

die "File $filename not found" if !-r $filename;

my $tree = HTML::TreeBuilder->new();



$tree->parse_file($filename);





my @h = $tree->content_list();





my @all_elements=$h[1]->content_list();



foreach my $item (@all_elements)

{



autoincrement($item) if ref(\$item) ne "SCALAR" and $item->tag() eq "table";



}





my @list1=$tree->content_list();



my @list2=$list1[1]->content_list();



foreach my $table (@list2)

{

print $table->as_HTML();

}



# Finally:

 

TOC HTML Generator in Perl - Build Table of Content for your web page

I've searched on Internet any program/script which would automatically generate me a TOC for my html code which I need for all pages of a new website: India customer care. See a sample page whose TOC has been generated using this script.

What I found on the internet

1. Codeproject HTML TOC Generator
   This did not seem to work. Even though I correctly inserted "INSERT contents" it was giving some error. It only worked partially.
2. A perl TOC GeneratorBut with the following issues:
   
   • Does not use DOM to parse or generate (means it just uses some tricks to read html)
     
   • Did not work when I tried
     
   • Had listed it's own limitations
     
3. one zzee company selling TOC generator costing $20. Since it's an executable, forget customizing it.
   

My Solution

My Needs

Each of my web page will consist of only single H1 tag which will be same as page title because of SEO reasons. Remaining of my page will consist of H2-H7 tags and I want a TOC generated for the page for those H2-H7 tags. I don't want any TOC generator which automatically replaces any previous TOC, since if I'd added any customizations it'd lose that.

My Perl Script TOC Generator

Limitations

• It'd ignore any H1 tags in the HTML page.
  
• The h2-h7 titles must be only in the following fomat:
  
  • <h2>Title abc</h2>
  • <h2><a ...>Title abc</h2>
  • It must not be in the format: <h2>Title<a ..>abc</a></h2>. That is h2 must not contain any html tag inside except of single a tag which must enclose full h2 text and not partially.

How to run it

Change the $filename to point to the desired file

How it works

Please see it does not modify the input file but prints out the new file content! It always dumps TOC in the beginning and remaining web page with inserted name tags without touching anything else. TOC contains nested UL's depending on H2-H7 nesting. So you'll need to copy paste the TOC html code in the desired location.

• If it's a new code never generated by this script
  
  • It generates TOC followed by web page with name= tags inserted within h tags
• If it's already processed code by this script
  
  • Beyond what it does above it, updates/deletes the old name tags.

Testing

I've tested with CSE HTML Validator and it's generating correct syntax code. Pl. see that my test code starts with a div tag only and not <html> since my site is on a CMS.

Does not work with your HTML code?

It happened with me then I found out that the input html file was not in correct syntax, one closing div was missing.

How Output TOC looks(I'm providing a sample!)

• Andhra Pradesh
  
  • Koti
    
  • Secunderabad
    
  • Vijaywada
    
  • Visakhapatnam
    
• Assam
  
  • Chatribari Road-Guwahati
    
  • Dibrugarh
    
  • Guwahati
    
• Bihar
  
  • Patna
    

Code

#!/usr/bin/perl -w

#Copyright anurag gupta ; free to use under GNU GPL License

use strict;

use feature "switch";

use Common;

use HTML::Element;

use HTML::TreeBuilder;

#"F:/anurag/work/indiacustomercare/airtel/recharge.html";

my $filename="F:/tmp/t9.html";

my $index=0;

my $labelprefix="anu555ltg-";

my $tocIndex=100001;

my $toc;

my @stack;

my $prevHtag="h2";

sub hTagEncountered($)

{

    my $hTag=shift;

    

    my $currLevel=(split //, $hTag)[1];

    

    given($hTag)

    {

        when(/h1/)

        {

           break; 

        }

        default{

            my $countCurr= (split /h/,$hTag)[1];

            my $countPrev= (split /h/,$prevHtag)[1];

            

            

            

            if($countCurr>$countPrev)

            {

                push @stack,($currLevel);

                $toc.="<ul>";

            }

            elsif($countCurr<$countPrev)

            {

                # Now check in the stack

                

                while ( @stack and $currLevel < $stack[$#stack])

                {

                    pop @stack;

                    $toc.="</ul>";

                }

            }

        }

        

    }

    

    $prevHtag=$hTag;

}

sub getLabel

{

my $name=$labelprefix.++$tocIndex;

}

sub traversehtml

{

    my $node=$_[0];

   # $node->dump();

   # print "-----------------\n";

   # print $node->tag()."\n";

   

  #  print ref($node),"->\n";

    

    if((ref(\$node) ne "SCALAR" )and ($node->tag() =~m/^h[2-7]$/i))  #it's an H Element!

    {

        

        my @h = $node->content_list();

        

        if(@h==1 and ref(\$h[0]) eq "SCALAR")  #H1 contains simple string and nothing else

        {

                    hTagEncountered($node->tag());

                           

                    my $label=getLabel();

                    

                    my $a = HTML::Element->new('a', name => $label);

                    

                    my $text=$node->as_trimmed_text();

                    

                    $a->push_content($text);

                    

                    $node->delete_content();

                    

                    $text=HTML::Entities::encode_entities($text);

                    

                    $node->push_content($a);

                    $toc.=<<EOF;

                    <li><a href="#$label">$text</a>

EOF

        }

        elsif (  @h==1 and ($h[0]->tag() eq "a"))   # <h1><a href="abc.com">ttt</a></h1> case

            {

                #See if any previous label already exists

               

                my $prevlabel = $h[0]->attr("name");

                

                

                $h[0]->attr("name",undef) if(defined($prevlabel) and $prevlabel=~m/$labelprefix/); #delete previous name tag if any

                

                #set the new label

                my $label=getLabel();

                

                $h[0]->attr("name",$label);

                

                hTagEncountered($node->tag());

                my $text=HTML::Entities::encode_entities($node->as_trimmed_text());

                $toc.=<<EOF;

                <li><a href="#$label">$text</a>

EOF

                

            }

        elsif (@h>1)  #<h1>some text here<a href="abc.com">ttt</a></h1> case

        {

           die "h1 must not contain any html elements";

        

        }

    

    }

    my @h = $node->content_list();

    

    foreach my $item (@h)

    {

       

       if(ref(\$item) ne "SCALAR")  {traversehtml($item); } #skip scalar items

    }

    

    

}

   die "File $filename not found" if !-r $filename;

    my $tree = HTML::TreeBuilder->new();

    

    $tree->parse_file($filename);

    

    

    my @h = $tree->content_list();

    

    traversehtml($h[1]);

    

    while(pop @stack)

    {

        $toc.="</ul>";

    }

    

    $toc="<ul>$toc</ul>";

    

    print qq{<div id="icctoc"><h2>TOC</h2>$toc</div>};

    

    my @list1=$tree->content_list();

    

    my @list2=$list1[1]->content_list();

    

for(my $i=0;$i<@list2;++$i){

    if(ref(\$list2[$i]) eq "SCALAR")

       {

        print $list2[$i]

       }

    else{

    print $list2[$i]->as_HTML();

    }

  

    

    }

        # Finally: