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.39 by elmex, Fri Sep 1 17:16:47 2006 UTC vs.
Revision 1.44 by root, Thu Sep 7 14:32:13 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;
… …
472 freezer.add (s); 465 freezer.add (s);
473} 466}
474 467
475object_thawer::object_thawer (const char *filename) 468object_thawer::object_thawer (const char *filename)
476{ 469{
470 static const char eof[] = "\n\n\n\0\0\0";
471
477 av = 0; 472 av = 0;
478 fp = 0; 473 text = 0;
474 line = 0;
479 475
480 if (!filename) 476 if (filename)
481 return;
482
483 fp = fopen (filename, "r");
484 if (!fp)
485 {
486 LOG (llevError, "object_thawer: unable to open '%s': %s.\n", filename, strerror (errno));
487 return;
488 }
489
490 if (perl_booted)
491 { 477 {
492 dSP; 478 dSP;
493 ENTER; 479 ENTER;
494 SAVETMPS; 480 SAVETMPS;
495 PUSHMARK (SP); 481 PUSHMARK (SP);
496 XPUSHs (sv_2mortal (newSVpv (filename, 0))); 482 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
497 PUTBACK; 483 PUTBACK;
498 484
499 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))
500 { 486 {
501 SPAGAIN; 487 SPAGAIN;
488
489 // second value - perl objects
490 {
502 SV *sv = POPs; 491 SV *sv = POPs;
503 if (SvROK (sv)) 492 if (SvROK (sv))
504 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 }
505 } 508 }
506 509
510 PUTBACK;
507 FREETMPS; 511 FREETMPS;
508 LEAVE; 512 LEAVE;
509 } 513 }
510} 514}
511 515
… …
531 reattach (type, obj); 535 reattach (type, obj);
532} 536}
533 537
534object_thawer::~object_thawer () 538object_thawer::~object_thawer ()
535{ 539{
536 if (fp) fclose (fp); 540 if (text) SvREFCNT_dec (text);
537 if (av) SvREFCNT_dec ((AV *)av); 541 if (av) SvREFCNT_dec (av);
538} 542}
539 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
540token object_thawer::get_token () 569keyword object_thawer::get_kv ()
541{ 570{
542#if 0 571 if (!line)
572 return KW_EOF;
573
543 for (;;) 574 for (;;)
544 { 575 {
545 if (!fgets (line, sizeof (line), fp)) 576 char *p = line;
546 return token (KW_eof);
547 577
548 unsigned char *p = (unsigned char *)line; 578 if (!*p)
579 return KW_EOF;
549 580
581 // parse keyword
550 while (*p > ' ') 582 while (*p > ' ')
551 p++; 583 p++;
552 584
553 int len = p - (unsigned char *)line; 585 int klen = p - line;
554 586
555 while ((*p - 1) < ' ') 587 if (*p++ != '\n')
556 p++;
557
558 if (*p)
559 { 588 {
560 char *v = p; 589 // parse value
590 while (*(unsigned char *)p <= ' ' && *p != '\n') // skip 0x01 .. 0x20
591 ++p;
561 592
593 last_value = p;
594
562 while (*p && *p != '\n') 595 while (*p != '\n')
563 p++; 596 p++;
564 597
565 *p = 0; 598 *p++ = 0;
566
567 return token (k, v);
568 } 599 }
569 else 600 else
570 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;
571 } 620 }
572#endif
573} 621}
574 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 int klen = keyword_len [kend];
639
640 kw [0] = '\n';
641 memcpy (kw + 1, keyword_str [kend], klen);
642 kw [klen + 1] = '\n';
643 kw [klen + 2] = 0;
644
645 // first test for completely empty msg... "endXXX\n"
646 if (!strncmp (line, kw + 1, klen + 1))
647 {
648 sh = 0;
649
650 line += klen + 1;
651
652 return;
653 }
654 else
655 {
656 // multi-line strings are delimited by "\nendXXX\n" or "endXXX\n" (NULL)
657
658 char *end = strstr (line, kw);
659
660 if (!end)
661 {
662 sh = 0;
663 return;
664 }
665
666 *end = 0;
667 sh = line;
668
669 line = end + keyword_len [kend] + 1;
670
671 while (*line++ != '\n')
672 ;
673 }
674}
675
676sint32 object_thawer::get_sint32 () const
677{
678 char *p = last_value;
679
680 if (!p)
681 return 0;
682
683 sint32 val = 0;
684 bool negate;
685
686 if (*p == '-')
687 {
688 negate = true;
689 ++p;
690 }
691 else
692 negate = false;
693
694 do
695 {
696 val *= 10;
697 val += *p++ - '0';
698 }
699 while (*p);
700
701 return negate ? -val : val;
702}
703
704sint64 object_thawer::get_sint64 () const
705{
706 return last_value ? atoll (last_value) : 0;
707}
708
709double object_thawer::get_double () const
710{
711 return last_value ? atof (last_value) : 0;
712}
713
575///////////////////////////////////////////////////////////////////////////// 714/////////////////////////////////////////////////////////////////////////////
576 715
577extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr) 716extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr)
578{ 717{
579 return 0; 718 return 0;
… …
687 char *argv[] = { 826 char *argv[] = {
688 "", 827 "",
689 "-e" 828 "-e"
690 "cf->bootstrap;" 829 "cf->bootstrap;"
691 "unshift @INC, cf::datadir ();" 830 "unshift @INC, cf::datadir ();"
831 "require cf;"
692 }; 832 };
693 833
694 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl)) 834 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl))
695 { 835 {
696 printf ("unable to initialize perl-interpreter, aborting.\n"); 836 printf ("unable to initialize perl-interpreter, aborting.\n");
697 exit (EXIT_FAILURE); 837 exit (EXIT_FAILURE);
698 } 838 }
699 839
700 obj_cache = newHV (); 840 obj_cache = newHV ();
701}
702
703void cfperl_boot ()
704{
705 perl_booted = true;
706
707 eval_pv ("require cf", 1);
708} 841}
709 842
710void cfperl_main () 843void cfperl_main ()
711{ 844{
712 dSP; 845 dSP;

Diff Legend

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