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