ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/server/cfperl.xs
(Generate patch)

Comparing deliantra/server/server/cfperl.xs (file contents):
Revision 1.35 by root, Thu Aug 31 09:19:34 2006 UTC vs.
Revision 1.42 by root, Mon Sep 4 11:08:00 2006 UTC

… …
51 51
52static f_plug_api gethook = cfapi_get_hooks; 52static f_plug_api gethook = cfapi_get_hooks;
53static f_plug_api object_set_property = cfapi_object_set_property; 53static f_plug_api object_set_property = cfapi_object_set_property;
54static f_plug_api object_insert = cfapi_object_insert; 54static f_plug_api object_insert = cfapi_object_insert;
55 55
56static bool perl_booted;
57
58/* this is a stupid way to do things, and awkward to use for plug-in authors */ 56/* this is a stupid way to do things, and awkward to use for plug-in authors */
59typedef struct 57typedef struct
60{ 58{
61 object* who; 59 object* who;
62 object* activator; 60 object* activator;
… …
326 { 324 {
327 SvREFCNT_dec (cb); 325 SvREFCNT_dec (cb);
328 cb = 0; 326 cb = 0;
329 } 327 }
330 328
331 if (attach)
332 {
333 free_string (attach);
334 attach = 0; 329 attach = 0;
335 }
336} 330}
337 331
338void attachable_base::optimise () 332void attachable_base::optimise ()
339{ 333{
340 if (!self) 334 if (!self)
… …
359 PUSHMARK (SP); 353 PUSHMARK (SP);
360 EXTEND (SP, 2); 354 EXTEND (SP, 2);
361 PUSHs (sv_2mortal (newSVdt (type, obj))); 355 PUSHs (sv_2mortal (newSVdt (type, obj)));
362 PUSHs (sv_2mortal (newSVpv (attach, 0))); 356 PUSHs (sv_2mortal (newSVpv (attach, 0)));
363 357
364 free_string (attach);
365 attach = 0; 358 attach = 0;
366 359
367 PUTBACK; 360 PUTBACK;
368 call_pv ("cf::instantiate", G_DISCARD | G_VOID | G_EVAL); 361 call_pv ("cf::instantiate", G_DISCARD | G_VOID | G_EVAL);
369 FREETMPS; 362 FREETMPS;
… …
410} 403}
411 404
412#include "kw_hash.h" 405#include "kw_hash.h"
413 406
414object_freezer::object_freezer () 407object_freezer::object_freezer ()
408: dynbuf (128 * 1024, 64 * 1024)
415{ 409{
416 av = newAV (); 410 av = newAV ();
417 // TODO: fast dynbuf implementation... yeah, we need obstacks
418 text = newSV (10 * 1024 * 1024); // only temporarily used, so be generous
419} 411}
420 412
421object_freezer::~object_freezer () 413object_freezer::~object_freezer ()
422{ 414{
423 SvREFCNT_dec (text);
424 SvREFCNT_dec (av); 415 SvREFCNT_dec (av);
425} 416}
426 417
427void object_freezer::put (attachable_base *ext) 418void object_freezer::put (attachable_base *ext)
428{ 419{
… …
431 if (ext->self) 422 if (ext->self)
432 { 423 {
433 int idx = AvFILLp ((AV *)av) + 1; 424 int idx = AvFILLp ((AV *)av) + 1;
434 av_store (av, idx, SvREFCNT_inc (ext->self)); 425 av_store (av, idx, SvREFCNT_inc (ext->self));
435 426
436 sv_catpvf (text, "oid %d\n", idx); 427 add ((void *)"oid ", 4);
428 add ((sint32)idx);
429 add ('\n');
437 } 430 }
438}
439
440void object_freezer::put (keyword k)
441{
442 sv_catpv (text, keyword_str [k]);
443}
444
445void object_freezer::put (const char *v)
446{
447 sv_catpv (text, v);
448}
449
450void object_freezer::put (int v)
451{
452 sv_catpvf (text, "%d\n", v);
453} 431}
454 432
455bool object_freezer::save (const char *filename) 433bool object_freezer::save (const char *filename)
456{ 434{
457 dSP; 435 dSP;
458 ENTER; 436 ENTER;
459 SAVETMPS; 437 SAVETMPS;
460 PUSHMARK (SP); 438 PUSHMARK (SP);
461 EXTEND (SP, 3); 439 EXTEND (SP, 3);
462 PUSHs (sv_2mortal (newSVpv (filename, 0))); 440 PUSHs (sv_2mortal (newSVpv (filename, 0)));
463 PUSHs (sv_2mortal (newRV_inc (text))); 441 PUSHs (sv_2mortal (newRV_noinc (newSVpvn ((char *)linearise (), size ()))));
464 PUSHs (sv_2mortal (newRV_inc ((SV *)av))); 442 PUSHs (sv_2mortal (newRV_inc ((SV *)av)));
465 PUTBACK; 443 PUTBACK;
466 call_pv ("cf::object_freezer_save", G_VOID | G_DISCARD | G_EVAL); 444 call_pv ("cf::object_freezer_save", G_VOID | G_DISCARD | G_EVAL);
467 FREETMPS; 445 FREETMPS;
468 LEAVE; 446 LEAVE;
… …
471int fprintf (object_freezer &freezer, const char *format, ...) 449int fprintf (object_freezer &freezer, const char *format, ...)
472{ 450{
473 va_list ap; 451 va_list ap;
474 452
475 va_start (ap, format); 453 va_start (ap, format);
476 sv_vcatpvfn (freezer.text, format, strlen (format), &ap, 0, 0, 0); 454
455 int len = vsnprintf ((char *)freezer.force (1024), 1024, format, ap);
456
457 if (len >= 0)
458 freezer.alloc (len);
459
477 va_end (ap); 460 va_end (ap);
478} 461}
479 462
480int fputs (const char *s, object_freezer &freezer) 463int fputs (const char *s, object_freezer &freezer)
481{ 464{
482 sv_catpvn (freezer.text, s, strlen (s)); 465 freezer.add (s);
483} 466}
484 467
485object_thawer::object_thawer (const char *filename) 468object_thawer::object_thawer (const char *filename)
486{ 469{
470 static const char eof[] = "\n\n\n\0\0\0";
471
487 av = 0; 472 av = 0;
488 fp = 0; 473 text = 0;
474 line = 0;
489 475
490 if (!filename) 476 if (filename)
491 return;
492
493 fp = fopen (filename, "r");
494 if (!fp)
495 {
496 LOG (llevError, "object_thawer: unable to open '%s': %s.\n", filename, strerror (errno));
497 return;
498 }
499
500 if (perl_booted)
501 { 477 {
502 dSP; 478 dSP;
503 ENTER; 479 ENTER;
504 SAVETMPS; 480 SAVETMPS;
505 PUSHMARK (SP); 481 PUSHMARK (SP);
506 XPUSHs (sv_2mortal (newSVpv (filename, 0))); 482 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
507 PUTBACK; 483 PUTBACK;
508 484
509 if (0 < call_pv ("cf::object_thawer_load", G_SCALAR | G_EVAL)) 485 if (2 == call_pv ("cf::object_thawer_load", G_ARRAY | G_EVAL))
510 { 486 {
511 SPAGAIN; 487 SPAGAIN;
488
489 // second value - perl objects
490 {
512 SV *sv = POPs; 491 SV *sv = POPs;
513 if (SvROK (sv)) 492 if (SvROK (sv))
514 av = (AV *)SvREFCNT_inc (SvRV (sv)); 493 av = (AV *)SvREFCNT_inc (SvRV (sv));
494 }
495
496 // first value - text part, pad with 3 zeroes
497 {
498 SV *sv = POPs;
499 STRLEN len;
500 char *sv_ = SvPVbyte (sv, len);
501 text = newSV (len + sizeof (eof));
502 SvCUR_set (text, len);
503 memcpy (SvPVX (text), sv_, len);
504 memcpy (SvEND (text), eof, sizeof (eof)); // just to be sure
505
506 line = SvPVX (text);
507 }
515 } 508 }
516 509
510 PUTBACK;
517 FREETMPS; 511 FREETMPS;
518 LEAVE; 512 LEAVE;
519 } 513 }
520} 514}
521 515
… …
541 reattach (type, obj); 535 reattach (type, obj);
542} 536}
543 537
544object_thawer::~object_thawer () 538object_thawer::~object_thawer ()
545{ 539{
546 if (fp) fclose (fp); 540 if (text) SvREFCNT_dec (text);
547 if (av) SvREFCNT_dec ((AV *)av); 541 if (av) SvREFCNT_dec (av);
548} 542}
549 543
544char *fgets (char *s, int n, object_thawer &thawer)
545{
546 char *p = thawer.line;
547 char *q = s;
548
549 if (!p)
550 return 0;
551
552 while (--n)
553 {
554 if (!*p)
555 break;
556
557 *q++ = *p;
558
559 if (*p++ == '\n')
560 break;
561 }
562
563 *q = 0;
564 thawer.line = p;
565
566 return s == q ? 0 : s;
567}
568
550token object_thawer::get_token () 569keyword object_thawer::get_kv ()
551{ 570{
552#if 0 571 if (!line)
572 return KW_EOF;
573
553 for (;;) 574 for (;;)
554 { 575 {
555 if (!fgets (line, sizeof (line), fp)) 576 char *p = line;
556 return token (KW_eof);
557 577
558 unsigned char *p = (unsigned char *)line; 578 if (!*p)
579 return KW_EOF;
559 580
581 // parse keyword
560 while (*p > ' ') 582 while (*p > ' ')
561 p++; 583 p++;
562 584
563 int len = p - (unsigned char *)line; 585 int klen = p - line;
564 586
565 while ((*p - 1) < ' ') 587 if (*p++ != '\n')
566 p++;
567
568 if (*p)
569 { 588 {
570 char *v = p; 589 // parse value
590 while (*p <= ' ' && *p != '\n') // skip 0x01 .. 0x20
591 ++p;
571 592
593 last_value = p;
594
572 while (*p && *p != '\n') 595 while (*p != '\n')
573 p++; 596 p++;
574 597
575 *p = 0; 598 *p++ = 0;
576
577 return token (k, v);
578 } 599 }
579 else 600 else
580 return token (k); 601 last_value = 0;
602
603 line [klen] = 0;
604 keyword_idx *kw = kw_lex::match (line, klen);
605
606 //printf ("KV %d<%s,%s>\n", kw ? kw->index : 0, line, last_value);//D
607
608 if (kw)
609 {
610 line = p;
611 return kw->index;
612 }
613 else if (!*line || *line == '#')
614 {
615 // empty/comment line
616 line = p;
617 }
618 else
619 return KW_ERROR;
581 } 620 }
582#endif
583} 621}
584 622
623void object_thawer::get (shstr &sh) const
624{
625 if (last_value)
626 sh = last_value;
627 else
628 {
629 sh = "<value missing>";
630 LOG (llevError, "keyword requires value: <%s>\n", line);//TODO: add filename
631 }
632}
633
634void object_thawer::get_ml (keyword kend, shstr &sh)
635{
636 char kw[128];
637
638 // multi-line strings are delimited by "\nendXXX\n"
639 kw [0] = '\n';
640 strcpy (kw + 1, keyword_str [kend]);
641
642 char *end = strstr (line, kw);
643
644 if (!end)
645 {
646 sh = 0;
647 return;
648 }
649
650 *end = 0;
651 sh = line;
652
653 line = end + keyword_len [kend] + 1;
654
655 while (*line++ != '\n')
656 ;
657}
658
659sint32 object_thawer::get_sint32 () const
660{
661 char *p = last_value;
662
663 if (!p)
664 return 0;
665
666 sint32 val = 0;
667 bool negate;
668
669 if (*p == '-')
670 {
671 negate = true;
672 ++p;
673 }
674 else
675 negate = false;
676
677 do
678 {
679 val *= 10;
680 val += *p++ - '0';
681 }
682 while (*p);
683
684 return negate ? -val : val;
685}
686
687sint64 object_thawer::get_sint64 () const
688{
689 return last_value ? atoll (last_value) : 0;
690}
691
692double object_thawer::get_double () const
693{
694 return last_value ? atof (last_value) : 0;
695}
696
585///////////////////////////////////////////////////////////////////////////// 697/////////////////////////////////////////////////////////////////////////////
586 698
587extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr) 699extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr)
588{ 700{
589 return 0; 701 return 0;
… …
697 char *argv[] = { 809 char *argv[] = {
698 "", 810 "",
699 "-e" 811 "-e"
700 "cf->bootstrap;" 812 "cf->bootstrap;"
701 "unshift @INC, cf::datadir ();" 813 "unshift @INC, cf::datadir ();"
814 "require cf;"
702 }; 815 };
703 816
704 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl)) 817 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl))
705 { 818 {
706 printf ("unable to initialize perl-interpreter, aborting.\n"); 819 printf ("unable to initialize perl-interpreter, aborting.\n");
707 exit (EXIT_FAILURE); 820 exit (EXIT_FAILURE);
708 } 821 }
709 822
710 obj_cache = newHV (); 823 obj_cache = newHV ();
711}
712
713void cfperl_boot ()
714{
715 perl_booted = true;
716
717 eval_pv ("require cf", 1);
718} 824}
719 825
720void cfperl_main () 826void cfperl_main ()
721{ 827{
722 dSP; 828 dSP;
… …
1298 1404
1299 const_iv (SK_EXP_ADD_SKILL) 1405 const_iv (SK_EXP_ADD_SKILL)
1300 const_iv (SK_EXP_TOTAL) 1406 const_iv (SK_EXP_TOTAL)
1301 const_iv (SK_EXP_NONE) 1407 const_iv (SK_EXP_NONE)
1302 const_iv (SK_SUBTRACT_SKILL_EXP) 1408 const_iv (SK_SUBTRACT_SKILL_EXP)
1409 const_iv (SK_EXP_SKILL_ONLY)
1303 1410
1304 const_iv (SK_LOCKPICKING) 1411 const_iv (SK_LOCKPICKING)
1305 const_iv (SK_HIDING) 1412 const_iv (SK_HIDING)
1306 const_iv (SK_SMITHERY) 1413 const_iv (SK_SMITHERY)
1307 const_iv (SK_BOWYER) 1414 const_iv (SK_BOWYER)
… …
2363 RETVAL 2470 RETVAL
2364 2471
2365 2472
2366MODULE = cf PACKAGE = cf::arch 2473MODULE = cf PACKAGE = cf::arch
2367 2474
2475archetype *find (const char *name)
2476 CODE:
2477 RETVAL = find_archetype (name);
2478 OUTPUT:
2479 RETVAL
2480
2368archetype *first() 2481archetype *first()
2369 PROTOTYPE: 2482 PROTOTYPE:
2370 CODE: 2483 CODE:
2371 RETVAL = first_archetype; 2484 RETVAL = first_archetype;
2372 OUTPUT: RETVAL 2485 OUTPUT: RETVAL

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines