You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
tdevelop/languages/perl/perlparser.cpp

495 lines
15 KiB

/***************************************************************************
perlparser.cpp - description
-------------------
begin : Sun Nov 2 2003
copyright : (C) 2003 by luc
email : willems.luc(at)pandora.be
***************************************************************************/
/***************************************************************************
* *
* This program is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
***************************************************************************/
#include "perlparser.h"
#include <kdebug.h>
#include <tqfile.h>
#include <tqregexp.h>
#include <tqfileinfo.h>
perlparser::perlparser(TDevCore* core,CodeModel* model, TQString interpreter) {
m_core = core;
m_model = model;
m_interpreter=interpreter;
//get INC paths for current installed perl
getPerlINC();
}
perlparser::~perlparser(){
}
const TQStringList perlparser::UseFiles()
{
return m_usefiles;
}
void perlparser::initialParse() {
m_usefiles.clear();
}
void perlparser::parse(const TQString &fileName){
TQFile f(fileName);
if (!f.open(IO_ReadOnly))
return;
TQTextStream stream(&f);
TQStringList list;
TQString rawline;
while (!stream.eof()) {
rawline = stream.readLine();
list.append(rawline.stripWhiteSpace().local8Bit());
}
f.close();
kdDebug(9016) << "parsing " << fileName << endl;
m_file = m_model->create<FileModel>();
m_file->setName(fileName );
this->parseLines(&list,fileName);
m_model->addFile( m_file );
}
void perlparser::parseLines(TQStringList* lines,const TQString &fileName)
{
TQRegExp packagere("^[ \t]*package[ \t]+([+A-Za-z0-9_:]*).*\\;");
TQRegExp basere("^[ \t]*use[ \t]+base[ \t]*\\(\'*\"*([A-Za-z0-9_:]*)");
TQRegExp libre("^[ \t]*use[ \t]+lib[ \t]*\\(\'*\"*([A-Za-z0-9_:]*)");
TQRegExp usere("^[ \t]*use[ \t]+([+A-Za-z0-9_:]*).*\\;");
TQRegExp isare("^[ \t]*@ISA[ \t=qw\\(\'\"]*([A-Za-z0-9_: ]*)");
TQRegExp globalre("^[ \t]*our[ \t]+\\(*([ \t,$%@*+A-Za-z0-9_]*)\\)*.*");
TQRegExp myre("^[ \t]*my[ \t]+\\(*([ \t,$%@*+A-Za-z0-9_]*)\\)*.*");
TQRegExp subre("^[ \t]*sub[ \t]+([A-Za-z0-9_]+)([A-Za-z0-9_]|([ \t]*[{])?)$");
TQRegExp blessre("bless[ \t]*[\\( ]*([,$%@*+A-Za-z0-9_]*).*;");
TQRegExp namere("^[ \t]*([$%@*])([A-Za-z0-9_]*).*$");
TQRegExp privatere("^_([A-Za-z0-9_]*)");
TQRegExp startpod("^=[a-z0-9]+ [a-z0-9]*");
TQRegExp cutpod("^=cut");
TQString line;
//clear all "last" know things
m_lastsub="";
m_lastattr="";
m_inpackage = false;
m_inscript = false;
m_inclass=false;
m_lastscript=0;
m_lastpackage=0;
m_lastclass=0;
int lineNo = -1;
bool inpod = false;
bool endpod = false;
//check if we are parsing a script or module
TQFileInfo fi(fileName);
bool inscript =(fi.extension() == "pl");
kdDebug(9016) << "inscript : " << inscript << "," << fi.extension() << endl;
if (inscript) {
addScript(fileName,lineNo,fi.fileName());
}
for ( TQStringList::Iterator it = lines->begin(); it != lines->end(); ++it ) {
++lineNo;
line = (*it).local8Bit();
//empty line ?
if (line.isEmpty()) { continue;}
//some POD checking , quick and dirty but it seams to work
if(inpod && endpod) { inpod=false; endpod=false;}
//are we in pod documentation ?
if (startpod.search(line)>=0) {inpod=true; continue;}
//are we in pod documentation ?
if (inpod) { endpod=( cutpod.search(line)>=0 ); continue; }
//sub matching
if (subre.search(line)>=0){
TQString subname=subre.cap(1);
kdDebug(9016) << "subre match [" << subname << "]" << endl;
bool prive = privatere.search(subname) >= 0;
kdDebug(9016) << "prive match [" << prive << "]" << endl;
if (m_inscript) { addScriptSub(fileName,lineNo,subname,prive);}
else {
if (m_inclass) { addClassMethod(fileName,lineNo,subname,prive);}
else { addPackageSub(fileName,lineNo,subname,prive);}
}
continue;
} //sub
//our matching
if (globalre.search(line)>=0) {
//splitup multible ours
TQString varlist=globalre.cap(1);
kdDebug(9016) << "globalre match [" << varlist <<"]" << endl;
TQStringList vars=TQStringList::split(",",varlist);
for ( TQStringList::Iterator it = vars.begin(); it != vars.end(); ++it ) {
if (namere.search(*it)>=0) {
TQString var = namere.cap(2);
kdDebug(9016) << "namere match [" << var << "]" << endl;
if (m_lastpackage) { addAttributetoPackage(fileName,lineNo,var); }
else { addAttributetoScript(fileName,lineNo,var); }
}
}
continue;
} //globalre
//bless matching
if ((blessre.search(line)>=0) && (!m_inscript)) {
kdDebug(9016) << "blessre match []" << endl;
addClass(fileName,lineNo);
addConstructor(fileName,lineNo,m_lastsub);
continue;
} //bless
//base matching
if ((basere.search(line)>=0) && (!m_inscript)) {
TQString parent = basere.cap(1);
//create child & parent classes
kdDebug(9016) << "basere match [" << parent << "]" << endl;
addClass(fileName,lineNo);
addParentClass(parent);
continue;
} else {
if (libre.search(line)>=0) {
TQString path = libre.cap(1);
//add lib to INC path list
kdDebug(9016) << "libre match [" << path << "]" << endl;
m_INClist.append(path);
continue;
} else {
if (usere.search(line)>=0) {
//add lib to use list for later parsing
TQString lib = usere.cap(1);
kdDebug(9016) << "usere match [" << lib << "]" << endl;
addUseLib(lib);
continue;
} \
}
} //base
if ((isare.search(line)>=0) && (!m_inscript)) {
TQString parent = isare.cap(1);
//create child & parent classes
kdDebug(9016) << "isare match [" << parent << "]" << endl;
addClass(fileName,lineNo);
addParentClass(parent);
continue;
} //isa
if ((packagere.search(line)>=0) && (!m_inscript)) {
TQString package=packagere.cap(1);
kdDebug(9016) << "packagere match [" << package << "]" << endl;
addPackage(fileName,lineNo,package);
continue;
}//package
} // for lines loop
}
void perlparser::addPackage(const TQString& fileName ,int lineNr , const TQString& name)
{
kdDebug(9016) << "AddPackage [" << name << "]" << endl;
NamespaceDom package = m_model->create<NamespaceModel>();
package->setName(name);
package->setFileName(fileName );
package->setStartPosition(lineNr, 0 );
package->setScope(name);
if (!m_file->hasNamespace(name)) {
m_file->addNamespace(package);
m_lastpackage=package;
} else {
kdDebug(9016) << "addPackage [" << name << " exist]" << endl;
}
//clear all "last" know things
m_lastpackagename=name;
m_lastsub="";
m_lastattr="";
m_inpackage=true;
m_inscript = false;
m_inclass=false;
m_lastclass=0;
m_lastscript=0;
}
void perlparser::addScript(const TQString& fileName ,int lineNr ,const TQString& name)
{
kdDebug(9016) << "addScript [" << name << "]" << endl;
//map name of script under /scripts
//m_file->setName("/Scripts/"+name);
kdDebug(9016) << "addScript [" << name << "]" << endl;
NamespaceDom script = m_model->create<NamespaceModel>();
script->setName(name);
script->setFileName(fileName );
script->setStartPosition(lineNr, 0 );
script->setScope(name);
if (!m_file->hasNamespace(name)) {
m_file->addNamespace(script);
m_lastscript=script;
} else {
kdDebug(9016) << "addScript [" << name << " exist]" << endl;
}
//clear all "last" know things
m_lastsub="";
m_lastattr="";
m_inpackage = false;
m_inscript = true;
m_inclass=false;
m_lastscriptname=name;
m_lastpackage=0;
m_lastclass=0;
}
void perlparser::addAttributetoPackage(const TQString& fileName ,int lineNr ,const TQString& name)
{
kdDebug(9016) << "addAttributetoPackage [" << name << "]" << endl;
VariableDom var = m_model->create<VariableModel>();
var->setName(name);
var->setFileName( fileName );
var->setStartPosition( lineNr, 0 );
if (m_lastpackage) {
if (!m_lastpackage->hasVariable(var->name()))
m_lastpackage->addVariable(var);
} else {
kdDebug(9016) << "addAttributetoPackge[ no m_file]" << endl;
}
m_lastattr=name;
}
void perlparser::addAttributetoScript(const TQString& fileName ,int lineNr ,const TQString& name)
{
kdDebug(9016) << "addAttributetoScript [" << name << "]" << endl;
VariableDom var = m_model->create<VariableModel>();
var->setName(name);
var->setFileName( fileName );
var->setStartPosition( lineNr, 0 );
if (m_lastscript) {
if (!m_lastscript->hasVariable(var->name()))
m_lastscript->addVariable(var);
} else {
kdDebug(9016) << "addAttributeScript[ no m_file]" << endl;
}
}
void perlparser::addClass(const TQString& fileName ,int lineNr)
{
kdDebug(9016) << "addClass [ " << m_lastpackagename << " ]" << endl;
if (m_lastpackage->hasClass(m_lastpackagename)) {
kdDebug(9016) << "Class already defined" << endl;
} else {
kdDebug(9016) << "new Class" << endl;
ClassDom lastClass = m_model->create<ClassModel>();
lastClass->setName(m_lastpackagename);
lastClass->setFileName(fileName);
lastClass->setStartPosition(lineNr, 0);
m_lastpackage->addClass(lastClass);
m_lastclass=lastClass;
m_inclass=true;
}
}
void perlparser::addConstructor(const TQString& fileName ,int lineNr ,const TQString& name)
{
kdDebug(9016) << "set Constructor["<< name << "]" << endl;
FunctionDom method;
if (m_lastpackage->hasFunction(name)) {
//remove last sub frompackage scope
method = m_lastpackage->functionByName(name)[0];
method->getStartPosition(&lineNr,0);
m_lastpackage->removeFunction(method);
}
method = m_lastclass->functionByName(name)[0];
if (!method) {
kdDebug(9016) << "add new Constructor["<< name << ", " << lineNr << "]" << endl;
method = m_model->create<FunctionModel>();
method->setName(name);
method->setFileName( fileName );
method->setStartPosition( lineNr, 0 );
m_lastclass->addFunction(method);
}
method->setStatic(true);
//update class position
m_lastclass->setStartPosition(lineNr,0);
}
void perlparser::addGlobalSub(const TQString& fileName ,int lineNr ,const TQString& name ,bool privatesub)
{
kdDebug(9016) << "addGlobalSub[ " << name << "]" << endl;
FunctionDom method = m_model->create<FunctionModel>();
method->setName(name);
method->setFileName( fileName );
method->setStartPosition( lineNr, 0 );
method->setStatic(true);
if (privatesub)
method->setAccess(CodeModelItem::Private);
if (m_lastpackage) {
if (!m_lastpackage->hasFunction(method->name()))
m_lastpackage->addFunction(method);
} else {
kdDebug(9016) << "addGlobalsub[ no m_lastpackage]" << endl;
}
//also add seperate to namespace
addPackageSub(fileName,lineNr,name,privatesub);
m_lastsub=name;
}
void perlparser::addScriptSub(const TQString& fileName ,int lineNr ,const TQString& name ,bool privatesub)
{
kdDebug(9016) << "addScriptSub[ " << name << "]" << endl;
FunctionDom method = m_model->create<FunctionModel>();
method->setName(name);
method->setFileName( fileName );
method->setStartPosition( lineNr, 0 );
if (privatesub)
method->setAccess(CodeModelItem::Private);
if(m_lastscript) {
m_lastscript->addFunction(method);
} else {
}
m_lastsub=name;
}
void perlparser::addClassMethod(const TQString& fileName ,int lineNr ,const TQString& name ,bool privatesub)
{
kdDebug(9016) << "addClassMethod[ " << name << "]" << endl;
FunctionDom method = m_model->create<FunctionModel>();
method->setName(name);
method->setFileName( fileName );
method->setStartPosition( lineNr, 0 );
method->setVirtual(true);
if (privatesub)
method->setAccess(CodeModelItem::Private);
if (m_lastclass) {
if (!m_lastclass->hasFunction(method->name()))
m_lastclass->addFunction(method);
} else {
kdDebug(9016) << "addClassmethod[ no m_lastclass]" << endl;
}
// addPackageSub(fileName,lineNr,name,privatesub);
m_lastsub=name;
}
void perlparser::addPackageSub(const TQString& fileName ,int lineNr ,const TQString& name ,bool privatesub)
{
kdDebug(9016) << "addPackageSub[ " << name << "]" << endl;
FunctionDom method = m_model->create<FunctionModel>();
method->setName(name);
method->setFileName( fileName );
method->setStartPosition( lineNr, 0 );
if (privatesub)
method->setAccess(CodeModelItem::Private);
if (m_lastpackage) {
if (!m_lastpackage->hasFunction(method->name()))
m_lastpackage->addFunction(method);
} else {
kdDebug(9016) << "addPackageSub[ no m_file]" << endl;
}
m_lastsub=name;
}
void perlparser::addParentClass(const TQString& parent)
{
kdDebug(9016) << "addParentClass[ " << parent << "]" << endl;
if (m_lastclass) {
m_lastclass->addBaseClass(parent);
} else {
kdDebug(9016) << "addParentClass[ no m_lastclass]" << endl;
}
}
void perlparser::addUseLib(const TQString& lib)
{
if (!m_model->hasFile(lib)) {
if (m_usefiles.findIndex(lib) == -1) {
//only add if not already parsed or in the list
kdDebug(9016) << "add lib for later parsing [" << lib << "]" << endl;
m_usefiles.append(lib);
}
}
}
void perlparser::getPerlINC() {
m_INClist.clear();
TQString cmd = "/usr/bin/perl -e\" print join('|',@INC);\"";
TQString result;
FILE *fd = popen(cmd.local8Bit().data(), "r");
char buffer[4090];
TQByteArray array;
while (!feof(fd)) {
int n = fread(buffer, 1, 2048, fd);
if (n == -1) {
pclose(fd);
return;
}
array.setRawData(buffer, n);
result=TQString(array);
array.resetRawData(buffer, n);
}
pclose(fd);
//get INC list so we can use it to parse "use" modules
m_INClist = TQStringList::split(TQString("|"),result);
kdDebug(9016) << "INC " << m_INClist.size() << " "<< result << endl;
}
TQString perlparser::findLib( const TQString& lib)
{
TQString result;
TQString file=lib;
file.replace( TQRegExp("::"), TQString("/"));
//find the correct path by using the INC list
TQStringList::Iterator inc = m_INClist.begin();
while((inc != m_INClist.end()) && (result.isEmpty()) ) {
TQFileInfo fi((*inc) + "/" + file + ".pm");
if ( fi.exists() ) {
result = (*inc) + "/" + file + ".pm";
}
++inc;
}
return result;
}