[Uml-devel] KDE/kdesdk/umbrello/umbrello/codegenerators

[Laurent Montel]

SVN commit 554092 by mlaurent:

Merge with kde-3.5 branch
I think that this changes was missing when merged was done


 M  +110 -81   perlwriter.cpp  


--- trunk/KDE/kdesdk/umbrello/umbrello/codegenerators/perlwriter.cpp #554091:554092
@@ -35,21 +35,67 @@
 
 PerlWriter::~PerlWriter() {}
 
+bool PerlWriter::GetUseStatements(UMLClassifier *c, QString &Ret,
+                                  QString &ThisPkgName){
 
+  if(!c){
+    return(false);
+  }
+
+  UMLClassifierList includes;
+  findObjectsRelated(c,includes);
+  UMLClassifier *conc;
+  QString AV = "@";
+  QString SV = "$";
+  QString HV = "%";
+  for(conc = includes.first(); conc ;conc = includes.next()) {
+    if (   (cleanName(conc->getName()) != AV)
+        && (cleanName(conc->getName()) != SV)
+        && (cleanName(conc->getName()) != HV)){
+      // ***TODO***
+      // Need to remove things like int, string, boolean etc...
+      QString OtherPkgName =  conc->getPackage(".");
+      OtherPkgName.replace(QRegExp("\\."),"::");
+      QString OtherName = OtherPkgName + "::" + cleanName(conc->getName());
+
+      // Only print out the use statement if the other package isn't the
+      // same as the one we are working on. (This happens for the
+      // "Singleton" design pattern.)
+      if(OtherName != ThisPkgName){
+        Ret += "use ";
+        Ret += OtherName;
+        Ret += ";";
+        Ret += m_endl;
+      }
+    }
+  }
+  UMLClassifierList  superclasses = c->getSuperClasses();
+  if (superclasses.count()) {
+    Ret += m_endl;
+    Ret += "use base qw( ";
+    for (UMLClassifier *obj = superclasses.first();
+         obj; obj = superclasses.next()) {
+      QString packageName =  obj->getPackage(".");
+      packageName.replace(QRegExp("\\."),"::");
+
+      Ret += packageName + "::" + cleanName(obj->getName()) + " ";
+    }
+    Ret += ");" + m_endl;
+  }
+
+  return(true);
+}
+
 void PerlWriter::writeClass(UMLClassifier *c) {
-    /*  if(!c) {
-                kDebug()<<"Cannot write class of NULL concept!" << endl;
-                return;
-        }
-    */
-    QString classname = cleanName(c->getName());// this is fine: cleanName is "::-clean"
-    QString fileName;
 
-    fileName = findFileName(c, ".pm");  //lower-cases my nice class names. That is bad.
-    // correct solution: refactor,
-    // split massive findFileName up, reimplement
-    // parts here
-    // actual solution: shameful ".pm" hack in codegenerator
+  /*  if(!c) {
+      kdDebug()<<"Cannot write class of NULL concept!" << endl;
+      return;
+      }
+  */
+  QString classname = cleanName(c->getName());// this is fine: cleanName is "::-clean"
+  QString packageName =  c->getPackage(".");
+  QString fileName;
 
   // Replace all white spaces with blanks
   packageName.simplifyWhiteSpace();
@@ -91,7 +137,8 @@
           emit codeGenerated(c, false);
           return;
         }
-        fileName = fragment;
+      }
+      curDir += "/" + newDir;
     }
     fileName = fragment + ".pm";
   }
@@ -137,89 +184,71 @@
                   );
       bPackageDeclared = true;
     }
-    QString oldDir = outputDirectory();
-    setOutputDirectory(curDir);
-    QFile fileperl;
-    if(!openFile(fileperl,fileName+".pm")) {
-        emit codeGenerated(c, false);
-        return;
+
+    if(str.find(QRegExp("%USE-STATEMENTS%"))){
+      QString UseStms;
+      if(GetUseStatements(c,UseStms,ThisPkgName)){
+        str.replace(QRegExp("%USE-STATEMENTS%"), UseStms);
+        bUseStmsWritten = true;
+      }
     }
-    QTextStream perl(&fileperl);
-    setOutputDirectory(oldDir);
-    //////////////////////////////
-    //Start generating the code!!
-    /////////////////////////////
 
+    perl<<str<<m_endl;
+  }
 
