#ifndef __ObjXSub_h__
#define __ObjXSub_h__
-// variables
-#undef uid
-#define uid pPerl->Perl_uid
-#undef euid
-#define euid pPerl->Perl_euid
-#undef gid
-#define gid pPerl->Perl_gid
-#undef egid
-#define egid pPerl->Perl_egid
-#undef endav
-#define endav pPerl->Perl_endav
+
+/* Varibles */
+#undef Argv
+#define Argv pPerl->Perl_Argv
+#undef Cmd
+#define Cmd pPerl->Perl_Cmd
+#undef DBcv
+#define DBcv pPerl->Perl_DBcv
+#undef DBgv
+#define DBgv pPerl->Perl_DBgv
+#undef DBline
+#define DBline pPerl->Perl_DBline
+#undef DBsignal
+#define DBsignal pPerl->Perl_DBsignal
+#undef DBsingle
+#define DBsingle pPerl->Perl_DBsingle
+#undef DBsub
+#define DBsub pPerl->Perl_DBsub
+#undef DBtrace
+#define DBtrace pPerl->Perl_DBtrace
+#undef No
+#define No pPerl->Perl_No
+#undef Sv
+#define Sv pPerl->Perl_Sv
+#undef Xpv
+#define Xpv pPerl->Perl_Xpv
+#undef Yes
+#define Yes pPerl->Perl_Yes
+#undef amagic_generation
+#define amagic_generation pPerl->Perl_amagic_generation
+#undef ampergv
+#define ampergv pPerl->Perl_ampergv
#undef an
-#define an pPerl->Perl_an
+#define an pPerl->Perl_an
+#undef archpat_auto
+#define archpat_auto pPerl->Perl_archpat_auto
+#undef argvgv
+#define argvgv pPerl->Perl_argvgv
+#undef argvoutgv
+#define argvoutgv pPerl->Perl_argvoutgv
+#undef basetime
+#define basetime pPerl->Perl_basetime
+#undef beginav
+#define beginav pPerl->Perl_beginav
+#undef bodytarget
+#define bodytarget pPerl->Perl_bodytarget
+#undef bostr
+#define bostr pPerl->Perl_bostr
+#undef bufend
+#define bufend pPerl->Perl_bufend
+#undef bufptr
+#define bufptr pPerl->Perl_bufptr
+#undef cddir
+#define cddir pPerl->Perl_cddir
+#undef chopset
+#define chopset pPerl->Perl_chopset
+#undef collation_ix
+#define collation_ix pPerl->Perl_collation_ix
+#undef collation_name
+#define collation_name pPerl->Perl_collation_name
+#undef collation_standard
+#define collation_standard pPerl->Perl_collation_standard
+#undef collxfrm_base
+#define collxfrm_base pPerl->Perl_collxfrm_base
+#undef collxfrm_mult
+#define collxfrm_mult pPerl->Perl_collxfrm_mult
+#undef colors
+#define colors pPerl->Perl_colors
+#undef colorset
+#define colorset pPerl->Perl_colorset
#undef compcv
-#define compcv pPerl->Perl_compcv
+#define compcv pPerl->Perl_compcv
+#undef compiling
+#define compiling pPerl->Perl_compiling
+#undef comppad
+#define comppad pPerl->Perl_comppad
+#undef comppad_name
+#define comppad_name pPerl->Perl_comppad_name
+#undef comppad_name_fill
+#define comppad_name_fill pPerl->Perl_comppad_name_fill
+#undef comppad_name_floor
+#define comppad_name_floor pPerl->Perl_comppad_name_floor
#undef cop_seqmax
-#define cop_seqmax pPerl->Perl_cop_seqmax
+#define cop_seqmax pPerl->Perl_cop_seqmax
+#undef copline
+#define copline pPerl->Perl_copline
+#undef cryptseen
+#define cryptseen pPerl->Perl_cryptseen
+#undef cshlen
+#define cshlen pPerl->Perl_cshlen
+#undef cshname
+#define cshname pPerl->Perl_cshname
+#undef curcop
+#define curcop pPerl->Perl_curcop
+#undef curcopdb
+#define curcopdb pPerl->Perl_curcopdb
+#undef curinterp
+#define curinterp pPerl->Perl_curinterp
+#undef curpad
+#define curpad pPerl->Perl_curpad
+#undef curpm
+#define curpm pPerl->Perl_curpm
+#undef curstack
+#define curstack pPerl->Perl_curstack
+#undef curstash
+#define curstash pPerl->Perl_curstash
+#undef curstname
+#define curstname pPerl->Perl_curstname
+#undef curthr
+#define curthr pPerl->Perl_curthr
+#undef cxstack
+#define cxstack pPerl->Perl_cxstack
+#undef cxstack_ix
+#define cxstack_ix pPerl->Perl_cxstack_ix
+#undef cxstack_max
+#define cxstack_max pPerl->Perl_cxstack_max
+#undef dbargs
+#define dbargs pPerl->Perl_dbargs
+#undef debdelim
+#define debdelim pPerl->Perl_debdelim
+#undef debname
+#define debname pPerl->Perl_debname
+#undef debstash
+#define debstash pPerl->Perl_debstash
+#undef debug
+#define debug pPerl->Perl_debug
+#undef defgv
+#define defgv pPerl->Perl_defgv
+#undef defoutgv
+#define defoutgv pPerl->Perl_defoutgv
#undef defstash
-#define defstash pPerl->Perl_defstash
+#define defstash pPerl->Perl_defstash
+#undef delaymagic
+#define delaymagic pPerl->Perl_delaymagic
+#undef diehook
+#define diehook pPerl->Perl_diehook
+#undef dirty
+#define dirty pPerl->Perl_dirty
+#undef dlevel
+#define dlevel pPerl->Perl_dlevel
+#undef dlmax
+#define dlmax pPerl->Perl_dlmax
+#undef do_undump
+#define do_undump pPerl->Perl_do_undump
+#undef doextract
+#define doextract pPerl->Perl_doextract
+#undef doswitches
+#define doswitches pPerl->Perl_doswitches
#undef dowarn
-#define dowarn pPerl->Perl_dowarn
+#define dowarn pPerl->Perl_dowarn
+#undef dumplvl
+#define dumplvl pPerl->Perl_dumplvl
+#undef e_fp
+#define e_fp pPerl->Perl_e_fp
+#undef e_tmpname
+#define e_tmpname pPerl->Perl_e_tmpname
+#undef egid
+#define egid pPerl->Perl_egid
+#undef endav
+#define endav pPerl->Perl_endav
+#undef envgv
+#define envgv pPerl->Perl_envgv
+#undef errgv
+#define errgv pPerl->Perl_errgv
+#undef error_count
+#define error_count pPerl->Perl_error_count
+#undef euid
+#define euid pPerl->Perl_euid
+#undef eval_cond
+#define eval_cond pPerl->Perl_eval_cond
+#undef eval_mutex
+#define eval_mutex pPerl->Perl_eval_mutex
+#undef eval_owner
+#define eval_owner pPerl->Perl_eval_owner
+#undef eval_root
+#define eval_root pPerl->Perl_eval_root
+#undef eval_start
+#define eval_start pPerl->Perl_eval_start
#undef evalseq
-#define evalseq pPerl->Perl_evalseq
+#define evalseq pPerl->Perl_evalseq
+#undef expect
+#define expect pPerl->Perl_expect
+#undef extralen
+#define extralen pPerl->Perl_extralen
+#undef fdpid
+#define fdpid pPerl->Perl_fdpid
+#undef filemode
+#define filemode pPerl->Perl_filemode
+#undef firstgv
+#define firstgv pPerl->Perl_firstgv
+#undef forkprocess
+#define forkprocess pPerl->Perl_forkprocess
+#undef formfeed
+#define formfeed pPerl->Perl_formfeed
+#undef formtarget
+#define formtarget pPerl->Perl_formtarget
+#undef generation
+#define generation pPerl->Perl_generation
+#undef gensym
+#define gensym pPerl->Perl_gensym
+#undef gid
+#define gid pPerl->Perl_gid
+#undef globalstash
+#define globalstash pPerl->Perl_globalstash
+#undef he_root
+#define he_root pPerl->Perl_he_root
#undef hexdigit
-#define hexdigit pPerl->Perl_hexdigit
-#undef sub_generation
-#define sub_generation pPerl->Perl_sub_generation
-#undef origenviron
-#define origenviron pPerl->Perl_origenviron
-#undef environ
-#define environ pPerl->Perl_environ
+#define hexdigit pPerl->Perl_hexdigit
+#undef hints
+#define hints pPerl->Perl_hints
+#undef in_clean_all
+#define in_clean_all pPerl->Perl_in_clean_all
+#undef in_clean_objs
+#define in_clean_objs pPerl->Perl_in_clean_objs
+#undef in_eval
+#define in_eval pPerl->Perl_in_eval
+#undef in_my
+#define in_my pPerl->Perl_in_my
+#undef in_my_stash
+#define in_my_stash pPerl->Perl_in_my_stash
+#undef incgv
+#define incgv pPerl->Perl_incgv
+#undef initav
+#define initav pPerl->Perl_initav
+#undef inplace
+#define inplace pPerl->Perl_inplace
+#undef last_in_gv
+#define last_in_gv pPerl->Perl_last_in_gv
+#undef last_lop
+#define last_lop pPerl->Perl_last_lop
+#undef last_lop_op
+#define last_lop_op pPerl->Perl_last_lop_op
+#undef last_uni
+#define last_uni pPerl->Perl_last_uni
+#undef lastfd
+#define lastfd pPerl->Perl_lastfd
+#undef lastgotoprobe
+#define lastgotoprobe pPerl->Perl_lastgotoprobe
+#undef lastscream
+#define lastscream pPerl->Perl_lastscream
+#undef lastsize
+#define lastsize pPerl->Perl_lastsize
+#undef lastspbase
+#define lastspbase pPerl->Perl_lastspbase
+#undef laststatval
+#define laststatval pPerl->Perl_laststatval
+#undef laststype
+#define laststype pPerl->Perl_laststype
+#undef leftgv
+#define leftgv pPerl->Perl_leftgv
+#undef lex_brackets
+#define lex_brackets pPerl->Perl_lex_brackets
+#undef lex_brackstack
+#define lex_brackstack pPerl->Perl_lex_brackstack
+#undef lex_casemods
+#define lex_casemods pPerl->Perl_lex_casemods
+#undef lex_casestack
+#define lex_casestack pPerl->Perl_lex_casestack
+#undef lex_defer
+#define lex_defer pPerl->Perl_lex_defer
+#undef lex_dojoin
+#define lex_dojoin pPerl->Perl_lex_dojoin
+#undef lex_expect
+#define lex_expect pPerl->Perl_lex_expect
+#undef lex_fakebrack
+#define lex_fakebrack pPerl->Perl_lex_fakebrack
+#undef lex_formbrack
+#define lex_formbrack pPerl->Perl_lex_formbrack
+#undef lex_inpat
+#define lex_inpat pPerl->Perl_lex_inpat
+#undef lex_inwhat
+#define lex_inwhat pPerl->Perl_lex_inwhat
+#undef lex_op
+#define lex_op pPerl->Perl_lex_op
+#undef lex_repl
+#define lex_repl pPerl->Perl_lex_repl
+#undef lex_starts
+#define lex_starts pPerl->Perl_lex_starts
+#undef lex_state
+#define lex_state pPerl->Perl_lex_state
+#undef lex_stuff
+#define lex_stuff pPerl->Perl_lex_stuff
+#undef lineary
+#define lineary pPerl->Perl_lineary
+#undef linestart
+#define linestart pPerl->Perl_linestart
+#undef linestr
+#define linestr pPerl->Perl_linestr
+#undef localizing
+#define localizing pPerl->Perl_localizing
+#undef localpatches
+#define localpatches pPerl->Perl_localpatches
+#undef main_cv
+#define main_cv pPerl->Perl_main_cv
+#undef main_root
+#define main_root pPerl->Perl_main_root
+#undef main_start
+#define main_start pPerl->Perl_main_start
+#undef mainstack
+#define mainstack pPerl->Perl_mainstack
+#undef malloc_mutex
+#define malloc_mutex pPerl->Perl_malloc_mutex
+#undef markstack
+#define markstack pPerl->Perl_markstack
+#undef markstack_max
+#define markstack_max pPerl->Perl_markstack_max
+#undef markstack_ptr
+#define markstack_ptr pPerl->Perl_markstack_ptr
+#undef max_intro_pending
+#define max_intro_pending pPerl->Perl_max_intro_pending
+#undef maxo
+#define maxo pPerl->Perl_maxo
+#undef maxscream
+#define maxscream pPerl->Perl_maxscream
+#undef maxsysfd
+#define maxsysfd pPerl->Perl_maxsysfd
+#undef mess_sv
+#define mess_sv pPerl->Perl_mess_sv
+#undef mh
+#define mh pPerl->Perl_mh
+#undef min_intro_pending
+#define min_intro_pending pPerl->Perl_min_intro_pending
+#undef minus_F
+#define minus_F pPerl->Perl_minus_F
+#undef minus_a
+#define minus_a pPerl->Perl_minus_a
+#undef minus_c
+#define minus_c pPerl->Perl_minus_c
+#undef minus_l
+#define minus_l pPerl->Perl_minus_l
+#undef minus_n
+#define minus_n pPerl->Perl_minus_n
+#undef minus_p
+#define minus_p pPerl->Perl_minus_p
+#undef modcount
+#define modcount pPerl->Perl_modcount
+#undef multi_close
+#define multi_close pPerl->Perl_multi_close
+#undef multi_end
+#define multi_end pPerl->Perl_multi_end
+#undef multi_open
+#define multi_open pPerl->Perl_multi_open
+#undef multi_start
+#define multi_start pPerl->Perl_multi_start
+#undef multiline
+#define multiline pPerl->Perl_multiline
+#undef mystrk
+#define mystrk pPerl->Perl_mystrk
+#undef na
+#define na pPerl->Perl_na
+#undef nexttoke
+#define nexttoke pPerl->Perl_nexttoke
+#undef nexttype
+#define nexttype pPerl->Perl_nexttype
+#undef nextval
+#define nextval pPerl->Perl_nextval
+#undef nice_chunk
+#define nice_chunk pPerl->Perl_nice_chunk
+#undef nice_chunk_size
+#define nice_chunk_size pPerl->Perl_nice_chunk_size
+#undef nomemok
+#define nomemok pPerl->Perl_nomemok
+#undef nrs
+#define nrs pPerl->Perl_nrs
+#undef nthreads
+#define nthreads pPerl->Perl_nthreads
+#undef nthreads_cond
+#define nthreads_cond pPerl->Perl_nthreads_cond
+#undef numeric_local
+#define numeric_local pPerl->Perl_numeric_local
+#undef numeric_name
+#define numeric_name pPerl->Perl_numeric_name
+#undef numeric_standard
+#define numeric_standard pPerl->Perl_numeric_standard
+#undef ofmt
+#define ofmt pPerl->Perl_ofmt
+#undef ofs
+#define ofs pPerl->Perl_ofs
+#undef ofslen
+#define ofslen pPerl->Perl_ofslen
+#undef oldbufptr
+#define oldbufptr pPerl->Perl_oldbufptr
+#undef oldlastpm
+#define oldlastpm pPerl->Perl_oldlastpm
+#undef oldname
+#define oldname pPerl->Perl_oldname
+#undef oldoldbufptr
+#define oldoldbufptr pPerl->Perl_oldoldbufptr
+#undef op
+#define op pPerl->Perl_op
+#undef op_mask
+#define op_mask pPerl->Perl_op_mask
+#undef op_seqmax
+#define op_seqmax pPerl->Perl_op_seqmax
+#undef opsave
+#define opsave pPerl->Perl_opsave
#undef origalen
-#define origalen pPerl->Perl_origalen
+#define origalen pPerl->Perl_origalen
+#undef origargc
+#define origargc pPerl->Perl_origargc
+#undef origargv
+#define origargv pPerl->Perl_origargv
+#undef origenviron
+#define origenviron pPerl->Perl_origenviron
+#undef origfilename
+#define origfilename pPerl->Perl_origfilename
+#undef ors
+#define ors pPerl->Perl_ors
+#undef orslen
+#define orslen pPerl->Perl_orslen
+#undef osname
+#define osname pPerl->Perl_osname
+#undef pad_reset_pending
+#define pad_reset_pending pPerl->Perl_pad_reset_pending
+#undef padix
+#define padix pPerl->Perl_padix
+#undef padix_floor
+#define padix_floor pPerl->Perl_padix_floor
+#undef parsehook
+#define parsehook pPerl->Perl_parsehook
+#undef patchlevel
+#define patchlevel pPerl->Perl_patchlevel
+#undef patleave
+#define patleave pPerl->Perl_patleave
+#undef pending_ident
+#define pending_ident pPerl->Perl_pending_ident
+#undef perl_destruct_level
+#define perl_destruct_level pPerl->Perl_perl_destruct_level
+#undef perldb
+#define perldb pPerl->Perl_perldb
+#undef pidstatus
+#define pidstatus pPerl->Perl_pidstatus
+#undef preambleav
+#define preambleav pPerl->Perl_preambleav
+#undef preambled
+#define preambled pPerl->Perl_preambled
+#undef preprocess
+#define preprocess pPerl->Perl_preprocess
#undef profiledata
-#define profiledata pPerl->Perl_profiledata
-#undef xiv_arenaroot
-#define xiv_arenaroot pPerl->Perl_xiv_arenaroot
-#undef xiv_root
-#define xiv_root pPerl->Perl_xiv_root
-#undef xnv_root
-#define xnv_root pPerl->Perl_xnv_root
-#undef xrv_root
-#define xrv_root pPerl->Perl_xrv_root
-#undef xpv_root
-#define xpv_root pPerl->Perl_xpv_root
-#undef stack_base
-#define stack_base pPerl->Perl_stack_base
-#undef stack_sp
-#define stack_sp pPerl->Perl_stack_sp
-#undef stack_max
-#define stack_max pPerl->Perl_stack_max
-#undef op
-#define op pPerl->Perl_op
-#undef scopestack
-#define scopestack pPerl->Perl_scopestack
-#undef scopestack_ix
-#define scopestack_ix pPerl->Perl_scopestack_ix
-#undef scopestack_max
-#define scopestack_max pPerl->Perl_scopestack_max
+#define profiledata pPerl->Perl_profiledata
+#undef reg_eval_set
+#define reg_eval_set pPerl->Perl_reg_eval_set
+#undef reg_flags
+#define reg_flags pPerl->Perl_reg_flags
+#undef reg_start_tmp
+#define reg_start_tmp pPerl->Perl_reg_start_tmp
+#undef reg_start_tmpl
+#define reg_start_tmpl pPerl->Perl_reg_start_tmpl
+#undef regbol
+#define regbol pPerl->Perl_regbol
+#undef regcc
+#define regcc pPerl->Perl_regcc
+#undef regcode
+#define regcode pPerl->Perl_regcode
+#undef regdata
+#define regdata pPerl->Perl_regdata
+#undef regdummy
+#define regdummy pPerl->Perl_regdummy
+#undef regendp
+#define regendp pPerl->Perl_regendp
+#undef regeol
+#define regeol pPerl->Perl_regeol
+#undef regflags
+#define regflags pPerl->Perl_regflags
+#undef regindent
+#define regindent pPerl->Perl_regindent
+#undef reginput
+#define reginput pPerl->Perl_reginput
+#undef reglastparen
+#define reglastparen pPerl->Perl_reglastparen
+#undef regnarrate
+#define regnarrate pPerl->Perl_regnarrate
+#undef regnaughty
+#define regnaughty pPerl->Perl_regnaughty
+#undef regnpar
+#define regnpar pPerl->Perl_regnpar
+#undef regparse
+#define regparse pPerl->Perl_regparse
+#undef regprecomp
+#define regprecomp pPerl->Perl_regprecomp
+#undef regprev
+#define regprev pPerl->Perl_regprev
+#undef regprogram
+#define regprogram pPerl->Perl_regprogram
+#undef regsawback
+#define regsawback pPerl->Perl_regsawback
+#undef regseen
+#define regseen pPerl->Perl_regseen
+#undef regsize
+#define regsize pPerl->Perl_regsize
+#undef regstartp
+#define regstartp pPerl->Perl_regstartp
+#undef regtill
+#define regtill pPerl->Perl_regtill
+#undef regxend
+#define regxend pPerl->Perl_regxend
+#undef restartop
+#define restartop pPerl->Perl_restartop
+#undef retstack
+#define retstack pPerl->Perl_retstack
+#undef retstack_ix
+#define retstack_ix pPerl->Perl_retstack_ix
+#undef retstack_max
+#define retstack_max pPerl->Perl_retstack_max
+#undef rightgv
+#define rightgv pPerl->Perl_rightgv
+#undef rs
+#define rs pPerl->Perl_rs
+#undef rsfp
+#define rsfp pPerl->Perl_rsfp
+#undef rsfp_filters
+#define rsfp_filters pPerl->Perl_rsfp_filters
+#undef runops
+#define runops pPerl->Perl_runops
+#undef rx
+#define rx pPerl->Perl_rx
#undef savestack
-#define savestack pPerl->Perl_savestack
+#define savestack pPerl->Perl_savestack
#undef savestack_ix
#define savestack_ix pPerl->Perl_savestack_ix
#undef savestack_max
#define savestack_max pPerl->Perl_savestack_max
-#undef tmps_floor
-#define tmps_floor pPerl->Perl_tmps_floor
-#undef tmps_ix
-#define tmps_ix pPerl->Perl_tmps_ix
-#undef retstack
-#define retstack pPerl->Perl_retstack
-#undef retstack_ix
-#define retstack_ix pPerl->Perl_retstack_ix
-#undef retstack_max
-#define retstack_max pPerl->Perl_retstack_max
-#undef markstack
-#define markstack pPerl->Perl_markstack
-#undef markstack_ptr
-#define markstack_ptr pPerl->Perl_markstack_ptr
-#undef markstack_max
-#define markstack_max pPerl->Perl_markstack_max
-#undef maxo
-#define maxo pPerl->Perl_maxo
-#undef op_mask
-#define op_mask pPerl->Perl_op_mask
-#undef curpad
-#define curpad pPerl->Perl_curpad
-#undef Sv
-#define Sv pPerl->Perl_Sv
-#undef Xpv
-#define Xpv pPerl->Perl_Xpv
-#undef tokenbuf
-#define tokenbuf pPerl->Perl_tokenbuf
+#undef sawampersand
+#define sawampersand pPerl->Perl_sawampersand
+#undef sawstudy
+#define sawstudy pPerl->Perl_sawstudy
+#undef sawvec
+#define sawvec pPerl->Perl_sawvec
+#undef scopestack
+#define scopestack pPerl->Perl_scopestack
+#undef scopestack_ix
+#define scopestack_ix pPerl->Perl_scopestack_ix
+#undef scopestack_max
+#define scopestack_max pPerl->Perl_scopestack_max
+#undef screamfirst
+#define screamfirst pPerl->Perl_screamfirst
+#undef screamnext
+#define screamnext pPerl->Perl_screamnext
+#undef scrgv
+#define scrgv pPerl->Perl_scrgv
+#undef secondgv
+#define secondgv pPerl->Perl_secondgv
+#undef seen_zerolen
+#define seen_zerolen pPerl->Perl_seen_zerolen
+#undef sh_path
+#define sh_path pPerl->Perl_sh_path
+#undef siggv
+#define siggv pPerl->Perl_siggv
+#undef sighandlerp
+#define sighandlerp pPerl->Perl_sighandlerp
+#undef signalstack
+#define signalstack pPerl->Perl_signalstack
+#undef sortcop
+#define sortcop pPerl->Perl_sortcop
+#undef sortcxix
+#define sortcxix pPerl->Perl_sortcxix
+#undef sortstack
+#define sortstack pPerl->Perl_sortstack
+#undef sortstash
+#define sortstash pPerl->Perl_sortstash
+#undef splitstr
+#define splitstr pPerl->Perl_splitstr
+#undef stack_base
+#define stack_base pPerl->Perl_stack_base
+#undef stack_max
+#define stack_max pPerl->Perl_stack_max
+#undef stack_sp
+#define stack_sp pPerl->Perl_stack_sp
+#undef start_env
+#define start_env pPerl->Perl_start_env
#undef statbuf
-#define statbuf pPerl->Perl_statbuf
-#undef timesbuf
-#define timesbuf pPerl->Perl_timesbuf
-#undef di
-#define di pPerl->Perl_di
-#undef ds
-#define ds pPerl->Perl_ds
-#undef dc
-#define dc pPerl->Perl_dc
-#undef sv_undef
-#define sv_undef pPerl->Perl_sv_undef
+#define statbuf pPerl->Perl_statbuf
+#undef statcache
+#define statcache pPerl->Perl_statcache
+#undef statgv
+#define statgv pPerl->Perl_statgv
+#undef statname
+#define statname pPerl->Perl_statname
+#undef statusvalue
+#define statusvalue pPerl->Perl_statusvalue
+#undef statusvalue_vms
+#define statusvalue_vms pPerl->Perl_statusvalue_vms
+#undef stdingv
+#define stdingv pPerl->Perl_stdingv
+#undef strchop
+#define strchop pPerl->Perl_strchop
+#undef strtab
+#define strtab pPerl->Perl_strtab
+#undef sub_generation
+#define sub_generation pPerl->Perl_sub_generation
+#undef sublex_info
+#define sublex_info pPerl->Perl_sublex_info
+#undef subline
+#define subline pPerl->Perl_subline
+#undef subname
+#define subname pPerl->Perl_subname
+#undef sv_arenaroot
+#define sv_arenaroot pPerl->Perl_sv_arenaroot
+#undef sv_count
+#define sv_count pPerl->Perl_sv_count
+#undef sv_mutex
+#define sv_mutex pPerl->Perl_sv_mutex
#undef sv_no
-#define sv_no pPerl->Perl_sv_no
+#define sv_no pPerl->Perl_sv_no
+#undef sv_objcount
+#define sv_objcount pPerl->Perl_sv_objcount
+#undef sv_root
+#define sv_root pPerl->Perl_sv_root
+#undef sv_undef
+#define sv_undef pPerl->Perl_sv_undef
#undef sv_yes
-#define sv_yes pPerl->Perl_sv_yes
-#undef na
-#define na pPerl->Perl_na
-
-#undef yydebug
-#define yydebug pPerl->Perl_yydebug
-#undef yynerrs
-#define yynerrs pPerl->Perl_yynerrs
-#undef yyerrflag
-#define yyerrflag pPerl->Perl_yyerrflag
-#undef yychar
-#define yychar pPerl->Perl_yychar
-#undef yyval
-#define yyval pPerl->Perl_yyval
-#undef yylval
-#define yylval pPerl->Perl_yylval
+#define sv_yes pPerl->Perl_sv_yes
+#undef tainted
+#define tainted pPerl->Perl_tainted
+#undef tainting
+#define tainting pPerl->Perl_tainting
+#undef thisexpr
+#define thisexpr pPerl->Perl_thisexpr
+#undef thr_key
+#define thr_key pPerl->Perl_thr_key
+#undef threadnum
+#define threadnum pPerl->Perl_threadnum
+#undef threads_mutex
+#define threads_mutex pPerl->Perl_threads_mutex
+#undef threadsv_names
+#define threadsv_names pPerl->Perl_threadsv_names
+#undef thrsv
+#define thrsv pPerl->Perl_thrsv
+#undef timesbuf
+#define timesbuf pPerl->Perl_timesbuf
+#undef tmps_floor
+#define tmps_floor pPerl->Perl_tmps_floor
+#undef tmps_ix
+#define tmps_ix pPerl->Perl_tmps_ix
+#undef tmps_max
+#define tmps_max pPerl->Perl_tmps_max
+#undef tmps_stack
+#define tmps_stack pPerl->Perl_tmps_stack
+#undef tokenbuf
+#define tokenbuf pPerl->Perl_tokenbuf
+#undef top_env
+#define top_env pPerl->Perl_top_env
+#undef toptarget
+#define toptarget pPerl->Perl_toptarget
+#undef uid
+#define uid pPerl->Perl_uid
+#undef unsafe
+#define unsafe pPerl->Perl_unsafe
+#undef warnhook
+#define warnhook pPerl->Perl_warnhook
+#undef xiv_arenaroot
+#define xiv_arenaroot pPerl->Perl_xiv_arenaroot
+#undef xiv_root
+#define xiv_root pPerl->Perl_xiv_root
+#undef xnv_root
+#define xnv_root pPerl->Perl_xnv_root
+#undef xpv_root
+#define xpv_root pPerl->Perl_xpv_root
+#undef xrv_root
+#define xrv_root pPerl->Perl_xrv_root
-// functions
+/* Functions */
#undef amagic_call
#define amagic_call pPerl->Perl_amagic_call
#undef sublex_start
#define sublex_start pPerl->Perl_sublex_start
#undef sv_2bool
-#define sv_2bool pPerl->Perl_sv_2bool
+#define sv_2bool pPerl->Perl_sv_2bool
#undef sv_2cv
-#define sv_2cv pPerl->Perl_sv_2cv
+#define sv_2cv pPerl->Perl_sv_2cv
#undef sv_2io
-#define sv_2io pPerl->Perl_sv_2io
+#define sv_2io pPerl->Perl_sv_2io
#undef sv_2iv
-#define sv_2iv pPerl->Perl_sv_2iv
+#define sv_2iv pPerl->Perl_sv_2iv
#undef sv_2mortal
-#define sv_2mortal pPerl->Perl_sv_2mortal
+#define sv_2mortal pPerl->Perl_sv_2mortal
#undef sv_2nv
-#define sv_2nv pPerl->Perl_sv_2nv
+#define sv_2nv pPerl->Perl_sv_2nv
#undef sv_2pv
-#define sv_2pv pPerl->Perl_sv_2pv
+#define sv_2pv pPerl->Perl_sv_2pv
+#undef sv_2uv
+#define sv_2uv pPerl->Perl_sv_2uv
#undef sv_add_arena
-#define sv_add_arena pPerl->Perl_sv_add_arena
+#define sv_add_arena pPerl->Perl_sv_add_arena
#undef sv_backoff
-#define sv_backoff pPerl->Perl_sv_backoff
+#define sv_backoff pPerl->Perl_sv_backoff
#undef sv_bless
-#define sv_bless pPerl->Perl_sv_bless
+#define sv_bless pPerl->Perl_sv_bless
#undef sv_catpv
-#define sv_catpv pPerl->Perl_sv_catpv
+#define sv_catpv pPerl->Perl_sv_catpv
#undef sv_catpvf
-#define sv_catpvf pPerl->Perl_sv_catpvf
+#define sv_catpvf pPerl->Perl_sv_catpvf
#undef sv_catpvn
-#define sv_catpvn pPerl->Perl_sv_catpvn
+#define sv_catpvn pPerl->Perl_sv_catpvn
#undef sv_catsv
-#define sv_catsv pPerl->Perl_sv_catsv
+#define sv_catsv pPerl->Perl_sv_catsv
#undef sv_chop
-#define sv_chop pPerl->Perl_sv_chop
+#define sv_chop pPerl->Perl_sv_chop
#undef sv_clean_all
-#define sv_clean_all pPerl->Perl_sv_clean_all
+#define sv_clean_all pPerl->Perl_sv_clean_all
#undef sv_clean_objs
-#define sv_clean_objs pPerl->Perl_sv_clean_objs
+#define sv_clean_objs pPerl->Perl_sv_clean_objs
#undef sv_clear
-#define sv_clear pPerl->Perl_sv_clear
+#define sv_clear pPerl->Perl_sv_clear
#undef sv_cmp
-#define sv_cmp pPerl->Perl_sv_cmp
+#define sv_cmp pPerl->Perl_sv_cmp
+#undef sv_cmp_locale
+#define sv_cmp_locale pPerl->Perl_sv_cmp_locale
+#undef sv_collxfrm
+#define sv_collxfrm pPerl->Perl_sv_collxfrm
+#undef sv_compile_2op
+#define sv_compile_2op pPerl->Perl_sv_compile_2op
#undef sv_dec
-#define sv_dec pPerl->Perl_sv_dec
+#define sv_dec pPerl->Perl_sv_dec
#undef sv_derived_from
-#define sv_derived_from pPerl->Perl_sv_derived_from
+#define sv_derived_from pPerl->Perl_sv_derived_from
#undef sv_dump
-#define sv_dump pPerl->Perl_sv_dump
+#define sv_dump pPerl->Perl_sv_dump
#undef sv_eq
-#define sv_eq pPerl->Perl_sv_eq
+#define sv_eq pPerl->Perl_sv_eq
#undef sv_free
-#define sv_free pPerl->Perl_sv_free
+#define sv_free pPerl->Perl_sv_free
#undef sv_free_arenas
-#define sv_free_arenas pPerl->Perl_sv_free_arenas
+#define sv_free_arenas pPerl->Perl_sv_free_arenas
#undef sv_gets
-#define sv_gets pPerl->Perl_sv_gets
+#define sv_gets pPerl->Perl_sv_gets
#undef sv_grow
-#define sv_grow pPerl->Perl_sv_grow
+#define sv_grow pPerl->Perl_sv_grow
#undef sv_inc
-#define sv_inc pPerl->Perl_sv_inc
+#define sv_inc pPerl->Perl_sv_inc
#undef sv_insert
-#define sv_insert pPerl->Perl_sv_insert
+#define sv_insert pPerl->Perl_sv_insert
#undef sv_isa
-#define sv_isa pPerl->Perl_sv_isa
+#define sv_isa pPerl->Perl_sv_isa
#undef sv_isobject
-#define sv_isobject pPerl->Perl_sv_isobject
+#define sv_isobject pPerl->Perl_sv_isobject
+#undef sv_iv
+#define sv_iv pPerl->Perl_sv_iv
#undef sv_len
-#define sv_len pPerl->Perl_sv_len
+#define sv_len pPerl->Perl_sv_len
#undef sv_magic
-#define sv_magic pPerl->Perl_sv_magic
+#define sv_magic pPerl->Perl_sv_magic
#undef sv_mortalcopy
-#define sv_mortalcopy pPerl->Perl_sv_mortalcopy
-#undef sv_mortalgrow
-#define sv_mortalgrow pPerl->sv_mortalgrow
+#define sv_mortalcopy pPerl->Perl_sv_mortalcopy
#undef sv_newmortal
-#define sv_newmortal pPerl->Perl_sv_newmortal
+#define sv_newmortal pPerl->Perl_sv_newmortal
#undef sv_newref
-#define sv_newref pPerl->Perl_sv_newref
+#define sv_newref pPerl->Perl_sv_newref
+#undef sv_nv
+#define sv_nv pPerl->Perl_sv_nv
#undef sv_pvn
-#define sv_pvn pPerl->Perl_sv_pvn
+#define sv_pvn pPerl->Perl_sv_pvn
#undef sv_pvn_force
-#define sv_pvn_force pPerl->Perl_sv_pvn_force
+#define sv_pvn_force pPerl->Perl_sv_pvn_force
#undef sv_reftype
-#define sv_reftype pPerl->Perl_sv_reftype
+#define sv_reftype pPerl->Perl_sv_reftype
#undef sv_replace
-#define sv_replace pPerl->Perl_sv_replace
+#define sv_replace pPerl->Perl_sv_replace
#undef sv_report_used
-#define sv_report_used pPerl->Perl_sv_report_used
+#define sv_report_used pPerl->Perl_sv_report_used
#undef sv_reset
-#define sv_reset pPerl->Perl_sv_reset
+#define sv_reset pPerl->Perl_sv_reset
#undef sv_setiv
-#define sv_setiv pPerl->Perl_sv_setiv
+#define sv_setiv pPerl->Perl_sv_setiv
#undef sv_setnv
-#define sv_setnv pPerl->Perl_sv_setnv
+#define sv_setnv pPerl->Perl_sv_setnv
+#undef sv_setpv
+#define sv_setpv pPerl->Perl_sv_setpv
+#undef sv_setpvf
+#define sv_setpvf pPerl->Perl_sv_setpvf
+#undef sv_setpviv
+#define sv_setpviv pPerl->Perl_sv_setpviv
+#undef sv_setpvn
+#define sv_setpvn pPerl->Perl_sv_setpvn
#undef sv_setref_iv
-#define sv_setref_iv pPerl->Perl_sv_setref_iv
+#define sv_setref_iv pPerl->Perl_sv_setref_iv
#undef sv_setref_nv
-#define sv_setref_nv pPerl->Perl_sv_setref_nv
+#define sv_setref_nv pPerl->Perl_sv_setref_nv
#undef sv_setref_pv
-#define sv_setref_pv pPerl->Perl_sv_setref_pv
+#define sv_setref_pv pPerl->Perl_sv_setref_pv
#undef sv_setref_pvn
-#define sv_setref_pvn pPerl->Perl_sv_setref_pvn
-#undef sv_setpv
-#define sv_setpv pPerl->Perl_sv_setpv
-#undef sv_setpvf
-#define sv_setpvf pPerl->Perl_sv_setpvf
-#undef sv_setpvn
-#define sv_setpvn pPerl->Perl_sv_setpvn
+#define sv_setref_pvn pPerl->Perl_sv_setref_pvn
#undef sv_setsv
-#define sv_setsv pPerl->Perl_sv_setsv
-#undef sv_unglob
-#define sv_unglob pPerl->sv_unglob
+#define sv_setsv pPerl->Perl_sv_setsv
+#undef sv_setuv
+#define sv_setuv pPerl->Perl_sv_setuv
+#undef sv_taint
+#define sv_taint pPerl->Perl_sv_taint
+#undef sv_tainted
+#define sv_tainted pPerl->Perl_sv_tainted
+#undef sv_true
+#define sv_true pPerl->Perl_sv_true
#undef sv_unmagic
-#define sv_unmagic pPerl->Perl_sv_unmagic
+#define sv_unmagic pPerl->Perl_sv_unmagic
#undef sv_unref
-#define sv_unref pPerl->Perl_sv_unref
+#define sv_unref pPerl->Perl_sv_unref
+#undef sv_untaint
+#define sv_untaint pPerl->Perl_sv_untaint
#undef sv_upgrade
-#define sv_upgrade pPerl->Perl_sv_upgrade
+#define sv_upgrade pPerl->Perl_sv_upgrade
#undef sv_usepvn
-#define sv_usepvn pPerl->Perl_sv_usepvn
+#define sv_usepvn pPerl->Perl_sv_usepvn
+#undef sv_uv
+#define sv_uv pPerl->Perl_sv_uv
+#undef sv_vcatpvfn
+#define sv_vcatpvfn pPerl->Perl_sv_vcatpvfn
#undef sv_vsetpvfn
-#define sv_vsetpvfn pPerl->Perl_sv_vsetpvfn
+#define sv_vsetpvfn pPerl->Perl_sv_vsetpvfn
#undef taint_env
#define taint_env pPerl->Perl_taint_env
#undef taint_not
void
CPerlObj::Init(void)
{
- curcop = &compiling;
- cxstack_ix = -1;
- cxstack_max = 128;
- chopset = " \n-";
+ curcop = &compiling;
+ cxstack_ix = -1;
+ cxstack_max = 128;
+ chopset = " \n-";
#ifdef USE_THREADS
- threadsv_names = THREADSV_NAMES;
- tmps_ix = -1;
- tmps_floor = -1;
+ threadsv_names = THREADSV_NAMES;
+ tmps_ix = -1;
+ tmps_floor = -1;
#endif
- maxo = MAXO;
- sh_path = SH_PATH;
- runops = RUNOPS_DEFAULT;
+ maxo = MAXO;
+ sh_path = SH_PATH;
+ runops = RUNOPS_DEFAULT;
#ifdef CSH
- cshname = CSH;
+ cshname = CSH;
#endif
- rsfp = Nullfp;
- expect = XSTATE;
+ rsfp = Nullfp;
+ expect = XSTATE;
#ifdef USE_LOCALE_COLLATE
- collation_standard = TRUE;
- collxfrm_mult = 2;
+ collation_standard = TRUE;
+ collxfrm_mult = 2;
#endif
#ifdef USE_LOCALE_NUMERIC
- numeric_standard = TRUE;
- numeric_local = TRUE;
+ numeric_standard = TRUE;
+ numeric_local = TRUE;
#endif /* !USE_LOCALE_NUMERIC */
/* constants (these are not literals to facilitate pointer comparisons) */
- Yes = "1";
- No = "";
- hexdigit = "0123456789abcdef0123456789ABCDEFx";
- patleave = "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}";
- splitstr = " ";
- perl_destruct_level = 0;
- maxsysfd = MAXSYSFD;
- statname = Nullsv;
- maxscream = -1;
- op_mask = NULL;
- dlmax = 128;
- curcopdb = NULL;
- copline = NOLINE;
- laststatval = -1;
- laststype = OP_STAT;
- generation = 100;
+ Yes = "1";
+ No = "";
+ hexdigit = "0123456789abcdef0123456789ABCDEFx";
+ patleave = "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}";
+ splitstr = " ";
+ perl_destruct_level = 0;
+ maxsysfd = MAXSYSFD;
+ statname = Nullsv;
+ maxscream = -1;
+ op_mask = NULL;
+ dlmax = 128;
+ curcopdb = NULL;
+ copline = NOLINE;
+ laststatval = -1;
+ laststype = OP_STAT;
+ generation = 100;
#ifdef WIN32
- New(2904, environ, 1, char*);
- *environ = NULL;
+ New(2904, environ, 1, char*);
+ *environ = NULL;
#endif
}
bool
do_exec(char *cmd)
{
- return PerlProc_Cmd(cmd);
+ return PerlProc_Cmd(cmd);
}
int
do_aspawn(void *vreally, void **vmark, void **vsp)
{
- return PerlProc_aspawn(vreally, vmark, vsp);
+ return PerlProc_aspawn(vreally, vmark, vsp);
}
-
-EXTERN_C void boot_DynaLoader _((CPERLarg_ CV* cv));
-
-void CPerlObj::BootDynaLoader(void)
-{
- char *file = __FILE__;
- dXSUB_SYS;
- newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
-}
-
#endif /* WIN32 */
#endif /* PERL_OBJECT */
CvPADLIST(compcv) = comppadlist;
boot_core_UNIVERSAL();
-#if defined(WIN32) && defined(PERL_OBJECT)
- BootDynaLoader();
-#endif
+
if (xsinit)
(*xsinit)(THIS); /* in case linked C routines want magical variables */
#if defined(VMS) || defined(WIN32) || defined(DJGPP)
void dump _((char *pat,...));
#ifdef WIN32
int do_aspawn _((void *vreally, void **vmark, void **vsp));
-void BootDynaLoader(void);
#endif
#ifdef DEBUGGING
#
!IF "$(RUNTIME)" == ""
! IF "$(OBJECT)" == "-DPERL_OBJECT"
-OBJECTFLAGS = -TP $(OBJECT)
RUNTIME = -MT
! ELSE
-OBJECTFLAGS =
RUNTIME = -MD
! ENDIF
!ENDIF
! IF "$(CCTYPE)" == "MSVC20"
OPTIMIZE = -Od $(RUNTIME) -Z7 -D_DEBUG -DDEBUGGING
! ELSE
-OPTIMIZE = -Od $(RUNTIME)d -Z7 -D_DEBUG -DDEBUGGING
+OPTIMIZE = -Od -TP $(RUNTIME)d -Z7 -D_DEBUG -DDEBUGGING
! ENDIF
LINK_DBG = -debug -pdb:none
!ELSE
! IF "$(CCTYPE)" == "MSVC20"
OPTIMIZE = -O1 $(RUNTIME) -DNDEBUG
! ELSE
-OPTIMIZE = -O1 $(RUNTIME) -DNDEBUG
+OPTIMIZE = -O1 -TP $(RUNTIME) -DNDEBUG
! ENDIF
LINK_DBG = -release
!ENDIF
oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \
version.lib odbc32.lib odbccp32.lib
-CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) $(PCHFLAGS) $(OPTIMIZE)
+CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(OBJECTDEF) $(LOCDEFS) $(PCHFLAGS) $(OPTIMIZE)
+
!IF "$(OBJECT)" == "-DPERL_OBJECT"
-COBJFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(OBJECTFLAGS) $(LOCDEFS) $(PCHFLAGS) $(OPTIMIZE)
DMYMALLOC = undef
!ELSE
-COBJFLAGS = $(CFLAGS)
DMYMALLOC = define
!ENDIF
+
+!IF "$(OBJECTDEF)" == "-DPERL_OBJECT"
+MINI_SRC =
+!ELSE
+MINI_SRC = ..\perlio.c ..\malloc.c
+!ENDIF
LINK_FLAGS = -nologo $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE)
OBJOUT_FLAG = -Fo
EXEOUT_FLAG = -Fe
PERLIMPLIB=..\perl.lib
PERLDLL=..\perl.dll
!ENDIF
+!IF "$(OBJECTDEF)" != "-DPERL_OBJECT"
MINIPERL=..\miniperl.exe
+!ENDIF
+MINIPERLEXE=..\miniperl.exe
PERLEXE=..\perl.exe
GLOBEXE=..\perlglob.exe
CONFIGPM=..\lib\Config.pm
CRYPT_OBJ=$(CRYPT_SRC:.c=.obj)
!ENDIF
+!IF "$(MINI_SRC)" != ""
+MINI_OBJ=..\perlio$(o) ..\malloc$(o)
+!ENDIF
+
#
# filenames given to xsubpp must have forward slashes (since it puts
# full pathnames in #line strings)
-XSUBPP=..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp -C++ -prototypes
+XSUBPP=..\$(MINIPERLEXE) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp -C++ -prototypes
CORE_C= ..\av.c \
..\deb.c \
..\mg.c \
..\op.c \
..\perl.c \
- ..\perlio.c \
..\perly.c \
..\pp.c \
..\pp_ctl.c \
..\toke.c \
..\universal.c \
..\util.c \
- ..\malloc.c \
+ $(MINI_SRC) \
$(CRYPT_SRC)
CORE_OBJ= ..\av$(o) \
..\mg$(o) \
..\op$(o) \
..\perl$(o) \
- ..\perlio$(o) \
..\perly$(o) \
..\pp$(o) \
..\pp_ctl$(o) \
..\toke$(o) \
..\universal$(o)\
..\util$(o) \
- ..\malloc$(o) \
+ $(MINI_OBJ) \
$(CRYPT_OBJ)
WIN32_C = perllib.c \
win32sck.c \
win32thread.c
+!IF "$(USE_THREADS)" == "" && "$(OBJECT)" == "-DPERL_OBJECT"
+WIN32_OBJ = win32$(o) \
+ win32sck$(o) \
+!ELSE
WIN32_OBJ = win32$(o) \
win32sck$(o) \
win32thread$(o)
+!ENDIF
PERL95_OBJ = perl95$(o) \
win32mt$(o) \
- win32sckmt$(o) \
- $(CRYPT_OBJ)
+ win32sckmt$(o)
+
+!IF "$(OBJECT)" == "-DPERL_OBJECT"
+DLL_OBJ = $(DYNALOADER)$(o)
+!ELSE
DLL_OBJ = perllib$(o) $(DYNALOADER)$(o)
+!ENDIF
X2P_OBJ = ..\x2p\a2p$(o) \
..\x2p\hash$(o) \
# Top targets
#
-all: $(PERLEXE) $(PERL95EXE) $(GLOBEXE) $(DYNALOADMODULES) $(MINIMOD) \
- $(X2P)
+all: $(GLOBEXE) $(X2P) $(MINIMOD) $(CONFIGPM)
+
+pass2 : $(PERLEXE) $(PERL95EXE) $(DYNALOADMODULES)
$(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c
copy $(CFGH_TMPL) config.h
..\config.sh : config.w32 $(MINIPERL) config_sh.PL
- $(MINIPERL) -I..\lib config_sh.PL \
+ $(MINIPERLEXE) -I..\lib config_sh.PL \
"INST_DRV=$(INST_DRV)" \
"INST_TOP=$(INST_TOP)" \
"archname=$(ARCHNAME)" \
"cc=$(CC)" \
- "ccflags=$(OPTIMIZE) $(DEFINES) $(OBJECTFLAGS)"\
+ "ccflags=$(OPTIMIZE) $(DEFINES) $(OBJECT)"\
"cf_email=$(EMAIL)" \
"d_crypt=$(D_CRYPT)" \
"libs=$(LIBFILES)" \
$(XCOPY) ..\*.h $(COREDIR)\*.*
$(XCOPY) *.h $(COREDIR)\*.*
$(RCOPY) include $(COREDIR)\*.*
- $(MINIPERL) -I..\lib config_h.PL || $(MAKE) CCTYPE=$(CCTYPE) \
- RUNTIME=$(RUNTIME) CFG=$(CFG) $(CONFIGPM)
-
+ $(MINIPERLEXE) -I..\lib config_h.PL || $(MAKE) CCTYPE=$(CCTYPE) \
+ RUNTIME=$(RUNTIME) CFG=$(CFG) OBJECTDEF=$(OBJECT) pass2
+
+!IF "$(OBJECTDEF)" != "-DPERL_OBJECT"
$(MINIPERL) : ..\miniperlmain$(o) $(CORE_OBJ) $(WIN32_OBJ)
$(LINK32) -subsystem:console -out:$@ @<<
$(LINK_FLAGS) $(LIBFILES) ..\miniperlmain$(o) $(CORE_OBJ) $(WIN32_OBJ)
<<
+!ENDIF
+
$(WIN32_OBJ) : $(CORE_H)
$(CORE_OBJ) : $(CORE_H)
$(DLL_OBJ) : $(CORE_H)
!IF "$(OBJECT)" == "-DPERL_OBJECT"
-perldll.def : makefile
+perldll.def : $(CONFIGPM)
echo LIBRARY PerlCore >perldll.def
echo DESCRIPTION 'Perl interpreter' >>perldll.def
echo EXPORTS >>perldll.def
echo perl_alloc >>perldll.def
+
+$(PERLDLL): perldll.def $(CORE_OBJ)
+ $(LINK32) -dll -def:perldll.def -out:$@ @<<
+ $(LINK_FLAGS) $(LIBFILES) $(CORE_OBJ)
+<<
+ $(XCOPY) $(PERLIMPLIB) $(COREDIR)
!ELSE
-perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym makedef.pl
+perldll.def : $(CONFIGPM) ..\global.sym makedef.pl
$(MINIPERL) -w makedef.pl $(OPTIMIZE) $(DEFINES) \
CCTYPE=$(CCTYPE) > perldll.def
-!ENDIF
-
-
$(PERLDLL): perldll.def $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ)
$(LINK32) -dll -def:perldll.def -out:$@ @<<
$(LINK_FLAGS) $(LIBFILES) $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ)
<<
$(XCOPY) $(PERLIMPLIB) $(COREDIR)
+!ENDIF
perl.def : $(MINIPERL) makeperldef.pl
$(MINIPERL) -I..\lib makeperldef.pl $(NULL) > perl.def
perlmain$(o) : perlmain.c
$(CC) $(CFLAGS) -UPERLDLL -c perlmain.c
-$(PERLEXE): $(PERLDLL) $(CONFIGPM) perlmain$(o)
- $(LINK32) -subsystem:console -out:perl.exe $(LINK_FLAGS) $(LIBFILES) \
- perlmain$(o) $(WINIOMAYBE) $(PERLIMPLIB)
- copy perl.exe $@
- del perl.exe
- copy splittree.pl ..
- $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto"
-
perl95.c : runperl.c
copy runperl.c perl95.c
win32mt$(o) : win32.c
$(CC) $(CFLAGS) -MT -UPERLDLL -DWIN95FIX -c $(OBJOUT_FLAG)win32mt$(o) win32.c
+
+!IF "$(OBJECT)" == "-DPERL_OBJECT"
+$(PERLEXE): $(PERLDLL) $(CONFIGPM) perlmain$(o) $(DLL_OBJ) $(WIN32_OBJ)
+ $(LINK32) -subsystem:console -out:perl.exe $(LINK_FLAGS) $(LIBFILES) \
+ perlmain$(o) $(DLL_OBJ) $(WIN32_OBJ) $(WINIOMAYBE) $(PERLIMPLIB)
+ copy perl.exe $@
+ del perl.exe
+ copy splittree.pl ..
+ $(MINIPERLEXE) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto"
+
+$(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ) $(DLL_OBJ)
+ $(LINK32) -subsystem:console -out:perl95.exe $(LINK_FLAGS) $(LIBFILES) \
+ $(DLL_OBJ) $(PERL95_OBJ) $(PERLIMPLIB)
+ copy perl95.exe $@
+ del perl95.exe
+
+!ELSE
+
+$(PERLEXE): $(PERLDLL) $(CONFIGPM) perlmain$(o)
+ $(LINK32) -subsystem:console -out:perl.exe $(LINK_FLAGS) $(LIBFILES) \
+ perlmain$(o) $(WINIOMAYBE) $(PERLIMPLIB)
+ copy perl.exe $@
+ del perl.exe
+ copy splittree.pl ..
+ $(MINIPERLEXE) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto"
+
$(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ)
$(LINK32) -subsystem:console -out:perl95.exe $(LINK_FLAGS) $(LIBFILES) \
$(PERL95_OBJ) $(PERLIMPLIB)
copy perl95.exe $@
del perl95.exe
-$(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM)
+!ENDIF
+
+$(DYNALOADER).c: $(CONFIGPM) $(EXTDIR)\DynaLoader\dl_win32.xs
if not exist ..\lib\auto mkdir ..\lib\auto
$(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL)
cd $(EXTDIR)\$(*B)
cd ..\win32
clean :
- -@erase miniperlmain$(o)
-@erase $(MINIPERL)
-@erase perlglob$(o)
-@erase perlmain$(o)
(void)dl_generic_private_init(THIS);
}
-#ifdef PERL_OBJECT
-#define dl_static_linked(x) 0
-#else
static int
dl_static_linked(char *filename)
{
};
return 0;
}
-#endif
MODULE = DynaLoader PACKAGE = DynaLoader
+++ /dev/null
-/*
-
- ipdir.c
- Interface for perl directory functions
-
-*/
-
-#include <ipdir.h>
-
-class CPerlDir : public IPerlDir
-{
-public:
- CPerlDir() { pPerl = NULL; };
- virtual int MKdir(const char *dirname, int mode, int &err);
- virtual int Chdir(const char *dirname, int &err);
- virtual int Rmdir(const char *dirname, int &err);
- virtual int Close(DIR *dirp, int &err);
- virtual DIR *Open(char *filename, int &err);
- virtual struct direct *Read(DIR *dirp, int &err);
- virtual void Rewind(DIR *dirp, int &err);
- virtual void Seek(DIR *dirp, long loc, int &err);
- virtual long Tell(DIR *dirp, int &err);
-
- inline void SetPerlObj(CPerlObj *p) { pPerl = p; };
-protected:
- CPerlObj *pPerl;
-};
-
-int CPerlDir::MKdir(const char *dirname, int mode, int &err)
-{
- return mkdir(dirname); /* just ignore mode */
-}
-
-int CPerlDir::Chdir(const char *dirname, int &err)
-{
- return chdir(dirname);
-}
-
-int CPerlDir::Rmdir(const char *dirname, int &err)
-{
- return rmdir(dirname);
-}
-
-#define PATHLEN 1024
-// The idea here is to read all the directory names into a string table
-// (separated by nulls) and when one of the other dir functions is called
-// return the pointer to the current file name.
-DIR *CPerlDir::Open(char *filename, int &err)
-{
- DIR *p;
- long len;
- long idx;
- char scannamespc[PATHLEN];
- char *scanname = scannamespc;
- struct stat sbuf;
- WIN32_FIND_DATA FindData;
- HANDLE fh;
-
- // Create the search pattern
- strcpy(scanname, filename);
-
- len = strlen(scanname);
- if(len > 1 && ((scanname[len-1] == '/') || (scanname[len-1] == '\\')))
- {
- // allow directory names of 'x:\' to pass
- if(!(len == 3 && scanname[1] == ':'))
- scanname[len-1] = '\0';
- }
-
- // check to see if filename is a directory
- if(stat(scanname, &sbuf) < 0 || sbuf.st_mode & _S_IFDIR == 0)
- {
- DWORD dTemp = GetFileAttributes(scanname);
- if(dTemp == 0xffffffff || !(dTemp & FILE_ATTRIBUTE_DIRECTORY))
- {
- return NULL;
- }
- }
-
- if((scanname[len-1] == '/') || (scanname[len-1] == '\\'))
- scanname[len-1] = '\0';
-
- strcat(scanname, "/*");
-
- // Get a DIR structure
- Newz(1501, p, 1, DIR);
- if(p == NULL)
- return NULL;
-
- // do the FindFirstFile call
- fh = FindFirstFile(scanname, &FindData);
- if(fh == INVALID_HANDLE_VALUE)
- {
- Safefree(p);
- return NULL;
- }
-
- // now allocate the first part of the string table for the filenames that we find.
- idx = strlen(FindData.cFileName)+1;
- New(1502, p->start, idx, char);
- if(p->start == NULL)
- {
- FindClose(fh);
- croak("opendir: malloc failed!\n");
- }
- strcpy(p->start, FindData.cFileName);
- p->nfiles++;
-
- // loop finding all the files that match the wildcard
- // (which should be all of them in this directory!).
- // the variable idx should point one past the null terminator
- // of the previous string found.
- //
- while(FindNextFile(fh, &FindData))
- {
- len = strlen(FindData.cFileName);
- // bump the string table size by enough for the
- // new name and it's null terminator
- Renew(p->start, idx+len+1, char);
- if(p->start == NULL)
- {
- FindClose(fh);
- croak("opendir: malloc failed!\n");
- }
- strcpy(&p->start[idx], FindData.cFileName);
- p->nfiles++;
- idx += len+1;
- }
- FindClose(fh);
- p->size = idx;
- p->curr = p->start;
- return p;
-}
-
-int CPerlDir::Close(DIR *dirp, int &err)
-{
- Safefree(dirp->start);
- Safefree(dirp);
- return 1;
-}
-
-// Readdir just returns the current string pointer and bumps the
-// string pointer to the next entry.
-struct direct *CPerlDir::Read(DIR *dirp, int &err)
-{
- int len;
- static int dummy = 0;
-
- if(dirp->curr)
- { // first set up the structure to return
- len = strlen(dirp->curr);
- strcpy(dirp->dirstr.d_name, dirp->curr);
- dirp->dirstr.d_namlen = len;
-
- // Fake an inode
- dirp->dirstr.d_ino = dummy++;
-
- // Now set up for the next call to readdir
- dirp->curr += len + 1;
- if(dirp->curr >= (dirp->start + dirp->size))
- {
- dirp->curr = NULL;
- }
-
- return &(dirp->dirstr);
- }
- else
- return NULL;
-}
-
-void CPerlDir::Rewind(DIR *dirp, int &err)
-{
- dirp->curr = dirp->start;
-}
-
-void CPerlDir::Seek(DIR *dirp, long loc, int &err)
-{
- dirp->curr = (char *)loc;
-}
-
-long CPerlDir::Tell(DIR *dirp, int &err)
-{
- return (long) dirp->curr;
-}
-
-
+++ /dev/null
-/*
-
- ipenv.c
- Interface for perl environment functions
-
-*/
-
-#include <ipenv.h>
-#include <stdlib.h>
-
-class CPerlEnv : public IPerlEnv
-{
-public:
- CPerlEnv() { w32_perldll_handle = INVALID_HANDLE_VALUE; pPerl = NULL; };
- virtual char *Getenv(const char *varname, int &err);
- virtual int Putenv(const char *envstring, int &err);
- virtual char* LibPath(char *sfx, ...);
-
- inline void SetPerlObj(CPerlObj *p) { pPerl = p; };
-protected:
- char w32_perllib_root[MAX_PATH+1];
- HANDLE w32_perldll_handle;
- CPerlObj *pPerl;
-};
-
-
-BOOL GetRegStr(HKEY hkey, const char *lpszValueName, char *lpszDefault, char *lpszData, unsigned long *lpdwDataLen)
-{ // Retrieve a REG_SZ or REG_EXPAND_SZ from the registry
- HKEY handle;
- DWORD type, dwDataLen = *lpdwDataLen;
- const char *subkey = "Software\\Perl";
- char szBuffer[MAX_PATH+1];
- long retval;
-
- retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
- if(retval == ERROR_SUCCESS)
- {
- retval = RegQueryValueEx(handle, lpszValueName, 0, &type, (LPBYTE)lpszData, &dwDataLen);
- RegCloseKey(handle);
- if(retval == ERROR_SUCCESS && (type == REG_SZ || type == REG_EXPAND_SZ))
- {
- if(type != REG_EXPAND_SZ)
- {
- *lpdwDataLen = dwDataLen;
- return TRUE;
- }
- strcpy(szBuffer, lpszData);
- dwDataLen = ExpandEnvironmentStrings(szBuffer, lpszData, *lpdwDataLen);
- if(dwDataLen < *lpdwDataLen)
- {
- *lpdwDataLen = dwDataLen;
- return TRUE;
- }
- }
- }
-
- strcpy(lpszData, lpszDefault);
- return FALSE;
-}
-
-char* GetRegStr(const char *lpszValueName, char *lpszDefault, char *lpszData, unsigned long *lpdwDataLen)
-{
- if(!GetRegStr(HKEY_CURRENT_USER, lpszValueName, lpszDefault, lpszData, lpdwDataLen))
- {
- GetRegStr(HKEY_LOCAL_MACHINE, lpszValueName, lpszDefault, lpszData, lpdwDataLen);
- }
- if(*lpszData == '\0')
- lpszData = NULL;
- return lpszData;
-}
-
-
-char *CPerlEnv::Getenv(const char *varname, int &err)
-{
- char* ptr = getenv(varname);
- if(ptr == NULL)
- {
- unsigned long dwDataLen = sizeof(w32_perllib_root);
- if(strcmp("PERL5DB", varname) == 0)
- ptr = GetRegStr(varname, "", w32_perllib_root, &dwDataLen);
- }
- return ptr;
-}
-
-int CPerlEnv::Putenv(const char *envstring, int &err)
-{
- return _putenv(envstring);
-}
-
-char* CPerlEnv::LibPath(char *sfx, ...)
-{
- va_list ap;
- char *end;
- va_start(ap,sfx);
- GetModuleFileName((w32_perldll_handle == INVALID_HANDLE_VALUE)
- ? GetModuleHandle(NULL)
- : (HINSTANCE)w32_perldll_handle,
- w32_perllib_root,
- sizeof(w32_perllib_root));
- *(end = strrchr(w32_perllib_root, '\\')) = '\0';
- if (stricmp(end-4,"\\bin") == 0)
- end -= 4;
- strcpy(end,"\\lib");
- while (sfx)
- {
- strcat(end,"\\");
- strcat(end,sfx);
- sfx = va_arg(ap,char *);
- }
- va_end(ap);
- return (w32_perllib_root);
-}
-
-
-
-
+++ /dev/null
-/*
-
- iplio.c
- Interface for perl Low IO functions
-
-*/
-
-#include <iplio.h>
-#include <sys/utime.h>
-
-
-class CPerlLIO : public IPerlLIO
-{
-public:
- CPerlLIO() { w32_platform = (-1); pPerl = NULL; pSock = NULL; pStdIO = NULL; };
-
- virtual int Access(const char *path, int mode, int &err);
- virtual int Chmod(const char *filename, int pmode, int &err);
- virtual int Chsize(int handle, long size, int &err);
- virtual int Close(int handle, int &err);
- virtual int Dup(int handle, int &err);
- virtual int Dup2(int handle1, int handle2, int &err);
- virtual int Flock(int fd, int oper, int &err);
- virtual int FStat(int handle, struct stat *buffer, int &err);
- virtual int IOCtl(int i, unsigned int u, char *data, int &err);
- virtual int Isatty(int handle, int &err);
- virtual long Lseek(int handle, long offset, int origin, int &err);
- virtual int Lstat(const char *path, struct stat *buffer, int &err);
- virtual char *Mktemp(char *Template, int &err);
- virtual int Open(const char *filename, int oflag, int &err);
- virtual int Open(const char *filename, int oflag, int pmode, int &err);
- virtual int Read(int handle, void *buffer, unsigned int count, int &err);
- virtual int Rename(const char *oldname, const char *newname, int &err);
- virtual int Setmode(int handle, int mode, int &err);
- virtual int STat(const char *path, struct stat *buffer, int &err);
- virtual char *Tmpnam(char *string, int &err);
- virtual int Umask(int pmode, int &err);
- virtual int Unlink(const char *filename, int &err);
- virtual int Utime(char *filename, struct utimbuf *times, int &err);
- virtual int Write(int handle, const void *buffer, unsigned int count, int &err);
-
- inline void SetPerlObj(CPerlObj *p) { pPerl = p; };
- inline void SetSockCtl(CPerlSock *p) { pSock = p; };
- inline void SetStdObj(IPerlStdIOWin *p) { pStdIO = p; };
-protected:
- inline int IsWin95(void)
- {
- return (os_id() == VER_PLATFORM_WIN32_WINDOWS);
- };
- inline int IsWinNT(void)
- {
- return (os_id() == VER_PLATFORM_WIN32_NT);
- };
- int GetOSfhandle(int filenum)
- {
- return pStdIO->GetOSfhandle(filenum);
- };
- DWORD os_id(void)
- {
- if((-1) == w32_platform)
- {
- OSVERSIONINFO osver;
-
- memset(&osver, 0, sizeof(OSVERSIONINFO));
- osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
- GetVersionEx(&osver);
- w32_platform = osver.dwPlatformId;
- }
- return (w32_platform);
- }
-
- DWORD w32_platform;
- CPerlObj *pPerl;
- CPerlSock *pSock;
- IPerlStdIOWin *pStdIO;
-};
-
-#define CALLFUNCRET(x)\
- int ret = x;\
- if(ret)\
- err = errno;\
- return ret;
-
-#define CALLFUNCERR(x)\
- int ret = x;\
- if(errno)\
- err = errno;\
- return ret;
-
-#define LCALLFUNCERR(x)\
- long ret = x;\
- if(errno)\
- err = errno;\
- return ret;
-
-int CPerlLIO::Access(const char *path, int mode, int &err)
-{
- CALLFUNCRET(access(path, mode))
-}
-
-int CPerlLIO::Chmod(const char *filename, int pmode, int &err)
-{
- CALLFUNCRET(chmod(filename, pmode))
-}
-
-int CPerlLIO::Chsize(int handle, long size, int &err)
-{
- CALLFUNCRET(chsize(handle, size))
-}
-
-int CPerlLIO::Close(int fd, int &err)
-{
- CALLFUNCRET(close(fd))
-}
-
-int CPerlLIO::Dup(int fd, int &err)
-{
- CALLFUNCERR(dup(fd))
-}
-
-int CPerlLIO::Dup2(int handle1, int handle2, int &err)
-{
- CALLFUNCERR(dup2(handle1, handle2))
-}
-
-
-#define LK_ERR(f,i) ((f) ? (i = 0) : (err = GetLastError()))
-#define LK_LEN 0xffff0000
-#define LOCK_SH 1
-#define LOCK_EX 2
-#define LOCK_NB 4
-#define LOCK_UN 8
-
-int CPerlLIO::Flock(int fd, int oper, int &err)
-{
- OVERLAPPED o;
- int i = -1;
- HANDLE fh;
-
- if (!IsWinNT()) {
- croak("flock() unimplemented on this platform");
- return -1;
- }
- fh = (HANDLE)GetOSfhandle(fd);
- memset(&o, 0, sizeof(o));
-
- switch(oper) {
- case LOCK_SH: /* shared lock */
- LK_ERR(LockFileEx(fh, 0, 0, LK_LEN, 0, &o),i);
- break;
- case LOCK_EX: /* exclusive lock */
- LK_ERR(LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK, 0, LK_LEN, 0, &o),i);
- break;
- case LOCK_SH|LOCK_NB: /* non-blocking shared lock */
- LK_ERR(LockFileEx(fh, LOCKFILE_FAIL_IMMEDIATELY, 0, LK_LEN, 0, &o),i);
- break;
- case LOCK_EX|LOCK_NB: /* non-blocking exclusive lock */
- LK_ERR(LockFileEx(fh,
- LOCKFILE_EXCLUSIVE_LOCK|LOCKFILE_FAIL_IMMEDIATELY,
- 0, LK_LEN, 0, &o),i);
- break;
- case LOCK_UN: /* unlock lock */
- LK_ERR(UnlockFileEx(fh, 0, LK_LEN, 0, &o),i);
- break;
- default: /* unknown */
- err = EINVAL;
- break;
- }
- return i;
-}
-
-int CPerlLIO::FStat(int fd, struct stat *sbufptr, int &err)
-{
- CALLFUNCERR(fstat(fd, sbufptr))
-}
-
-int CPerlLIO::IOCtl(int i, unsigned int u, char *data, int &err)
-{
- return pSock->IoctlSocket((SOCKET)i, (long)u, (u_long*)data, err);
-}
-
-int CPerlLIO::Isatty(int fd, int &err)
-{
- return isatty(fd);
-}
-
-long CPerlLIO::Lseek(int fd, long offset, int origin, int &err)
-{
- LCALLFUNCERR(lseek(fd, offset, origin))
-}
-
-int CPerlLIO::Lstat(const char *path, struct stat *sbufptr, int &err)
-{
- return STat(path, sbufptr, err);
-}
-
-char *CPerlLIO::Mktemp(char *Template, int &err)
-{
- return mktemp(Template);
-}
-
-int CPerlLIO::Open(const char *filename, int oflag, int &err)
-{
- int ret;
- if(stricmp(filename, "/dev/null") == 0)
- ret = open("NUL", oflag);
- else
- ret = open(filename, oflag);
-
- if(errno)
- err = errno;
- return ret;
-}
-
-int CPerlLIO::Open(const char *filename, int oflag, int pmode, int &err)
-{
- int ret;
- if(stricmp(filename, "/dev/null") == 0)
- ret = open("NUL", oflag, pmode);
- else
- ret = open(filename, oflag, pmode);
-
- if(errno)
- err = errno;
- return ret;
-}
-
-int CPerlLIO::Read(int fd, void *buffer, unsigned int cnt, int &err)
-{
- CALLFUNCERR(read(fd, buffer, cnt))
-}
-
-int CPerlLIO::Rename(const char *OldFileName, const char *newname, int &err)
-{
- char szNewWorkName[MAX_PATH+1];
- WIN32_FIND_DATA fdOldFile, fdNewFile;
- HANDLE handle;
- char *ptr;
-
- if((strchr(OldFileName, '\\') || strchr(OldFileName, '/'))
- && strchr(newname, '\\') == NULL
- && strchr(newname, '/') == NULL)
- {
- strcpy(szNewWorkName, OldFileName);
- if((ptr = strrchr(szNewWorkName, '\\')) == NULL)
- ptr = strrchr(szNewWorkName, '/');
- strcpy(++ptr, newname);
- }
- else
- strcpy(szNewWorkName, newname);
-
- if(stricmp(OldFileName, szNewWorkName) != 0)
- { // check that we're not being fooled by relative paths
- // and only delete the new file
- // 1) if it exists
- // 2) it is not the same file as the old file
- // 3) old file exist
- // GetFullPathName does not return the long file name on some systems
- handle = FindFirstFile(OldFileName, &fdOldFile);
- if(handle != INVALID_HANDLE_VALUE)
- {
- FindClose(handle);
-
- handle = FindFirstFile(szNewWorkName, &fdNewFile);
-
- if(handle != INVALID_HANDLE_VALUE)
- FindClose(handle);
- else
- fdNewFile.cFileName[0] = '\0';
-
- if(strcmp(fdOldFile.cAlternateFileName, fdNewFile.cAlternateFileName) != 0
- && strcmp(fdOldFile.cFileName, fdNewFile.cFileName) != 0)
- { // file exists and not same file
- DeleteFile(szNewWorkName);
- }
- }
- }
- int ret = rename(OldFileName, szNewWorkName);
- if(ret)
- err = errno;
-
- return ret;
-}
-
-int CPerlLIO::Setmode(int fd, int mode, int &err)
-{
- CALLFUNCRET(setmode(fd, mode))
-}
-
-int CPerlLIO::STat(const char *path, struct stat *sbufptr, int &err)
-{
- char t[MAX_PATH];
- const char *p = path;
- int l = strlen(path);
- int res;
-
- if (l > 1) {
- switch(path[l - 1]) {
- case '\\':
- case '/':
- if (path[l - 2] != ':') {
- strncpy(t, path, l - 1);
- t[l - 1] = 0;
- p = t;
- };
- }
- }
- res = stat(path, sbufptr);
-#ifdef __BORLANDC__
- if (res == 0) {
- if (S_ISDIR(buffer->st_mode))
- buffer->st_mode |= S_IWRITE | S_IEXEC;
- else if (S_ISREG(buffer->st_mode)) {
- if (l >= 4 && path[l-4] == '.') {
- const char *e = path + l - 3;
- if (strnicmp(e,"exe",3)
- && strnicmp(e,"bat",3)
- && strnicmp(e,"com",3)
- && (IsWin95() || strnicmp(e,"cmd",3)))
- buffer->st_mode &= ~S_IEXEC;
- else
- buffer->st_mode |= S_IEXEC;
- }
- else
- buffer->st_mode &= ~S_IEXEC;
- }
- }
-#endif
- return res;
-}
-
-char *CPerlLIO::Tmpnam(char *string, int &err)
-{
- return tmpnam(string);
-}
-
-int CPerlLIO::Umask(int pmode, int &err)
-{
- return umask(pmode);
-}
-
-int CPerlLIO::Unlink(const char *filename, int &err)
-{
- chmod(filename, _S_IREAD | _S_IWRITE);
- CALLFUNCRET(unlink(filename))
-}
-
-int CPerlLIO::Utime(char *filename, struct utimbuf *times, int &err)
-{
- CALLFUNCRET(utime(filename, times))
-}
-
-int CPerlLIO::Write(int fd, const void *buffer, unsigned int cnt, int &err)
-{
- CALLFUNCERR(write(fd, buffer, cnt))
-}
-
+++ /dev/null
-/*
-
- ipmem.c
- Interface for perl memory allocation
-
-*/
-
-#include <ipmem.h>
-
-class CPerlMem : public IPerlMem
-{
-public:
- CPerlMem() { pPerl = NULL; };
- virtual void* Malloc(size_t);
- virtual void* Realloc(void*, size_t);
- virtual void Free(void*);
-
- inline void SetPerlObj(CPerlObj *p) { pPerl = p; };
-protected:
- CPerlObj *pPerl;
-};
-
-void* CPerlMem::Malloc(size_t size)
-{
- return malloc(size);
-}
-
-void* CPerlMem::Realloc(void* ptr, size_t size)
-{
- return realloc(ptr, size);
-}
-
-void CPerlMem::Free(void* ptr)
-{
- free(ptr);
-}
-
-
-
+++ /dev/null
-/*
-
- ipproc.c
- Interface for perl process functions
-
-*/
-
-#include <ipproc.h>
-#include <stdlib.h>
-#include <fcntl.h>
-
-#define EXECF_EXEC 1
-#define EXECF_SPAWN 2
-#define EXECF_SPAWN_NOWAIT 3
-
-class CPerlProc : public IPerlProc
-{
-public:
- CPerlProc()
- {
- pPerl = NULL;
- w32_perlshell_tokens = NULL;
- w32_perlshell_items = -1;
- w32_platform = -1;
-#ifndef __BORLANDC__
- w32_num_children = 0;
-#endif
- };
- virtual void Abort(void);
- virtual void Exit(int status);
- virtual void _Exit(int status);
- virtual int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
- virtual int Execv(const char *cmdname, const char *const *argv);
- virtual int Execvp(const char *cmdname, const char *const *argv);
- virtual uid_t Getuid(void);
- virtual uid_t Geteuid(void);
- virtual gid_t Getgid(void);
- virtual gid_t Getegid(void);
- virtual char *Getlogin(void);
- virtual int Kill(int pid, int sig);
- virtual int Killpg(int pid, int sig);
- virtual int PauseProc(void);
- virtual PerlIO* Popen(const char *command, const char *mode);
- virtual int Pclose(PerlIO *stream);
- virtual int Pipe(int *phandles);
- virtual int Setuid(uid_t u);
- virtual int Setgid(gid_t g);
- virtual int Sleep(unsigned int);
- virtual int Times(struct tms *timebuf);
- virtual int Wait(int *status);
- virtual Sighandler_t Signal(int sig, Sighandler_t subcode);
- virtual void GetSysMsg(char*& msg, DWORD& dwLen, DWORD dwErr);
- virtual void FreeBuf(char* msg);
- virtual BOOL DoCmd(char *cmd);
- virtual int Spawn(char*cmds);
- virtual int Spawnvp(int mode, const char *cmdname, const char *const *argv);
- virtual int ASpawn(void *vreally, void **vmark, void **vsp);
-
- inline void SetPerlObj(CPerlObj *p) { pPerl = p; };
-protected:
- int Spawn(char *cmd, int exectype);
- void GetShell(void);
- long Tokenize(char *str, char **dest, char ***destv);
-
- inline int IsWin95(void)
- {
- return (os_id() == VER_PLATFORM_WIN32_WINDOWS);
- };
- inline int IsWinNT(void)
- {
- return (os_id() == VER_PLATFORM_WIN32_NT);
- };
-
- inline long filetime_to_clock(PFILETIME ft)
- {
- __int64 qw = ft->dwHighDateTime;
- qw <<= 32;
- qw |= ft->dwLowDateTime;
- qw /= 10000; /* File time ticks at 0.1uS, clock at 1mS */
- return (long) qw;
- };
-
- DWORD os_id(void)
- {
- if((-1) == w32_platform)
- {
- OSVERSIONINFO osver;
-
- memset(&osver, 0, sizeof(OSVERSIONINFO));
- osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
- GetVersionEx(&osver);
- w32_platform = osver.dwPlatformId;
- }
- return (w32_platform);
- };
-
- DWORD w32_platform;
- char szLoginNameStr[128];
- char *w32_perlshell_tokens;
- long w32_perlshell_items;
- char **w32_perlshell_vec;
-#ifndef __BORLANDC__
- long w32_num_children;
- HANDLE w32_child_pids[MAXIMUM_WAIT_OBJECTS];
-#endif
- CPerlObj *pPerl;
-};
-
-
-static BOOL
-has_redirection(char *ptr)
-{
- int inquote = 0;
- char quote = '\0';
-
- /*
- * Scan string looking for redirection (< or >) or pipe
- * characters (|) that are not in a quoted string
- */
- while(*ptr) {
- switch(*ptr) {
- case '\'':
- case '\"':
- if(inquote) {
- if(quote == *ptr) {
- inquote = 0;
- quote = '\0';
- }
- }
- else {
- quote = *ptr;
- inquote++;
- }
- break;
- case '>':
- case '<':
- case '|':
- if(!inquote)
- return TRUE;
- default:
- break;
- }
- ++ptr;
- }
- return FALSE;
-}
-
-/* Tokenize a string. Words are null-separated, and the list
- * ends with a doubled null. Any character (except null and
- * including backslash) may be escaped by preceding it with a
- * backslash (the backslash will be stripped).
- * Returns number of words in result buffer.
- */
-long
-CPerlProc::Tokenize(char *str, char **dest, char ***destv)
-{
- char *retstart = Nullch;
- char **retvstart = 0;
- int items = -1;
- if (str) {
- int slen = strlen(str);
- register char *ret;
- register char **retv;
- New(1307, ret, slen+2, char);
- New(1308, retv, (slen+3)/2, char*);
-
- retstart = ret;
- retvstart = retv;
- *retv = ret;
- items = 0;
- while (*str) {
- *ret = *str++;
- if (*ret == '\\' && *str)
- *ret = *str++;
- else if (*ret == ' ') {
- while (*str == ' ')
- str++;
- if (ret == retstart)
- ret--;
- else {
- *ret = '\0';
- ++items;
- if (*str)
- *++retv = ret+1;
- }
- }
- else if (!*str)
- ++items;
- ret++;
- }
- retvstart[items] = Nullch;
- *ret++ = '\0';
- *ret = '\0';
- }
- *dest = retstart;
- *destv = retvstart;
- return items;
-}
-
-
-void
-CPerlProc::GetShell(void)
-{
- if (!w32_perlshell_tokens) {
- /* we don't use COMSPEC here for two reasons:
- * 1. the same reason perl on UNIX doesn't use SHELL--rampant and
- * uncontrolled unportability of the ensuing scripts.
- * 2. PERL5SHELL could be set to a shell that may not be fit for
- * interactive use (which is what most programs look in COMSPEC
- * for).
- */
- char* defaultshell = (IsWinNT() ? "cmd.exe /x/c" : "command.com /c");
- char* usershell = getenv("PERL5SHELL");
- w32_perlshell_items = Tokenize(usershell ? usershell : defaultshell,
- &w32_perlshell_tokens,
- &w32_perlshell_vec);
- }
-}
-
-int
-CPerlProc::ASpawn(void *vreally, void **vmark, void **vsp)
-{
- SV *really = (SV*)vreally;
- SV **mark = (SV**)vmark;
- SV **sp = (SV**)vsp;
- char **argv;
- char *str;
- int status;
- int flag = P_WAIT;
- int index = 0;
-
- if (sp <= mark)
- return -1;
-
- GetShell();
- New(1306, argv, (sp - mark) + w32_perlshell_items + 2, char*);
-
- if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
- ++mark;
- flag = SvIVx(*mark);
- }
-
- while(++mark <= sp) {
- if (*mark && (str = SvPV(*mark, na)))
- argv[index++] = str;
- else
- argv[index++] = "";
- }
- argv[index++] = 0;
-
- status = Spawnvp(flag,
- (really ? SvPV(really,na) : argv[0]),
- (const char* const*)argv);
-
- if (status < 0 && errno == ENOEXEC) {
- /* possible shell-builtin, invoke with shell */
- int sh_items;
- sh_items = w32_perlshell_items;
- while (--index >= 0)
- argv[index+sh_items] = argv[index];
- while (--sh_items >= 0)
- argv[sh_items] = w32_perlshell_vec[sh_items];
-
- status = Spawnvp(flag,
- (really ? SvPV(really,na) : argv[0]),
- (const char* const*)argv);
- }
-
- if (status < 0) {
- if (pPerl->Perl_dowarn)
- warn("Can't spawn \"%s\": %s", argv[0], strerror(errno));
- status = 255 * 256;
- }
- else if (flag != P_NOWAIT)
- status *= 256;
- Safefree(argv);
- return (pPerl->Perl_statusvalue = status);
-}
-
-
-int
-CPerlProc::Spawn(char *cmd, int exectype)
-{
- char **a;
- char *s;
- char **argv;
- int status = -1;
- BOOL needToTry = TRUE;
- char *cmd2;
-
- /* Save an extra exec if possible. See if there are shell
- * metacharacters in it */
- if(!has_redirection(cmd)) {
- New(1301,argv, strlen(cmd) / 2 + 2, char*);
- New(1302,cmd2, strlen(cmd) + 1, char);
- strcpy(cmd2, cmd);
- a = argv;
- for (s = cmd2; *s;) {
- while (*s && isspace(*s))
- s++;
- if (*s)
- *(a++) = s;
- while(*s && !isspace(*s))
- s++;
- if(*s)
- *s++ = '\0';
- }
- *a = Nullch;
- if (argv[0]) {
- switch (exectype) {
- case EXECF_SPAWN:
- status = Spawnvp(P_WAIT, argv[0],
- (const char* const*)argv);
- break;
- case EXECF_SPAWN_NOWAIT:
- status = Spawnvp(P_NOWAIT, argv[0],
- (const char* const*)argv);
- break;
- case EXECF_EXEC:
- status = Execvp(argv[0], (const char* const*)argv);
- break;
- }
- if (status != -1 || errno == 0)
- needToTry = FALSE;
- }
- Safefree(argv);
- Safefree(cmd2);
- }
- if (needToTry) {
- char **argv;
- int i = -1;
- GetShell();
- New(1306, argv, w32_perlshell_items + 2, char*);
- while (++i < w32_perlshell_items)
- argv[i] = w32_perlshell_vec[i];
- argv[i++] = cmd;
- argv[i] = Nullch;
- switch (exectype) {
- case EXECF_SPAWN:
- status = Spawnvp(P_WAIT, argv[0],
- (const char* const*)argv);
- break;
- case EXECF_SPAWN_NOWAIT:
- status = Spawnvp(P_NOWAIT, argv[0],
- (const char* const*)argv);
- break;
- case EXECF_EXEC:
- status = Execvp(argv[0], (const char* const*)argv);
- break;
- }
- cmd = argv[0];
- Safefree(argv);
- }
- if (status < 0) {
- if (pPerl->Perl_dowarn)
- warn("Can't %s \"%s\": %s",
- (exectype == EXECF_EXEC ? "exec" : "spawn"),
- cmd, strerror(errno));
- status = 255 * 256;
- }
- else if (exectype != EXECF_SPAWN_NOWAIT)
- status *= 256;
- return (pPerl->Perl_statusvalue = status);
-}
-
-
-void CPerlProc::Abort(void)
-{
- abort();
-}
-
-void CPerlProc::Exit(int status)
-{
- exit(status);
-}
-
-void CPerlProc::_Exit(int status)
-{
- _exit(status);
-}
-
-int CPerlProc::Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
-{
- return execl(cmdname, arg0, arg1, arg2, arg3);
-}
-
-int CPerlProc::Execv(const char *cmdname, const char *const *argv)
-{
- return execv(cmdname, argv);
-}
-
-int CPerlProc::Execvp(const char *cmdname, const char *const *argv)
-{
- return execvp(cmdname, argv);
-}
-
-#define ROOT_UID ((uid_t)0)
-#define ROOT_GID ((gid_t)0)
-
-uid_t CPerlProc::Getuid(void)
-{
- return ROOT_UID;
-}
-
-uid_t CPerlProc::Geteuid(void)
-{
- return ROOT_UID;
-}
-
-gid_t CPerlProc::Getgid(void)
-{
- return ROOT_GID;
-}
-
-gid_t CPerlProc::Getegid(void)
-{
- return ROOT_GID;
-}
-
-
-char *CPerlProc::Getlogin(void)
-{
- char unknown[] = "<Unknown>";
- unsigned long len;
-
- len = sizeof(szLoginNameStr);
- if(!GetUserName(szLoginNameStr, &len))
- {
- strcpy(szLoginNameStr, unknown);
- }
- return szLoginNameStr;
-}
-
-int CPerlProc::Kill(int pid, int sig)
-{
- HANDLE hProcess;
-
- hProcess = OpenProcess(PROCESS_ALL_ACCESS, FALSE, (DWORD)pid);
- if(hProcess == NULL)
- croak("kill process failed!\n");
-
- if(TerminateProcess(hProcess, 0) == FALSE)
- croak("kill process failed!\n");
-
- CloseHandle(hProcess);
- return 0;
-}
-
-int CPerlProc::Killpg(int pid, int sig)
-{
- croak("killpg not implemented!\n");
- return 0;
-}
-
-int CPerlProc::PauseProc(void)
-{
- Sleep((unsigned int)((32767L << 16) + 32767));
- return 0;
-}
-
-PerlIO* CPerlProc::Popen(const char *command, const char *mode)
-{
- return (PerlIO*)_popen(command, mode);
-}
-
-int CPerlProc::Pclose(PerlIO *pf)
-{
- return _pclose((FILE*)pf);
-}
-
-int CPerlProc::Pipe(int *phandles)
-{
- return _pipe(phandles, 512, O_BINARY);
-}
-
-int CPerlProc::Sleep(unsigned int s)
-{
- ::Sleep(s*1000);
- return 0;
-}
-
-int CPerlProc::Times(struct tms *timebuf)
-{
- FILETIME user;
- FILETIME kernel;
- FILETIME dummy;
- if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy,
- &kernel,&user)) {
- timebuf->tms_utime = filetime_to_clock(&user);
- timebuf->tms_stime = filetime_to_clock(&kernel);
- timebuf->tms_cutime = 0;
- timebuf->tms_cstime = 0;
-
- } else {
- /* That failed - e.g. Win95 fallback to clock() */
- clock_t t = clock();
- timebuf->tms_utime = t;
- timebuf->tms_stime = 0;
- timebuf->tms_cutime = 0;
- timebuf->tms_cstime = 0;
- }
- return 0;
-}
-
-int CPerlProc::Wait(int *status)
-{
-#ifdef __BORLANDC__
- return wait(status);
-#else
- /* XXX this wait emulation only knows about processes
- * spawned via win32_spawnvp(P_NOWAIT, ...).
- */
- int i, retval;
- DWORD exitcode, waitcode;
-
- if (!w32_num_children) {
- errno = ECHILD;
- return -1;
- }
-
- /* if a child exists, wait for it to die */
- waitcode = WaitForMultipleObjects(w32_num_children,
- w32_child_pids,
- FALSE,
- INFINITE);
- if (waitcode != WAIT_FAILED) {
- if (waitcode >= WAIT_ABANDONED_0
- && waitcode < WAIT_ABANDONED_0 + w32_num_children)
- i = waitcode - WAIT_ABANDONED_0;
- else
- i = waitcode - WAIT_OBJECT_0;
- if (GetExitCodeProcess(w32_child_pids[i], &exitcode) ) {
- CloseHandle(w32_child_pids[i]);
- *status = (int)((exitcode & 0xff) << 8);
- retval = (int)w32_child_pids[i];
- Copy(&w32_child_pids[i+1], &w32_child_pids[i],
- (w32_num_children-i-1), HANDLE);
- w32_num_children--;
- return retval;
- }
- }
-
-FAILED:
- errno = GetLastError();
- return -1;
-
-#endif
-}
-
-int CPerlProc::Setuid(uid_t u)
-{
- return (u == ROOT_UID ? 0 : -1);
-}
-
-int CPerlProc::Setgid(gid_t g)
-{
- return (g == ROOT_GID ? 0 : -1);
-}
-
-Sighandler_t CPerlProc::Signal(int sig, Sighandler_t subcode)
-{
- return 0;
-}
-
-void CPerlProc::GetSysMsg(char*& sMsg, DWORD& dwLen, DWORD dwErr)
-{
- dwLen = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER
- |FORMAT_MESSAGE_IGNORE_INSERTS
- |FORMAT_MESSAGE_FROM_SYSTEM, NULL,
- dwErr, 0, (char *)&sMsg, 1, NULL);
- if (0 < dwLen) {
- while (0 < dwLen && isspace(sMsg[--dwLen]))
- ;
- if ('.' != sMsg[dwLen])
- dwLen++;
- sMsg[dwLen]= '\0';
- }
- if (0 == dwLen) {
- sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
- dwLen = sprintf(sMsg,
- "Unknown error #0x%lX (lookup 0x%lX)",
- dwErr, GetLastError());
- }
-}
-
-void CPerlProc::FreeBuf(char* sMsg)
-{
- LocalFree(sMsg);
-}
-
-BOOL CPerlProc::DoCmd(char *cmd)
-{
- Spawn(cmd, EXECF_EXEC);
- return FALSE;
-}
-
-int CPerlProc::Spawn(char* cmd)
-{
- return Spawn(cmd, EXECF_SPAWN);
-}
-
-int CPerlProc::Spawnvp(int mode, const char *cmdname, const char *const *argv)
-{
- int status;
-
- status = spawnvp(mode, cmdname, (char * const *)argv);
-#ifndef __BORLANDC__
- /* XXX For the P_NOWAIT case, Borland RTL returns pinfo.dwProcessId
- * while VC RTL returns pinfo.hProcess. For purposes of the custom
- * implementation of win32_wait(), we assume the latter.
- */
- if (mode == P_NOWAIT && status >= 0)
- w32_child_pids[w32_num_children++] = (HANDLE)status;
-#endif
- return status;
-}
-
-
-
-
+++ /dev/null
-/*
-
- ipsock.c
- Interface for perl socket functions
-
-*/
-
-#include <ipsock.h>
-#include <fcntl.h>
-
-#define USE_SOCKETS_AS_HANDLES
-
-class CPerlSock : public IPerlSock
-{
-public:
- CPerlSock();
- ~CPerlSock();
- virtual u_long Htonl(u_long hostlong);
- virtual u_short Htons(u_short hostshort);
- virtual u_long Ntohl(u_long netlong);
- virtual u_short Ntohs(u_short netshort);
- virtual SOCKET Accept(SOCKET s, struct sockaddr* addr, int* addrlen, int &err);
- virtual int Bind(SOCKET s, const struct sockaddr* name, int namelen, int &err);
- virtual int Connect(SOCKET s, const struct sockaddr* name, int namelen, int &err);
- virtual void Endhostent(int &err);
- virtual void Endnetent(int &err);
- virtual void Endprotoent(int &err);
- virtual void Endservent(int &err);
- virtual struct hostent* Gethostbyaddr(const char* addr, int len, int type, int &err);
- virtual struct hostent* Gethostbyname(const char* name, int &err);
- virtual struct hostent* Gethostent(int &err);
- virtual int Gethostname(char* name, int namelen, int &err);
- virtual struct netent *Getnetbyaddr(long net, int type, int &err);
- virtual struct netent *Getnetbyname(const char *, int &err);
- virtual struct netent *Getnetent(int &err);
- virtual int Getpeername(SOCKET s, struct sockaddr* name, int* namelen, int &err);
- virtual struct protoent* Getprotobyname(const char* name, int &err);
- virtual struct protoent* Getprotobynumber(int number, int &err);
- virtual struct protoent* Getprotoent(int &err);
- virtual struct servent* Getservbyname(const char* name, const char* proto, int &err);
- virtual struct servent* Getservbyport(int port, const char* proto, int &err);
- virtual struct servent* Getservent(int &err);
- virtual int Getsockname(SOCKET s, struct sockaddr* name, int* namelen, int &err);
- virtual int Getsockopt(SOCKET s, int level, int optname, char* optval, int* optlen, int &err);
- virtual unsigned long InetAddr(const char* cp, int &err);
- virtual char* InetNtoa(struct in_addr in, int &err);
- virtual int IoctlSocket(SOCKET s, long cmd, u_long *argp, int& err);
- virtual int Listen(SOCKET s, int backlog, int &err);
- virtual int Recvfrom(SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen, int &err);
- virtual int Select(int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout, int &err);
- virtual int Send(SOCKET s, const char* buffer, int len, int flags, int &err);
- virtual int Sendto(SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen, int &err);
- virtual void Sethostent(int stayopen, int &err);
- virtual void Setnetent(int stayopen, int &err);
- virtual void Setprotoent(int stayopen, int &err);
- virtual void Setservent(int stayopen, int &err);
- virtual int Setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen, int &err);
- virtual int Shutdown(SOCKET s, int how, int &err);
- virtual SOCKET Socket(int af, int type, int protocol, int &err);
- virtual int Socketpair(int domain, int type, int protocol, int* fds, int &err);
-
- void CloseSocket(int fh, int& err);
- void* GetAddress(HINSTANCE hInstance, char *lpFunctionName);
- void LoadWinSock(void);
-
- inline void SetPerlObj(CPerlObj *p) { pPerl = p; };
- inline void SetStdObj(IPerlStdIOWin *p) { pStdIO = p; };
-protected:
- void Start(void);
-
- inline int OpenOSfhandle(long osfhandle)
- {
- return pStdIO->OpenOSfhandle(osfhandle, O_RDWR|O_BINARY);
- };
- int GetOSfhandle(int filenum)
- {
- return pStdIO->GetOSfhandle(filenum);
- };
-
- inline void StartSockets(void)
- {
- if(!bStarted)
- Start();
- };
-
- BOOL bStarted;
- CPerlObj *pPerl;
- IPerlStdIOWin *pStdIO;
-};
-
-
-#define SOCKETAPI PASCAL
-
-typedef SOCKET (SOCKETAPI *LPSOCKACCEPT)(SOCKET, struct sockaddr *, int *);
-typedef int (SOCKETAPI *LPSOCKBIND)(SOCKET, const struct sockaddr *, int);
-typedef int (SOCKETAPI *LPSOCKCLOSESOCKET)(SOCKET);
-typedef int (SOCKETAPI *LPSOCKCONNECT)(SOCKET, const struct sockaddr *, int);
-typedef unsigned long (SOCKETAPI *LPINETADDR)(const char *);
-typedef char* (SOCKETAPI *LPINETNTOA)(struct in_addr);
-typedef int (SOCKETAPI *LPSOCKIOCTLSOCKET)(SOCKET, long, u_long *);
-typedef int (SOCKETAPI *LPSOCKGETPEERNAME)(SOCKET, struct sockaddr *, int *);
-typedef int (SOCKETAPI *LPSOCKGETSOCKNAME)(SOCKET, struct sockaddr *, int *);
-typedef int (SOCKETAPI *LPSOCKGETSOCKOPT)(SOCKET, int, int, char *, int *);
-typedef u_long (SOCKETAPI *LPSOCKHTONL)(u_long);
-typedef u_short (SOCKETAPI *LPSOCKHTONS)(u_short);
-typedef int (SOCKETAPI *LPSOCKLISTEN)(SOCKET, int);
-typedef u_long (SOCKETAPI *LPSOCKNTOHL)(u_long);
-typedef u_short (SOCKETAPI *LPSOCKNTOHS)(u_short);
-typedef int (SOCKETAPI *LPSOCKRECV)(SOCKET, char *, int, int);
-typedef int (SOCKETAPI *LPSOCKRECVFROM)(SOCKET, char *, int, int, struct sockaddr *, int *);
-typedef int (SOCKETAPI *LPSOCKSELECT)(int, fd_set *, fd_set *, fd_set *, const struct timeval *);
-typedef int (SOCKETAPI *LPSOCKSEND)(SOCKET, const char *, int, int);
-typedef int (SOCKETAPI *LPSOCKSENDTO)(SOCKET, const char *, int, int, const struct sockaddr *, int);
-typedef int (SOCKETAPI *LPSOCKSETSOCKOPT)(SOCKET, int, int, const char *, int);
-typedef int (SOCKETAPI *LPSOCKSHUTDOWN)(SOCKET, int);
-typedef SOCKET (SOCKETAPI *LPSOCKSOCKET)(int, int, int);
-
-/* Database function prototypes */
-typedef struct hostent *(SOCKETAPI *LPSOCKGETHOSTBYADDR)(const char *, int, int);
-typedef struct hostent *(SOCKETAPI *LPSOCKGETHOSTBYNAME)(const char *);
-typedef int (SOCKETAPI *LPSOCKGETHOSTNAME)(char *, int);
-typedef struct servent *(SOCKETAPI *LPSOCKGETSERVBYPORT)(int, const char *);
-typedef struct servent *(SOCKETAPI *LPSOCKGETSERVBYNAME)(const char *, const char *);
-typedef struct protoent *(SOCKETAPI *LPSOCKGETPROTOBYNUMBER)(int);
-typedef struct protoent *(SOCKETAPI *LPSOCKGETPROTOBYNAME)(const char *);
-
-/* Microsoft Windows Extension function prototypes */
-typedef int (SOCKETAPI *LPSOCKWSASTARTUP)(unsigned short, LPWSADATA);
-typedef int (SOCKETAPI *LPSOCKWSACLEANUP)(void);
-typedef int (SOCKETAPI *LPSOCKWSAGETLASTERROR)(void);
-typedef int (SOCKETAPI *LPWSAFDIsSet)(SOCKET, fd_set *);
-
-static HINSTANCE hWinSockDll = 0;
-
-static LPSOCKACCEPT paccept = 0;
-static LPSOCKBIND pbind = 0;
-static LPSOCKCLOSESOCKET pclosesocket = 0;
-static LPSOCKCONNECT pconnect = 0;
-static LPINETADDR pinet_addr = 0;
-static LPINETNTOA pinet_ntoa = 0;
-static LPSOCKIOCTLSOCKET pioctlsocket = 0;
-static LPSOCKGETPEERNAME pgetpeername = 0;
-static LPSOCKGETSOCKNAME pgetsockname = 0;
-static LPSOCKGETSOCKOPT pgetsockopt = 0;
-static LPSOCKHTONL phtonl = 0;
-static LPSOCKHTONS phtons = 0;
-static LPSOCKLISTEN plisten = 0;
-static LPSOCKNTOHL pntohl = 0;
-static LPSOCKNTOHS pntohs = 0;
-static LPSOCKRECV precv = 0;
-static LPSOCKRECVFROM precvfrom = 0;
-static LPSOCKSELECT pselect = 0;
-static LPSOCKSEND psend = 0;
-static LPSOCKSENDTO psendto = 0;
-static LPSOCKSETSOCKOPT psetsockopt = 0;
-static LPSOCKSHUTDOWN pshutdown = 0;
-static LPSOCKSOCKET psocket = 0;
-static LPSOCKGETHOSTBYADDR pgethostbyaddr = 0;
-static LPSOCKGETHOSTBYNAME pgethostbyname = 0;
-static LPSOCKGETHOSTNAME pgethostname = 0;
-static LPSOCKGETSERVBYPORT pgetservbyport = 0;
-static LPSOCKGETSERVBYNAME pgetservbyname = 0;
-static LPSOCKGETPROTOBYNUMBER pgetprotobynumber = 0;
-static LPSOCKGETPROTOBYNAME pgetprotobyname = 0;
-static LPSOCKWSASTARTUP pWSAStartup = 0;
-static LPSOCKWSACLEANUP pWSACleanup = 0;
-static LPSOCKWSAGETLASTERROR pWSAGetLastError = 0;
-static LPWSAFDIsSet pWSAFDIsSet = 0;
-
-void* CPerlSock::GetAddress(HINSTANCE hInstance, char *lpFunctionName)
-{
- char buffer[512];
- FARPROC proc = GetProcAddress(hInstance, lpFunctionName);
- if(proc == 0)
- {
- sprintf(buffer, "Unable to get address of %s in WSock32.dll", lpFunctionName);
- croak(buffer);
- }
- return proc;
-}
-
-void CPerlSock::LoadWinSock(void)
-{
- if(hWinSockDll == NULL)
- {
- HINSTANCE hLib = LoadLibrary("WSock32.DLL");
- if(hLib == NULL)
- croak("Could not load WSock32.dll\n");
-
- paccept = (LPSOCKACCEPT)GetAddress(hLib, "accept");
- pbind = (LPSOCKBIND)GetAddress(hLib, "bind");
- pclosesocket = (LPSOCKCLOSESOCKET)GetAddress(hLib, "closesocket");
- pconnect = (LPSOCKCONNECT)GetAddress(hLib, "connect");
- pinet_addr = (LPINETADDR)GetAddress(hLib, "inet_addr");
- pinet_ntoa = (LPINETNTOA)GetAddress(hLib, "inet_ntoa");
- pioctlsocket = (LPSOCKIOCTLSOCKET)GetAddress(hLib, "ioctlsocket");
- pgetpeername = (LPSOCKGETPEERNAME)GetAddress(hLib, "getpeername");
- pgetsockname = (LPSOCKGETSOCKNAME)GetAddress(hLib, "getsockname");
- pgetsockopt = (LPSOCKGETSOCKOPT)GetAddress(hLib, "getsockopt");
- phtonl = (LPSOCKHTONL)GetAddress(hLib, "htonl");
- phtons = (LPSOCKHTONS)GetAddress(hLib, "htons");
- plisten = (LPSOCKLISTEN)GetAddress(hLib, "listen");
- pntohl = (LPSOCKNTOHL)GetAddress(hLib, "ntohl");
- pntohs = (LPSOCKNTOHS)GetAddress(hLib, "ntohs");
- precv = (LPSOCKRECV)GetAddress(hLib, "recv");
- precvfrom = (LPSOCKRECVFROM)GetAddress(hLib, "recvfrom");
- pselect = (LPSOCKSELECT)GetAddress(hLib, "select");
- psend = (LPSOCKSEND)GetAddress(hLib, "send");
- psendto = (LPSOCKSENDTO)GetAddress(hLib, "sendto");
- psetsockopt = (LPSOCKSETSOCKOPT)GetAddress(hLib, "setsockopt");
- pshutdown = (LPSOCKSHUTDOWN)GetAddress(hLib, "shutdown");
- psocket = (LPSOCKSOCKET)GetAddress(hLib, "socket");
- pgethostbyaddr = (LPSOCKGETHOSTBYADDR)GetAddress(hLib, "gethostbyaddr");
- pgethostbyname = (LPSOCKGETHOSTBYNAME)GetAddress(hLib, "gethostbyname");
- pgethostname = (LPSOCKGETHOSTNAME)GetAddress(hLib, "gethostname");
- pgetservbyport = (LPSOCKGETSERVBYPORT)GetAddress(hLib, "getservbyport");
- pgetservbyname = (LPSOCKGETSERVBYNAME)GetAddress(hLib, "getservbyname");
- pgetprotobynumber = (LPSOCKGETPROTOBYNUMBER)GetAddress(hLib, "getprotobynumber");
- pgetprotobyname = (LPSOCKGETPROTOBYNAME)GetAddress(hLib, "getprotobyname");
- pWSAStartup = (LPSOCKWSASTARTUP)GetAddress(hLib, "WSAStartup");
- pWSACleanup = (LPSOCKWSACLEANUP)GetAddress(hLib, "WSACleanup");
- pWSAGetLastError = (LPSOCKWSAGETLASTERROR)GetAddress(hLib, "WSAGetLastError");
- pWSAFDIsSet = (LPWSAFDIsSet)GetAddress(hLib, "__WSAFDIsSet");
- hWinSockDll = hLib;
- }
-}
-
-
-CPerlSock::CPerlSock()
-{
- bStarted = FALSE;
- pPerl = NULL;
- pStdIO = NULL;
-}
-
-CPerlSock::~CPerlSock()
-{
- if(bStarted)
- pWSACleanup();
-}
-
-void
-CPerlSock::Start(void)
-{
- unsigned short version;
- WSADATA retdata;
- int ret;
- int iSockOpt = SO_SYNCHRONOUS_NONALERT;
-
- LoadWinSock();
- /*
- * initalize the winsock interface and insure that it is
- * cleaned up at exit.
- */
- version = 0x101;
- if(ret = pWSAStartup(version, &retdata))
- croak("Unable to locate winsock library!\n");
- if(retdata.wVersion != version)
- croak("Could not find version 1.1 of winsock dll\n");
-
- /* atexit((void (*)(void)) EndSockets); */
-
-#ifdef USE_SOCKETS_AS_HANDLES
- /*
- * Enable the use of sockets as filehandles
- */
- psetsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
- (char *)&iSockOpt, sizeof(iSockOpt));
-#endif /* USE_SOCKETS_AS_HANDLES */
- bStarted = TRUE;
-}
-
-
-u_long
-CPerlSock::Htonl(u_long hostlong)
-{
- StartSockets();
- return phtonl(hostlong);
-}
-
-u_short
-CPerlSock::Htons(u_short hostshort)
-{
- StartSockets();
- return phtons(hostshort);
-}
-
-u_long
-CPerlSock::Ntohl(u_long netlong)
-{
- StartSockets();
- return pntohl(netlong);
-}
-
-u_short
-CPerlSock::Ntohs(u_short netshort)
-{
- StartSockets();
- return pntohs(netshort);
-}
-
-
-/* thanks to Beverly Brown (beverly@datacube.com) */
-#ifdef USE_SOCKETS_AS_HANDLES
-# define OPEN_SOCKET(x) OpenOSfhandle(x)
-# define TO_SOCKET(x) GetOSfhandle(x)
-#else
-# define OPEN_SOCKET(x) (x)
-# define TO_SOCKET(x) (x)
-#endif /* USE_SOCKETS_AS_HANDLES */
-
-#define SOCKET_TEST(x, y) \
- STMT_START { \
- StartSockets(); \
- if((x) == (y)) \
- err = pWSAGetLastError(); \
- } STMT_END
-
-#define SOCKET_TEST_ERROR(x) SOCKET_TEST(x, SOCKET_ERROR)
-
-SOCKET
-CPerlSock::Accept(SOCKET s, struct sockaddr* addr, int* addrlen, int &err)
-{
- SOCKET r;
-
- SOCKET_TEST((r = paccept(TO_SOCKET(s), addr, addrlen)), INVALID_SOCKET);
- return OPEN_SOCKET(r);
-}
-
-int
-CPerlSock::Bind(SOCKET s, const struct sockaddr* addr, int addrlen, int &err)
-{
- int r;
-
- SOCKET_TEST_ERROR(r = pbind(TO_SOCKET(s), addr, addrlen));
- return r;
-}
-
-void
-CPerlSock::CloseSocket(int fh, int& err)
-{
- SOCKET_TEST_ERROR(pclosesocket(TO_SOCKET(fh)));
-}
-
-int
-CPerlSock::Connect(SOCKET s, const struct sockaddr* addr, int addrlen, int &err)
-{
- int r;
-
- SOCKET_TEST_ERROR(r = pconnect(TO_SOCKET(s), addr, addrlen));
- return r;
-}
-
-void CPerlSock::Endhostent(int &err)
-{
- croak("endhostent not implemented!\n");
-}
-
-void CPerlSock::Endnetent(int &err)
-{
- croak("endnetent not implemented!\n");
-}
-
-void CPerlSock::Endprotoent(int &err)
-{
- croak("endprotoent not implemented!\n");
-}
-
-void CPerlSock::Endservent(int &err)
-{
- croak("endservent not implemented!\n");
-}
-
-struct hostent*
-CPerlSock::Gethostbyaddr(const char* addr, int len, int type, int &err)
-{
- struct hostent *r;
-
- SOCKET_TEST(r = pgethostbyaddr(addr, len, type), NULL);
- return r;
-}
-
-struct hostent*
-CPerlSock::Gethostbyname(const char* name, int &err)
-{
- struct hostent *r;
-
- SOCKET_TEST(r = pgethostbyname(name), NULL);
- return r;
-}
-
-struct hostent* CPerlSock::Gethostent(int &err)
-{
- croak("gethostent not implemented!\n");
- return NULL;
-}
-
-int
-CPerlSock::Gethostname(char* name, int len, int &err)
-{
- int r;
-
- SOCKET_TEST_ERROR(r = pgethostname(name, len));
- return r;
-}
-
-struct netent *CPerlSock::Getnetbyaddr(long net, int type, int &err)
-{
- croak("getnetbyaddr not implemented!\n");
- return NULL;
-}
-
-struct netent *CPerlSock::Getnetbyname(const char *, int &err)
-{
- croak("getnetbyname not implemented!\n");
- return NULL;
-}
-
-struct netent *CPerlSock::Getnetent(int &err)
-{
- croak("getnetent not implemented!\n");
- return NULL;
-}
-
-int
-CPerlSock::Getpeername(SOCKET s, struct sockaddr* addr, int* addrlen, int &err)
-{
- int r;
-
- SOCKET_TEST_ERROR(r = pgetpeername(TO_SOCKET(s), addr, addrlen));
- return r;
-}
-
-struct protoent*
-CPerlSock::Getprotobyname(const char* name, int &err)
-{
- struct protoent *r;
-
- SOCKET_TEST(r = pgetprotobyname(name), NULL);
- return r;
-}
-
-struct protoent*
-CPerlSock::Getprotobynumber(int number, int &err)
-{
- struct protoent *r;
-
- SOCKET_TEST(r = pgetprotobynumber(number), NULL);
- return r;
-}
-
-struct protoent* CPerlSock::Getprotoent(int &err)
-{
- croak("getprotoent not implemented!\n");
- return NULL;
-}
-
-struct servent*
-CPerlSock::Getservbyname(const char* name, const char* proto, int &err)
-{
- struct servent *r;
- dTHR;
-
- SOCKET_TEST(r = pgetservbyname(name, proto), NULL);
-// if (r) {
-// r = win32_savecopyservent(&myservent, r, proto);
-// }
- return r;
-}
-
-struct servent*
-CPerlSock::Getservbyport(int port, const char* proto, int &err)
-{
- struct servent *r;
- dTHR;
-
- SOCKET_TEST(r = pgetservbyport(port, proto), NULL);
-// if (r) {
-// r = win32_savecopyservent(&myservent, r, proto);
-// }
- return r;
-}
-
-struct servent* CPerlSock::Getservent(int &err)
-{
- croak("getservent not implemented!\n");
- return NULL;
-}
-
-int
-CPerlSock::Getsockname(SOCKET s, struct sockaddr* addr, int* addrlen, int &err)
-{
- int r;
-
- SOCKET_TEST_ERROR(r = pgetsockname(TO_SOCKET(s), addr, addrlen));
- return r;
-}
-
-int
-CPerlSock::Getsockopt(SOCKET s, int level, int optname, char* optval, int* optlen, int &err)
-{
- int r;
-
- SOCKET_TEST_ERROR(r = pgetsockopt(TO_SOCKET(s), level, optname, optval, optlen));
- return r;
-}
-
-unsigned long
-CPerlSock::InetAddr(const char* cp, int &err)
-{
- unsigned long r;
-
- SOCKET_TEST(r = pinet_addr(cp), INADDR_NONE);
- return r;
-}
-
-char*
-CPerlSock::InetNtoa(struct in_addr in, int &err)
-{
- char* r;
-
- SOCKET_TEST(r = pinet_ntoa(in), NULL);
- return r;
-}
-
-int
-CPerlSock::IoctlSocket(SOCKET s, long cmd, u_long *argp, int& err)
-{
- int r;
-
- SOCKET_TEST_ERROR(r = pioctlsocket(TO_SOCKET(s), cmd, argp));
- return r;
-}
-
-int
-CPerlSock::Listen(SOCKET s, int backlog, int &err)
-{
- int r;
-
- SOCKET_TEST_ERROR(r = plisten(TO_SOCKET(s), backlog));
- return r;
-}
-
-int
-CPerlSock::Recvfrom(SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen, int &err)
-{
- int r;
-
- SOCKET_TEST_ERROR(r = precvfrom(TO_SOCKET(s), buffer, len, flags, from, fromlen));
- return r;
-}
-
-int
-CPerlSock::Select(int nfds, char* rd, char* wr, char* ex, const struct timeval* timeout, int &err)
-{
- long r;
- int i, fd, bit, offset;
- FD_SET nrd, nwr, nex;
-
- FD_ZERO(&nrd);
- FD_ZERO(&nwr);
- FD_ZERO(&nex);
- for (i = 0; i < nfds; i++)
- {
- fd = TO_SOCKET(i);
- bit = 1L<<(i % (sizeof(char)*8));
- offset = i / (sizeof(char)*8);
- if(rd != NULL && (rd[offset] & bit))
- FD_SET(fd, &nrd);
- if(wr != NULL && (wr[offset] & bit))
- FD_SET(fd, &nwr);
- if(ex != NULL && (ex[offset] & bit))
- FD_SET(fd, &nex);
- }
- SOCKET_TEST_ERROR(r = pselect(nfds, &nrd, &nwr, &nex, timeout));
-
- for(i = 0; i < nfds; i++)
- {
- fd = TO_SOCKET(i);
- bit = 1L<<(i % (sizeof(char)*8));
- offset = i / (sizeof(char)*8);
- if(rd != NULL && (rd[offset] & bit))
- {
- if(!pWSAFDIsSet(fd, &nrd))
- rd[offset] &= ~bit;
- }
- if(wr != NULL && (wr[offset] & bit))
- {
- if(!pWSAFDIsSet(fd, &nwr))
- wr[offset] &= ~bit;
- }
- if(ex != NULL && (ex[offset] & bit))
- {
- if(!pWSAFDIsSet(fd, &nex))
- ex[offset] &= ~bit;
- }
- }
- return r;
-}
-
-int
-CPerlSock::Send(SOCKET s, const char* buffer, int len, int flags, int &err)
-{
- int r;
-
- SOCKET_TEST_ERROR(r = psend(TO_SOCKET(s), buffer, len, flags));
- return r;
-}
-
-int
-CPerlSock::Sendto(SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen, int &err)
-{
- int r;
-
- SOCKET_TEST_ERROR(r = psendto(TO_SOCKET(s), buffer, len, flags, to, tolen));
- return r;
-}
-
-void CPerlSock::Sethostent(int stayopen, int &err)
-{
- croak("sethostent not implemented!\n");
-}
-
-void CPerlSock::Setnetent(int stayopen, int &err)
-{
- croak("setnetent not implemented!\n");
-}
-
-void CPerlSock::Setprotoent(int stayopen, int &err)
-{
- croak("setprotoent not implemented!\n");
-}
-
-void CPerlSock::Setservent(int stayopen, int &err)
-{
- croak("setservent not implemented!\n");
-}
-
-int
-CPerlSock::Setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen, int &err)
-{
- int r;
-
- SOCKET_TEST_ERROR(r = psetsockopt(TO_SOCKET(s), level, optname, optval, optlen));
- return r;
-}
-
-int
-CPerlSock::Shutdown(SOCKET s, int how, int &err)
-{
- int r;
-
- SOCKET_TEST_ERROR(r = pshutdown(TO_SOCKET(s), how));
- return r;
-}
-
-SOCKET
-CPerlSock::Socket(int af, int type, int protocol, int &err)
-{
- SOCKET s;
-
-#ifdef USE_SOCKETS_AS_HANDLES
- StartSockets();
- if((s = psocket(af, type, protocol)) == INVALID_SOCKET)
- err = pWSAGetLastError();
- else
- s = OPEN_SOCKET(s);
-#else
- SOCKET_TEST(s = psocket(af, type, protocol), INVALID_SOCKET);
-#endif /* USE_SOCKETS_AS_HANDLES */
-
- return s;
-}
-
-int CPerlSock::Socketpair(int domain, int type, int protocol, int* fds, int &err)
-{
- croak("socketpair not implemented!\n");
- return 0;
-}
-
-
+++ /dev/null
-/*
-
- ipstdio.c
- Interface for perl stdio functions
-
-*/
-
-#include "ipstdiowin.h"
-#include <stdio.h>
-
-class CPerlStdIO : public IPerlStdIOWin
-{
-public:
- CPerlStdIO()
- {
- pPerl = NULL;
- pSock = NULL;
- w32_platform = -1;
- ZeroMemory(bSocketTable, sizeof(bSocketTable));
- };
- virtual PerlIO* Stdin(void);
- virtual PerlIO* Stdout(void);
- virtual PerlIO* Stderr(void);
- virtual PerlIO* Open(const char *, const char *, int &err);
- virtual int Close(PerlIO*, int &err);
- virtual int Eof(PerlIO*, int &err);
- virtual int Error(PerlIO*, int &err);
- virtual void Clearerr(PerlIO*, int &err);
- virtual int Getc(PerlIO*, int &err);
- virtual char* GetBase(PerlIO *, int &err);
- virtual int GetBufsiz(PerlIO *, int &err);
- virtual int GetCnt(PerlIO *, int &err);
- virtual char* GetPtr(PerlIO *, int &err);
- virtual int Putc(PerlIO*, int, int &err);
- virtual int Puts(PerlIO*, const char *, int &err);
- virtual int Flush(PerlIO*, int &err);
- virtual int Ungetc(PerlIO*,int, int &err);
- virtual int Fileno(PerlIO*, int &err);
- virtual PerlIO* Fdopen(int, const char *, int &err);
- virtual PerlIO* Reopen(const char*, const char*, PerlIO*, int &err);
- virtual SSize_t Read(PerlIO*,void *,Size_t, int &err);
- virtual SSize_t Write(PerlIO*,const void *,Size_t, int &err);
- virtual void SetBuf(PerlIO *, char*, int &err);
- virtual int SetVBuf(PerlIO *, char*, int, Size_t, int &err);
- virtual void SetCnt(PerlIO *, int, int &err);
- virtual void SetPtrCnt(PerlIO *, char *, int, int& err);
- virtual void Setlinebuf(PerlIO*, int &err);
- virtual int Printf(PerlIO*, int &err, const char *,...);
- virtual int Vprintf(PerlIO*, int &err, const char *, va_list);
- virtual long Tell(PerlIO*, int &err);
- virtual int Seek(PerlIO*, off_t, int, int &err);
- virtual void Rewind(PerlIO*, int &err);
- virtual PerlIO* Tmpfile(int &err);
- virtual int Getpos(PerlIO*, Fpos_t *, int &err);
- virtual int Setpos(PerlIO*, const Fpos_t *, int &err);
- virtual void Init(int &err);
- virtual void InitOSExtras(void* p);
- virtual int OpenOSfhandle(long osfhandle, int flags);
- virtual int GetOSfhandle(int filenum);
-
- void ShutDown(void);
-
- inline void SetPerlObj(CPerlObj *p) { pPerl = p; };
- inline void SetSockCtl(CPerlSock *p) { pSock = p; };
-protected:
- inline int IsWin95(void)
- {
- return (os_id() == VER_PLATFORM_WIN32_WINDOWS);
- };
- inline int IsWinNT(void)
- {
- return (os_id() == VER_PLATFORM_WIN32_NT);
- };
- inline void AddToSocketTable(int fh)
- {
- if(fh < _NSTREAM_)
- bSocketTable[fh] = TRUE;
- };
- inline BOOL InSocketTable(int fh)
- {
- if(fh < _NSTREAM_)
- return bSocketTable[fh];
- return FALSE;
- };
- inline void RemoveFromSocketTable(int fh)
- {
- if(fh < _NSTREAM_)
- bSocketTable[fh] = FALSE;
- };
- DWORD os_id(void)
- {
- if((-1) == w32_platform)
- {
- OSVERSIONINFO osver;
-
- memset(&osver, 0, sizeof(OSVERSIONINFO));
- osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
- GetVersionEx(&osver);
- w32_platform = osver.dwPlatformId;
- }
- return (w32_platform);
- };
-
-
- CPerlObj *pPerl;
- CPerlSock *pSock;
- DWORD w32_platform;
- BOOL bSocketTable[_NSTREAM_];
-};
-
-void CPerlStdIO::ShutDown(void)
-{
- int i, err;
- for(i = 0; i < _NSTREAM_; ++i)
- {
- if(InSocketTable(i))
- pSock->CloseSocket(i, err);
- }
-};
-
-#ifdef _X86_
-extern "C" int __cdecl _alloc_osfhnd(void);
-extern "C" int __cdecl _set_osfhnd(int fh, long value);
-extern "C" void __cdecl _unlock(int);
-
-#if (_MSC_VER >= 1000)
-typedef struct
-{
- long osfhnd; /* underlying OS file HANDLE */
- char osfile; /* attributes of file (e.g., open in text mode?) */
- char pipech; /* one char buffer for handles opened on pipes */
-} ioinfo;
-extern "C" ioinfo * __pioinfo[];
-#define IOINFO_L2E 5
-#define IOINFO_ARRAY_ELTS (1 << IOINFO_L2E)
-#define _pioinfo(i) (__pioinfo[i >> IOINFO_L2E] + (i & (IOINFO_ARRAY_ELTS - 1)))
-#define _osfile(i) (_pioinfo(i)->osfile)
-#else
-extern "C" extern char _osfile[];
-#endif // (_MSC_VER >= 1000)
-
-#define FOPEN 0x01 // file handle open
-#define FAPPEND 0x20 // file handle opened O_APPEND
-#define FDEV 0x40 // file handle refers to device
-#define FTEXT 0x80 // file handle is in text mode
-
-#define _STREAM_LOCKS 26 // Table of stream locks
-#define _LAST_STREAM_LOCK (_STREAM_LOCKS+_NSTREAM_-1) // Last stream lock
-#define _FH_LOCKS (_LAST_STREAM_LOCK+1) // Table of fh locks
-#endif // _X86_
-
-int CPerlStdIO::OpenOSfhandle(long osfhandle, int flags)
-{
- int fh;
-
-#ifdef _X86_
- if(IsWin95())
- {
- // all this is here to handle Win95's GetFileType bug.
- char fileflags; // _osfile flags
-
- // copy relevant flags from second parameter
- fileflags = FDEV;
-
- if(flags & _O_APPEND)
- fileflags |= FAPPEND;
-
- if(flags & _O_TEXT)
- fileflags |= FTEXT;
-
- // attempt to allocate a C Runtime file handle
- if((fh = _alloc_osfhnd()) == -1)
- {
- errno = EMFILE; // too many open files
- _doserrno = 0L; // not an OS error
- return -1; // return error to caller
- }
-
- // the file is open. now, set the info in _osfhnd array
- _set_osfhnd(fh, osfhandle);
-
- fileflags |= FOPEN; // mark as open
-
-#if (_MSC_VER >= 1000)
- _osfile(fh) = fileflags; // set osfile entry
-#else
- _osfile[fh] = fileflags; // set osfile entry
-#endif
- }
- else
-#endif // _X86_
- fh = _open_osfhandle(osfhandle, flags);
-
- if(fh >= 0)
- AddToSocketTable(fh);
-
- return fh; // return handle
-}
-
-int CPerlStdIO::GetOSfhandle(int filenum)
-{
- return _get_osfhandle(filenum);
-}
-
-PerlIO* CPerlStdIO::Stdin(void)
-{
- return (PerlIO*)(&_iob[0]);
-}
-
-PerlIO* CPerlStdIO::Stdout(void)
-{
- return (PerlIO*)(&_iob[1]);
-}
-
-PerlIO* CPerlStdIO::Stderr(void)
-{
- return (PerlIO*)(&_iob[2]);
-}
-
-PerlIO* CPerlStdIO::Open(const char *path, const char *mode, int &err)
-{
- PerlIO* ret = NULL;
- if(*path != '\0')
- {
- if(stricmp(path, "/dev/null") == 0)
- ret = (PerlIO*)fopen("NUL", mode);
- else
- ret = (PerlIO*)fopen(path, mode);
-
- if(errno)
- err = errno;
- }
- else
- err = EINVAL;
- return ret;
-}
-
-extern "C" int _free_osfhnd(int fh);
-int CPerlStdIO::Close(PerlIO* pf, int &err)
-{
- int ret = 0, fileNo = fileno((FILE*)pf);
- if(InSocketTable(fileNo))
- {
- RemoveFromSocketTable(fileNo);
- pSock->CloseSocket(fileNo, err);
- _free_osfhnd(fileNo);
- fclose((FILE*)pf);
- }
- else
- ret = fclose((FILE*)pf);
-
- if(errno)
- err = errno;
- return ret;
-}
-
-int CPerlStdIO::Eof(PerlIO* pf, int &err)
-{
- int ret = feof((FILE*)pf);
- if(errno)
- err = errno;
- return ret;
-}
-
-int CPerlStdIO::Error(PerlIO* pf, int &err)
-{
- int ret = ferror((FILE*)pf);
- if(errno)
- err = errno;
- return ret;
-}
-
-void CPerlStdIO::Clearerr(PerlIO* pf, int &err)
-{
- clearerr((FILE*)pf);
- err = 0;
-}
-
-int CPerlStdIO::Getc(PerlIO* pf, int &err)
-{
- int ret = fgetc((FILE*)pf);
- if(errno)
- err = errno;
- return ret;
-}
-
-int CPerlStdIO::Putc(PerlIO* pf, int c, int &err)
-{
- int ret = fputc(c, (FILE*)pf);
- if(errno)
- err = errno;
- return ret;
-}
-
-int CPerlStdIO::Puts(PerlIO* pf, const char *s, int &err)
-{
- int ret = fputs(s, (FILE*)pf);
- if(errno)
- err = errno;
- return ret;
-}
-
-int CPerlStdIO::Flush(PerlIO* pf, int &err)
-{
- int ret = fflush((FILE*)pf);
- if(errno)
- err = errno;
- return ret;
-}
-
-int CPerlStdIO::Ungetc(PerlIO* pf,int c, int &err)
-{
- int ret = ungetc(c, (FILE*)pf);
- if(errno)
- err = errno;
- return ret;
-}
-
-int CPerlStdIO::Fileno(PerlIO* pf, int &err)
-{
- int ret = fileno((FILE*)pf);
- if(errno)
- err = errno;
- return ret;
-}
-
-PerlIO* CPerlStdIO::Fdopen(int fh, const char *mode, int &err)
-{
- PerlIO* ret = (PerlIO*)fdopen(fh, mode);
- if(errno)
- err = errno;
- return ret;
-}
-
-PerlIO* CPerlStdIO::Reopen(const char* filename, const char* mode, PerlIO* pf, int &err)
-{
- PerlIO* ret = (PerlIO*)freopen(filename, mode, (FILE*)pf);
- if(errno)
- err = errno;
- return ret;
-}
-
-SSize_t CPerlStdIO::Read(PerlIO* pf, void * buffer, Size_t count, int &err)
-{
- size_t ret = fread(buffer, 1, count, (FILE*)pf);
- if(errno)
- err = errno;
- return ret;
-}
-
-SSize_t CPerlStdIO::Write(PerlIO* pf, const void * buffer, Size_t count, int &err)
-{
- size_t ret = fwrite(buffer, 1, count, (FILE*)pf);
- if(errno)
- err = errno;
- return ret;
-}
-
-void CPerlStdIO::Setlinebuf(PerlIO*pf, int &err)
-{
- setvbuf((FILE*)pf, NULL, _IOLBF, 0);
-}
-
-int CPerlStdIO::Printf(PerlIO* pf, int &err, const char *format, ...)
-{
- va_list(arglist);
- va_start(arglist, format);
- int ret = Vprintf(pf, err, format, arglist);
- if(errno)
- err = errno;
- return ret;
-}
-
-int CPerlStdIO::Vprintf(PerlIO* pf, int &err, const char * format, va_list arg)
-{
- int ret = vfprintf((FILE*)pf, format, arg);
- if(errno)
- err = errno;
- return ret;
-}
-
-long CPerlStdIO::Tell(PerlIO* pf, int &err)
-{
- long ret = ftell((FILE*)pf);
- if(errno)
- err = errno;
- return ret;
-}
-
-int CPerlStdIO::Seek(PerlIO* pf, off_t offset, int origin, int &err)
-{
- int ret = fseek((FILE*)pf, offset, origin);
- if(errno)
- err = errno;
- return ret;
-}
-
-void CPerlStdIO::Rewind(PerlIO* pf, int &err)
-{
- rewind((FILE*)pf);
-}
-
-PerlIO* CPerlStdIO::Tmpfile(int &err)
-{
- return (PerlIO*)tmpfile();
-}
-
-int CPerlStdIO::Getpos(PerlIO* pf, Fpos_t *p, int &err)
-{
- int ret = fgetpos((FILE*)pf, (fpos_t*)p);
- if(errno)
- err = errno;
- return ret;
-}
-
-int CPerlStdIO::Setpos(PerlIO* pf, const Fpos_t *p, int &err)
-{
- int ret = fsetpos((FILE*)pf, (fpos_t*)p);
- if(errno)
- err = errno;
- return ret;
-}
-
-char* CPerlStdIO::GetBase(PerlIO *pf, int &err)
-{
- return ((FILE*)pf)->_base;
-}
-
-int CPerlStdIO::GetBufsiz(PerlIO *pf, int &err)
-{
- return ((FILE*)pf)->_bufsiz;
-}
-
-int CPerlStdIO::GetCnt(PerlIO *pf, int &err)
-{
- return ((FILE*)pf)->_cnt;
-}
-
-char* CPerlStdIO::GetPtr(PerlIO *pf, int &err)
-{
- return ((FILE*)pf)->_ptr;
-}
-
-void CPerlStdIO::SetBuf(PerlIO *pf, char* buffer, int &err)
-{
- setbuf((FILE*)pf, buffer);
-}
-
-int CPerlStdIO::SetVBuf(PerlIO *pf, char* buffer, int type, Size_t size, int &err)
-{
- return setvbuf((FILE*)pf, buffer, type, size);
-}
-
-void CPerlStdIO::SetCnt(PerlIO *pf, int n, int &err)
-{
- ((FILE*)pf)->_cnt = n;
-}
-
-void CPerlStdIO::SetPtrCnt(PerlIO *pf, char *ptr, int n, int& err)
-{
- ((FILE*)pf)->_ptr = ptr;
- ((FILE*)pf)->_cnt = n;
-}
-
-void CPerlStdIO::Init(int &err)
-{
-}
-
-
-static
-XS(w32_GetCwd)
-{
- dXSARGS;
- SV *sv = sv_newmortal();
- /* Make one call with zero size - return value is required size */
- DWORD len = GetCurrentDirectory((DWORD)0,NULL);
- SvUPGRADE(sv,SVt_PV);
- SvGROW(sv,len);
- SvCUR(sv) = GetCurrentDirectory((DWORD) SvLEN(sv), SvPVX(sv));
- /*
- * If result != 0
- * then it worked, set PV valid,
- * else leave it 'undef'
- */
- if (SvCUR(sv))
- SvPOK_on(sv);
- EXTEND(sp,1);
- ST(0) = sv;
- XSRETURN(1);
-}
-
-static
-XS(w32_SetCwd)
-{
- dXSARGS;
- if (items != 1)
- croak("usage: Win32::SetCurrentDirectory($cwd)");
- if (SetCurrentDirectory(SvPV(ST(0),na)))
- XSRETURN_YES;
-
- XSRETURN_NO;
-}
-
-static
-XS(w32_GetNextAvailDrive)
-{
- dXSARGS;
- char ix = 'C';
- char root[] = "_:\\";
- while (ix <= 'Z') {
- root[0] = ix++;
- if (GetDriveType(root) == 1) {
- root[2] = '\0';
- XSRETURN_PV(root);
- }
- }
- XSRETURN_UNDEF;
-}
-
-static
-XS(w32_GetLastError)
-{
- dXSARGS;
- XSRETURN_IV(GetLastError());
-}
-
-static
-XS(w32_LoginName)
-{
- dXSARGS;
- char szBuffer[128];
- DWORD size = sizeof(szBuffer);
- if (GetUserName(szBuffer, &size)) {
- /* size includes NULL */
- ST(0) = sv_2mortal(newSVpv(szBuffer,size-1));
- XSRETURN(1);
- }
- XSRETURN_UNDEF;
-}
-
-static
-XS(w32_NodeName)
-{
- dXSARGS;
- char name[MAX_COMPUTERNAME_LENGTH+1];
- DWORD size = sizeof(name);
- if (GetComputerName(name,&size)) {
- /* size does NOT include NULL :-( */
- ST(0) = sv_2mortal(newSVpv(name,size));
- XSRETURN(1);
- }
- XSRETURN_UNDEF;
-}
-
-
-static
-XS(w32_DomainName)
-{
- dXSARGS;
- char name[256];
- DWORD size = sizeof(name);
- if (GetUserName(name,&size)) {
- char sid[1024];
- DWORD sidlen = sizeof(sid);
- char dname[256];
- DWORD dnamelen = sizeof(dname);
- SID_NAME_USE snu;
- if (LookupAccountName(NULL, name, &sid, &sidlen,
- dname, &dnamelen, &snu)) {
- XSRETURN_PV(dname); /* all that for this */
- }
- }
- XSRETURN_UNDEF;
-}
-
-static
-XS(w32_FsType)
-{
- dXSARGS;
- char fsname[256];
- DWORD flags, filecomplen;
- if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
- &flags, fsname, sizeof(fsname))) {
- if (GIMME == G_ARRAY) {
- XPUSHs(sv_2mortal(newSVpv(fsname,0)));
- XPUSHs(sv_2mortal(newSViv(flags)));
- XPUSHs(sv_2mortal(newSViv(filecomplen)));
- PUTBACK;
- return;
- }
- XSRETURN_PV(fsname);
- }
- XSRETURN_UNDEF;
-}
-
-static
-XS(w32_GetOSVersion)
-{
- dXSARGS;
- OSVERSIONINFO osver;
-
- osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
- if (GetVersionEx(&osver)) {
- XPUSHs(newSVpv(osver.szCSDVersion, 0));
- XPUSHs(newSViv(osver.dwMajorVersion));
- XPUSHs(newSViv(osver.dwMinorVersion));
- XPUSHs(newSViv(osver.dwBuildNumber));
- XPUSHs(newSViv(osver.dwPlatformId));
- PUTBACK;
- return;
- }
- XSRETURN_UNDEF;
-}
-
-static
-XS(w32_IsWinNT)
-{
- dXSARGS;
- OSVERSIONINFO osver;
- memset(&osver, 0, sizeof(OSVERSIONINFO));
- osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
- GetVersionEx(&osver);
- XSRETURN_IV(VER_PLATFORM_WIN32_NT == osver.dwPlatformId);
-}
-
-static
-XS(w32_IsWin95)
-{
- dXSARGS;
- OSVERSIONINFO osver;
- memset(&osver, 0, sizeof(OSVERSIONINFO));
- osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
- GetVersionEx(&osver);
- XSRETURN_IV(VER_PLATFORM_WIN32_WINDOWS == osver.dwPlatformId);
-}
-
-static
-XS(w32_FormatMessage)
-{
- dXSARGS;
- DWORD source = 0;
- char msgbuf[1024];
-
- if (items != 1)
- croak("usage: Win32::FormatMessage($errno)");
-
- if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,
- &source, SvIV(ST(0)), 0,
- msgbuf, sizeof(msgbuf)-1, NULL))
- XSRETURN_PV(msgbuf);
-
- XSRETURN_UNDEF;
-}
-
-static
-XS(w32_Spawn)
-{
- dXSARGS;
- char *cmd, *args;
- PROCESS_INFORMATION stProcInfo;
- STARTUPINFO stStartInfo;
- BOOL bSuccess = FALSE;
-
- if(items != 3)
- croak("usage: Win32::Spawn($cmdName, $args, $PID)");
-
- cmd = SvPV(ST(0),na);
- args = SvPV(ST(1), na);
-
- memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */
- stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */
- stStartInfo.dwFlags = STARTF_USESHOWWINDOW; /* Enable wShowWindow control */
- stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE; /* Start min (normal) */
-
- if(CreateProcess(
- cmd, /* Image path */
- args, /* Arguments for command line */
- NULL, /* Default process security */
- NULL, /* Default thread security */
- FALSE, /* Must be TRUE to use std handles */
- NORMAL_PRIORITY_CLASS, /* No special scheduling */
- NULL, /* Inherit our environment block */
- NULL, /* Inherit our currrent directory */
- &stStartInfo, /* -> Startup info */
- &stProcInfo)) /* <- Process info (if OK) */
- {
- CloseHandle(stProcInfo.hThread);/* library source code does this. */
- sv_setiv(ST(2), stProcInfo.dwProcessId);
- bSuccess = TRUE;
- }
- XSRETURN_IV(bSuccess);
-}
-
-static
-XS(w32_GetTickCount)
-{
- dXSARGS;
- XSRETURN_IV(GetTickCount());
-}
-
-static
-XS(w32_GetShortPathName)
-{
- dXSARGS;
- SV *shortpath;
- DWORD len;
-
- if(items != 1)
- croak("usage: Win32::GetShortPathName($longPathName)");
-
- shortpath = sv_mortalcopy(ST(0));
- SvUPGRADE(shortpath, SVt_PV);
- /* src == target is allowed */
- do {
- len = GetShortPathName(SvPVX(shortpath),
- SvPVX(shortpath),
- SvLEN(shortpath));
- } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));
- if (len) {
- SvCUR_set(shortpath,len);
- ST(0) = shortpath;
- }
- else
- ST(0) = &sv_undef;
- XSRETURN(1);
-}
-
-
-void CPerlStdIO::InitOSExtras(void* p)
-{
- char *file = __FILE__;
- dXSUB_SYS;
-
- /* XXX should be removed after checking with Nick */
- newXS("Win32::GetCurrentDirectory", w32_GetCwd, file);
-
- /* these names are Activeware compatible */
- newXS("Win32::GetCwd", w32_GetCwd, file);
- newXS("Win32::SetCwd", w32_SetCwd, file);
- newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
- newXS("Win32::GetLastError", w32_GetLastError, file);
- newXS("Win32::LoginName", w32_LoginName, file);
- newXS("Win32::NodeName", w32_NodeName, file);
- newXS("Win32::DomainName", w32_DomainName, file);
- newXS("Win32::FsType", w32_FsType, file);
- newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
- newXS("Win32::IsWinNT", w32_IsWinNT, file);
- newXS("Win32::IsWin95", w32_IsWin95, file);
- newXS("Win32::FormatMessage", w32_FormatMessage, file);
- newXS("Win32::Spawn", w32_Spawn, file);
- newXS("Win32::GetTickCount", w32_GetTickCount, file);
- newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
-
-}
-
-
+++ /dev/null
-/*
-
- ipstdiowin.h
- Interface for perl stdio functions
-
-*/
-
-#ifndef __Inc__IPerlStdIOWin___
-#define __Inc__IPerlStdIOWin___
-
-#include <ipstdio.h>
-
-
-class IPerlStdIOWin : public IPerlStdIO
-{
-public:
- virtual int OpenOSfhandle(long osfhandle, int flags) = 0;
- virtual int GetOSfhandle(int filenum) = 0;
-};
-
-#endif /* __Inc__IPerlStdIOWin___ */
-
+++ /dev/null
-LIBRARY PerlCore
-DESCRIPTION 'Perl interpreter'
-EXPORTS
- perl_alloc
#define NO_XSLOCKS
#include "XSUB.H"
+#include "Win32iop.h"
+
#undef errno
#if defined(_MT)
_CRTIMP int * __cdecl _errno(void);
_CRTIMP extern int errno;
#endif
+CPerlObj *pPerl;
+
+#include <fcntl.h>
#include <ipdir.h>
#include <ipenv.h>
#include <ipsock.h>
#include <iplio.h>
#include <ipmem.h>
#include <ipproc.h>
+#include <ipstdio.h>
+
+class IPerlStdIOWin : public IPerlStdIO
+{
+public:
+ virtual int OpenOSfhandle(long osfhandle, int flags) = 0;
+ virtual int GetOSfhandle(int filenum) = 0;
+};
+
+extern int g_closedir(DIR *dirp);
+extern DIR *g_opendir(char *filename);
+extern struct direct *g_readdir(DIR *dirp);
+extern void g_rewinddir(DIR *dirp);
+extern void g_seekdir(DIR *dirp, long loc);
+extern long g_telldir(DIR *dirp);
+class CPerlDir : public IPerlDir
+{
+public:
+ CPerlDir() {};
+ virtual int Makedir(const char *dirname, int mode, int &err)
+ {
+ return win32_mkdir(dirname, mode);
+ };
+ virtual int Chdir(const char *dirname, int &err)
+ {
+ return win32_chdir(dirname);
+ };
+ virtual int Rmdir(const char *dirname, int &err)
+ {
+ return win32_rmdir(dirname);
+ };
+ virtual int Close(DIR *dirp, int &err)
+ {
+ return g_closedir(dirp);
+ };
+ virtual DIR *Open(char *filename, int &err)
+ {
+ return g_opendir(filename);
+ };
+ virtual struct direct *Read(DIR *dirp, int &err)
+ {
+ return g_readdir(dirp);
+ };
+ virtual void Rewind(DIR *dirp, int &err)
+ {
+ g_rewinddir(dirp);
+ };
+ virtual void Seek(DIR *dirp, long loc, int &err)
+ {
+ g_seekdir(dirp, loc);
+ };
+ virtual long Tell(DIR *dirp, int &err)
+ {
+ return g_telldir(dirp);
+ };
+};
+
+
+extern char * g_win32_perllib_path(char *sfx,...);
+class CPerlEnv : public IPerlEnv
+{
+public:
+ CPerlEnv() {};
+ virtual char *Getenv(const char *varname, int &err)
+ {
+ return win32_getenv(varname);
+ };
+ virtual int Putenv(const char *envstring, int &err)
+ {
+ return _putenv(envstring);
+ };
+ virtual char* LibPath(char *sfx, ...)
+ {
+ LPSTR ptr1, ptr2, ptr3, ptr4, ptr5;
+ va_list ap;
+ va_start(ap,sfx);
+ ptr1 = va_arg(ap,char *);
+ ptr2 = va_arg(ap,char *);
+ ptr3 = va_arg(ap,char *);
+ ptr4 = va_arg(ap,char *);
+ ptr5 = va_arg(ap,char *);
+ return g_win32_perllib_path(sfx, ptr1, ptr2, ptr3, ptr4, ptr5);
+ };
+};
+
+#define PROCESS_AND_RETURN \
+ if(errno) \
+ err = errno; \
+ return r
+
+class CPerlSock : public IPerlSock
+{
+public:
+ CPerlSock() {};
+ virtual u_long Htonl(u_long hostlong)
+ {
+ return win32_htonl(hostlong);
+ };
+ virtual u_short Htons(u_short hostshort)
+ {
+ return win32_htons(hostshort);
+ };
+ virtual u_long Ntohl(u_long netlong)
+ {
+ return win32_ntohl(netlong);
+ };
+ virtual u_short Ntohs(u_short netshort)
+ {
+ return win32_ntohs(netshort);
+ }
+
+ virtual SOCKET Accept(SOCKET s, struct sockaddr* addr, int* addrlen, int &err)
+ {
+ SOCKET r = win32_accept(s, addr, addrlen);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Bind(SOCKET s, const struct sockaddr* name, int namelen, int &err)
+ {
+ int r = win32_bind(s, name, namelen);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Connect(SOCKET s, const struct sockaddr* name, int namelen, int &err)
+ {
+ int r = win32_connect(s, name, namelen);
+ PROCESS_AND_RETURN;
+ };
+ virtual void Endhostent(int &err)
+ {
+ win32_endhostent();
+ };
+ virtual void Endnetent(int &err)
+ {
+ win32_endnetent();
+ };
+ virtual void Endprotoent(int &err)
+ {
+ win32_endprotoent();
+ };
+ virtual void Endservent(int &err)
+ {
+ win32_endservent();
+ };
+ virtual struct hostent* Gethostbyaddr(const char* addr, int len, int type, int &err)
+ {
+ struct hostent *r = win32_gethostbyaddr(addr, len, type);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct hostent* Gethostbyname(const char* name, int &err)
+ {
+ struct hostent *r = win32_gethostbyname(name);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct hostent* Gethostent(int &err)
+ {
+ croak("gethostent not implemented!\n");
+ return NULL;
+ };
+ virtual int Gethostname(char* name, int namelen, int &err)
+ {
+ int r = win32_gethostname(name, namelen);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct netent *Getnetbyaddr(long net, int type, int &err)
+ {
+ struct netent *r = win32_getnetbyaddr(net, type);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct netent *Getnetbyname(const char *name, int &err)
+ {
+ struct netent *r = win32_getnetbyname((char*)name);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct netent *Getnetent(int &err)
+ {
+ struct netent *r = win32_getnetent();
+ PROCESS_AND_RETURN;
+ };
+ virtual int Getpeername(SOCKET s, struct sockaddr* name, int* namelen, int &err)
+ {
+ int r = win32_getpeername(s, name, namelen);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct protoent* Getprotobyname(const char* name, int &err)
+ {
+ struct protoent *r = win32_getprotobyname(name);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct protoent* Getprotobynumber(int number, int &err)
+ {
+ struct protoent *r = win32_getprotobynumber(number);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct protoent* Getprotoent(int &err)
+ {
+ struct protoent *r = win32_getprotoent();
+ PROCESS_AND_RETURN;
+ };
+ virtual struct servent* Getservbyname(const char* name, const char* proto, int &err)
+ {
+ struct servent *r = win32_getservbyname(name, proto);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct servent* Getservbyport(int port, const char* proto, int &err)
+ {
+ struct servent *r = win32_getservbyport(port, proto);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct servent* Getservent(int &err)
+ {
+ struct servent *r = win32_getservent();
+ PROCESS_AND_RETURN;
+ };
+ virtual int Getsockname(SOCKET s, struct sockaddr* name, int* namelen, int &err)
+ {
+ int r = win32_getsockname(s, name, namelen);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Getsockopt(SOCKET s, int level, int optname, char* optval, int* optlen, int &err)
+ {
+ int r = win32_getsockopt(s, level, optname, optval, optlen);
+ PROCESS_AND_RETURN;
+ };
+ virtual unsigned long InetAddr(const char* cp, int &err)
+ {
+ unsigned long r = win32_inet_addr(cp);
+ PROCESS_AND_RETURN;
+ };
+ virtual char* InetNtoa(struct in_addr in, int &err)
+ {
+ char *r = win32_inet_ntoa(in);
+ PROCESS_AND_RETURN;
+ };
+ virtual int IoctlSocket(SOCKET s, long cmd, u_long *argp, int& err)
+ {
+ int r = win32_ioctlsocket(s, cmd, argp);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Listen(SOCKET s, int backlog, int &err)
+ {
+ int r = win32_listen(s, backlog);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Recvfrom(SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen, int &err)
+ {
+ int r = win32_recvfrom(s, buffer, len, flags, from, fromlen);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Select(int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout, int &err)
+ {
+ int r = win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Send(SOCKET s, const char* buffer, int len, int flags, int &err)
+ {
+ int r = win32_send(s, buffer, len, flags);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Sendto(SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen, int &err)
+ {
+ int r = win32_sendto(s, buffer, len, flags, to, tolen);
+ PROCESS_AND_RETURN;
+ };
+ virtual void Sethostent(int stayopen, int &err)
+ {
+ win32_sethostent(stayopen);
+ };
+ virtual void Setnetent(int stayopen, int &err)
+ {
+ win32_setnetent(stayopen);
+ };
+ virtual void Setprotoent(int stayopen, int &err)
+ {
+ win32_setprotoent(stayopen);
+ };
+ virtual void Setservent(int stayopen, int &err)
+ {
+ win32_setservent(stayopen);
+ };
+ virtual int Setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen, int &err)
+ {
+ int r = win32_setsockopt(s, level, optname, optval, optlen);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Shutdown(SOCKET s, int how, int &err)
+ {
+ int r = win32_shutdown(s, how);
+ PROCESS_AND_RETURN;
+ };
+ virtual SOCKET Socket(int af, int type, int protocol, int &err)
+ {
+ SOCKET r = win32_socket(af, type, protocol);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Socketpair(int domain, int type, int protocol, int* fds, int &err)
+ {
+ croak("socketpair not implemented!\n");
+ return 0;
+ };
+};
+
+
+#define CALLFUNCRET(x)\
+ int ret = x;\
+ if(ret)\
+ err = errno;\
+ return ret;
+
+#define CALLFUNCERR(x)\
+ int ret = x;\
+ if(errno)\
+ err = errno;\
+ return ret;
+
+#define LCALLFUNCERR(x)\
+ long ret = x;\
+ if(errno)\
+ err = errno;\
+ return ret;
+
+class CPerlLIO : public IPerlLIO
+{
+public:
+ CPerlLIO() {};
+ virtual int Access(const char *path, int mode, int &err)
+ {
+ CALLFUNCRET(access(path, mode))
+ };
+ virtual int Chmod(const char *filename, int pmode, int &err)
+ {
+ CALLFUNCRET(chmod(filename, pmode))
+ };
+ virtual int Chsize(int handle, long size, int &err)
+ {
+ CALLFUNCRET(chsize(handle, size))
+ };
+ virtual int Close(int handle, int &err)
+ {
+ CALLFUNCRET(win32_close(handle))
+ };
+ virtual int Dup(int handle, int &err)
+ {
+ CALLFUNCERR(win32_dup(handle))
+ };
+ virtual int Dup2(int handle1, int handle2, int &err)
+ {
+ CALLFUNCERR(win32_dup2(handle1, handle2))
+ };
+ virtual int Flock(int fd, int oper, int &err)
+ {
+ CALLFUNCERR(win32_flock(fd, oper))
+ };
+ virtual int FileStat(int handle, struct stat *buffer, int &err)
+ {
+ CALLFUNCERR(fstat(handle, buffer))
+ };
+ virtual int IOCtl(int i, unsigned int u, char *data, int &err)
+ {
+ CALLFUNCERR(win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data))
+ };
+ virtual int Isatty(int fd, int &err)
+ {
+ return isatty(fd);
+ };
+ virtual long Lseek(int handle, long offset, int origin, int &err)
+ {
+ LCALLFUNCERR(win32_lseek(handle, offset, origin))
+ };
+ virtual int Lstat(const char *path, struct stat *buffer, int &err)
+ {
+ return NameStat(path, buffer, err);
+ };
+ virtual char *Mktemp(char *Template, int &err)
+ {
+ return mktemp(Template);
+ };
+ virtual int Open(const char *filename, int oflag, int &err)
+ {
+ CALLFUNCERR(win32_open(filename, oflag))
+ };
+ virtual int Open(const char *filename, int oflag, int pmode, int &err)
+ {
+ int ret;
+ if(stricmp(filename, "/dev/null") == 0)
+ ret = open("NUL", oflag, pmode);
+ else
+ ret = open(filename, oflag, pmode);
+
+ if(errno)
+ err = errno;
+ return ret;
+ };
+ virtual int Read(int handle, void *buffer, unsigned int count, int &err)
+ {
+ CALLFUNCERR(win32_read(handle, buffer, count))
+ };
+ virtual int Rename(const char *OldFileName, const char *newname, int &err)
+ {
+ char szNewWorkName[MAX_PATH+1];
+ WIN32_FIND_DATA fdOldFile, fdNewFile;
+ HANDLE handle;
+ char *ptr;
+
+ if((strchr(OldFileName, '\\') || strchr(OldFileName, '/'))
+ && strchr(newname, '\\') == NULL
+ && strchr(newname, '/') == NULL)
+ {
+ strcpy(szNewWorkName, OldFileName);
+ if((ptr = strrchr(szNewWorkName, '\\')) == NULL)
+ ptr = strrchr(szNewWorkName, '/');
+ strcpy(++ptr, newname);
+ }
+ else
+ strcpy(szNewWorkName, newname);
+
+ if(stricmp(OldFileName, szNewWorkName) != 0)
+ { // check that we're not being fooled by relative paths
+ // and only delete the new file
+ // 1) if it exists
+ // 2) it is not the same file as the old file
+ // 3) old file exist
+ // GetFullPathName does not return the long file name on some systems
+ handle = FindFirstFile(OldFileName, &fdOldFile);
+ if(handle != INVALID_HANDLE_VALUE)
+ {
+ FindClose(handle);
+
+ handle = FindFirstFile(szNewWorkName, &fdNewFile);
+
+ if(handle != INVALID_HANDLE_VALUE)
+ FindClose(handle);
+ else
+ fdNewFile.cFileName[0] = '\0';
+
+ if(strcmp(fdOldFile.cAlternateFileName, fdNewFile.cAlternateFileName) != 0
+ && strcmp(fdOldFile.cFileName, fdNewFile.cFileName) != 0)
+ { // file exists and not same file
+ DeleteFile(szNewWorkName);
+ }
+ }
+ }
+ int ret = rename(OldFileName, szNewWorkName);
+ if(ret)
+ err = errno;
+
+ return ret;
+ };
+ virtual int Setmode(int handle, int mode, int &err)
+ {
+ CALLFUNCRET(win32_setmode(handle, mode))
+ };
+ virtual int NameStat(const char *path, struct stat *buffer, int &err)
+ {
+ return win32_stat(path, buffer);
+ };
+ virtual char *Tmpnam(char *string, int &err)
+ {
+ return tmpnam(string);
+ };
+ virtual int Umask(int pmode, int &err)
+ {
+ return umask(pmode);
+ };
+ virtual int Unlink(const char *filename, int &err)
+ {
+ chmod(filename, _S_IREAD | _S_IWRITE);
+ CALLFUNCRET(unlink(filename))
+ };
+ virtual int Utime(char *filename, struct utimbuf *times, int &err)
+ {
+ CALLFUNCRET(win32_utime(filename, times))
+ };
+ virtual int Write(int handle, const void *buffer, unsigned int count, int &err)
+ {
+ CALLFUNCERR(win32_write(handle, buffer, count))
+ };
+};
+
+class CPerlMem : public IPerlMem
+{
+public:
+ CPerlMem() {};
+ virtual void* Malloc(size_t size)
+ {
+ return win32_malloc(size);
+ };
+ virtual void* Realloc(void* ptr, size_t size)
+ {
+ return win32_realloc(ptr, size);
+ };
+ virtual void Free(void* ptr)
+ {
+ win32_free(ptr);
+ };
+};
+
+#define EXECF_EXEC 1
+#define EXECF_SPAWN 2
+
+extern char *g_getlogin(void);
+extern int do_spawn2(char *cmd, int exectype);
+extern int g_do_aspawn(void *vreally, void **vmark, void **vsp);
+class CPerlProc : public IPerlProc
+{
+public:
+ CPerlProc() {};
+ virtual void Abort(void)
+ {
+ win32_abort();
+ };
+ virtual void Exit(int status)
+ {
+ exit(status);
+ };
+ virtual void _Exit(int status)
+ {
+ _exit(status);
+ };
+ virtual int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
+ {
+ return execl(cmdname, arg0, arg1, arg2, arg3);
+ };
+ virtual int Execv(const char *cmdname, const char *const *argv)
+ {
+ return win32_execvp(cmdname, argv);
+ };
+ virtual int Execvp(const char *cmdname, const char *const *argv)
+ {
+ return win32_execvp(cmdname, argv);
+ };
+ virtual uid_t Getuid(void)
+ {
+ return getuid();
+ };
+ virtual uid_t Geteuid(void)
+ {
+ return geteuid();
+ };
+ virtual gid_t Getgid(void)
+ {
+ return getgid();
+ };
+ virtual gid_t Getegid(void)
+ {
+ return getegid();
+ };
+ virtual char *Getlogin(void)
+ {
+ return g_getlogin();
+ };
+ virtual int Kill(int pid, int sig)
+ {
+ return kill(pid, sig);
+ };
+ virtual int Killpg(int pid, int sig)
+ {
+ croak("killpg not implemented!\n");
+ return 0;
+ };
+ virtual int PauseProc(void)
+ {
+ return win32_sleep((32767L << 16) + 32767);
+ };
+ virtual PerlIO* Popen(const char *command, const char *mode)
+ {
+ return (PerlIO*)win32_popen(command, mode);
+ };
+ virtual int Pclose(PerlIO *stream)
+ {
+ return win32_pclose((FILE*)stream);
+ };
+ virtual int Pipe(int *phandles)
+ {
+ return win32_pipe(phandles, 512, _O_BINARY);
+ };
+ virtual int Setuid(uid_t u)
+ {
+ return setuid(u);
+ };
+ virtual int Setgid(gid_t g)
+ {
+ return setgid(g);
+ };
+ virtual int Sleep(unsigned int s)
+ {
+ return win32_sleep(s);
+ };
+ virtual int Times(struct tms *timebuf)
+ {
+ return win32_times(timebuf);
+ };
+ virtual int Wait(int *status)
+ {
+ return win32_wait(status);
+ };
+ virtual Sighandler_t Signal(int sig, Sighandler_t subcode)
+ {
+ return 0;
+ };
+ virtual void GetSysMsg(char*& sMsg, DWORD& dwLen, DWORD dwErr)
+ {
+ dwLen = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER
+ |FORMAT_MESSAGE_IGNORE_INSERTS
+ |FORMAT_MESSAGE_FROM_SYSTEM, NULL,
+ dwErr, 0, (char *)&sMsg, 1, NULL);
+ if (0 < dwLen) {
+ while (0 < dwLen && isspace(sMsg[--dwLen]))
+ ;
+ if ('.' != sMsg[dwLen])
+ dwLen++;
+ sMsg[dwLen]= '\0';
+ }
+ if (0 == dwLen) {
+ sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
+ dwLen = sprintf(sMsg,
+ "Unknown error #0x%lX (lookup 0x%lX)",
+ dwErr, GetLastError());
+ }
+ };
+ virtual void FreeBuf(char* sMsg)
+ {
+ LocalFree(sMsg);
+ };
+ virtual BOOL DoCmd(char *cmd)
+ {
+ do_spawn2(cmd, EXECF_EXEC);
+ return FALSE;
+ };
+ virtual int Spawn(char* cmds)
+ {
+ return do_spawn2(cmds, EXECF_SPAWN);
+ };
+ virtual int Spawnvp(int mode, const char *cmdname, const char *const *argv)
+ {
+ return win32_spawnvp(mode, cmdname, argv);
+ };
+ virtual int ASpawn(void *vreally, void **vmark, void **vsp)
+ {
+ return g_do_aspawn(vreally, vmark, vsp);
+ };
+};
+
+
+class CPerlStdIO : public IPerlStdIOWin
+{
+public:
+ CPerlStdIO() {};
+ virtual PerlIO* Stdin(void)
+ {
+ return (PerlIO*)win32_stdin();
+ };
+ virtual PerlIO* Stdout(void)
+ {
+ return (PerlIO*)win32_stdout();
+ };
+ virtual PerlIO* Stderr(void)
+ {
+ return (PerlIO*)win32_stderr();
+ };
+ virtual PerlIO* Open(const char *path, const char *mode, int &err)
+ {
+ PerlIO*pf = (PerlIO*)win32_fopen(path, mode);
+ if(errno)
+ err = errno;
+ return pf;
+ };
+ virtual int Close(PerlIO* pf, int &err)
+ {
+ CALLFUNCERR(win32_fclose(((FILE*)pf)))
+ };
+ virtual int Eof(PerlIO* pf, int &err)
+ {
+ CALLFUNCERR(win32_feof((FILE*)pf))
+ };
+ virtual int Error(PerlIO* pf, int &err)
+ {
+ CALLFUNCERR(win32_ferror((FILE*)pf))
+ };
+ virtual void Clearerr(PerlIO* pf, int &err)
+ {
+ win32_clearerr((FILE*)pf);
+ };
+ virtual int Getc(PerlIO* pf, int &err)
+ {
+ CALLFUNCERR(win32_getc((FILE*)pf))
+ };
+ virtual char* GetBase(PerlIO* pf, int &err)
+ {
+ return ((FILE*)pf)->_base;
+ };
+ virtual int GetBufsiz(PerlIO* pf, int &err)
+ {
+ return ((FILE*)pf)->_bufsiz;
+ };
+ virtual int GetCnt(PerlIO* pf, int &err)
+ {
+ return ((FILE*)pf)->_cnt;
+ };
+ virtual char* GetPtr(PerlIO* pf, int &err)
+ {
+ return ((FILE*)pf)->_ptr;
+ };
+ virtual int Putc(PerlIO* pf, int c, int &err)
+ {
+ CALLFUNCERR(win32_fputc(c, (FILE*)pf))
+ };
+ virtual int Puts(PerlIO* pf, const char *s, int &err)
+ {
+ CALLFUNCERR(win32_fputs(s, (FILE*)pf))
+ };
+ virtual int Flush(PerlIO* pf, int &err)
+ {
+ CALLFUNCERR(win32_fflush((FILE*)pf))
+ };
+ virtual int Ungetc(PerlIO* pf,int c, int &err)
+ {
+ CALLFUNCERR(win32_ungetc(c, (FILE*)pf))
+ };
+ virtual int Fileno(PerlIO* pf, int &err)
+ {
+ CALLFUNCERR(win32_fileno((FILE*)pf))
+ };
+ virtual PerlIO* Fdopen(int fd, const char *mode, int &err)
+ {
+ PerlIO* pf = (PerlIO*)win32_fdopen(fd, mode);
+ if(errno)
+ err = errno;
+ return pf;
+ };
+ virtual PerlIO* Reopen(const char*path, const char*mode, PerlIO* pf, int &err)
+ {
+ PerlIO* newPf = (PerlIO*)win32_freopen(path, mode, (FILE*)pf);
+ if(errno)
+ err = errno;
+ return newPf;
+ };
+ virtual SSize_t Read(PerlIO* pf, void *buffer, Size_t size, int &err)
+ {
+ SSize_t i = win32_fread(buffer, size, 1, (FILE*)pf);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual SSize_t Write(PerlIO* pf, const void *buffer, Size_t size, int &err)
+ {
+ SSize_t i = win32_fwrite(buffer, size, 1, (FILE*)pf);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual void SetBuf(PerlIO* pf, char* buffer, int &err)
+ {
+ win32_setbuf((FILE*)pf, buffer);
+ };
+ virtual int SetVBuf(PerlIO* pf, char* buffer, int type, Size_t size, int &err)
+ {
+ int i = win32_setvbuf((FILE*)pf, buffer, type, size);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual void SetCnt(PerlIO* pf, int n, int &err)
+ {
+ ((FILE*)pf)->_cnt = n;
+ };
+ virtual void SetPtrCnt(PerlIO* pf, char * ptr, int n, int& err)
+ {
+ ((FILE*)pf)->_ptr = ptr;
+ ((FILE*)pf)->_cnt = n;
+ };
+ virtual void Setlinebuf(PerlIO* pf, int &err)
+ {
+ win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0);
+ };
+ virtual int Printf(PerlIO* pf, int &err, const char *format,...)
+ {
+ va_list(arglist);
+ va_start(arglist, format);
+ int i = win32_vfprintf((FILE*)pf, format, arglist);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual int Vprintf(PerlIO* pf, int &err, const char *format, va_list arglist)
+ {
+ int i = win32_vfprintf((FILE*)pf, format, arglist);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual long Tell(PerlIO* pf, int &err)
+ {
+ long l = win32_ftell((FILE*)pf);
+ if(errno)
+ err = errno;
+ return l;
+ };
+ virtual int Seek(PerlIO* pf, off_t offset, int origin, int &err)
+ {
+ int i = win32_fseek((FILE*)pf, offset, origin);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual void Rewind(PerlIO* pf, int &err)
+ {
+ win32_rewind((FILE*)pf);
+ };
+ virtual PerlIO* Tmpfile(int &err)
+ {
+ PerlIO* pf = (PerlIO*)win32_tmpfile();
+ if(errno)
+ err = errno;
+ return pf;
+ };
+ virtual int Getpos(PerlIO* pf, Fpos_t *p, int &err)
+ {
+ int i = win32_fgetpos((FILE*)pf, p);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual int Setpos(PerlIO* pf, const Fpos_t *p, int &err)
+ {
+ int i = win32_fsetpos((FILE*)pf, p);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual void Init(int &err)
+ {
+ };
+ virtual void InitOSExtras(void* p)
+ {
+ Perl_init_os_extras();
+ };
+ virtual int OpenOSfhandle(long osfhandle, int flags)
+ {
+ return win32_open_osfhandle(osfhandle, flags);
+ }
+ virtual int GetOSfhandle(int filenum)
+ {
+ return win32_get_osfhandle(filenum);
+ }
+};
-#include "ipstdiowin.h"
-#include "ipdir.c"
-#include "ipenv.c"
-#include "ipsock.c"
-#include "iplio.c"
-#include "ipmem.c"
-#include "ipproc.c"
-#include "ipstdio.c"
static void xs_init _((CPERLarg));
#define stderr (&_iob[2])
class CPerlHost
{
public:
- CPerlHost() { pPerl = NULL; };
- inline BOOL PerlCreate(void)
+ CPerlHost() { pPerl = NULL; };
+ inline BOOL PerlCreate(void)
+ {
+ try
{
+ pPerl = perl_alloc(&perlMem, &perlEnv, &perlStdIO, &perlLIO, &perlDir, &perlSock, &perlProc);
+ if(pPerl != NULL)
+ {
try
{
- pPerl = perl_alloc(&perlMem,
- &perlEnv,
- &perlStdIO,
- &perlLIO,
- &perlDir,
- &perlSock,
- &perlProc);
- if(pPerl != NULL)
- {
- perlDir.SetPerlObj(pPerl);
- perlEnv.SetPerlObj(pPerl);
- perlLIO.SetPerlObj(pPerl);
- perlLIO.SetSockCtl(&perlSock);
- perlLIO.SetStdObj(&perlStdIO);
- perlMem.SetPerlObj(pPerl);
- perlProc.SetPerlObj(pPerl);
- perlSock.SetPerlObj(pPerl);
- perlSock.SetStdObj(&perlStdIO);
- perlStdIO.SetPerlObj(pPerl);
- perlStdIO.SetSockCtl(&perlSock);
- try
- {
- pPerl->perl_construct();
- }
- catch(...)
- {
- fprintf(stderr, "%s\n", "Error: Unable to construct data structures");
- pPerl->perl_free();
- pPerl = NULL;
- }
- }
+ pPerl->perl_construct();
}
catch(...)
{
- fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
- pPerl = NULL;
+ fprintf(stderr, "%s\n", "Error: Unable to construct data structures");
+ pPerl->perl_free();
+ pPerl = NULL;
}
- return (pPerl != NULL);
- };
- inline int PerlParse(int argc, char** argv, char** env)
+ }
+ }
+ catch(...)
{
- char* environ = NULL;
- int retVal;
- try
- {
- retVal = pPerl->perl_parse(xs_init, argc, argv, (env == NULL || *env == NULL ? &environ : env));
- }
- catch(int x)
- {
- // this is where exit() should arrive
- retVal = x;
- }
- catch(...)
- {
- fprintf(stderr, "Error: Parse exception\n");
- retVal = -1;
- }
- return retVal;
- };
- inline int PerlRun(void)
+ fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
+ pPerl = NULL;
+ }
+ return (pPerl != NULL);
+ };
+ inline int PerlParse(int argc, char** argv, char** env)
+ {
+ char* environ = NULL;
+ int retVal;
+ try
{
- int retVal;
- try
- {
- retVal = pPerl->perl_run();
- }
- catch(int x)
- {
- // this is where exit() should arrive
- retVal = x;
- }
- catch(...)
- {
- fprintf(stderr, "Error: Runtime exception\n");
- retVal = -1;
- }
- return retVal;
- };
- inline void PerlDestroy(void)
+ retVal = pPerl->perl_parse(xs_init, argc, argv, (env == NULL || *env == NULL ? &environ : env));
+ }
+ catch(int x)
{
- try
- {
- pPerl->perl_destruct();
- pPerl->perl_free();
- }
- catch(...)
- {
- }
- };
+ // this is where exit() should arrive
+ retVal = x;
+ }
+ catch(...)
+ {
+ fprintf(stderr, "Error: Parse exception\n");
+ retVal = -1;
+ }
+ return retVal;
+ };
+ inline int PerlRun(void)
+ {
+ int retVal;
+ try
+ {
+ retVal = pPerl->perl_run();
+ }
+ catch(int x)
+ {
+ // this is where exit() should arrive
+ retVal = x;
+ }
+ catch(...)
+ {
+ fprintf(stderr, "Error: Runtime exception\n");
+ retVal = -1;
+ }
+ return retVal;
+ };
+ inline void PerlDestroy(void)
+ {
+ try
+ {
+ pPerl->perl_destruct();
+ pPerl->perl_free();
+ }
+ catch(...)
+ {
+ }
+ };
protected:
- CPerlObj *pPerl;
- CPerlDir perlDir;
- CPerlEnv perlEnv;
- CPerlLIO perlLIO;
- CPerlMem perlMem;
- CPerlProc perlProc;
- CPerlSock perlSock;
- CPerlStdIO perlStdIO;
+ CPerlDir perlDir;
+ CPerlEnv perlEnv;
+ CPerlLIO perlLIO;
+ CPerlMem perlMem;
+ CPerlProc perlProc;
+ CPerlSock perlSock;
+ CPerlStdIO perlStdIO;
};
#undef PERL_SYS_INIT
int
main(int argc, char **argv, char **env)
{
- CPerlHost host;
- int exitstatus = 1;
+ CPerlHost host;
+ int exitstatus = 1;
- if(!host.PerlCreate())
- exit(exitstatus);
+ if(!host.PerlCreate())
+ exit(exitstatus);
- exitstatus = host.PerlParse(argc, argv, env);
+ exitstatus = host.PerlParse(argc, argv, env);
- if (!exitstatus)
- {
- exitstatus = host.PerlRun();
+ if (!exitstatus)
+ {
+ exitstatus = host.PerlRun();
}
- host.PerlDestroy();
+ host.PerlDestroy();
return exitstatus;
}
+char *staticlinkmodules[] = {
+ "DynaLoader",
+ NULL,
+};
-static void xs_init(CPERLarg)
-{
-}
+EXTERN_C void boot_DynaLoader _((CPERLarg_ CV* cv));
-EXTERN_C void boot_DynaLoader _((CPERLarg_ CV* cv))
+static void
+xs_init(CPERLarg)
{
+ char *file = __FILE__;
+ dXSUB_SYS;
+ newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
}
#else /* PERL_OBJECT */
#include "EXTERN.h"
#include "perl.h"
+
+#define NO_XSLOCKS
+#ifdef PERL_OBJECT
+extern CPerlObj* pPerl;
+#endif
#include "XSUB.h"
+
+#include "Win32iop.h"
#include <fcntl.h>
#include <sys/stat.h>
#ifndef __GNUC__
#define EXECF_SPAWN 2
#define EXECF_SPAWN_NOWAIT 3
+#if defined(PERL_OBJECT)
+#undef win32_perllib_path
+#define win32_perllib_path g_win32_perllib_path
+#undef do_aspawn
+#define do_aspawn g_do_aspawn
+#undef do_spawn
+#define do_spawn g_do_spawn
+#undef do_exec
+#define do_exec g_do_exec
+#undef opendir
+#define opendir g_opendir
+#undef readdir
+#define readdir g_readdir
+#undef telldir
+#define telldir g_telldir
+#undef seekdir
+#define seekdir g_seekdir
+#undef rewinddir
+#define rewinddir g_rewinddir
+#undef closedir
+#define closedir g_closedir
+#undef getlogin
+#define getlogin g_getlogin
+#endif
+
static DWORD os_id(void);
static void get_shell(void);
static long tokenize(char *str, char **dest, char ***destv);
-static int do_spawn2(char *cmd, int exectype);
+ int do_spawn2(char *cmd, int exectype);
static BOOL has_redirection(char *ptr);
static long filetime_to_clock(PFILETIME ft);
static BOOL filetime_from_time(PFILETIME ft, time_t t);
+
char * w32_perlshell_tokens = Nullch;
char ** w32_perlshell_vec;
long w32_perlshell_items = -1;
return FALSE;
}
+#if !defined(PERL_OBJECT)
/* since the current process environment is being updated in util.c
* the library functions will get the correct environment
*/
{
return win32_pclose(fp);
}
+#endif
static DWORD
os_id(void)
argv[index++] = 0;
status = win32_spawnvp(flag,
- (really ? SvPV(really,na) : argv[0]),
+ (const char*)(really ? SvPV(really,na) : argv[0]),
(const char* const*)argv);
if (status < 0 && errno == ENOEXEC) {
argv[sh_items] = w32_perlshell_vec[sh_items];
status = win32_spawnvp(flag,
- (really ? SvPV(really,na) : argv[0]),
+ (const char*)(really ? SvPV(really,na) : argv[0]),
(const char* const*)argv);
}
return (statusvalue = status);
}
-static int
+int
do_spawn2(char *cmd, int exectype)
{
char **a;
#ifndef USE_WIN32_RTL_ENV
+BOOL GetRegStr(HKEY hkey, const char *lpszValueName, char *lpszDefault, char *lpszData, unsigned long *lpdwDataLen)
+{ // Retrieve a REG_SZ or REG_EXPAND_SZ from the registry
+ HKEY handle;
+ DWORD type, dwDataLen = *lpdwDataLen;
+ const char *subkey = "Software\\Perl";
+ char szBuffer[MAX_PATH+1];
+ long retval;
+
+ retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
+ if(retval == ERROR_SUCCESS)
+ {
+ retval = RegQueryValueEx(handle, lpszValueName, 0, &type, (LPBYTE)lpszData, &dwDataLen);
+ RegCloseKey(handle);
+ if(retval == ERROR_SUCCESS && (type == REG_SZ || type == REG_EXPAND_SZ))
+ {
+ if(type != REG_EXPAND_SZ)
+ {
+ *lpdwDataLen = dwDataLen;
+ return TRUE;
+ }
+ strcpy(szBuffer, lpszData);
+ dwDataLen = ExpandEnvironmentStrings(szBuffer, lpszData, *lpdwDataLen);
+ if(dwDataLen < *lpdwDataLen)
+ {
+ *lpdwDataLen = dwDataLen;
+ return TRUE;
+ }
+ }
+ }
+
+ strcpy(lpszData, lpszDefault);
+ return FALSE;
+}
+
+char* GetRegStr(const char *lpszValueName, char *lpszDefault, char *lpszData, unsigned long *lpdwDataLen)
+{
+ if(!GetRegStr(HKEY_CURRENT_USER, lpszValueName, lpszDefault, lpszData, lpdwDataLen))
+ {
+ GetRegStr(HKEY_LOCAL_MACHINE, lpszValueName, lpszDefault, lpszData, lpdwDataLen);
+ }
+ if(*lpszData == '\0')
+ lpszData = NULL;
+ return lpszData;
+}
+
DllExport char *
win32_getenv(const char *name)
{
curlen = needlen;
needlen = GetEnvironmentVariable(name,curitem,curlen);
}
+ if(curitem == NULL)
+ {
+ unsigned long dwDataLen = curlen;
+ if(strcmp("PERL5DB", name) == 0)
+ curitem = GetRegStr(name, "", curitem, &dwDataLen);
+ }
return curitem;
}
sMsg[dwLen]= '\0';
}
if (0 == dwLen) {
- sMsg = LocalAlloc(0, 64/**sizeof(TCHAR)*/);
+ sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
dwLen = sprintf(sMsg,
"Unknown error #0x%lX (lookup 0x%lX)",
dwErr, GetLastError());
XSRETURN_YES;
}
+#define TMPBUFSZ 1024
+#define MAX_LENGTH 2048
+#define SUCCESSRETURNED(x) (x == ERROR_SUCCESS)
+#define REGRETURN(x) XSRETURN_IV(SUCCESSRETURNED(x))
+#define SvHKEY(index) (HKEY)((unsigned long)SvIV(index))
+#define SETIV(index,value) sv_setiv(ST(index), value)
+#define SETNV(index,value) sv_setnv(ST(index), value)
+#define SETPV(index,string) sv_setpv(ST(index), string)
+#define SETPVN(index, buffer, length) sv_setpvn(ST(index), (char*)buffer, length)
+#define SETHKEY(index, hkey) SETIV(index,(long)hkey)
+
+static time_t ft2timet(FILETIME *ft)
+{
+ SYSTEMTIME st;
+ struct tm tm;
+
+ FileTimeToSystemTime(ft, &st);
+ tm.tm_sec = st.wSecond;
+ tm.tm_min = st.wMinute;
+ tm.tm_hour = st.wHour;
+ tm.tm_mday = st.wDay;
+ tm.tm_mon = st.wMonth - 1;
+ tm.tm_year = st.wYear - 1900;
+ tm.tm_wday = st.wDayOfWeek;
+ tm.tm_yday = -1;
+ tm.tm_isdst = -1;
+ return mktime (&tm);
+}
+
+static
+XS(w32_RegCloseKey)
+{
+ dXSARGS;
+
+ if(items != 1)
+ {
+ croak("usage: Win32::RegCloseKey($hkey);\n");
+ }
+
+ REGRETURN(RegCloseKey(SvHKEY(ST(0))));
+}
+
+static
+XS(w32_RegConnectRegistry)
+{
+ dXSARGS;
+ HKEY handle;
+
+ if(items != 3)
+ {
+ croak("usage: Win32::RegConnectRegistry($machine, $hkey, $handle);\n");
+ }
+
+ if(SUCCESSRETURNED(RegConnectRegistry((char *)SvPV(ST(0), na), SvHKEY(ST(1)), &handle)))
+ {
+ SETHKEY(2,handle);
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+static
+XS(w32_RegCreateKey)
+{
+ dXSARGS;
+ HKEY handle;
+ DWORD disposition;
+ long retval;
+
+ if(items != 3)
+ {
+ croak("usage: Win32::RegCreateKey($hkey, $subkey, $handle);\n");
+ }
+
+ retval = RegCreateKeyEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), 0, NULL, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS,
+ NULL, &handle, &disposition);
+
+ if(SUCCESSRETURNED(retval))
+ {
+ SETHKEY(2,handle);
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+static
+XS(w32_RegCreateKeyEx)
+{
+ dXSARGS;
+
+ unsigned int length;
+ long retval;
+ HKEY hkey, handle;
+ char *subkey;
+ char *keyclass;
+ DWORD options, disposition;
+ REGSAM sam;
+ SECURITY_ATTRIBUTES sa, *psa;
+
+ if(items != 9)
+ {
+ croak("usage: Win32::RegCreateKeyEx($hkey, $subkey, $reserved, $class, $options, $sam, "
+ "$security, $handle, $disposition);\n");
+ }
+
+ hkey = SvHKEY(ST(0));
+ subkey = (char *)SvPV(ST(1), na);
+ keyclass = (char *)SvPV(ST(3), na);
+ options = (DWORD) ((unsigned long)SvIV(ST(4)));
+ sam = (REGSAM) ((unsigned long)SvIV(ST(5)));
+ psa = (SECURITY_ATTRIBUTES*)SvPV(ST(6), length);
+ if(length != sizeof(SECURITY_ATTRIBUTES))
+ {
+ psa = &sa;
+ memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES));
+ sa.nLength = sizeof(SECURITY_ATTRIBUTES);
+ }
+
+ retval = RegCreateKeyEx(hkey, subkey, 0, keyclass, options, sam,
+ psa, &handle, &disposition);
+
+ if(SUCCESSRETURNED(retval))
+ {
+ if(psa == &sa)
+ SETPVN(6, &sa, sizeof(sa));
+
+ SETHKEY(7,handle);
+ SETIV(8,disposition);
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+static
+XS(w32_RegDeleteKey)
+{
+ dXSARGS;
+
+ if(items != 2)
+ {
+ croak("usage: Win32::RegDeleteKey($hkey, $subkey);\n");
+ }
+
+ REGRETURN(RegDeleteKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na)));
+}
+
+static
+XS(w32_RegDeleteValue)
+{
+ dXSARGS;
+
+ if(items != 2)
+ {
+ croak("usage: Win32::RegDeleteValue($hkey, $valname);\n");
+ }
+
+ REGRETURN(RegDeleteValue(SvHKEY(ST(0)), (char *)SvPV(ST(1), na)));
+}
+
+static
+XS(w32_RegEnumKey)
+{
+ dXSARGS;
+
+ char keybuffer[TMPBUFSZ];
+
+ if(items != 3)
+ {
+ croak("usage: Win32::RegEnumKey($hkey, $idx, $subkeyname);\n");
+ }
+
+ if(SUCCESSRETURNED(RegEnumKey(SvHKEY(ST(0)), SvIV(ST(1)), keybuffer, sizeof(keybuffer))))
+ {
+ SETPV(2, keybuffer);
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+static
+XS(w32_RegEnumKeyEx)
+{
+ dXSARGS;
+ int length;
+
+ DWORD keysz, classsz;
+ char keybuffer[TMPBUFSZ];
+ char classbuffer[TMPBUFSZ];
+ long retval;
+ FILETIME filetime;
+
+ if(items != 6)
+ {
+ croak("usage: Win32::RegEnumKeyEx($hkey, $idx, $subkeyname, $reserved, $class, $time);\n");
+ }
+
+ keysz = sizeof(keybuffer);
+ classsz = sizeof(classbuffer);
+ retval = RegEnumKeyEx(SvHKEY(ST(0)), SvIV(ST(1)), keybuffer, &keysz, 0,
+ classbuffer, &classsz, &filetime);
+ if(SUCCESSRETURNED(retval))
+ {
+ SETPV(2, keybuffer);
+ SETPV(4, classbuffer);
+ SETIV(5, ft2timet(&filetime));
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+static
+XS(w32_RegEnumValue)
+{
+ dXSARGS;
+ HKEY hkey;
+ DWORD type, namesz, valsz;
+ long retval;
+ static HKEY last_hkey;
+ char myvalbuf[MAX_LENGTH];
+ char mynambuf[MAX_LENGTH];
+
+ if(items != 6)
+ {
+ croak("usage: Win32::RegEnumValue($hkey, $i, $name, $reserved, $type, $value);\n");
+ }
+
+ hkey = SvHKEY(ST(0));
+
+ // If this is a new key, find out how big the maximum name and value sizes are and
+ // allocate space for them. Free any old storage and set the old key value to the
+ // current key.
+
+ if(hkey != (HKEY)last_hkey)
+ {
+ char keyclass[TMPBUFSZ];
+ DWORD classsz, subkeys, maxsubkey, maxclass, values, salen, maxnamesz, maxvalsz;
+ FILETIME ft;
+ classsz = sizeof(keyclass);
+ retval = RegQueryInfoKey(hkey, keyclass, &classsz, 0, &subkeys, &maxsubkey, &maxclass,
+ &values, &maxnamesz, &maxvalsz, &salen, &ft);
+
+ if(!SUCCESSRETURNED(retval))
+ {
+ XSRETURN_NO;
+ }
+ memset(myvalbuf, 0, MAX_LENGTH);
+ memset(mynambuf, 0, MAX_LENGTH);
+ last_hkey = hkey;
+ }
+
+ namesz = MAX_LENGTH;
+ valsz = MAX_LENGTH;
+ retval = RegEnumValue(hkey, SvIV(ST(1)), mynambuf, &namesz, 0, &type, (LPBYTE) myvalbuf, &valsz);
+ if(!SUCCESSRETURNED(retval))
+ {
+ XSRETURN_NO;
+ }
+ else
+ {
+ SETPV(2, mynambuf);
+ SETIV(4, type);
+
+ // return includes the null terminator so delete it if REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ
+ switch(type)
+ {
+ case REG_SZ:
+ case REG_MULTI_SZ:
+ case REG_EXPAND_SZ:
+ if(valsz)
+ --valsz;
+ case REG_BINARY:
+ SETPVN(5, myvalbuf, valsz);
+ break;
+
+ case REG_DWORD_BIG_ENDIAN:
+ {
+ BYTE tmp = myvalbuf[0];
+ myvalbuf[0] = myvalbuf[3];
+ myvalbuf[3] = tmp;
+ tmp = myvalbuf[1];
+ myvalbuf[1] = myvalbuf[2];
+ myvalbuf[2] = tmp;
+ }
+ case REG_DWORD_LITTLE_ENDIAN: // same as REG_DWORD
+ SETNV(5, (double)*((DWORD*)myvalbuf));
+ break;
+
+ default:
+ break;
+ }
+
+ XSRETURN_YES;
+ }
+}
+
+static
+XS(w32_RegFlushKey)
+{
+ dXSARGS;
+
+ if(items != 1)
+ {
+ croak("usage: Win32::RegFlushKey($hkey);\n");
+ }
+
+ REGRETURN(RegFlushKey(SvHKEY(ST(0))));
+}
+
+static
+XS(w32_RegGetKeySecurity)
+{
+ dXSARGS;
+ SECURITY_DESCRIPTOR sd;
+ DWORD sdsz;
+
+ if(items != 3)
+ {
+ croak("usage: Win32::RegGetKeySecurity($hkey, $security_info, $security_descriptor);\n");
+ }
+
+ if(SUCCESSRETURNED(RegGetKeySecurity(SvHKEY(ST(0)), SvIV(ST(1)), &sd, &sdsz)))
+ {
+ SETPVN(2, &sd, sdsz);
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+static
+XS(w32_RegLoadKey)
+{
+ dXSARGS;
+
+ if(items != 3)
+ {
+ croak("usage: Win32::RegLoadKey($hkey, $subkey, $filename);\n");
+ }
+
+ REGRETURN(RegLoadKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), (char *)SvPV(ST(2), na)));
+}
+
+static
+XS(w32_RegNotifyChangeKeyValue)
+{
+ croak("Win32::RegNotifyChangeKeyValue not yet implemented!\n");
+}
+
+static
+XS(w32_RegOpenKey)
+{
+ dXSARGS;
+ HKEY handle;
+
+ if(items != 3)
+ {
+ croak("usage: Win32::RegOpenKey($hkey, $subkey, $handle);\n");
+ }
+
+ if(SUCCESSRETURNED(RegOpenKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), &handle)))
+ {
+ SETHKEY(2,handle);
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+static
+XS(w32_RegOpenKeyEx)
+{
+ dXSARGS;
+ HKEY handle;
+
+ if(items != 5)
+ {
+ croak("usage: Win32::RegOpenKeyEx($hkey, $subkey, $reserved, $sam, $handle);\n");
+ }
+
+ if(SUCCESSRETURNED(RegOpenKeyEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na),
+ 0, (REGSAM) ((unsigned long)SvIV(ST(3))), &handle)))
+ {
+ SETHKEY(4,handle);
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+#pragma optimize("", off)
+static
+XS(w32_RegQueryInfoKey)
+{
+ dXSARGS;
+ int length;
+
+ char keyclass[TMPBUFSZ];
+ DWORD subkeys, maxsubkey, maxclass, values, maxvalname, maxvaldata;
+ DWORD seclen, classsz;
+ FILETIME ft;
+ long retval;
+
+ if(items != 10)
+ {
+ croak("usage: Win32::RegQueryInfoKey($hkey, $class, $numsubkeys, $maxsubkey,"
+ "$maxclass, $values, $maxvalname, $maxvaldata, $secdesclen,"
+ "$lastwritetime);\n");
+ }
+
+ classsz = sizeof(keyclass);
+ retval = RegQueryInfoKey(SvHKEY(ST(0)), keyclass, &classsz, 0, &subkeys, &maxsubkey,
+ &maxclass, &values, &maxvalname, &maxvaldata,
+ &seclen, &ft);
+ if(SUCCESSRETURNED(retval))
+ {
+ SETPV(1, keyclass);
+ SETIV(2, subkeys);
+ SETIV(3, maxsubkey);
+ SETIV(4, maxclass);
+ SETIV(5, values);
+ SETIV(6, maxvalname);
+ SETIV(7, maxvaldata);
+ SETIV(8, seclen);
+ SETIV(9, ft2timet(&ft));
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+#pragma optimize("", on)
+
+static
+XS(w32_RegQueryValue)
+{
+ dXSARGS;
+
+ unsigned char databuffer[TMPBUFSZ*2];
+ long datasz = sizeof(databuffer);
+
+ if(items != 3)
+ {
+ croak("usage: Win32::RegQueryValue($hkey, $valuename, $data);\n");
+ }
+
+ if(SUCCESSRETURNED(RegQueryValue(SvHKEY(ST(0)), SvPV(ST(1), na), (char*)databuffer, &datasz)))
+ {
+ // return includes the null terminator so delete it
+ SETPVN(2, databuffer, --datasz);
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+static
+XS(w32_RegQueryValueEx)
+{
+ dXSARGS;
+
+ unsigned char databuffer[TMPBUFSZ*2];
+ DWORD datasz = sizeof(databuffer);
+ DWORD type;
+ LONG result;
+ LPBYTE ptr = databuffer;
+
+ if(items != 5)
+ {
+ croak("usage: Win32::RegQueryValueEx($hkey, $valuename, $reserved, $type, $data);\n");
+ }
+
+ result = RegQueryValueEx(SvHKEY(ST(0)), SvPV(ST(1), na), 0, &type, ptr, &datasz);
+ if(result == ERROR_MORE_DATA)
+ {
+ New(0, ptr, datasz+1, BYTE);
+ result = RegQueryValueEx(SvHKEY(ST(0)), SvPV(ST(1), na), 0, &type, ptr, &datasz);
+ }
+ if(SUCCESSRETURNED(result))
+ {
+ SETIV(3, type);
+
+ // return includes the null terminator so delete it if REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ
+ switch(type)
+ {
+ case REG_SZ:
+ case REG_MULTI_SZ:
+ case REG_EXPAND_SZ:
+ --datasz;
+ case REG_BINARY:
+ SETPVN(4, ptr, datasz);
+ break;
+
+ case REG_DWORD_BIG_ENDIAN:
+ {
+ BYTE tmp = ptr[0];
+ ptr[0] = ptr[3];
+ ptr[3] = tmp;
+ tmp = ptr[1];
+ ptr[1] = ptr[2];
+ ptr[2] = tmp;
+ }
+ case REG_DWORD_LITTLE_ENDIAN: // same as REG_DWORD
+ SETNV(4, (double)*((DWORD*)ptr));
+ break;
+
+ default:
+ break;
+ }
+
+ if(ptr != databuffer)
+ safefree(ptr);
+
+ XSRETURN_YES;
+ }
+ if(ptr != databuffer)
+ safefree(ptr);
+
+ XSRETURN_NO;
+}
+
+static
+XS(w32_RegReplaceKey)
+{
+ dXSARGS;
+
+ if(items != 4)
+ {
+ croak("usage: Win32::RegReplaceKey($hkey, $subkey, $newfile, $oldfile);\n");
+ }
+
+ REGRETURN(RegReplaceKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), (char *)SvPV(ST(2), na), (char *)SvPV(ST(3), na)));
+}
+
+static
+XS(w32_RegRestoreKey)
+{
+ dXSARGS;
+
+ if(items < 2 || items > 3)
+ {
+ croak("usage: Win32::RegRestoreKey($hkey, $filename [, $flags]);\n");
+ }
+
+ REGRETURN(RegRestoreKey(SvHKEY(ST(0)), (char*)SvPV(ST(1), na), (DWORD)((items == 3) ? SvIV(ST(2)) : 0)));
+}
+
+static
+XS(w32_RegSaveKey)
+{
+ dXSARGS;
+
+ if(items != 2)
+ {
+ croak("usage: Win32::RegSaveKey($hkey, $filename);\n");
+ }
+
+ REGRETURN(RegSaveKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), NULL));
+}
+
+static
+XS(w32_RegSetKeySecurity)
+{
+ dXSARGS;
+
+ if(items != 3)
+ {
+ croak("usage: Win32::RegSetKeySecurity($hkey, $security_info, $security_descriptor);\n");
+ }
+
+ REGRETURN(RegSetKeySecurity(SvHKEY(ST(0)), SvIV(ST(1)), (SECURITY_DESCRIPTOR*)SvPV(ST(2), na)));
+}
+
+static
+XS(w32_RegSetValue)
+{
+ dXSARGS;
+
+ unsigned int size;
+ char *buffer;
+
+ if(items != 4)
+ {
+ croak("usage: Win32::RegSetValue($hkey, $subKey, $type, $data);\n");
+ }
+
+ DWORD type = SvIV(ST(2));
+ if(type != REG_SZ && type != REG_EXPAND_SZ)
+ {
+ croak("Win32::RegSetValue: Type was not REG_SZ or REG_EXPAND_SZ, cannot set %s\n", (char *)SvPV(ST(1), na));
+ }
+
+ buffer = (char *)SvPV(ST(3), size);
+ REGRETURN(RegSetValue(SvHKEY(ST(0)), SvPV(ST(1), na), REG_SZ, buffer, size));
+}
+
+static
+XS(w32_RegSetValueEx)
+{
+ dXSARGS;
+
+ DWORD type;
+ DWORD val;
+ unsigned int size;
+ char *buffer;
+
+ if(items != 5)
+ {
+ croak("usage: Win32::RegSetValueEx($hkey, $valname, $reserved, $type, $data);\n");
+ }
+
+ type = (DWORD)SvIV(ST(3));
+ switch(type)
+ {
+ case REG_SZ:
+ case REG_BINARY:
+ case REG_MULTI_SZ:
+ case REG_EXPAND_SZ:
+ buffer = (char *)SvPV(ST(4), size);
+ if(type != REG_BINARY)
+ size++; // include null terminator in size
+
+ REGRETURN(RegSetValueEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), 0, type, (PBYTE) buffer, size));
+ break;
+
+ case REG_DWORD_BIG_ENDIAN:
+ case REG_DWORD_LITTLE_ENDIAN: // Same as REG_DWORD
+ val = (DWORD)SvIV(ST(4));
+ REGRETURN(RegSetValueEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), 0, type, (PBYTE) &val, sizeof(DWORD)));
+ break;
+
+ default:
+ croak("Win32::RegSetValueEx: Type not specified, cannot set %s\n", (char *)SvPV(ST(1), na));
+ }
+}
+
+static
+XS(w32_RegUnloadKey)
+{
+ dXSARGS;
+
+ if(items != 2)
+ {
+ croak("usage: Win32::RegUnLoadKey($hkey, $subkey);\n");
+ }
+
+ REGRETURN(RegUnLoadKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na)));
+}
+
+static
+XS(w32_RegisterServer)
+{
+ dXSARGS;
+ BOOL bSuccess = FALSE;
+ HINSTANCE hInstance;
+ unsigned int length;
+ FARPROC sFunc;
+
+ if(items != 1)
+ {
+ croak("usage: Win32::RegisterServer($LibraryName)\n");
+ }
+
+ hInstance = LoadLibrary((char *)SvPV(ST(0), length));
+ if(hInstance != NULL)
+ {
+ sFunc = GetProcAddress(hInstance, "DllRegisterServer");
+ if(sFunc != NULL)
+ {
+ bSuccess = (sFunc() == 0);
+ }
+ FreeLibrary(hInstance);
+ }
+
+ if(bSuccess)
+ {
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+static
+XS(w32_UnregisterServer)
+{
+ dXSARGS;
+ BOOL bSuccess = FALSE;
+ HINSTANCE hInstance;
+ unsigned int length;
+ FARPROC sFunc;
+
+ if(items != 1)
+ {
+ croak("usage: Win32::UnregisterServer($LibraryName)\n");
+ }
+
+ hInstance = LoadLibrary((char *)SvPV(ST(0), length));
+ if(hInstance != NULL)
+ {
+ sFunc = GetProcAddress(hInstance, "DllUnregisterServer");
+ if(sFunc != NULL)
+ {
+ bSuccess = (sFunc() == 0);
+ }
+ FreeLibrary(hInstance);
+ }
+
+ if(bSuccess)
+ {
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+
void
Perl_init_os_extras()
{
newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
newXS("Win32::Sleep", w32_Sleep, file);
+ /* the following extensions are used interally and may be changed at any time */
+ /* therefore no documentation is provided */
+ newXS("Win32::RegCloseKey", w32_RegCloseKey, file);
+ newXS("Win32::RegConnectRegistry", w32_RegConnectRegistry, file);
+ newXS("Win32::RegCreateKey", w32_RegCreateKey, file);
+ newXS("Win32::RegCreateKeyEx", w32_RegCreateKeyEx, file);
+ newXS("Win32::RegDeleteKey", w32_RegDeleteKey, file);
+ newXS("Win32::RegDeleteValue", w32_RegDeleteValue, file);
+
+ newXS("Win32::RegEnumKey", w32_RegEnumKey, file);
+ newXS("Win32::RegEnumKeyEx", w32_RegEnumKeyEx, file);
+ newXS("Win32::RegEnumValue", w32_RegEnumValue, file);
+
+ newXS("Win32::RegFlushKey", w32_RegFlushKey, file);
+ newXS("Win32::RegGetKeySecurity", w32_RegGetKeySecurity, file);
+
+ newXS("Win32::RegLoadKey", w32_RegLoadKey, file);
+ newXS("Win32::RegOpenKey", w32_RegOpenKey, file);
+ newXS("Win32::RegOpenKeyEx", w32_RegOpenKeyEx, file);
+ newXS("Win32::RegQueryInfoKey", w32_RegQueryInfoKey, file);
+ newXS("Win32::RegQueryValue", w32_RegQueryValue, file);
+ newXS("Win32::RegQueryValueEx", w32_RegQueryValueEx, file);
+
+ newXS("Win32::RegReplaceKey", w32_RegReplaceKey, file);
+ newXS("Win32::RegRestoreKey", w32_RegRestoreKey, file);
+ newXS("Win32::RegSaveKey", w32_RegSaveKey, file);
+ newXS("Win32::RegSetKeySecurity", w32_RegSetKeySecurity, file);
+ newXS("Win32::RegSetValue", w32_RegSetValue, file);
+ newXS("Win32::RegSetValueEx", w32_RegSetValueEx, file);
+ newXS("Win32::RegUnloadKey", w32_RegUnloadKey, file);
+
+ newXS("Win32::RegisterServer", w32_RegisterServer, file);
+ newXS("Win32::UnregisterServer", w32_UnregisterServer, file);
+
/* XXX Bloat Alert! The following Activeware preloads really
* ought to be part of Win32::Sys::*, so they're not included
* here.
* otherwise import it.
*/
+#if defined(PERL_OBJECT)
+#define DllExport
+#else
#if defined(PERLDLL) || defined(WIN95FIX)
#define DllExport __declspec(dllexport)
#else
#define DllExport __declspec(dllimport)
#endif
+#endif
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#include <windows.h>
#include "EXTERN.h"
#include "perl.h"
+
+#if defined(PERL_OBJECT)
+#define NO_XSLOCKS
+extern CPerlObj* pPerl;
+#include "XSUB.h"
+#endif
+
#include <sys/socket.h>
#include <fcntl.h>
#include <sys/stat.h>
d->s_proto = s->s_proto;
else
#endif
- if (proto && strlen(proto))
+ if (proto && strlen(proto))
d->s_proto = (char *)proto;
else
d->s_proto = "tcp";
#include "EXTERN.h"
#include "perl.h"
+#if defined(PERL_OBJECT)
+#define NO_XSLOCKS
+extern CPerlObj* pPerl;
+#include "XSUB.h"
+#endif
+
#ifdef USE_DECLSPEC_THREAD
__declspec(thread) struct perl_thread *Perl_current_thread = NULL;
#endif
projects / p5sagit/p5-mst-13.2.git / commitdiff