I have the issue with when I execute the Perl code below.
I have uploaded 6.7.2 parser.pm, but it’s not working with 7.3.1, same thing working with 6.7.2. You have any idea about on this please asap.
Error:-
mismatched tag at line 30, column 4, byte 924 at
\Autonomy\TeamSite\iw-perl\vendor\lib/XML/Parser.pm line 187. Please find the script below..
When I verified the content_UI log, its showing the below error
[Fri Apr 12 16:01:43 2013] [error] [client 10.138.134.66] mismatched tag at line 30, column 4, byte 924 at
\\Autonomy\\TeamSite\\iw-perl\\vendor\\lib/XML/Parser.pm line 187\r, referer:
http://10.245.8.151/iw-cc/iw-bin/wdpro_menu.ipl/cmf_import_rates.ipl[Fri Apr 12 16:01:43 2013] [error] [client 10.138.134.66] , referer:
http://10.245.8.151/iw-cc/iw-bin/wdpro_menu.ipl/cmf_import_rates.ipl[Fri Apr 12 16:13:49 2013] [error] [client 10.138.134.66] \r
[Fri Apr 12 16:13:49 2013] [error] [client 10.138.134.66] mismatched tag at line 30, column 4, byte 924 at
\\Autonomy\\TeamSite\\iw-perl\\vendor\\lib/XML/Parser.pm line 187\r
BEGIN { use TeamSite::Config;
my $iwhome = TeamSite::Config::iwgethome();
push
@INC,"$iwhome\\custom\\";
push
@INC,"Y:\\custom\\";
}
# need any of these ????
use CMF::Common qw(:all);
use TeamSite::CGI_lite;
use TeamSite::Config;
use DBI;
use
use CMF::IntRatesDatabase qw(:all);
use Win32API::Net;
#
my $iwhome = GetIWHome;
$| = 1; # When running as a CGI, you need to turn off output buffering
# first, identify current environment/workarea
my $cgi = TeamSite::CGI_lite->new();
$cgi->parse_data();
# first, sets up $file_directory (workarea/reference_data/rates path)
my $area_path = $cgi->{'form'}{'area_path'};
my $file_directory = "unset";
if ($area_path =~ /reference_data\rates$/)
{
$file_directory = $area_path;
} else {
$file_directory = $area_path . "\\reference_data\\rates";
}
print "Content-type: text/html\n\n";
print<<"END";
Import Interest Rates
<SCRIPT LANGUAGE=SCRIPT LANGUAGE=\"JavaScript\">
</SCRIPT>
END
# Connect to the database ...... You need to do this before the call to the cgi->form action statement
# because it will not run if the user has clicked on the form submit.
$dbh = DBConnect($data_source, $db_user, $db_pwd);
# now start serious processing ......
if ($cgi->{form}{action} ne 'done') # first time in, i.e first screen
{
initialscreen();
DBDisConnect();
} else { # action = 'done', ie second screen
# n.b $file_directory was able to be set up earlier as, though 'area_path' not standard part of form
# on second call, it has been deliberately passed through as a hidden field
my $holdprods = $cgi->{'form'}{'Products'};
my
@prodsArray =
@$holdprods;
my $tempprodid = "";
my
@listprodids = ();
# my
@prodids = ();
# my
@prodids2 = ();
if (length($holdprods) eq 0)
{
print "
No Products were selected for import.";
goto setbutton;
}
print "
The following Products have been updated in your current work area's '\\reference_data\\rates':";
# first, build two copies of arrays of ProdIds to enable an associative array to be built
my $numinarray =
@$holdprods;
if ($numinarray > 0)
{
foreach $prodname(
@prodsArray) {
$firstunderscore = index($prodname, "_");
$tempprodid = substr($prodname, 0, $firstunderscore);
push(
@listprodids, $tempprodid);
# push(
@prodids2, $tempprodid);
}
} else {
$firstunderscore = index($holdprods, "_");
$tempprodid = substr($holdprods, 0, $firstunderscore);
push(
@listprodids, $tempprodid);
# push(
@prodids2, $tempprodid);
}
# now, build into the associative array (easier to search file ProdID against select Prodids)
#
@listprodids {
@prodids} =
@prodids2;
#while(($a, $b)=each %listprodids) {print "$a=>$b,"};
foreach $prodid (
@listprodids) {
# next, read through all files in workarea, and delete any with a matching Product ID (match to slected ids)
# loop round array - processing each product id in turn
my $errmessage = "";
# $errmessage = deletefiles ();
$errmessage = deletefiles ($prodid);
if ($errmessage ne "")
{
print "Error: delete of old interest rates failed, press 'OK' to 'cancel'";
print "
" . $errmessage;
# goto setbutton;
}
# finally, reimport all files for selected Prodids from database (file system for TEST).
# $errmessage = reimportfiles ();
$errmessage = reimportfiles ($prodid);
if ($errmessage ne "")
{
print "Error: import of latest interest rates failed, press 'OK' to 'cancel'";
print "
" . $errmessage;
# goto setbutton;
}
}
# after processing: display back list of updated products & display 'OK' (close) button
if ($numinarray > 0)
{
foreach $prodname2 (
@prodsArray) {
$firstunderscore = index($prodname2, "_");
$tempprodid = substr($prodname2, $firstunderscore + 1);
print "
Product: " . $tempprodid;
}
} else {
$firstunderscore = index($holdprods, "_");
$tempprodid = substr($holdprods, $firstunderscore + 1);
print "
Product: " . $tempprodid;
}
if ($numinarray > 0)
{
foreach $prodname(
@prodsArray) {
$firstunderscore = index($prodname, "_");
$tempprodid = substr($prodname, 0, $firstunderscore);
push(
@listprodids, $tempprodid);
# push(
@prodids2, $tempprodid);
}
} else {
$firstunderscore = index($holdprods, "_");
$tempprodid = substr($holdprods, 0, $firstunderscore);
push(
@listprodids, $tempprodid);
# push(
@prodids2, $tempprodid);
}
setbutton:
print "
\n"; # START OF TABLE CONTAINING BUTTONS print "| |
\n"; print "\n";
print "\n"; print "\n"; print "
\n";
DBDisConnect();
exit;
}
# ---------------------------- start of sub-routines
# end of processing part, start of initial set_up
sub initialscreen
{
# first get the list of unique product names
@UniqueProductList = GetFullUniqueList ();
print "
Please Select the Products you require:\n";
print "\n";
#print "\n";
print "\n";
print "\n";
print "\n";
foreach $entry (
@UniqueProductList) {
my ($prodid, $prodname, $launchid, $file) = (${$entry}{id}, ${$entry}{name},${$entry}{launch_id},${$entry}{filename});
my $tempname = $prodid . "_" . $prodname;
# print "" . $prodname . "\n";
print "" . $launchid . ": " . $prodname . "\n";
}
print "";
print "
\n"; # START OF TABLE CONTAINING BUTTONS print "| |
\n"; print "\n";
print "\n"; print "\n"; print "\n"; print "
\n";
print "";
print<<"END";
END
}
sub deletefiles
{
my ($idtodelete) =
@_;
# print "to delete " . $idtodelete;
# amended Version 4 - added \\ & $idtodelete to file directory in fulldirectory & used this variable
my $fulldirectory = $file_directory . "\\" . $idtodelete;
# print "
delete full path: " . $fulldirectory;
opendir(TheDocFiles, $fulldirectory);
@Allfiles = readdir(TheDocFiles);
closedir(TheDocFiles);
my $fullpath = "";
my $count = 0;
my $response = "";
foreach $Name (
@Allfiles){ if (-d $Name) {next} # name is for a directory, not a file
# 1. identify ProductID of file
$firstunderscore = index($Name, "_");
$fileprodid = substr($Name, 0, $firstunderscore);
# 2. check if prod id matches any of ids in
@listprodids # if ($listprodids{"$fileprodid"})
if ($fileprodid eq $idtodelete)
{
# print "match found " . $fileprodid;
# amended version 4 - delete from fulldirectory, not filedirectory
$fullpath = $fulldirectory . "\\" . $Name;
$count = unlink ("$fullpath");
if ($count == 0)
{
$response = $! . " for Product: " . $Name;
return $response;
}
}
}
return $response;
}
sub reimportfiles
{
# expect several different sets of data (each for a different 'effective_from' date) for each product
my ($idtoimport) =
@_;
#print "import";
# get the list of product filenames/xml from the database
# returned as a 'list' of entries, each entry being a hash_array, in a $variable
@SpecificProductDetailsList = GetSpecificProductList($idtoimport);
my $response = "";
use File::Copy; # required ?
# for each $entry in list (which is hash array of filename, xml), split out filename & data
foreach $entry (
@SpecificProductDetailsList) {
my ($file, $data) = (${$entry}{filename}, ${$entry}{xml});
#create new file .. $file_directory has basic path to workarea, concatenate $file onto end for full path/filename
my $fullpathonly = $file_directory . "\\" . $idtoimport;
mkdir $fullpathonly,1;
# replace any "/" with underscores (late change (May 2003) for some IRMS Products)
$file =~ s|/|_|go;
# next line amended for version 4, add extra \\ & idtoimport
$fullfileandpath = $file_directory . "\\" . $idtoimport . "\\" . $file . ".xml";
$fullfileandpath =~ s|\\|/|go;
# replace spaces with underscores as failsafe so Workflows can put the data live
$fullfileandpath =~ s| |_|go;
# print "
import full file/path = " . $fullfileandpath;
if (-e $fullfileandpath){print "
oops, file " . $fullfileandpath . " already exists";}
# create file and write to it
open(writenewfile, ">$fullfileandpath");
# remove xml declaration
$data =~ s/.*\?>//;
# wrap tag around xml
print writenewfile "" . $data . "";
close(writenewfile);
# then populate with data and save, set $response to errmsg if problem
}
return $response
}
# --------------- end of sub-routines
exit;
