Filename.st
changeset 5011 192fd647de07
parent 4979 9d24293ca0dc
child 5012 3134cc1bd02b
--- a/Filename.st	Fri Nov 19 14:27:43 1999 +0100
+++ b/Filename.st	Fri Nov 19 15:17:40 1999 +0100
@@ -2670,6 +2670,101 @@
     "Modified: / 21.9.1998 / 15:33:07 / cg"
 !
 
+mimeTypeOfContents
+    "this tries to guess the mime type of contents of
+     the file. Returns nil, if the file is unreadable, not a plain file
+     or the contents is unknown.
+     This is done using some heuristics, and may need some improvement"
+
+    |type buffer s n suffix idx idx2 baseNm|
+
+    self isDirectory ifTrue:[
+        ^ 'nil'
+    ].
+    (type := self type) == #characterSpecial ifTrue:[
+        ^ nil
+    ].
+    type == #blockSpecial ifTrue:[
+        ^ nil
+    ].
+    type == #socket ifTrue:[
+        ^ nil
+    ].
+
+    self isReadable ifFalse:[^ nil].
+    self fileSize == 0 ifTrue:[^ nil].
+
+    suffix := self suffix asLowercase.
+    baseNm := self withoutSuffix baseName asLowercase.
+
+    "/ read some data from the file ...
+    buffer := String new:2024.
+    s := self readStream.
+    s isNil ifTrue:[^ nil].
+
+    n := s nextBytes:buffer size into:buffer.
+    s close.
+
+    (idx := buffer findString:'MIMEType:') ~~ 0 ifTrue:[
+self halt.
+        idx := idx + 'MIMEType:' size.
+        idx2 := buffer indexOf:Character cr startingAt:idx.
+        idx > idx ifTrue:[
+self halt.
+            ^ buffer copyFrom:idx to:idx.
+        ].
+    ].
+
+    (buffer findString:'subclass:') ~~ 0 ifTrue:[
+        ^ 'application/x-smalltalk-source'
+    ].
+    (buffer findString:'methodsFor:') ~~ 0 ifTrue:[
+        ^ 'application/x-smalltalk-source'
+    ].
+
+    (buffer findString:'<BODY:') ~~ 0 ifTrue:[
+        ^ 'text/html'
+    ].
+    (idx := buffer findString:'<H') ~~ 0 ifTrue:[
+        ((buffer continuesWith:'<HEAD' startingAt:idx)
+        or:[(buffer continuesWith:'<HTML' startingAt:idx)
+        or:[(buffer continuesWith:'<H1' startingAt:idx)
+        or:[(buffer continuesWith:'<H2' startingAt:idx)
+        or:[(buffer continuesWith:'<H3' startingAt:idx)
+        or:[(buffer continuesWith:'<H4' startingAt:idx)
+        or:[(buffer continuesWith:'<H5' startingAt:idx)
+        or:[(buffer continuesWith:'<H6' startingAt:idx)]]]]]]])
+        ifTrue:[
+            ^ 'text/html'
+        ]
+    ].
+        
+    (buffer findString:'%!!PS-Adobe') ~~ 0 ifTrue:[
+        ^ 'application/postscript'
+    ].
+
+    (buffer findString:'#!! /bin/sh') ~~ 0 ifTrue:[
+        ^ 'application/x-sh'
+    ].
+    (buffer findString:'#!!/bin/sh') ~~ 0 ifTrue:[
+        ^ 'application/x-sh'
+    ].
+
+    ^ nil
+
+    "
+     'Makefile' asFilename mimeTypeOfContents 
+     '.' asFilename mimeTypeOfContents     
+     '/dev/null' asFilename mimeTypeOfContents 
+     '/tmp/.X11-unix/X0' asFilename mimeTypeOfContents 
+     'smalltalk.rc' asFilename mimeTypeOfContents    
+     'bitmaps/SBrowser.xbm' asFilename mimeTypeOfContents    
+     '../../rules/stmkmf' asFilename mimeTypeOfContents    
+    "
+
+    "Modified: / 19.11.1999 / 15:16:57 / cg"
+!
+
 recursiveDirectoryContents
     "return the contents of the directory and all subdirectories
      as a collection of strings.
@@ -3389,6 +3484,6 @@
 !Filename class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.168 1999-11-10 23:58:33 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.169 1999-11-19 14:17:40 cg Exp $'
 ! !
 Filename initialize!