ext/Sys/Syslog/Syslog.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4
   5 #ifdef I_SYSLOG
   6 #include <syslog.h>
   7 #endif
   8
   9 #define PERL_constant_NOTFOUND  1
  10 #define PERL_constant_NOTDEF    2
  11 #define PERL_constant_ISIV      3
  12 #define PERL_constant_ISNV      4
  13 #define PERL_constant_ISPV      5
  14 #define PERL_constant_ISPVN     6
  15 #define PERL_constant_ISUV      7
  16
  17 #ifndef NVTYPE
  18 typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it.  */
  19 #endif
  20
  21 static int
  22 constant_7 (const char *name, IV *iv_return) {
  23   /* Names all of length 7.  */
  24   /* When generated this function returned values for the list of names given
  25      here.  However, subsequent manual editing may have added or removed some.
  26      LOG_ERR LOG_FTP LOG_LPR LOG_PID */
  27   /* Offset 4 gives the best switch position.  */
  28   switch (name[4]) {
  29   case 'E':
  30     if (memEQ(name, "LOG_ERR", 7)) {
  31     /*                   ^        */
  32 #ifdef LOG_ERR
  33       *iv_return = LOG_ERR;
  34       return PERL_constant_ISIV;
  35 #else
  36       return PERL_constant_NOTDEF;
  37 #endif
  38     }
  39     break;
  40   case 'F':
  41     if (memEQ(name, "LOG_FTP", 7)) {
  42     /*                   ^        */
  43 #ifdef LOG_FTP
  44       *iv_return = LOG_FTP;
  45       return PERL_constant_ISIV;
  46 #else
  47       return PERL_constant_NOTDEF;
  48 #endif
  49     }
  50     break;
  51   case 'L':
  52     if (memEQ(name, "LOG_LPR", 7)) {
  53     /*                   ^        */
  54 #ifdef LOG_LPR
  55       *iv_return = LOG_LPR;
  56       return PERL_constant_ISIV;
  57 #else
  58       return PERL_constant_NOTDEF;
  59 #endif
  60     }
  61     break;
  62   case 'P':
  63     if (memEQ(name, "LOG_PID", 7)) {
  64     /*                   ^        */
  65 #ifdef LOG_PID
  66       *iv_return = LOG_PID;
  67       return PERL_constant_ISIV;
  68 #else
  69       return PERL_constant_NOTDEF;
  70 #endif
  71     }
  72     break;
  73   }
  74   return PERL_constant_NOTFOUND;
  75 }
  76
  77 static int
  78 constant_8 (const char *name, IV *iv_return) {
  79   /* Names all of length 8.  */
  80   /* When generated this function returned values for the list of names given
  81      here.  However, subsequent manual editing may have added or removed some.
  82      LOG_AUTH LOG_CONS LOG_CRIT LOG_CRON LOG_INFO LOG_KERN LOG_LFMT LOG_MAIL
  83      LOG_NEWS LOG_USER LOG_UUCP */
  84   /* Offset 6 gives the best switch position.  */
  85   switch (name[6]) {
  86   case 'C':
  87     if (memEQ(name, "LOG_UUCP", 8)) {
  88     /*                     ^       */
  89 #ifdef LOG_UUCP
  90       *iv_return = LOG_UUCP;
  91       return PERL_constant_ISIV;
  92 #else
  93       return PERL_constant_NOTDEF;
  94 #endif
  95     }
  96     break;
  97   case 'E':
  98     if (memEQ(name, "LOG_USER", 8)) {
  99     /*                     ^       */
 100 #ifdef LOG_USER
 101       *iv_return = LOG_USER;
 102       return PERL_constant_ISIV;
 103 #else
 104       return PERL_constant_NOTDEF;
 105 #endif
 106     }
 107     break;
 108   case 'F':
 109     if (memEQ(name, "LOG_INFO", 8)) {
 110     /*                     ^       */
 111 #ifdef LOG_INFO
 112       *iv_return = LOG_INFO;
 113       return PERL_constant_ISIV;
 114 #else
 115       return PERL_constant_NOTDEF;
 116 #endif
 117     }
 118     break;
 119   case 'I':
 120     if (memEQ(name, "LOG_CRIT", 8)) {
 121     /*                     ^       */
 122 #ifdef LOG_CRIT
 123       *iv_return = LOG_CRIT;
 124       return PERL_constant_ISIV;
 125 #else
 126       return PERL_constant_NOTDEF;
 127 #endif
 128     }
 129     if (memEQ(name, "LOG_MAIL", 8)) {
 130     /*                     ^       */
 131 #ifdef LOG_MAIL
 132       *iv_return = LOG_MAIL;
 133       return PERL_constant_ISIV;
 134 #else
 135       return PERL_constant_NOTDEF;
 136 #endif
 137     }
 138     break;
 139   case 'M':
 140     if (memEQ(name, "LOG_LFMT", 8)) {
 141     /*                     ^       */
 142 #ifdef LOG_LFMT
 143       *iv_return = LOG_LFMT;
 144       return PERL_constant_ISIV;
 145 #else
 146       return PERL_constant_NOTDEF;
 147 #endif
 148     }
 149     break;
 150   case 'N':
 151     if (memEQ(name, "LOG_CONS", 8)) {
 152     /*                     ^       */
 153 #ifdef LOG_CONS
 154       *iv_return = LOG_CONS;
 155       return PERL_constant_ISIV;
 156 #else
 157       return PERL_constant_NOTDEF;
 158 #endif
 159     }
 160     break;
 161   case 'O':
 162     if (memEQ(name, "LOG_CRON", 8)) {
 163     /*                     ^       */
 164 #ifdef LOG_CRON
 165       *iv_return = LOG_CRON;
 166       return PERL_constant_ISIV;
 167 #else
 168       return PERL_constant_NOTDEF;
 169 #endif
 170     }
 171     break;
 172   case 'R':
 173     if (memEQ(name, "LOG_KERN", 8)) {
 174     /*                     ^       */
 175 #ifdef LOG_KERN
 176       *iv_return = LOG_KERN;
 177       return PERL_constant_ISIV;
 178 #else
 179       return PERL_constant_NOTDEF;
 180 #endif
 181     }
 182     break;
 183   case 'T':
 184     if (memEQ(name, "LOG_AUTH", 8)) {
 185     /*                     ^       */
 186 #ifdef LOG_AUTH
 187       *iv_return = LOG_AUTH;
 188       return PERL_constant_ISIV;
 189 #else
 190       return PERL_constant_NOTDEF;
 191 #endif
 192     }
 193     break;
 194   case 'W':
 195     if (memEQ(name, "LOG_NEWS", 8)) {
 196     /*                     ^       */
 197 #ifdef LOG_NEWS
 198       *iv_return = LOG_NEWS;
 199       return PERL_constant_ISIV;
 200 #else
 201       return PERL_constant_NOTDEF;
 202 #endif
 203     }
 204     break;
 205   }
 206   return PERL_constant_NOTFOUND;
 207 }
 208
 209 static int
 210 constant_9 (const char *name, IV *iv_return) {
 211   /* Names all of length 9.  */
 212   /* When generated this function returned values for the list of names given
 213      here.  However, subsequent manual editing may have added or removed some.
 214      LOG_ALERT LOG_DEBUG LOG_EMERG */
 215   /* Offset 4 gives the best switch position.  */
 216   switch (name[4]) {
 217   case 'A':
 218     if (memEQ(name, "LOG_ALERT", 9)) {
 219     /*                   ^          */
 220 #ifdef LOG_ALERT
 221       *iv_return = LOG_ALERT;
 222       return PERL_constant_ISIV;
 223 #else
 224       return PERL_constant_NOTDEF;
 225 #endif
 226     }
 227     break;
 228   case 'D':
 229     if (memEQ(name, "LOG_DEBUG", 9)) {
 230     /*                   ^          */
 231 #ifdef LOG_DEBUG
 232       *iv_return = LOG_DEBUG;
 233       return PERL_constant_ISIV;
 234 #else
 235       return PERL_constant_NOTDEF;
 236 #endif
 237     }
 238     break;
 239   case 'E':
 240     if (memEQ(name, "LOG_EMERG", 9)) {
 241     /*                   ^          */
 242 #ifdef LOG_EMERG
 243       *iv_return = LOG_EMERG;
 244       return PERL_constant_ISIV;
 245 #else
 246       return PERL_constant_NOTDEF;
 247 #endif
 248     }
 249     break;
 250   }
 251   return PERL_constant_NOTFOUND;
 252 }
 253
 254 static int
 255 constant_10 (const char *name, IV *iv_return) {
 256   /* Names all of length 10.  */
 257   /* When generated this function returned values for the list of names given
 258      here.  However, subsequent manual editing may have added or removed some.
 259      LOG_DAEMON LOG_LOCAL0 LOG_LOCAL1 LOG_LOCAL2 LOG_LOCAL3 LOG_LOCAL4
 260      LOG_LOCAL5 LOG_LOCAL6 LOG_LOCAL7 LOG_NDELAY LOG_NOTICE LOG_NOWAIT
 261      LOG_ODELAY LOG_PERROR LOG_SYSLOG */
 262   /* Offset 9 gives the best switch position.  */
 263   switch (name[9]) {
 264   case '0':
 265     if (memEQ(name, "LOG_LOCAL0", 10)) {
 266     /*                        ^       */
 267 #ifdef LOG_LOCAL0
 268       *iv_return = LOG_LOCAL0;
 269       return PERL_constant_ISIV;
 270 #else
 271       return PERL_constant_NOTDEF;
 272 #endif
 273     }
 274     break;
 275   case '1':
 276     if (memEQ(name, "LOG_LOCAL1", 10)) {
 277     /*                        ^       */
 278 #ifdef LOG_LOCAL1
 279       *iv_return = LOG_LOCAL1;
 280       return PERL_constant_ISIV;
 281 #else
 282       return PERL_constant_NOTDEF;
 283 #endif
 284     }
 285     break;
 286   case '2':
 287     if (memEQ(name, "LOG_LOCAL2", 10)) {
 288     /*                        ^       */
 289 #ifdef LOG_LOCAL2
 290       *iv_return = LOG_LOCAL2;
 291       return PERL_constant_ISIV;
 292 #else
 293       return PERL_constant_NOTDEF;
 294 #endif
 295     }
 296     break;
 297   case '3':
 298     if (memEQ(name, "LOG_LOCAL3", 10)) {
 299     /*                        ^       */
 300 #ifdef LOG_LOCAL3
 301       *iv_return = LOG_LOCAL3;
 302       return PERL_constant_ISIV;
 303 #else
 304       return PERL_constant_NOTDEF;
 305 #endif
 306     }
 307     break;
 308   case '4':
 309     if (memEQ(name, "LOG_LOCAL4", 10)) {
 310     /*                        ^       */
 311 #ifdef LOG_LOCAL4
 312       *iv_return = LOG_LOCAL4;
 313       return PERL_constant_ISIV;
 314 #else
 315       return PERL_constant_NOTDEF;
 316 #endif
 317     }
 318     break;
 319   case '5':
 320     if (memEQ(name, "LOG_LOCAL5", 10)) {
 321     /*                        ^       */
 322 #ifdef LOG_LOCAL5
 323       *iv_return = LOG_LOCAL5;
 324       return PERL_constant_ISIV;
 325 #else
 326       return PERL_constant_NOTDEF;
 327 #endif
 328     }
 329     break;
 330   case '6':
 331     if (memEQ(name, "LOG_LOCAL6", 10)) {
 332     /*                        ^       */
 333 #ifdef LOG_LOCAL6
 334       *iv_return = LOG_LOCAL6;
 335       return PERL_constant_ISIV;
 336 #else
 337       return PERL_constant_NOTDEF;
 338 #endif
 339     }
 340     break;
 341   case '7':
 342     if (memEQ(name, "LOG_LOCAL7", 10)) {
 343     /*                        ^       */
 344 #ifdef LOG_LOCAL7
 345       *iv_return = LOG_LOCAL7;
 346       return PERL_constant_ISIV;
 347 #else
 348       return PERL_constant_NOTDEF;
 349 #endif
 350     }
 351     break;
 352   case 'E':
 353     if (memEQ(name, "LOG_NOTICE", 10)) {
 354     /*                        ^       */
 355 #ifdef LOG_NOTICE
 356       *iv_return = LOG_NOTICE;
 357       return PERL_constant_ISIV;
 358 #else
 359       return PERL_constant_NOTDEF;
 360 #endif
 361     }
 362     break;
 363   case 'G':
 364     if (memEQ(name, "LOG_SYSLOG", 10)) {
 365     /*                        ^       */
 366 #ifdef LOG_SYSLOG
 367       *iv_return = LOG_SYSLOG;
 368       return PERL_constant_ISIV;
 369 #else
 370       return PERL_constant_NOTDEF;
 371 #endif
 372     }
 373     break;
 374   case 'N':
 375     if (memEQ(name, "LOG_DAEMON", 10)) {
 376     /*                        ^       */
 377 #ifdef LOG_DAEMON
 378       *iv_return = LOG_DAEMON;
 379       return PERL_constant_ISIV;
 380 #else
 381       return PERL_constant_NOTDEF;
 382 #endif
 383     }
 384     break;
 385   case 'R':
 386     if (memEQ(name, "LOG_PERROR", 10)) {
 387     /*                        ^       */
 388 #ifdef LOG_PERROR
 389       *iv_return = LOG_PERROR;
 390       return PERL_constant_ISIV;
 391 #else
 392       return PERL_constant_NOTDEF;
 393 #endif
 394     }
 395     break;
 396   case 'T':
 397     if (memEQ(name, "LOG_NOWAIT", 10)) {
 398     /*                        ^       */
 399 #ifdef LOG_NOWAIT
 400       *iv_return = LOG_NOWAIT;
 401       return PERL_constant_ISIV;
 402 #else
 403       return PERL_constant_NOTDEF;
 404 #endif
 405     }
 406     break;
 407   case 'Y':
 408     if (memEQ(name, "LOG_NDELAY", 10)) {
 409     /*                        ^       */
 410 #ifdef LOG_NDELAY
 411       *iv_return = LOG_NDELAY;
 412       return PERL_constant_ISIV;
 413 #else
 414       return PERL_constant_NOTDEF;
 415 #endif
 416     }
 417     if (memEQ(name, "LOG_ODELAY", 10)) {
 418     /*                        ^       */
 419 #ifdef LOG_ODELAY
 420       *iv_return = LOG_ODELAY;
 421       return PERL_constant_ISIV;
 422 #else
 423       return PERL_constant_NOTDEF;
 424 #endif
 425     }
 426     break;
 427   }
 428   return PERL_constant_NOTFOUND;
 429 }
 430
 431 static int
 432 constant_11 (const char *name, IV *iv_return) {
 433   /* Names all of length 11.  */
 434   /* When generated this function returned values for the list of names given
 435      here.  However, subsequent manual editing may have added or removed some.
 436      LOG_FACMASK LOG_PRIMASK LOG_WARNING */
 437   /* Offset 6 gives the best switch position.  */
 438   switch (name[6]) {
 439   case 'C':
 440     if (memEQ(name, "LOG_FACMASK", 11)) {
 441     /*                     ^           */
 442 #ifdef LOG_FACMASK
 443       *iv_return = LOG_FACMASK;
 444       return PERL_constant_ISIV;
 445 #else
 446       return PERL_constant_NOTDEF;
 447 #endif
 448     }
 449     break;
 450   case 'I':
 451     if (memEQ(name, "LOG_PRIMASK", 11)) {
 452     /*                     ^           */
 453 #ifdef LOG_PRIMASK
 454       *iv_return = LOG_PRIMASK;
 455       return PERL_constant_ISIV;
 456 #else
 457       return PERL_constant_NOTDEF;
 458 #endif
 459     }
 460     break;
 461   case 'R':
 462     if (memEQ(name, "LOG_WARNING", 11)) {
 463     /*                     ^           */
 464 #ifdef LOG_WARNING
 465       *iv_return = LOG_WARNING;
 466       return PERL_constant_ISIV;
 467 #else
 468       return PERL_constant_NOTDEF;
 469 #endif
 470     }
 471     break;
 472   }
 473   return PERL_constant_NOTFOUND;
 474 }
 475
 476 static int
 477 constant (const char *name, STRLEN len, IV *iv_return) {
 478   /* Initially switch on the length of the name.  */
 479   /* When generated this function returned values for the list of names given
 480      in this section of perl code.  Rather than manually editing these functions
 481      to add or remove constants, which would result in this comment and section
 482      of code becoming inaccurate, we recommend that you edit this section of
 483      code, and use it to regenerate a new set of constant functions which you
 484      then use to replace the originals.
 485
 486      Regenerate these constant functions by feeding this entire source file to
 487      perl -x
 488
 489 #!perl -w
 490 use ExtUtils::Constant qw (constant_types C_constant XS_constant);
 491
 492 my $types = {IV => 1};
 493 my @names = (qw(LOG_ALERT LOG_AUTH LOG_AUTHPRIV LOG_CONS LOG_CRIT LOG_CRON
 494                LOG_DAEMON LOG_DEBUG LOG_EMERG LOG_ERR LOG_FACMASK LOG_FTP
 495                LOG_INFO LOG_KERN LOG_LFMT LOG_LOCAL0 LOG_LOCAL1 LOG_LOCAL2
 496                LOG_LOCAL3 LOG_LOCAL4 LOG_LOCAL5 LOG_LOCAL6 LOG_LOCAL7 LOG_LPR
 497                LOG_MAIL LOG_NDELAY LOG_NEWS LOG_NFACILITIES LOG_NOTICE
 498                LOG_NOWAIT LOG_ODELAY LOG_PERROR LOG_PID LOG_PRIMASK LOG_SYSLOG
 499                LOG_USER LOG_UUCP LOG_WARNING));
 500
 501 print constant_types(); # macro defs
 502 foreach (C_constant ("Sys::Syslog", 'constant', 'IV', $types, undef, undef, @names) ) {
 503     print $_, "\n"; # C constant subs
 504 }
 505 print "#### XS Section:\n";
 506 print XS_constant ("Sys::Syslog", $types);
 507 __END__
 508    */
 509
 510   switch (len) {
 511   case 7:
 512     return constant_7 (name, iv_return);
 513     break;
 514   case 8:
 515     return constant_8 (name, iv_return);
 516     break;
 517   case 9:
 518     return constant_9 (name, iv_return);
 519     break;
 520   case 10:
 521     return constant_10 (name, iv_return);
 522     break;
 523   case 11:
 524     return constant_11 (name, iv_return);
 525     break;
 526   case 12:
 527     if (memEQ(name, "LOG_AUTHPRIV", 12)) {
 528 #ifdef LOG_AUTHPRIV
 529       *iv_return = LOG_AUTHPRIV;
 530       return PERL_constant_ISIV;
 531 #else
 532       return PERL_constant_NOTDEF;
 533 #endif
 534     }
 535     break;
 536   case 15:
 537     if (memEQ(name, "LOG_NFACILITIES", 15)) {
 538 #ifdef LOG_NFACILITIES
 539       *iv_return = LOG_NFACILITIES;
 540       return PERL_constant_ISIV;
 541 #else
 542       return PERL_constant_NOTDEF;
 543 #endif
 544     }
 545     break;
 546   }
 547   return PERL_constant_NOTFOUND;
 548 }
 549
 550 MODULE = Sys::Syslog            PACKAGE = Sys::Syslog
 551
 552 char *
 553 _PATH_LOG()
 554     CODE:
 555 #ifdef _PATH_LOG
 556         RETVAL = _PATH_LOG;
 557 #else
 558         RETVAL = "";
 559 #endif
 560     OUTPUT:
 561         RETVAL
 562
 563 int
 564 LOG_FAC(p)
 565     INPUT:
 566         int             p
 567     CODE:
 568 #ifdef LOG_FAC
 569         RETVAL = LOG_FAC(p);
 570 #else
 571         croak("Your vendor has not defined the Sys::Syslog macro LOG_FAC");
 572         RETVAL = -1;
 573 #endif
 574     OUTPUT:
 575         RETVAL
 576
 577 int
 578 LOG_PRI(p)
 579     INPUT:
 580         int             p
 581     CODE:
 582 #ifdef LOG_PRI
 583         RETVAL = LOG_PRI(p);
 584 #else
 585         croak("Your vendor has not defined the Sys::Syslog macro LOG_PRI");
 586         RETVAL = -1;
 587 #endif
 588     OUTPUT:
 589         RETVAL
 590
 591 int
 592 LOG_MAKEPRI(fac,pri)
 593     INPUT:
 594         int             fac
 595         int             pri
 596     CODE:
 597 #ifdef LOG_MAKEPRI
 598         RETVAL = LOG_MAKEPRI(fac,pri);
 599 #else
 600         croak("Your vendor has not defined the Sys::Syslog macro LOG_MAKEPRI");
 601         RETVAL = -1;
 602 #endif
 603     OUTPUT:
 604         RETVAL
 605
 606 int
 607 LOG_MASK(pri)
 608     INPUT:
 609         int             pri
 610     CODE:
 611 #ifdef LOG_MASK
 612         RETVAL = LOG_MASK(pri);
 613 #else
 614         croak("Your vendor has not defined the Sys::Syslog macro LOG_MASK");
 615         RETVAL = -1;
 616 #endif
 617     OUTPUT:
 618         RETVAL
 619
 620 int
 621 LOG_UPTO(pri)
 622     INPUT:
 623         int             pri
 624     CODE:
 625 #ifdef LOG_UPTO
 626         RETVAL = LOG_UPTO(pri);
 627 #else
 628         croak("Your vendor has not defined the Sys::Syslog macro LOG_UPTO");
 629         RETVAL = -1;
 630 #endif
 631     OUTPUT:
 632         RETVAL
 633
 634
 635 void
 636 constant(sv)
 637     PREINIT:
 638 #ifdef dXSTARG
 639         dXSTARG; /* Faster if we have it.  */
 640 #else
 641         dTARGET;
 642 #endif
 643         STRLEN          len;
 644         int             type;
 645         IV              iv;
 646         /* NV           nv;     Uncomment this if you need to return NVs */
 647         /* const char   *pv;    Uncomment this if you need to return PVs */
 648     INPUT:
 649         SV *            sv;
 650         const char *    s = SvPV(sv, len);
 651     PPCODE:
 652         /* Change this to constant(s, len, &iv, &nv);
 653            if you need to return both NVs and IVs */
 654         type = constant(s, len, &iv);
 655       /* Return 1 or 2 items. First is error message, or undef if no error.
 656            Second, if present, is found value */
 657         switch (type) {
 658         case PERL_constant_NOTFOUND:
 659           sv = sv_2mortal(newSVpvf("%s is not a valid Sys::Syslog macro", s));
 660           PUSHs(sv);
 661           break;
 662         case PERL_constant_NOTDEF:
 663           sv = sv_2mortal(newSVpvf(
 664             "Your vendor has not defined Sys::Syslog macro %s used", s));
 665           PUSHs(sv);
 666           break;
 667         case PERL_constant_ISIV:
 668           EXTEND(SP, 1);
 669           PUSHs(&PL_sv_undef);
 670           PUSHi(iv);
 671           break;
 672         default:
 673           sv = sv_2mortal(newSVpvf(
 674             "Unexpected return type %d while processing Sys::Syslog macro %s used",
 675                type, s));
 676           PUSHs(sv);
 677         }