Perl now builds and links on VC++, but crashes on start.

Originally committed to SVN as r1743.
This commit is contained in:
Rodrigo Braz Monteiro 2008-01-16 19:36:17 +00:00
parent 8ee4b4a769
commit b9c9782c76
5 changed files with 53 additions and 37 deletions

View File

@ -33,7 +33,6 @@
// Contact: mailto:jiifurusu@gmail.com // Contact: mailto:jiifurusu@gmail.com
// //
#pragma once #pragma once
#ifndef _AUTO4_PERL_H #ifndef _AUTO4_PERL_H
#define _AUTO4_PERL_H #define _AUTO4_PERL_H
@ -52,7 +51,7 @@
#include <XSUB.h> #include <XSUB.h>
#include "auto4_perldata.inc" // Parl variables manipulation macros #include "auto4_perldata.inc" // Parl variables manipulation macros
#undef bool
// the fucking perl.h redefines _() -.- please disregard warnings during compilation // the fucking perl.h redefines _() -.- please disregard warnings during compilation
#undef _ #undef _
@ -69,7 +68,6 @@
namespace Automation4 { namespace Automation4 {
/////////// ///////////
// XSUBS // XSUBS
// //
@ -115,14 +113,20 @@ namespace Automation4 {
void WriteVars() const; // Sync the script's vars from script object to perl package void WriteVars() const; // Sync the script's vars from script object to perl package
/* TODO: add c++ equivalents */ /* TODO: add c++ equivalents */
static XS(set_info); // Aegisub::Script::set_info()
void AddFeature(Feature *feature); void AddFeature(Feature *feature);
void DeleteFeature(Feature *feature); void DeleteFeature(Feature *feature);
static XS(register_macro); // Aegisub::Script::register_macro() static PerlScript *GetActive() { return active; }
static XS(register_console); // Aegisub::Script::register_console() /* TODO: move this into PerlConsole class */
void SetName(const wxString &str) { name = str; }
void SetDescription(const wxString &str) { description = str; }
void SetAuthor(const wxString &str) { author = str; }
void SetVersion(const wxString &str) { version = str; }
}; };
XS(set_info); // Aegisub::Script::set_info()
XS(register_macro); // Aegisub::Script::register_macro()
XS(register_console); // Aegisub::Script::register_console() /* TODO: move this into PerlConsole class */
////////////////// //////////////////
// Macro object // Macro object
@ -170,10 +174,10 @@ namespace Automation4 {
// //
class PerlLog { class PerlLog {
public: public:
static XS(log_warning); // Aegisub::warn()
}; };
XS(text_extents); // Aegisub::text_extents() XS(log_warning); // Aegisub::warn()
XS(text_extents); // Aegisub::text_extents()
}; };

View File