-    //try to find a heading file (license, coments, etc)
-    QString str;
-    QString AV = "@";
-    QString SV = "$";
-    QString HV = "%";
-    str = getHeadingFile(".pm");   // what this mean?
-    if(!str.isEmpty()) {
-        str.replace(QRegExp("%filename%"),fileName+".pm");
-        str.replace(QRegExp("%filepath%"),fileperl.name());
-        str.replace(QRegExp("%date%"),QDate::currentDate().toString());
-        str.replace(QRegExp("%time%"),QTime::currentTime().toString());
-        perl<<str<<m_endl;
-    }
-    perl << m_endl << m_endl << "package " << classname << ";" << m_endl << m_endl;
+  // if the package wasn't declared above during keyword substitution,
+  // add it now. (At the end of the file.)
+  if(! bPackageDeclared){
+    perl << m_endl << m_endl << "package " <<ThisPkgName << ";" << m_endl
+         << m_endl;
     //write includes
-    perl << m_endl << "#UML_MODELER_BEGIN_PERSONAL_VARS_" << classname << m_endl ;
-    perl << m_endl << "#UML_MODELER_END_PERSONAL_VARS_" << classname << m_endl << m_endl ;
-    UMLClassifierList includes;//ca existe en perl??
-    findObjectsRelated(c,includes);
-    UMLClassifier *conc;
-    for(conc = includes.first(); conc ;conc = includes.next()) {
-        if ((cleanName(conc->getName()) != AV) && (cleanName(conc->getName()) != SV ) && (cleanName(conc->getName()) != HV))
-        {
-            perl << "use " << cleanName(conc->getName()) << ";" << m_endl; // seems OK
-        }
+    perl << m_endl << "#UML_MODELER_BEGIN_PERSONAL_VARS_" << classname
+         << m_endl ;
+    perl << m_endl << "#UML_MODELER_END_PERSONAL_VARS_" << classname
+         << m_endl << m_endl ;
+  }
+
+  if(! bUseStmsWritten){
+    QString UseStms;
+    if(GetUseStatements(c,UseStms,ThisPkgName)){
+      perl<<UseStms<<m_endl;
     }
-    perl << m_endl;
+  }
 
-    UMLClassifierList superclasses = c->getSuperClasses();
-    UMLAssociationList aggregations = c->getAggregations();
-    UMLAssociationList compositions = c->getCompositions();
+  perl << m_endl;
 
-    if (superclasses.count()) {
-        perl << "use base qw( ";
-        for (UMLClassifier *obj = superclasses.first();
-                obj; obj = superclasses.next()) {
-            perl << cleanName(obj->getName()) << " ";
-        }
-        perl << ");" << m_endl;
-    }
+  // Do we really need these for anything???
+  UMLAssociationList aggregations = c->getAggregations();
+  UMLAssociationList compositions = c->getCompositions();
 
     //Write class Documentation
-    if(forceDoc() || !c->getDoc().isEmpty()) {
-        perl << m_endl << "=head1";
-        perl << " " << classname.upper() << m_endl << m_endl;
-        perl << c->getDoc();
-        perl << m_endl << m_endl << "=cut" << m_endl << m_endl;
-    }
+  if(forceDoc() || !c->getDoc().isEmpty()) {
+    perl << m_endl << "=head1";
+    perl << " " << classname.upper() << m_endl << m_endl;
+    perl << c->getDoc();
+    perl << m_endl << m_endl << "=cut" << m_endl << m_endl;
+  }
 
-    //check if class is abstract and / or has abstract methods
-    if(c->getAbstract())
-        perl << "=head1 ABSTRACT CLASS" << m_endl << m_endl << "=cut" << m_endl;
+  //check if class is abstract and / or has abstract methods
+  if(c->getAbstract())
+    perl << "=head1 ABSTRACT CLASS" << m_endl << m_endl << "=cut" << m_endl;
 
-    //attributes
-    if (! c->isInterface())
-        writeAttributes(c, perl);      // keep for documentation's sake
+  //attributes
+  if (! c->isInterface())
+    writeAttributes(c, perl);      // keep for documentation's sake
 
-    //operations
-    writeOperations(c,perl);
+  //operations
+  writeOperations(c,perl);
 
-    perl << m_endl;
+  perl << m_endl;
 
-    //finish file
-    //perl << m_endl << m_endl << "=cut" << m_endl;
-    perl << m_endl << m_endl << "return 1;" << m_endl;
+  //finish file
+  //perl << m_endl << m_endl << "=cut" << m_endl;
+  perl << m_endl << m_endl << "return 1;" << m_endl;
 
-    //close files and notify we are done
-    fileperl.close();
-    emit codeGenerated(c, true);
+  //close files and notify we are done
+  fileperl.close();
+  emit codeGenerated(c, true);
 }
 
 /**