How to Get XML From Database – Simple Perl Script

Although Perl is relatively old programming language and there should be plenty of reference available online – I still find it challenging to write something new in Perl because of it’s unusual syntax and many ways of doing the same thing.
Here is a simple script to get XML from database.

#!/opt/perl-5.8.8/bin/perl -T
BEGIN {
  $ENV{'SYBASE'}='/export/home/sybase/clients-mssql/current';
  $ENV{'LANG'}='C'
}
use lib "/export/home/sybase/clients-mssql/current/perl";
use Sybase::DBlib;
####################################################
use strict;
use warnings;
use Template;
use Carp;
use CGI qw(param); #will use it for getting params from URL query string
use HTML::Entities ();
####################################################
my($ini)="db_web.ini"; #will need it for out db connection
my($user, $pswd, $dbname, $server, $string);
$string=&GetParam($ini); #get db params from ini file
($user, $pswd, $dbname, $server)=split(/:/, $string);

my($db)=Sybase::DBlib->new($user, $pswd, $server,DBSETLCHARSET('UTF-8'));
#the trick with charset from previous post
my($dbstatus)=$db->dbuse($dbname);
my ($query);
$query = new CGI;

my $cmd;
my(%arr,@field_name_list,$field_name);
my @data;
my $i=0;
print "Content-type: text/xml\n\n";
print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>";
print '<xml>';

@field_name_list=(
'accession',
'first_name',
'last_name',
'project_id',
'affiliation','description',
'ext_id','url',
'reported_url',
'supporting_count');
$cmd='exec GetArticlesByID \''.$query->param('article_id').'\';';
$db->dbcmd($cmd);
$db->dbsqlexec;
print '<articles>';
while ($db->dbresults() != NO_MORE_RESULTS) {
	while (%arr = $db->dbnextrow(1)) {
		print '<article>';
		&PrintXML;
		print '</article>';
	}
}
print '</articles>';	

@field_name_list=('id',
'email',
'body',
'num_views',
'ip',
'article_name');
$cmd='exec GetCommentsByArticle \''.$query->param('article_id').'\';';
$db->dbcmd($cmd);
$db->dbsqlexec;
print '<comments>';
while ($db->dbresults() != NO_MORE_RESULTS) {
	while (%arr = $db->dbnextrow(1)) {
		print '<comment>';
		&PrintXML;
		print '</comment>';
	}
}
print '</comments>';	

print '</xml>';
#################
sub GetParam {
  my($file)=@_;
  my($line, $u, $p, $serv, $data, $tag, $value, $ret);
  open(FIN, $file)||croak "Can't open $file...\n";
  while($line=){
    chomp($line);
    if($line =~ /^\;/){next;}
    if($line =~ /=/){
      ($tag, $value)=split(/=/, $line);
      $tag=~s/\s+//;
      $value=~s/^\s+//;
      if($tag eq "dbserver_read"){
        $serv=$value;
      }
      elsif($tag eq "dbname"){
        $data=$value;
      }
      elsif($tag eq "cgi_pub_user"){
        $u=$value;
      }
      elsif($tag eq "cgi_pub_pwd"){
        $p=$value;
      }
    else{next;}
    }
  }
  close FIN;
  $ret="${u}:${p}:${data}:${serv}";
  return("$ret");
}

sub ConvertEntities {
	my ($str)=@_;
	$str=~s/\/>/g if defined $str;
	$str=~s/\&(?![a-z]+;)/&/g if defined $str;
	return ($str);
}

sub SeparateCommasWithSpace {
	my ($str)=@_;
	$str=~s/,/, /g if defined $str;
	return ($str);
}

sub PrintXML {
	foreach my $field_name (@field_name_list) {
		if (defined($arr{$field_name})) {
			$arr{$field_name}=&ConvertEntities($arr{$field_name});
			print '<'.$field_name.'>'.$arr{$field_name}.'</'.$field_name.'>';
		}
		else {
		}
	}
}
sub PrintFieldsInXML {
	foreach my $field_name (@{$_[1]}) {
		if (defined($_[0]{$field_name})) {
			$_[0]{$field_name}=&ConvertEntities($_[0]{$field_name});
			print '<'.$field_name.'>'.$_[0]{$field_name}.'</'.$field_name.'>';
        }
		else {
		}
	}
}

I used two subroutines which take array of filed names and result of database query row by row and print it to xml file. Database parameters are taken from ini file.

Author: Azat

Techies, entrepreneur, 20+ years in tech/IT/software/web development expert: NodeJS, JavaScript, MongoDB, Ruby on Rails, PHP, SQL, HTML, CSS. 500 Startups (batch Fall 2011) alumnus. http://azat.co http://github.com/azat-co

One thought on “How to Get XML From Database – Simple Perl Script”

Leave a Reply

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.