@ -49,8 +49,8 @@ namespace Automation4 {
void xs_perl_console(pTHX) void xs_perl_console(pTHX)
{ {
newXS("Aegisub::PerlConsole::echo", PerlConsole::echo, __FILE__); newXS("Aegisub::PerlConsole::echo", echo, __FILE__);
newXS("Aegisub::PerlConsole::register_console", PerlConsole::register_console, __FILE__); newXS("Aegisub::PerlConsole::register_console", register_console, __FILE__);
} }
@ -220,7 +220,7 @@ namespace Automation4 {
return wxString(SvPV_nolen(e), pl2wx); return wxString(SvPV_nolen(e), pl2wx);
} }
XS(PerlConsole::register_console) XS(register_console)
{ {
dXSARGS; dXSARGS;
PerlScript *script = PerlScript::GetScript(); PerlScript *script = PerlScript::GetScript();
@ -234,13 +234,13 @@ namespace Automation4 {
name = wxString(SvPV_nolen(ST(0)), pl2wx); name = wxString(SvPV_nolen(ST(0)), pl2wx);
} }
if(!registered) if(!PerlConsole::GetConsole())
// If there's no registered console // If there's no registered console
script->AddFeature(new PerlConsole(name, desc, script)); script->AddFeature(new PerlConsole(name, desc, script));
} }
} }
XS(PerlConsole::echo) XS(echo)
{ {
dXSARGS; dXSARGS;
@ -253,9 +253,9 @@ namespace Automation4 {
buffer << _T(" ") << wxString(SvPV_nolen(ST(i)), pl2wx); buffer << _T(" ") << wxString(SvPV_nolen(ST(i)), pl2wx);
} }
if(registered) { if(PerlConsole::GetConsole()) {
// If there's a console echo to it // If there's a console echo to it
registered->dialog->Echo(buffer); PerlConsole::GetConsole()->GetDialog()->Echo(buffer);
} }
else { else {
// Otherwise print on stdout // Otherwise print on stdout

View File

@ -76,15 +76,16 @@ namespace Automation4 {
virtual ~PerlConsole(); virtual ~PerlConsole();
static PerlConsole *GetConsole() { return registered; } static PerlConsole *GetConsole() { return registered; }
Dialog *GetDialog() { return dialog; }
virtual bool Validate(AssFile *subs, const std::vector<int> &selected, int active) { return true; } virtual bool Validate(AssFile *subs, const std::vector<int> &selected, int active) { return true; }
virtual void Process(AssFile *subs, std::vector<int> &selected, int active, wxWindow * const progress_parent); virtual void Process(AssFile *subs, std::vector<int> &selected, int active, wxWindow * const progress_parent);
static wxString Evaluate(const wxString &str) { if(registered) return registered->evaluate(str); } static wxString Evaluate(const wxString &str) { if(registered) return registered->evaluate(str); }
static XS(register_console);
static XS(echo);
}; };
XS(register_console);
XS(echo);
}; };

View File

