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.40 by root, Sun Sep 3 00:18:42 2006 UTC vs.
Revision 1.41 by root, Sun Sep 3 22:45:57 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;
467 freezer.add (s); 465 freezer.add (s);
468} 466}
469 467
470object_thawer::object_thawer (const char *filename) 468object_thawer::object_thawer (const char *filename)
471{ 469{
470 static const char eof[] = "\n\n\n\0\0\0";
471
472 av = 0; 472 av = 0;
473 fp = 0; 473 text = 0;
474 474
475 if (!filename) 475 if (filename)
476 return;
477
478 fp = fopen (filename, "r");
479 if (!fp)
480 {
481 LOG (llevError, "object_thawer: unable to open '%s': %s.\n", filename, strerror (errno));
482 return;
483 }
484
485 if (perl_booted)
486 { 476 {
487 dSP; 477 dSP;
488 ENTER; 478 ENTER;
489 SAVETMPS; 479 SAVETMPS;
490 PUSHMARK (SP); 480 PUSHMARK (SP);
491 XPUSHs (sv_2mortal (newSVpv (filename, 0))); 481 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
492 PUTBACK; 482 PUTBACK;
493 483
494 if (0 < call_pv ("cf::object_thawer_load", G_SCALAR | G_EVAL)) 484 if (2 == call_pv ("cf::object_thawer_load", G_ARRAY | G_EVAL))
495 { 485 {
496 SPAGAIN; 486 SPAGAIN;
487
488 // second value - perl objects
489 {
497 SV *sv = POPs; 490 SV *sv = POPs;
498 if (SvROK (sv)) 491 if (SvROK (sv))
499 av = (AV *)SvREFCNT_inc (SvRV (sv)); 492 av = (AV *)SvREFCNT_inc (SvRV (sv));
493 }
494
495 // first value - text part, pad with 3 zeroes
496 {
497 SV *sv = POPs;
498 STRLEN len;
499 char *sv_ = SvPVbyte (sv, len);
500 text = newSV (len + sizeof (eof));
501 SvCUR_set (text, len);
502 memcpy (SvPVX (text), sv_, len);
503 memcpy (SvEND (text), eof, sizeof (eof)); // just to be sure
504 }
500 } 505 }
501 506
507 PUTBACK;
502 FREETMPS; 508 FREETMPS;
503 LEAVE; 509 LEAVE;
504 } 510 }
511
512 if (!text)
513 text = newSVpvn (eof, sizeof (eof));
514
515 line = SvPVX (text);
505} 516}
506 517
507void object_thawer::get (data_type type, void *obj, attachable_base *ext, int oid) 518void object_thawer::get (data_type type, void *obj, attachable_base *ext, int oid)
508{ 519{
509 if (!av || oid < 0) // this is actually an error of sorts 520 if (!av || oid < 0) // this is actually an error of sorts
526 reattach (type, obj); 537 reattach (type, obj);
527} 538}
528 539
529object_thawer::~object_thawer () 540object_thawer::~object_thawer ()
530{ 541{
531 if (fp) fclose (fp); 542 if (text) SvREFCNT_dec (text);
532 if (av) SvREFCNT_dec ((AV *)av); 543 if (av) SvREFCNT_dec (av);
533} 544}
534 545
546char *fgets (char *s, int n, object_thawer &thawer)
547{
548 char *p = thawer.line;
549 char *q = s;
550
551 while (--n)
552 {
553 if (!*p)
554 break;
555
556 *q++ = *p;
557
558 if (*p++ == '\n')
559 break;
560 }
561
562 *q = 0;
563 thawer.line = p;
564
565 return s == q ? 0 : s;
566}
567
535token object_thawer::get_token () 568keyword object_thawer::get_kv ()
536{ 569{
537#if 0
538 for (;;) 570 for (;;)
539 { 571 {
540 if (!fgets (line, sizeof (line), fp)) 572 char *p = line;
541 return token (KW_eof);
542 573
543 unsigned char *p = (unsigned char *)line; 574 if (!*p)
575 return KW_EOF;
544 576
577 // parse keyword
545 while (*p > ' ') 578 while (*p > ' ')
546 p++; 579 p++;
547 580
548 int len = p - (unsigned char *)line; 581 int klen = p - line;
549 582
550 while ((*p - 1) < ' ') 583 if (*p++ != '\n')
551 p++;
552
553 if (*p)
554 { 584 {
555 char *v = p; 585 // parse value
586 while (*p <= ' ' && *p != '\n') // skip 0x01 .. 0x20
587 ++p;
556 588
589 last_value = p;
590
557 while (*p && *p != '\n') 591 while (*p != '\n')
558 p++; 592 p++;
559 593
560 *p = 0; 594 *p++ = 0;
561
562 return token (k, v);
563 } 595 }
564 else 596 else
565 return token (k); 597 last_value = 0;
598
599 line [klen] = 0;
600 keyword_idx *kw = kw_lex::match (line, klen);
601
602 //printf ("KV %d<%s,%s>\n", kw ? kw->index : 0, line, last_value);//D
603
604 if (kw)
605 {
606 line = p;
607 return kw->index;
608 }
609 else if (!*line || *line == '#')
610 {
611 // empty/comment line
612 line = p;
613 }
614 else
615 return KW_ERROR;
566 } 616 }
567#endif
568} 617}
569 618
619void object_thawer::get (shstr &sh) const
620{
621 if (last_value)
622 sh = last_value;
623 else
624 {
625 sh = "<value missing>";
626 LOG (llevError, "keyword requires value: <%s>\n", line);//TODO: add filename
627 }
628}
629
630void object_thawer::get_ml (keyword kend, shstr &sh)
631{
632 char kw[128];
633
634 // multi-line strings are delimited by "\nendXXX\n"
635 kw [0] = '\n';
636 strcpy (kw + 1, keyword_str [kend]);
637
638 char *end = strstr (line, kw);
639
640 if (!end)
641 {
642 sh = 0;
643 return;
644 }
645
646 *end = 0;
647 sh = line;
648
649 line = end + keyword_len [kend] + 1;
650
651 while (*line++ != '\n')
652 ;
653}
654
655sint32 object_thawer::get_sint32 () const
656{
657 char *p = last_value;
658
659 if (!p)
660 return 0;
661
662 sint32 val = 0;
663 bool negate;
664
665 if (*p == '-')
666 {
667 negate = true;
668 ++p;
669 }
670 else
671 negate = false;
672
673 do
674 {
675 val *= 10;
676 val += *p++ - '0';
677 }
678 while (*p);
679
680 return negate ? -val : val;
681}
682
683sint64 object_thawer::get_sint64 () const
684{
685 return last_value ? atoll (last_value) : 0;
686}
687
688double object_thawer::get_double () const
689{
690 return last_value ? atof (last_value) : 0;
691}
692
570///////////////////////////////////////////////////////////////////////////// 693/////////////////////////////////////////////////////////////////////////////
571 694
572extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr) 695extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr)
573{ 696{
574 return 0; 697 return 0;
682 char *argv[] = { 805 char *argv[] = {
683 "", 806 "",
684 "-e" 807 "-e"
685 "cf->bootstrap;" 808 "cf->bootstrap;"
686 "unshift @INC, cf::datadir ();" 809 "unshift @INC, cf::datadir ();"
810 "require cf;"
687 }; 811 };
688 812
689 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl)) 813 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl))
690 { 814 {
691 printf ("unable to initialize perl-interpreter, aborting.\n"); 815 printf ("unable to initialize perl-interpreter, aborting.\n");
692 exit (EXIT_FAILURE); 816 exit (EXIT_FAILURE);
693 } 817 }
694 818
695 obj_cache = newHV (); 819 obj_cache = newHV ();
696}
697
698void cfperl_boot ()
699{
700 perl_booted = true;
701
702 eval_pv ("require cf", 1);
703} 820}
704 821
705void cfperl_main () 822void cfperl_main ()
706{ 823{
707 dSP; 824 dSP;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines