view release on metacpan or  search on metacpan

slibu.c  view on Meta::CPAN

 out = strcons(m,NULL);
 for(j=0,ptr=get_c_string(out);j < n; ++j)
   switch(str[j])
     {case '>':
	strcpy(ptr,"&gt;");
	ptr += strlen(ptr);
	break;
      case '<':
	strcpy(ptr,"&lt;");
	ptr += strlen(ptr);
	break;
      case '&':
	strcpy(ptr,"&amp;");
	ptr += strlen(ptr);
	break;
      default:
	*ptr++ = str[j];}
 return(out);}

LISP html_decode(LISP in)
{return(in);}

LISP lgets(LISP file,LISP buffn)
{FILE *f;
 int iflag;
 long n;
 char buffer[2048],*ptr;
 f = get_c_file(file,stdin);
 if NULLP(buffn)
   n = sizeof(buffer);
 else if ((n = get_c_long(buffn)) < 0)
   err("size must be >= 0",buffn);
 else if (n > sizeof(buffer))
   err("not handling buffer of size",listn(2,buffn,flocons(sizeof(buffer))));
 iflag = no_interrupt(1);
 if ((ptr = fgets(buffer,n,f)))
   {no_interrupt(iflag);
    return(strcons(strlen(buffer),buffer));}
 no_interrupt(iflag);
 return(NIL);}

LISP readline(LISP file)
{LISP result;
 char *start,*ptr;
 result = lgets(file,NIL);
 if NULLP(result) return(NIL);
 start = get_c_string(result);
 if ((ptr = strchr(start,'\n')))
   {*ptr = 0;
    /* we also change the dim, because otherwise our equal? function
       is confused. What we really need are arrays with fill pointers. */
    result->storage_as.string.dim = ptr - start;
    return(result);}
 else
   /* we should be doing lgets until we  get a string with a newline or NIL,
      and then append the results */
   return(result);}

#ifndef WIN32

LISP l_chown(LISP path,LISP uid,LISP gid)
{long iflag;
 iflag = no_interrupt(1);
 if (chown(get_c_string(path),get_c_long(uid),get_c_long(gid)))
   err("chown",cons(path,llast_c_errmsg(-1)));
 no_interrupt(iflag);
 return(NIL);}

#endif

#if defined(unix) && !defined(linux)
LISP l_lchown(LISP path,LISP uid,LISP gid)
{long iflag;
 iflag = no_interrupt(1);
 if (lchown(get_c_string(path),get_c_long(uid),get_c_long(gid)))
   err("lchown",cons(path,llast_c_errmsg(-1)));
 no_interrupt(iflag);
 return(NIL);}
#endif


#ifdef unix

LISP popen_l(LISP name,LISP how)
{return(fopen_cg(popen,
		 get_c_string(name),
		 NULLP(how) ? "r" : get_c_string(how)));}

/* note: if the user fails to call pclose then the gc is going
         to utilize fclose, which can result in a <defunct>
	 process laying around. However, we don't want to
	 modify file_gc_free nor add a new datatype.
	 So beware.
	 */
LISP pclose_l(LISP ptr)
{FILE *f = get_c_file(ptr,NULL);
 long iflag = no_interrupt(1);
 int retval,xerrno;
 retval = pclose(f);
 xerrno = errno;
 ptr->storage_as.c_file.f = (FILE *) NULL;
 free(ptr->storage_as.c_file.name);
 ptr->storage_as.c_file.name = NULL;
 no_interrupt(iflag);
 if (retval < 0)
   err("pclose",llast_c_errmsg(xerrno));
 return(flocons(retval));}

#endif

LISP so_init_name(LISP fname,LISP iname)
{LISP init_name;
 if NNULLP(iname)
   init_name = iname;
 else
   {init_name = car(last(lstrbreakup(fname,cintern("/"))));
#if !defined(VMS)
    init_name = lstrunbreakup(butlast(lstrbreakup(init_name,cintern("."))),
			      cintern("."));
#endif
    init_name = string_append(listn(2,cintern("init_"),init_name));}
 return(intern(init_name));}