@ -45,7 +45,7 @@ namespace Automation4 {
void xs_perl_misc(pTHX) void xs_perl_misc(pTHX)
{ {
newXS("Aegisub::warn", PerlLog::log_warning, __FILE__); newXS("Aegisub::warn", log_warning, __FILE__);
newXS("Aegisub::text_extents", text_extents, __FILE__); newXS("Aegisub::text_extents", text_extents, __FILE__);
} }
@ -54,7 +54,7 @@ namespace Automation4 {
// PerlLog // PerlLog
// //
XS(PerlLog::log_warning) XS(log_warning)
{ {
dXSARGS; dXSARGS;
wxString buffer; wxString buffer;

View File

@ -41,6 +41,8 @@
#include "auto4_perl_console.h" #include "auto4_perl_console.h"
#include "version.h" #include "version.h"
#include "standard_paths.h" #include "standard_paths.h"
#include <wx/filename.h>
#include <wx/utils.h>
namespace Automation4 { namespace Automation4 {
@ -48,8 +50,8 @@ namespace Automation4 {
void xs_perl_script(pTHX) void xs_perl_script(pTHX)
{ {
newXS("Aegisub::Script::set_info", PerlScript::set_info, __FILE__); newXS("Aegisub::Script::set_info", set_info, __FILE__);
newXS("Aegisub::Script::register_macro", PerlScript::register_macro, __FILE__); newXS("Aegisub::Script::register_macro", register_macro, __FILE__);
} }
@ -92,13 +94,17 @@ namespace Automation4 {
// Feed some defaults into the script info // Feed some defaults into the script info
name = GetPrettyFilename().BeforeLast(_T('.')); name = GetPrettyFilename().BeforeLast(_T('.'));
description = _("Perl script"); description = _("Perl script");
author = wxString(getlogin(), wxConvLibc); author = wxGetUserId();
version = GetAegisubShortVersionString(); version = GetAegisubShortVersionString();
// Get file's mtime // Get file's mtime
struct stat s; //struct stat s;
stat(GetFilename().mb_str(wxConvLibc), &s); //stat(GetFilename().mb_str(wxConvLibc), &s);
mtime = s.st_mtime; //mtime = s.st_mtime;
wxFileName fn(GetFilename());
wxDateTime mod;
fn.GetTimes(NULL,&mod,NULL);
mtime = mod.GetTicks();
// Create the script's package // Create the script's package
gv_stashpv(package.mb_str(wx2pl), 1); gv_stashpv(package.mb_str(wx2pl), 1);
@ -150,10 +156,13 @@ namespace Automation4 {
// Check if the source file is newer // Check if the source file is newer
if(script->reload) { if(script->reload) {
struct stat s; // struct stat s;
stat(script->GetFilename().mb_str(wxConvLibc), &s); // stat(script->GetFilename().mb_str(wxConvLibc), &s);
if(script->mtime != s.st_mtime) { wxFileName fn(script->GetFilename());
printf("%d != %d !\n", script->mtime, s.st_mtime); wxDateTime mod;
fn.GetTimes(NULL,&mod,NULL);
if(script->mtime != mod.GetTicks()) {
printf("%d != %d !\n", script->mtime, mod.GetTicks());
wxLogVerbose(_("Reloading %s because the file on disk (%s) changed"), script->GetName().c_str(), script->GetFilename().c_str()); wxLogVerbose(_("Reloading %s because the file on disk (%s) changed"), script->GetName().c_str(), script->GetFilename().c_str());
script->Reload(); script->Reload();
} }
@ -176,7 +185,7 @@ namespace Automation4 {
av_unshift(inc_av, inc_count); av_unshift(inc_av, inc_count);
// Add the include paths // Add the include paths
for(I32 i = 0; i < inc_count; i++) { for(I32 i = 0; i < inc_count; i++) {
wxLogDebug(_T("Adding %d to @INC"), include_path.Item(i).c_str()); wxLogDebug(_T("Adding %d to @INC"), script->include_path.Item(i).c_str());
AV_TOUCH(inc_av, i) AV_TOUCH(inc_av, i)
AV_STORE(newSVpv(script->include_path.Item(i).mb_str(wx2pl), 0)); AV_STORE(newSVpv(script->include_path.Item(i).mb_str(wx2pl), 0));
} }
@ -205,7 +214,7 @@ namespace Automation4 {
if(av_len(active->inc_saved) >= 0) { if(av_len(active->inc_saved) >= 0) {
// If there's a saved one // If there's a saved one
AV_COPY(active->inc_saved, inc_av); AV_COPY(active->inc_saved, inc_av);
wxLogTrace("@INC = ( %*s )", 0, SvPV_nolen(eval_pv("\"@INC\"", 1))); wxLogTrace(_T("@INC = ( %*s )"), 0, SvPV_nolen(eval_pv("\"@INC\"", 1)));
av_clear(active->inc_saved); av_clear(active->inc_saved);
} }
} }
@ -300,9 +309,10 @@ namespace Automation4 {
sv_setpv(whore, version.mb_str(wx2pl)); sv_setpv(whore, version.mb_str(wx2pl));
} }
XS(PerlScript::set_info) XS(set_info)
{ {
dXSARGS; dXSARGS;
PerlScript *active = PerlScript::GetActive();
if(active) { if(active) {
// Update the object's vars // Update the object's vars
active->ReadVars(); active->ReadVars();
@ -310,13 +320,13 @@ namespace Automation4 {
// Set script info vars // Set script info vars
switch (items) { switch (items) {
case 4: case 4:
active->version = wxString(SvPV_nolen(ST(3)), pl2wx); active->SetVersion(wxString(SvPV_nolen(ST(3)), pl2wx));
case 3: case 3:
active->author = wxString(SvPV_nolen(ST(2)), pl2wx); active->SetAuthor(wxString(SvPV_nolen(ST(2)), pl2wx));
case 2: case 2:
active->description = wxString(SvPV_nolen(ST(1)), pl2wx); active->SetDescription(wxString(SvPV_nolen(ST(1)), pl2wx));
case 1: case 1:
active->name = wxString(SvPV_nolen(ST(0)), pl2wx); active->SetName(wxString(SvPV_nolen(ST(0)), pl2wx));
} }
// Update the package's vars // Update the package's vars
@ -324,9 +334,10 @@ namespace Automation4 {
} }
} }
XS(PerlScript::register_macro) XS(register_macro)
{ {
dXSARGS; dXSARGS;
PerlScript *active = PerlScript::GetActive();
if(active && items >= 3) { if(active && items >= 3) {
wxString name, description; wxString name, description;
SV *proc_sub = NULL, *val_sub = NULL; SV *proc_sub = NULL, *val_sub = NULL;