PageRenderTime 57ms CodeModel.GetById 25ms RepoModel.GetById 0ms app.codeStats 0ms

/stat.xs

https://github.com/gitpan/vms-stat
Unknown | 175 lines | 165 code | 10 blank | 0 comment | 0 complexity | f903cb7f327df2a47b5130ca889fc7ad MD5 | raw file
  1. /*
  2. * VMS::Stat.xs - VMS extensions to stat.h
  3. *
  4. * Peter Prymmer
  5. * Version 0.03
  6. * Revision: 15-MAY-2004
  7. *
  8. * Version 0.01
  9. * Revision: 26-APR-2004
  10. */
  11. #include "EXTERN.h"
  12. #include "perl.h"
  13. #include "XSUB.h"
  14. #include <libdef.h> /* LIB$_INVARG */
  15. #include "ppport.h"
  16. #include <stat.h> /* prototype for mkdir() (also provides package name and a raison d'etre) */
  17. #include <rms.h> /* struct FAB and cc$rms_fab (via inclusion of fabdef.h) */
  18. #include <starlet.h> /* prototype for sys$open() and sys$close() */
  19. #define VMS_STAT_FAB_ITEMS 32
  20. MODULE = VMS::Stat PACKAGE = VMS::Stat
  21. void
  22. vmsmkdir(dir_spec,...)
  23. char * dir_spec
  24. PROTOTYPE: @
  25. CODE:
  26. mode_t mode;
  27. mode_t default_mode = 0777;
  28. unsigned int uic;
  29. unsigned short max_versions;
  30. unsigned short r_v_number;
  31. int rc;
  32. if (!dir_spec || !*dir_spec) {
  33. SETERRNO(EINVAL,LIB$_INVARG);
  34. XSRETURN_UNDEF;
  35. }
  36. if (items > 5) croak("too many args");
  37. /* This hack stolen right out of vmsopen() */
  38. switch (items) {
  39. case 1:
  40. rc = mkdir(dir_spec,default_mode);
  41. break;
  42. case 2:
  43. mode = (mode_t)SvIV(ST(1));
  44. rc = mkdir(dir_spec,mode);
  45. break;
  46. case 3:
  47. mode = (mode_t)SvIV(ST(1));
  48. uic = (unsigned int)SvIV(ST(2));
  49. rc = mkdir(dir_spec,mode,uic);
  50. break;
  51. case 4:
  52. mode = (mode_t)SvIV(ST(1));
  53. uic = (unsigned int)SvIV(ST(2));
  54. max_versions = (unsigned short)SvIV(ST(3));
  55. rc = mkdir(dir_spec,mode,uic,max_versions);
  56. break;
  57. case 5:
  58. mode = (mode_t)SvIV(ST(1));
  59. uic = (unsigned int)SvIV(ST(2));
  60. max_versions = (unsigned short)SvIV(ST(3));
  61. r_v_number = (unsigned short)SvIV(ST(4));
  62. rc = mkdir(dir_spec,mode,uic,max_versions,r_v_number);
  63. break;
  64. }
  65. ST(0) = (rc == 0) ? &PL_sv_yes : &PL_sv_undef;
  66. char *
  67. get_fab(filespec)
  68. SV * filespec
  69. PROTOTYPE: $
  70. INIT:
  71. struct FAB fab;
  72. int i;
  73. int rc;
  74. STRLEN len;
  75. fab = cc$rms_fab; /* initialize data structures */
  76. fab.fab$l_fna = SvPV(filespec,len);
  77. fab.fab$b_fns = len;
  78. CODE:
  79. rc = sys$open( &fab );
  80. if ( ! ( rc & 1 ) ) {
  81. SETERRNO(rc,rc);
  82. ST(0) = sv_newmortal();
  83. sv_setpv(ST(0),"");
  84. ST(1) = sv_newmortal();
  85. ST(1) = &PL_sv_undef;
  86. XSRETURN(2);
  87. }
  88. rc = sys$close ( &fab );
  89. if ( ! ( rc & 1 ) ) {
  90. SETERRNO(rc,rc);
  91. ST(0) = sv_newmortal();
  92. sv_setpv(ST(0),"");
  93. ST(1) = sv_newmortal();
  94. ST(1) = &PL_sv_undef;
  95. XSRETURN(2);
  96. }
  97. SETERRNO(rc,rc);
  98. /* extend perl return ST-ack pointer sp by an appropriate amount */
  99. EXTEND(sp,VMS_STAT_FAB_ITEMS);
  100. for ( i=0; i<VMS_STAT_FAB_ITEMS; i++) {
  101. ST(i) = sv_newmortal();
  102. }
  103. i = 0;
  104. sv_setpv(ST(i),"ai"); i++;
  105. ST(i) = ( fab.fab$v_ai ) ? &PL_sv_yes : &PL_sv_no; i++;
  106. sv_setpv(ST(i),"alq"); i++;
  107. sv_setiv(ST(i),fab.fab$l_alq); i++;
  108. /* bdt skipped for now */
  109. /* sv_setpv(ST(i),"bdt"); i++; */
  110. sv_setpv(ST(i),"bi"); i++;
  111. ST(i) = ( fab.fab$v_bi ) ? &PL_sv_yes : &PL_sv_no; i++;
  112. sv_setpv(ST(i),"bks"); i++;
  113. sv_setiv(ST(i),fab.fab$b_bks); i++;
  114. sv_setpv(ST(i),"bls"); i++;
  115. sv_setiv(ST(i),fab.fab$w_bls); i++;
  116. sv_setpv(ST(i),"cbt"); i++;
  117. ST(i) = ( fab.fab$v_cbt ) ? &PL_sv_yes : &PL_sv_no; i++;
  118. /* cdt skipped for now */
  119. /* sv_setpv(ST(i),"cdt"); i++; */
  120. sv_setpv(ST(i),"ctg"); i++;
  121. ST(i) = ( fab.fab$v_ctg ) ? &PL_sv_yes : &PL_sv_no; i++;
  122. sv_setpv(ST(i),"deq"); i++;
  123. sv_setiv(ST(i),fab.fab$w_deq); i++;
  124. /* did skipped for now */
  125. /* sv_setpv(ST(i),"did"); i++; */
  126. /* directory skipped for now */
  127. /* sv_setpv(ST(i),"directory"); i++; */
  128. /* dvi skipped for now */
  129. /* sv_setpv(ST(i),"dvi"); i++; */
  130. /* edt skipped for now */
  131. /* sv_setpv(ST(i),"edt"); i++; */
  132. /* eof skipped for now */
  133. /* sv_setpv(ST(i),"eof"); i++; */
  134. /* erl aka ERASE */
  135. sv_setpv(ST(i),"erase"); i++;
  136. ST(i) = ( fab.fab$v_erl ) ? &PL_sv_yes : &PL_sv_no; i++;
  137. /* ffb */
  138. sv_setpv(ST(i),"fsz"); i++;
  139. sv_setiv(ST(i),fab.fab$b_fsz); i++;
  140. sv_setpv(ST(i),"gbc"); i++;
  141. sv_setiv(ST(i),fab.fab$w_gbc); i++;
  142. /* sv_setpv(ST(i),"journal_file"); i++; */
  143. /* ST(i) = ( fab$v_journal_file ) ? &PL_sv_yes : &PL_sv_no; i++; */
  144. /* sv_setpv(ST(i),"known"); i++; */
  145. /* ST(i) = ( fab$v_kfo ) ? &PL_sv_yes : &PL_sv_no; i++; */
  146. sv_setpv(ST(i),"mrn"); i++;
  147. sv_setiv(ST(i),fab.fab$l_mrn); i++;
  148. sv_setpv(ST(i),"mrs"); i++;
  149. sv_setiv(ST(i),fab.fab$w_mrs); i++;
  150. /* noa */
  151. /* nobackup */
  152. /* nok */
  153. sv_setpv(ST(i),"org"); i++;
  154. sv_setiv(ST(i),fab.fab$b_org); i++;
  155. sv_setpv(ST(i),"rat"); i++;
  156. sv_setiv(ST(i),fab.fab$b_rat); i++;
  157. /* sv_setpv(ST(i),"rck"); i++; */
  158. /* ST(i) = ( fab$v_rck ) ? &PL_sv_yes : &PL_sv_no; i++; */
  159. sv_setpv(ST(i),"rfm"); i++;
  160. sv_setiv(ST(i),fab.fab$b_rfm); i++;
  161. /* sv_setpv(ST(i),"ru"); i++; */
  162. /* ST(i) = ( fab$v_ru ) ? &PL_sv_yes : &PL_sv_no; i++; */
  163. /* sv_setpv(ST(i),"wck"); i++; */
  164. /* ST(i) = ( fab$v_wck ) ? &PL_sv_yes : &PL_sv_no; i++; */
  165. XSRETURN(VMS_STAT_FAB_ITEMS);