void MP4SoundAtom::Read()
{
MP4Atom *parent = GetParentAtom();
if (ATOMID(parent->GetType()) != ATOMID("stsd")) {
// Quicktime has an interesting thing - they'll put an mp4a atom
// which is blank inside a wave atom, which is inside an mp4a atom
// we have a mp4a inside an wave inside an mp4a - delete all properties
m_pProperties.Delete(8);
m_pProperties.Delete(7);
m_pProperties.Delete(6);
m_pProperties.Delete(5);
m_pProperties.Delete(4);
m_pProperties.Delete(3);
m_pProperties.Delete(2);
m_pProperties.Delete(1);
m_pProperties.Delete(0);
if (ATOMID(GetType()) == ATOMID("alac")) {
AddProperty(new MP4BytesProperty("decoderConfig", m_size));
ReadProperties();
}
if (m_pChildAtomInfos.Size() > 0) {
ReadChildAtoms();
}
} else {
ReadProperties(0, 3); // read first 3 properties
AddProperties(((MP4IntegerProperty *)m_pProperties[2])->GetValue());
ReadProperties(3); // continue
if (m_pChildAtomInfos.Size() > 0) {
ReadChildAtoms();
}
}
Skip();
}
MP4ItmfItemList*
genericGetItemsByCode( MP4File& file, const string& code )
{
MP4Atom* ilst = file.FindAtom( "moov.udta.meta.ilst" );
if( !ilst )
return __itemListAlloc();
// pass 1: filter by code and populate indexList
const uint32_t childCount = ilst->GetNumberOfChildAtoms();
vector<uint32_t> indexList;
for( uint32_t i = 0; i < childCount; i++ ) {
if( ATOMID( ilst->GetChildAtom( i )->GetType() ) != ATOMID( code.c_str() ))
continue;
indexList.push_back( i );
}
if( indexList.size() < 1 )
return __itemListAlloc();
MP4ItmfItemList& list = *__itemListAlloc();
__itemListResize( list, (uint32_t)indexList.size() );
// pass 2: process each atom
const vector<uint32_t>::size_type max = indexList.size();
for( vector<uint32_t>::size_type i = 0; i < max; i++ ) {
uint32_t& aidx = indexList[i];
__itemAtomToModel( *(MP4ItemAtom*)ilst->GetChildAtom( aidx ), list.elements[i] );
}
return &list;
}
MP4SoundAtom::MP4SoundAtom(const char *atomid)
: MP4Atom(atomid)
{
AddReserved("reserved1", 6); /* 0 */
AddProperty( /* 1 */
new MP4Integer16Property("dataReferenceIndex"));
AddProperty( /* 2 */
new MP4Integer16Property("soundVersion"));
AddReserved( "reserved2", 6); /* 3 */
AddProperty( /* 4 */
new MP4Integer16Property("channels"));
AddProperty( /* 5 */
new MP4Integer16Property("sampleSize"));
AddProperty( /* 6 */
new MP4Integer16Property("packetSize"));
AddProperty( /* 7 */
new MP4Integer32Property("timeScale"));
if (ATOMID(atomid) == ATOMID("mp4a")) {
AddReserved("reserved3", 2); /* 8 */
ExpectChildAtom("esds", Required, OnlyOne);
ExpectChildAtom("wave", Optional, OnlyOne);
} else if (ATOMID(atomid) == ATOMID("alac")) {
AddReserved("reserved3", 2); /* 8 */
ExpectChildAtom("alac", Optional, Optional);
//AddProperty( new MP4BytesProperty("alacInfo", 36));
}
}
void MP4File::MakeIsmaCompliant(bool addIsmaComplianceSdp)
{
ProtectWriteOperation("MP4MakeIsmaCompliant");
if (m_useIsma) {
// already done
return;
}
// find first audio and/or video tracks
MP4TrackId audioTrackId = MP4_INVALID_TRACK_ID;
try {
audioTrackId = FindTrackId(0, MP4_AUDIO_TRACK_TYPE);
}
catch (MP4Error* e) {
delete e;
}
MP4TrackId videoTrackId = MP4_INVALID_TRACK_ID;
try {
videoTrackId = FindTrackId(0, MP4_VIDEO_TRACK_TYPE);
}
catch (MP4Error* e) {
delete e;
}
const char *audio_media_data_name, *video_media_data_name;
audio_media_data_name = MP4GetTrackMediaDataName(this, audioTrackId);
if (!(ATOMID(audio_media_data_name) == ATOMID("mp4a") ||
ATOMID(audio_media_data_name) == ATOMID("enca"))) {
VERBOSE_ERROR(m_verbosity,
printf("MakeIsmaCompliant:can't make ISMA compliant when file contains an %s track\n", audio_media_data_name);
);
void MP4UdtaAtom::Read()
{
if (ATOMID(m_pParentAtom->GetType()) == ATOMID("trak")) {
ExpectChildAtom("hinf", Optional, OnlyOne);
}
MP4Atom::Read();
}
void MP4TextAtom::Read ()
{
if (ATOMID(m_pParentAtom->GetType()) == ATOMID("stsd")) {
AddPropertiesStsdType();
} else if (ATOMID(m_pParentAtom->GetType()) == ATOMID("gmhd")) {
AddPropertiesGmhdType();
}
MP4Atom::Read();
}
void MP4HntiAtom::Read()
{
MP4Atom* grandParent = m_pParentAtom->GetParentAtom();
ASSERT(grandParent);
if (ATOMID(grandParent->GetType()) == ATOMID("trak")) {
ExpectChildAtom("sdp ", Optional, OnlyOne);
} else {
ExpectChildAtom("rtp ", Optional, OnlyOne);
}
MP4Atom::Read();
}
MP4ItmfItemList*
genericGetItemsByMeaning( MP4File& file, const string& meaning, const string& name )
{
MP4Atom* ilst = file.FindAtom( "moov.udta.meta.ilst" );
if( !ilst )
return __itemListAlloc();
// pass 1: filter by code and populate indexList
const uint32_t childCount = ilst->GetNumberOfChildAtoms();
vector<uint32_t> indexList;
for( uint32_t i = 0; i < childCount; i++ ) {
MP4Atom& atom = *ilst->GetChildAtom( i );
if( ATOMID( atom.GetType() ) != ATOMID( "----" ))
continue;
// filter-out meaning mismatch
MP4MeanAtom* meanAtom = (MP4MeanAtom*)atom.FindAtom( "----.mean" );
if( !meanAtom )
continue;
if( meanAtom->value.CompareToString( meaning ))
continue;
if( !name.empty() ) {
// filter-out name mismatch
MP4MeanAtom* nameAtom = (MP4MeanAtom*)atom.FindAtom( "----.name" );
if( !nameAtom )
continue;
if( nameAtom->value.CompareToString( name ))
continue;
}
indexList.push_back( i );
}
if( indexList.size() < 1 )
return __itemListAlloc();
MP4ItmfItemList& list = *__itemListAlloc();
__itemListResize( list, (uint32_t)indexList.size() );
// pass 2: process each atom
const vector<uint32_t>::size_type max = indexList.size();
for( vector<uint32_t>::size_type i = 0; i < max; i++ ) {
uint32_t& aidx = indexList[i];
__itemAtomToModel( *(MP4ItemAtom*)ilst->GetChildAtom( aidx ), list.elements[i] );
}
return &list;
}
void MP4TextAtom::Generate()
{
if (ATOMID(m_pParentAtom->GetType()) == ATOMID("stsd")) {
AddPropertiesStsdType();
GenerateStsdType();
} else if (ATOMID(m_pParentAtom->GetType()) == ATOMID("gmhd")) {
AddPropertiesGmhdType();
GenerateGmhdType();
} else {
VERBOSE_WARNING(m_pFile->GetVerbosity(),
printf("Warning: text atom in unexpected context, can not generate"));
}
}
void MP4Meta2Atom::Read ()
{
MP4Atom *parent = GetParentAtom();
if (ATOMID(parent->GetType()) == ATOMID("udta")) {
// add data property
AddReserved("reserved2", 4); /* 0 */
AddProperty(
new MP4BytesProperty("metadata")); /* 1 */
((MP4BytesProperty*)m_pProperties[1])->SetValueSize(m_size - 4);
} else {
ExpectChildAtom("data", Required, OnlyOne);
}
MP4Atom::Read();
}
LispObj *
Lisp_MakeStringOutputStream(LispBuiltin *builtin)
/*
make-string-output-stream &key element-type
*/
{
LispObj *element_type;
element_type = ARGUMENT(0);
if (element_type != UNSPEC) {
/* just check argument... */
if (SYMBOLP(element_type) && ATOMID(element_type) == Scharacter)
; /* do nothing */
else if (KEYWORDP(element_type) &&
ATOMID(element_type) == Sdefault)
; /* do nothing */
else
LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type));
}
return (LSTRINGSTREAM("", STREAM_WRITE, 1));
}
LispObj *
LispFindPackage(LispObj *name)
{
char *string = NULL;
if (PACKAGEP(name))
return (name);
if (SYMBOLP(name))
string = ATOMID(name)->value;
else if (STRINGP(name))
string = THESTR(name);
else
LispDestroy("FIND-PACKAGE: %s is not a string or symbol", STROBJ(name));
return (LispFindPackageFromString(string));
}
MP4StandardAtom::MP4StandardAtom (const char *type) : MP4Atom(type)
{
/*
* This is a big if else loop. Make sure that you don't break it
* when adding new atoms, or you will set the unknown type flag
*
* Try to keep it in alphabetical order - it should only be called
* 1 time per atom, so it's not that urgent.
*/
/*
* b???
*/
if (ATOMID(type) == ATOMID("bitr")) {
AddProperty( /* 0 */
new MP4Integer32Property("avgBitrate"));
AddProperty( /* 1 */
new MP4Integer32Property("maxBitrate"));
} else if (ATOMID(type) == ATOMID("btrt")) {
AddProperty( new MP4Integer32Property("bufferSizeDB")); /* 0 */
AddProperty( new MP4Integer32Property("avgBitrate")); /* 1 */
AddProperty( new MP4Integer32Property("maxBitrate")); /* 2 */
/*
* c???
*/
} else if (ATOMID(type) == ATOMID("co64")) {
AddVersionAndFlags();
MP4Integer32Property* pCount =
new MP4Integer32Property("entryCount");
AddProperty(pCount);
MP4TableProperty* pTable = new MP4TableProperty("entries", pCount);
AddProperty(pTable);
pTable->AddProperty(
new MP4Integer64Property("chunkOffset"));
} else if (ATOMID(type) == ATOMID("cpil")) {
ExpectChildAtom("data", Required, OnlyOne);
} else if (ATOMID(type) == ATOMID("covr")) { /* Apple iTunes */
ExpectChildAtom("data", Required, Many);
} else if (ATOMID(type) == ATOMID("cprt")) {
AddVersionAndFlags();
AddProperty(
new MP4Integer16Property("language"));
AddProperty(
new MP4StringProperty("notice"));
} else if (ATOMID(type) == ATOMID("ctts")) {
AddVersionAndFlags();
MP4Integer32Property* pCount =
new MP4Integer32Property("entryCount");
AddProperty(pCount);
MP4TableProperty* pTable = new MP4TableProperty("entries", pCount);
AddProperty(pTable);
pTable->AddProperty(new MP4Integer32Property("sampleCount"));
pTable->AddProperty(new MP4Integer32Property("sampleOffset"));
/*
* d???
*/
} else if (ATOMID(type) == ATOMID("dinf")) {
ExpectChildAtom("dref", Required, OnlyOne);
} else if (ATOMID(type) == ATOMID("dimm")) {
AddProperty( // bytes of immediate data
new MP4Integer64Property("bytes"));
} else if (ATOMID(type) == ATOMID("disk")) { /* Apple iTunes */
ExpectChildAtom("data", Required, OnlyOne);
} else if (ATOMID(type) == ATOMID("dmax")) {
AddProperty( // max packet duration
new MP4Integer32Property("milliSecs"));
} else if (ATOMID(type) == ATOMID("dmed")) {
AddProperty( // bytes sent from media data
new MP4Integer64Property("bytes"));
} else if (ATOMID(type) == ATOMID("drep")) {
AddProperty( // bytes of repeated data
new MP4Integer64Property("bytes"));
/*
* e???
*/
} else if (ATOMID(type) == ATOMID("edts")) {
ExpectChildAtom("elst", Required, OnlyOne);
} else if (ATOMID(type) == ATOMID("esds")) {
AddVersionAndFlags();
AddProperty(
new MP4DescriptorProperty(NULL, MP4ESDescrTag, 0,
Required, OnlyOne));
/*
* f???
*/
} else if (ATOMID(type) == ATOMID("frma")) {
AddProperty( /* 0 */
new MP4Integer32Property("data-format"));
/*
* g???
*/
} else if (ATOMID(type) == ATOMID("gnre")) { // Apple iTunes
ExpectChildAtom("data", Optional, OnlyOne);
/*
* h???
*/
} else if (ATOMID(type) == ATOMID("hmhd")) {
AddVersionAndFlags();
AddProperty(new MP4Integer16Property("maxPduSize"));
AddProperty(new MP4Integer16Property("avgPduSize"));
AddProperty(new MP4Integer32Property("maxBitRate"));
AddProperty(new MP4Integer32Property("avgBitRate"));
AddProperty(new MP4Integer32Property("slidingAvgBitRate"));
/*
* i???
*/
} else if (ATOMID(type) == ATOMID("iKMS")) {
AddVersionAndFlags(); /* 0, 1 */
MP4StringProperty* pProp = new MP4StringProperty("kms_URI");
AddProperty(pProp); /* 2 */
} else if (ATOMID(type) == ATOMID("iSFM")) {
AddVersionAndFlags(); /* 0, 1 */
AddProperty( /* 2 */
new MP4BitfieldProperty("selective-encryption", 1));
AddProperty( /* 3 */
new MP4BitfieldProperty("reserved", 7));
AddProperty( /* 4 */
new MP4Integer8Property("key-indicator-length"));
AddProperty( /* 5 */
new MP4Integer8Property("IV-length"));
} else if (ATOMID(type) == ATOMID("ilst")) {
ExpectChildAtom("\251nam", Optional, OnlyOne); /* name */
ExpectChildAtom("\251ART", Optional, OnlyOne); /* artist */
ExpectChildAtom("\251wrt", Optional, OnlyOne); /* writer */
ExpectChildAtom("\251alb", Optional, OnlyOne); /* album */
ExpectChildAtom("\251day", Optional, OnlyOne); /* date */
ExpectChildAtom("\251too", Optional, OnlyOne); /* tool */
ExpectChildAtom("\251cmt", Optional, OnlyOne); /* comment */
ExpectChildAtom("\251gen", Optional, OnlyOne); /* custom genre */
ExpectChildAtom("trkn", Optional, OnlyOne); /* tracknumber */
ExpectChildAtom("disk", Optional, OnlyOne); /* disknumber */
ExpectChildAtom("gnre", Optional, OnlyOne); /* genre (ID3v1 index + 1) */
ExpectChildAtom("cpil", Optional, OnlyOne); /* compilation */
ExpectChildAtom("tmpo", Optional, OnlyOne); /* BPM */
ExpectChildAtom("covr", Optional, OnlyOne); /* cover art */
ExpectChildAtom("----", Optional, Many); /* ---- free form */
} else if (ATOMID(type) == ATOMID("imif")) {
AddVersionAndFlags();
AddProperty(new MP4DescriptorProperty("ipmp_desc", MP4IPMPDescrTag,
MP4IPMPDescrTag, Required, Many));
} else if (ATOMID(type) == ATOMID("iods")) {
AddVersionAndFlags();
AddProperty(
new MP4DescriptorProperty(NULL, MP4FileIODescrTag,
MP4FileODescrTag,
Required, OnlyOne));
/*
* m???
*/
} else if (ATOMID(type) == ATOMID("maxr")) {
AddProperty(new MP4Integer32Property("granularity"));
AddProperty(new MP4Integer32Property("bytes"));
} else if (ATOMID(type) == ATOMID("mdia")) {
ExpectChildAtom("mdhd", Required, OnlyOne);
ExpectChildAtom("hdlr", Required, OnlyOne);
ExpectChildAtom("minf", Required, OnlyOne);
} else if (ATOMID(type) == ATOMID("meta")) { // iTunes
AddVersionAndFlags(); /* 0, 1 */
ExpectChildAtom("hdlr", Required, OnlyOne);
ExpectChildAtom("ilst", Required, OnlyOne);
} else if (ATOMID(type) == ATOMID("mfhd")) {
AddVersionAndFlags(); /* 0, 1 */
AddProperty( /* 2 */
new MP4Integer32Property("sequenceNumber"));
} else if (ATOMID(type) == ATOMID("minf")) {
ExpectChildAtom("vmhd", Optional, OnlyOne);
ExpectChildAtom("smhd", Optional, OnlyOne);
ExpectChildAtom("hmhd", Optional, OnlyOne);
ExpectChildAtom("nmhd", Optional, OnlyOne);
ExpectChildAtom("dinf", Required, OnlyOne);
ExpectChildAtom("stbl", Required, OnlyOne);
} else if (ATOMID(type) == ATOMID("moof")) {
ExpectChildAtom("mfhd", Required, OnlyOne);
ExpectChildAtom("traf", Optional, Many);
} else if (ATOMID(type) == ATOMID("moov")) {
ExpectChildAtom("mvhd", Required, OnlyOne);
ExpectChildAtom("iods", Optional, OnlyOne);
ExpectChildAtom("trak", Required, Many);
ExpectChildAtom("udta", Optional, Many);
ExpectChildAtom("mvex", Optional, OnlyOne);
} else if (ATOMID(type) == ATOMID("mvex")) {
ExpectChildAtom("trex", Required, Many);
/*
* n???
*/
} else if (ATOMID(type) == ATOMID("nmhd")) {
AddVersionAndFlags();
} else if (ATOMID(type) == ATOMID("nump")) {
AddProperty( // packets sent
new MP4Integer64Property("packets"));
/*
* o???
*/
} else if (ATOMID(type) == ATOMID("odkm")) {
AddVersionAndFlags();
ExpectChildAtom("ohdr", Required, OnlyOne);
/*
* p???
*/
} else if (ATOMID(type) == ATOMID("payt")) {
AddProperty(new MP4Integer32Property("payloadNumber"));
AddProperty(new MP4StringProperty("rtpMap", Counted));
} else if (ATOMID(type) == ATOMID("pmax")) {
AddProperty( // max packet size
new MP4Integer32Property("bytes"));
/*
* s???
*/
} else if (ATOMID(type) == ATOMID("schi")) {
// not sure if this is child atoms or table of boxes
// get clarification on spec 9.1.2.5
ExpectChildAtom("odkm", Optional, OnlyOne);
ExpectChildAtom("iKMS", Optional, OnlyOne);
ExpectChildAtom("iSFM", Optional, OnlyOne);
} else if (ATOMID(type) == ATOMID("schm")) {
AddVersionAndFlags(); /* 0, 1 */
AddProperty( /* 2 */
new MP4Integer32Property("scheme_type"));
AddProperty( /* 3 */
new MP4Integer32Property("scheme_version"));
// browser URI if flags set, TODO
} else if (ATOMID(type) == ATOMID("sinf")) {
ExpectChildAtom("frma", Required, OnlyOne);
ExpectChildAtom("imif", Optional, OnlyOne);
ExpectChildAtom("schm", Optional, OnlyOne);
ExpectChildAtom("schi", Optional, OnlyOne);
} else if (ATOMID(type) == ATOMID("smhd")) {
AddVersionAndFlags();
AddReserved("reserved", 4);
} else if (ATOMID(type) == ATOMID("snro")) {
AddProperty(new MP4Integer32Property("offset"));
} else if (ATOMID(type) == ATOMID("stco")) {
AddVersionAndFlags();
MP4Integer32Property* pCount = new MP4Integer32Property("entryCount");
AddProperty(pCount);
MP4TableProperty* pTable = new MP4TableProperty("entries", pCount);
AddProperty(pTable);
pTable->AddProperty(new MP4Integer32Property("chunkOffset"));
} else if (ATOMID(type) == ATOMID("stsh")) {
AddVersionAndFlags();
MP4Integer32Property* pCount = new MP4Integer32Property("entryCount");
AddProperty(pCount);
MP4TableProperty* pTable = new MP4TableProperty("entries", pCount);
AddProperty(pTable);
pTable->AddProperty(new MP4Integer32Property("shadowedSampleNumber"));
pTable->AddProperty(new MP4Integer32Property("syncSampleNumber"));
} else if (ATOMID(type) == ATOMID("stss")) {
AddVersionAndFlags();
MP4Integer32Property* pCount = new MP4Integer32Property("entryCount");
AddProperty(pCount);
MP4TableProperty* pTable = new MP4TableProperty("entries", pCount);
AddProperty(pTable);
pTable->AddProperty(new MP4Integer32Property("sampleNumber"));
} else if (ATOMID(type) == ATOMID("stts")) {
AddVersionAndFlags();
MP4Integer32Property* pCount = new MP4Integer32Property("entryCount");
AddProperty(pCount);
MP4TableProperty* pTable = new MP4TableProperty("entries", pCount);
AddProperty(pTable);
pTable->AddProperty(new MP4Integer32Property("sampleCount"));
pTable->AddProperty(new MP4Integer32Property("sampleDelta"));
/*
* t???
*/
} else if (ATOMID(type) == ATOMID("tims")) {
AddProperty(
new MP4Integer32Property("timeScale"));
} else if (ATOMID(type) == ATOMID("tmin")) {
AddProperty( // min relative xmit time
new MP4Integer32Property("milliSecs"));
} else if (ATOMID(type) == ATOMID("tmax")) {
AddProperty( // max relative xmit time
new MP4Integer32Property("milliSecs"));
} else if (ATOMID(type) == ATOMID("tmpo")) { // iTunes
ExpectChildAtom("data", Required, OnlyOne);
} else if (ATOMID(type) == ATOMID("traf")) {
ExpectChildAtom("tfhd", Required, OnlyOne);
ExpectChildAtom("trun", Optional, Many);
} else if (ATOMID(type) == ATOMID("trak")) {
ExpectChildAtom("tkhd", Required, OnlyOne);
ExpectChildAtom("tref", Optional, OnlyOne);
ExpectChildAtom("edts", Optional, OnlyOne);
ExpectChildAtom("mdia", Required, OnlyOne);
ExpectChildAtom("udta", Optional, Many);
} else if (ATOMID(type) == ATOMID("tref")) {
ExpectChildAtom("dpnd", Optional, OnlyOne);
ExpectChildAtom("hint", Optional, OnlyOne);
ExpectChildAtom("ipir", Optional, OnlyOne);
ExpectChildAtom("mpod", Optional, OnlyOne);
ExpectChildAtom("sync", Optional, OnlyOne);
} else if (ATOMID(type) == ATOMID("trex")) {
AddVersionAndFlags(); /* 0, 1 */
AddProperty( /* 2 */
new MP4Integer32Property("trackId"));
AddProperty( /* 3 */
new MP4Integer32Property("defaultSampleDesriptionIndex"));
AddProperty( /* 4 */
new MP4Integer32Property("defaultSampleDuration"));
AddProperty( /* 5 */
new MP4Integer32Property("defaultSampleSize"));
AddProperty( /* 6 */
new MP4Integer32Property("defaultSampleFlags"));
} else if (ATOMID(type) == ATOMID("trkn")) { // iTunes
ExpectChildAtom("data", Required, OnlyOne);
} else if (ATOMID(type) == ATOMID("trpy") ||
ATOMID(type) == ATOMID("tpyl")) {
AddProperty( // bytes sent including RTP headers
new MP4Integer64Property("bytes"));
} else if (ATOMID(type) == ATOMID("tsro")) {
AddProperty(
new MP4Integer32Property("offset"));
} else if (ATOMID(type) == ATOMID("wave")) {
ExpectChildAtom("esds", Required, OnlyOne);
/*
* copyright???
*/
} else if (ATOMID(type) == ATOMID(art) ||
ATOMID(type) == ATOMID(wrt) ||
ATOMID(type) == ATOMID(alb) ||
ATOMID(type) == ATOMID(day) ||
ATOMID(type) == ATOMID(too) ||
ATOMID(type) == ATOMID(gen) ||
ATOMID(type) == ATOMID(grp)) { /* Apple iTunes */
ExpectChildAtom("data", Required, OnlyOne);
/*
* ----
*/
} else if (ATOMID(type) == ATOMID("----")) { /* Apple iTunes */
ExpectChildAtom("mean", Required, OnlyOne);
ExpectChildAtom("name", Required, OnlyOne);
ExpectChildAtom("data", Required, OnlyOne);
} else {
/*
* default - unknown type
*/
SetUnknownType(true);
}
}
LispObj *
Lisp_PQgetvalue(LispBuiltin *builtin)
/*
pq-getvalue result tuple field &optional type-specifier
*/
{
char *string;
double real = 0.0;
PGresult *res;
int tuple, field, isint = 0, isreal = 0, integer;
LispObj *result, *otupple, *field_number, *type;
type = ARGUMENT(3);
field_number = ARGUMENT(2);
otupple = ARGUMENT(1);
result = ARGUMENT(0);
if (!CHECKO(result, PGresult_t))
LispDestroy("%s: cannot convert %s to PGresult*",
STRFUN(builtin), STROBJ(result));
res = (PGresult*)(result->data.opaque.data);
CHECK_INDEX(otupple);
tuple = FIXNUM_VALUE(otupple);
CHECK_INDEX(field_number);
field = FIXNUM_VALUE(field_number);
string = PQgetvalue(res, tuple, field);
if (type != UNSPEC) {
char *typestring;
CHECK_SYMBOL(type);
typestring = ATOMID(type);
if (strcmp(typestring, "INT16") == 0) {
integer = *(short*)string;
isint = 1;
goto simple_type;
}
else if (strcmp(typestring, "INT32") == 0) {
integer = *(int*)string;
isint = 1;
goto simple_type;
}
else if (strcmp(typestring, "FLOAT") == 0) {
real = *(float*)string;
isreal = 1;
goto simple_type;
}
else if (strcmp(typestring, "REAL") == 0) {
real = *(double*)string;
isreal = 1;
goto simple_type;
}
else if (strcmp(typestring, "PG-POLYGON") == 0)
goto polygon_type;
else if (strcmp(typestring, "STRING") != 0)
LispDestroy("%s: unknown type %s",
STRFUN(builtin), typestring);
}
simple_type:
return (isint ? INTEGER(integer) : isreal ? DFLOAT(real) :
(string ? STRING(string) : NIL));
polygon_type:
{
LispObj *poly, *box, *p = NIL, *cdr, *obj;
POLYGON *polygon;
int i, size;
size = PQgetlength(res, tuple, field);
polygon = (POLYGON*)(string - sizeof(int));
GCDisable();
/* get polygon->boundbox */
cdr = EVAL(CONS(ATOM("MAKE-PG-POINT"),
CONS(KEYWORD("X"),
CONS(REAL(polygon->boundbox.high.x),
CONS(KEYWORD("Y"),
CONS(REAL(polygon->boundbox.high.y), NIL))))));
obj = EVAL(CONS(ATOM("MAKE-PG-POINT"),
CONS(KEYWORD("X"),
CONS(REAL(polygon->boundbox.low.x),
CONS(KEYWORD("Y"),
CONS(REAL(polygon->boundbox.low.y), NIL))))));
box = EVAL(CONS(ATOM("MAKE-PG-BOX"),
CONS(KEYWORD("HIGH"),
CONS(cdr,
CONS(KEYWORD("LOW"),
CONS(obj, NIL))))));
/* get polygon->p values */
for (i = 0; i < polygon->npts; i++) {
obj = EVAL(CONS(ATOM("MAKE-PG-POINT"),
CONS(KEYWORD("X"),
CONS(REAL(polygon->p[i].x),
CONS(KEYWORD("Y"),
CONS(REAL(polygon->p[i].y), NIL))))));
if (i == 0)
p = cdr = CONS(obj, NIL);
else {
RPLACD(cdr, CONS(obj, NIL));
cdr = CDR(cdr);
}
}
/* make result */
poly = EVAL(CONS(ATOM("MAKE-PG-POLYGON"),
CONS(KEYWORD("SIZE"),
CONS(REAL(size),
CONS(KEYWORD("NUM-POINTS"),
CONS(REAL(polygon->npts),
CONS(KEYWORD("BOUNDBOX"),
CONS(box,
CONS(KEYWORD("POINTS"),
CONS(QUOTE(p), NIL))))))))));
GCEnable();
return (poly);
}
}
/* XXX Non standard functions below
*/
LispObj *
Lisp_MakePipe(LispBuiltin *builtin)
/*
make-pipe command-line &key :direction :element-type :external-format
*/
{
char *string;
LispObj *stream = NIL;
int flags, direction;
LispFile *error_file;
LispPipe *program;
int ifd[2];
int ofd[2];
int efd[2];
char *argv[4];
LispObj *command_line, *odirection, *element_type, *external_format;
external_format = ARGUMENT(3);
element_type = ARGUMENT(2);
odirection = ARGUMENT(1);
command_line = ARGUMENT(0);
if (PATHNAMEP(command_line))
command_line = CAR(command_line->data.quote);
else if (!STRINGP(command_line))
LispDestroy("%s: %s is a bad pathname",
STRFUN(builtin), STROBJ(command_line));
if (odirection != UNSPEC) {
direction = -1;
if (KEYWORDP(odirection)) {
if (odirection == Kprobe)
direction = DIR_PROBE;
else if (odirection == Kinput)
direction = DIR_INPUT;
else if (odirection == Koutput)
direction = DIR_OUTPUT;
else if (odirection == Kio)
direction = DIR_IO;
}
if (direction == -1)
LispDestroy("%s: bad :DIRECTION %s",
STRFUN(builtin), STROBJ(odirection));
}
else
direction = DIR_INPUT;
if (element_type != UNSPEC) {
/* just check argument... */
if (SYMBOLP(element_type) && ATOMID(element_type) == Scharacter)
; /* do nothing */
else if (KEYWORDP(element_type) && ATOMID(element_type) == Sdefault)
; /* do nothing */
else
LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type));
}
if (external_format != UNSPEC) {
/* just check argument... */
if (SYMBOLP(external_format) && ATOMID(external_format) == Scharacter)
; /* do nothing */
else if (KEYWORDP(external_format) &&
ATOMID(external_format) == Sdefault)
; /* do nothing */
else
LispDestroy("%s: only :%s and %s supported for :EXTERNAL-FORMAT, not %s",
STRFUN(builtin), Sdefault, Scharacter, STROBJ(external_format));
}
string = THESTR(command_line);
program = LispMalloc(sizeof(LispPipe));
if (direction != DIR_PROBE) {
argv[0] = "sh";
argv[1] = "-c";
argv[2] = string;
argv[3] = NULL;
pipe(ifd);
pipe(ofd);
pipe(efd);
if ((program->pid = fork()) == 0) {
close(0);
close(1);
close(2);
dup2(ofd[0], 0);
dup2(ifd[1], 1);
dup2(efd[1], 2);
close(ifd[0]);
close(ifd[1]);
close(ofd[0]);
close(ofd[1]);
close(efd[0]);
close(efd[1]);
execve("/bin/sh", argv, environ);
exit(-1);
}
else if (program->pid < 0)
LispDestroy("%s: fork: %s", STRFUN(builtin), strerror(errno));
program->input = LispFdopen(ifd[0], FILE_READ | FILE_UNBUFFERED);
close(ifd[1]);
program->output = LispFdopen(ofd[1], FILE_WRITE | FILE_UNBUFFERED);
close(ofd[0]);
error_file = LispFdopen(efd[0], FILE_READ | FILE_UNBUFFERED);
close(efd[1]);
}
else {
program->pid = -1;
program->input = program->output = error_file = NULL;
}
flags = direction == DIR_PROBE ? 0 : STREAM_READ;
program->errorp = FILESTREAM(error_file, command_line, flags);
flags = 0;
if (direction != DIR_PROBE) {
if (direction == DIR_INPUT || direction == DIR_IO)
flags |= STREAM_READ;
if (direction == DIR_OUTPUT || direction == DIR_IO)
flags |= STREAM_WRITE;
}
stream = PIPESTREAM(program, command_line, flags);
LispMused(program);
return (stream);
}
LispObj *
Lisp_Open(LispBuiltin *builtin)
/*
open filename &key direction element-type if-exists if-does-not-exist external-format
*/
{
GC_ENTER();
char *string;
LispObj *stream = NIL;
int mode, flags, direction, exist, noexist, file_exist;
LispFile *file;
LispObj *filename, *odirection, *element_type, *if_exists,
*if_does_not_exist, *external_format;
external_format = ARGUMENT(5);
if_does_not_exist = ARGUMENT(4);
if_exists = ARGUMENT(3);
element_type = ARGUMENT(2);
odirection = ARGUMENT(1);
filename = ARGUMENT(0);
if (STRINGP(filename)) {
filename = APPLY1(Oparse_namestring, filename);
GC_PROTECT(filename);
}
else if (STREAMP(filename)) {
if (filename->data.stream.type != LispStreamFile)
LispDestroy("%s: %s is not a FILE-STREAM",
STRFUN(builtin), STROBJ(filename));
filename = filename->data.stream.pathname;
}
else {
CHECK_PATHNAME(filename);
}
if (odirection != UNSPEC) {
direction = -1;
if (KEYWORDP(odirection)) {
if (odirection == Kprobe)
direction = DIR_PROBE;
else if (odirection == Kinput)
direction = DIR_INPUT;
else if (odirection == Koutput)
direction = DIR_OUTPUT;
else if (odirection == Kio)
direction = DIR_IO;
}
if (direction == -1)
LispDestroy("%s: bad :DIRECTION %s",
STRFUN(builtin), STROBJ(odirection));
}
else
direction = DIR_INPUT;
if (element_type != UNSPEC) {
/* just check argument... */
if (SYMBOLP(element_type) &&
ATOMID(element_type) == Scharacter)
; /* do nothing */
else if (KEYWORDP(element_type) &&
ATOMID(element_type) == Sdefault)
; /* do nothing */
else
LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type));
}
if (if_exists != UNSPEC) {
exist = -1;
if (if_exists == NIL)
exist = EXT_NIL;
else if (KEYWORDP(if_exists)) {
if (if_exists == Kerror)
exist = EXT_ERROR;
else if (if_exists == Knew_version)
exist = EXT_NEW_VERSION;
else if (if_exists == Krename)
exist = EXT_RENAME;
else if (if_exists == Krename_and_delete)
exist = EXT_RENAME_DELETE;
else if (if_exists == Koverwrite)
exist = EXT_OVERWRITE;
else if (if_exists == Kappend)
exist = EXT_APPEND;
else if (if_exists == Ksupersede)
exist = EXT_SUPERSEDE;
}
if (exist == -1)
LispDestroy("%s: bad :IF-EXISTS %s",
STRFUN(builtin), STROBJ(if_exists));
}
else
exist = EXT_ERROR;
if (if_does_not_exist != UNSPEC) {
noexist = -1;
if (if_does_not_exist == NIL)
noexist = NOEXT_NIL;
if (KEYWORDP(if_does_not_exist)) {
if (if_does_not_exist == Kerror)
noexist = NOEXT_ERROR;
else if (if_does_not_exist == Kcreate)
noexist = NOEXT_CREATE;
}
if (noexist == -1)
LispDestroy("%s: bad :IF-DOES-NO-EXISTS %s",
STRFUN(builtin), STROBJ(if_does_not_exist));
}
else
noexist = direction != DIR_INPUT ? NOEXT_NOTHING : NOEXT_ERROR;
if (external_format != UNSPEC) {
/* just check argument... */
if (SYMBOLP(external_format) &&
ATOMID(external_format) == Scharacter)
; /* do nothing */
else if (KEYWORDP(external_format) &&
ATOMID(external_format) == Sdefault)
; /* do nothing */
else
LispDestroy("%s: only :%s and %s supported for :EXTERNAL-FORMAT, not %s",
STRFUN(builtin), Sdefault, Scharacter, STROBJ(external_format));
}
/* string representation of pathname */
string = THESTR(CAR(filename->data.pathname));
mode = 0;
file_exist = access(string, F_OK) == 0;
if (file_exist) {
if (exist == EXT_NIL) {
GC_LEAVE();
return (NIL);
}
}
else {
if (noexist == NOEXT_NIL) {
GC_LEAVE();
return (NIL);
}
if (noexist == NOEXT_ERROR)
LispDestroy("%s: file %s does not exist",
STRFUN(builtin), STROBJ(CAR(filename->data.quote)));
else if (noexist == NOEXT_CREATE) {
LispFile *tmp = LispFopen(string, FILE_WRITE);
if (tmp)
LispFclose(tmp);
else
LispDestroy("%s: cannot create file %s",
STRFUN(builtin),
STROBJ(CAR(filename->data.quote)));
}
}
if (direction == DIR_OUTPUT || direction == DIR_IO) {
if (file_exist) {
if (exist == EXT_ERROR)
LispDestroy("%s: file %s already exists",
STRFUN(builtin), STROBJ(CAR(filename->data.quote)));
if (exist == EXT_RENAME) {
/* Add an ending '~' at the end of the backup file */
char tmp[PATH_MAX + 1];
strcpy(tmp, string);
if (strlen(tmp) + 1 > PATH_MAX)
LispDestroy("%s: backup name for %s too long",
STRFUN(builtin),
STROBJ(CAR(filename->data.quote)));
strcat(tmp, "~");
if (rename(string, tmp))
LispDestroy("%s: rename: %s",
STRFUN(builtin), strerror(errno));
mode |= FILE_WRITE;
}
else if (exist == EXT_OVERWRITE)
mode |= FILE_WRITE;
else if (exist == EXT_APPEND)
mode |= FILE_APPEND;
}
else
mode |= FILE_WRITE;
if (direction == DIR_IO)
mode |= FILE_IO;
}
else
mode |= FILE_READ;
file = LispFopen(string, mode);
if (file == NULL)
LispDestroy("%s: open: %s", STRFUN(builtin), strerror(errno));
flags = 0;
if (direction == DIR_PROBE) {
LispFclose(file);
file = NULL;
}
else {
if (direction == DIR_INPUT || direction == DIR_IO)
flags |= STREAM_READ;
if (direction == DIR_OUTPUT || direction == DIR_IO)
flags |= STREAM_WRITE;
}
stream = FILESTREAM(file, filename, flags);
GC_LEAVE();
return (stream);
}
