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.
495 lines
15 KiB
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(KDevCore* 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;
|
|
}
|
|
|