LISP so_ext(LISP fname)
{char *ext = ".so";
 LISP lext;
#if defined(hpux)
 ext = ".sl";
#endif
#if defined(vms)
 ext = "";
#endif
#if defined(WIN32)
 ext = ".dll";
#endif
 lext = strcons(strlen(ext),ext);

slibu.c  view on Meta::CPAN

 init_subr_1("%%%memref",lmemref_byte);
 init_subr_0("getpid",lgetpid);
#ifndef WIN32
 init_subr_0("getppid",lgetppid);
#endif
 init_subr_1("exit",lexit);
 init_subr_1("trunc",ltrunc);
#ifdef unix
 init_subr_1("putenv",lputenv);
#endif
 init_subr_0("md5-init",md5_init);
 init_subr_3("md5-update",md5_update);
 init_subr_1("md5-final",md5_final);
#if defined(__osf__) || defined(sun)
 init_subr_2("cpu-usage-limits",cpu_usage_limits);
#endif
#if defined(__osf__) || defined(SUN5)
 init_subr_1("current-resource-usage",current_resource_usage);
#endif
#if  defined(unix) || defined(WIN32)
 init_subr_1("opendir",l_opendir);
 init_subr_1("closedir",l_closedir);
 init_subr_1("readdir",l_readdir);
#endif
 init_subr_1("delete-file",delete_file);
 init_subr_1("file-times",file_times);
 init_subr_1("unix-time->strtime",utime2str);
 init_subr_0("unix-time",unix_time);
 init_subr_1("unix-ctime",unix_ctime);
 init_subr_1("getenv",lgetenv);
 init_subr_1("sleep",lsleep);
 init_subr_1("url-encode",url_encode);
 init_subr_1("url-decode",url_decode);
 init_subr_2("gets",lgets);
 init_subr_1("readline",readline);
 init_subr_1("html-encode",html_encode);
 init_subr_1("html-decode",html_decode);
#if defined(unix) || defined(WIN32)
 init_subr_1("decode-file-mode",decode_st_mode);
 init_subr_1("encode-file-mode",encode_st_mode);
 init_subr_1("stat",l_stat);
 init_subr_1("fstat",l_fstat);
#endif
#ifdef unix
 init_subr_1("encode-open-flags",encode_open_flags);
 init_subr_1("lstat",l_lstat);
#endif
#if defined(__osf__) || defined(SUN5)
 init_subr_3("fnmatch",l_fnmatch);
#endif
#ifdef unix
 init_subr_2("symlink",lsymlink);
 init_subr_2("link",llink);
 init_subr_1("unlink",lunlink);
 init_subr_1("rmdir",lrmdir);
 init_subr_2("mkdir",lmkdir);
 init_subr_2("rename",lrename);
 init_subr_1("readlink",lreadlink);
#endif
#ifndef WIN32
 init_subr_3("chown",l_chown);
#endif
#if defined(unix) && !defined(linux)
 init_subr_3("lchown",l_lchown);
#endif
 init_subr_1("http-date",http_date);
#if defined(__osf__)
 init_subr_1("http-date-parse",http_date_parse);
#endif
#ifdef unix
 init_subr_2("popen",popen_l);
 init_subr_1("pclose",pclose_l);
#endif
 init_subr_2("load-so",load_so);
 init_subr_1("require-so",require_so);
 init_subr_1("so-ext",so_ext);
#ifdef unix
 setvar(cintern("SEEK_SET"),flocons(SEEK_SET),NIL);
 setvar(cintern("SEEK_CUR"),flocons(SEEK_CUR),NIL);
 setvar(cintern("SEEK_END"),flocons(SEEK_END),NIL);
 setvar(cintern("F_RDLCK"),flocons(F_RDLCK),NIL);
 setvar(cintern("F_WRLCK"),flocons(F_WRLCK),NIL);
 setvar(cintern("F_UNLCK"),flocons(F_UNLCK),NIL);
 init_subr_5("F_SETLK",lF_SETLK);
 init_subr_5("F_SETLKW",lF_SETLKW);
 init_subr_5("F_GETLK",lF_GETLK);

#endif
 init_subr_0("siod-lib",siod_lib_l);

#ifdef unix
 if ((!(tmp1 = getenv(ld_library_path_env))) ||
     (!strstr(tmp1,siod_lib)))
   {tmp2 = (char *) must_malloc(strlen(ld_library_path_env) + 1 +
				((tmp1) ? strlen(tmp1) + 1 : 0) +
				strlen(siod_lib) + 1);
    sprintf(tmp2,"%s=%s%s%s",
	    ld_library_path_env,
	    (tmp1) ? tmp1 : "",
	    (tmp1) ? ":" : "",
	    siod_lib);
    /* note that we cannot free the string afterwards. */
    putenv(tmp2);}
#endif
#ifdef vms
 setvar(cintern("*require-so-dir*"),
	string_append(listn(2,
			    strcons(-1,siod_lib),
			    strcons(-1,".EXE"))),
	NIL);
#endif
 init_subr_1("localtime",llocaltime);
 init_subr_1("gmtime",lgmtime);
#if defined(unix) || defined(WIN32)
 init_subr_0("tzset",ltzset);
#endif
 init_subr_1("mktime",lmktime);
 init_subr_1("chdir",lchdir);
#if defined(__osf__)
 init_subr_0("rld-pathnames",rld_pathnames);
#endif
#if defined(__osf__) || defined(SUN5) || defined(linux)
 init_subr_3("strptime",lstrptime);
#endif