#include "perldoc.h" #include #include #include #include #include #include #include #include #include #include #include #include using namespace TDEIO; PerldocProtocol::PerldocProtocol(const TQCString &pool, const TQCString &app) : SlaveBase("perldoc", pool, app) {} PerldocProtocol::~PerldocProtocol() {} void PerldocProtocol::get(const KURL& url) { TQStringList l = TQStringList::split('/', url.path()); mimeType("text/html"); bool plain = false; TQString cmd = "perldoc "; if (l[0] == "functions") { plain = true; cmd += "-t -f "; cmd += TDEProcess::quote(l[1]); } else if (l[0] == "faq") { cmd += "-u -q "; cmd += TDEProcess::quote(l[1]); cmd += " | pod2html"; } else { TQCString errstr(i18n("The only existing directories are functions and faq.").local8Bit()); data(errstr); finished(); return; } kdDebug() << "Command: " << cmd << endl; if (plain) data(TQCString("

")); 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); data(array); array.resetRawData(buffer, n); } pclose(fd); if (plain) data(TQCString("

")); finished(); } void PerldocProtocol::mimetype(const KURL &url) { TQStringList l = TQStringList::split('/', url.path()); mimeType((l[0] == "faq")? "text/html" : "text/plain"); finished(); } TQCString PerldocProtocol::errorMessage() { return TQCString( "" + i18n("Error in perldoc").local8Bit() + "" ); } void PerldocProtocol::stat(const KURL &/*url*/) { UDSAtom uds_atom; uds_atom.m_uds = TDEIO::UDS_FILE_TYPE; uds_atom.m_long = S_IFREG | S_IRWXU | S_IRWXG | S_IRWXO; UDSEntry uds_entry; uds_entry.append(uds_atom); statEntry(uds_entry); finished(); } void PerldocProtocol::listDir(const KURL &url) { error( TDEIO::ERR_CANNOT_ENTER_DIRECTORY, url.path() ); } extern "C" { int kdemain(int argc, char **argv) { TDEInstance instance( "tdeio_perldoc" ); TDEGlobal::locale()->setMainCatalogue("tdevelop"); if (argc != 4) { fprintf(stderr, "Usage: tdeio_perldoc protocol domain-socket1 domain-socket2\n"); exit(-1); } PerldocProtocol slave(argv[2], argv[3]); slave.dispatchLoop(); return 0; } }