MIMETypes.st
changeset 3691 f0cdcbd903e0
parent 3585 11f3dcdc89fe
child 3756 ca18095fa3c0
--- a/MIMETypes.st	Tue May 31 15:21:21 2016 +0200
+++ b/MIMETypes.st	Thu Jun 02 11:30:06 2016 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "
  COPYRIGHT (c) 1997 by eXept Software AG 
 	      All Rights Reserved
@@ -15,14 +17,15 @@
 
 Object subclass:#MIMETypes
 	instanceVariableNames:''
-	classVariableNames:'TypeToImageReaderClassMapping TypeToCommentStringMapping
-		TypeToFileSuffixMapping TypeToViewerApplicationMapping
-		SuffixToCommentStringMapping FileSuffixToTypeMapping
-		FilenameToTypeMapping FileSuffixToImageReaderClassMapping
-		CharSetToFontMapping LastSuffix LastType
-		DefaultCommandPerMIMEPerOS DefaultPrintCommandPerMIMEPerOS
-		TypeToParenthesisSpecMapping SuffixToParenthesisSpecMapping
-		TypeToInfoMapping'
+	classVariableNames:'CharSetToFontMapping DefaultCommandPerMIMEPerOS
+		DefaultPrintCommandPerMIMEPerOS
+		FileSuffixToImageReaderClassMapping FileSuffixToTypeMapping
+		FilenameToTypeMapping LastSuffix LastType
+		SuffixToCommentStringMapping SuffixToParenthesisSpecMapping
+		TypeFromContentsDetectors TypeToCommentStringMapping
+		TypeToFileSuffixMapping TypeToImageReaderClassMapping
+		TypeToInfoMapping TypeToParenthesisSpecMapping
+		TypeToViewerApplicationMapping'
 	poolDictionaries:''
 	category:'Net-Communication-Support'
 !
@@ -104,6 +107,17 @@
 
 !MIMETypes class methodsFor:'initialization'!
 
+addMimeTypeDetector:aMimeTypeFromContentsDetectorBlock
+    "any class (especially: image readers) may add a block
+     which detects the mime-type from a givel contents.
+     The block is called with two arguments, some data (usually the first few kilobytes
+     of a file) and the suffix of the file, or nil if unknown.
+     The block should return the mimeType or nil."
+     
+    TypeFromContentsDetectors isNil ifTrue:[ TypeFromContentsDetectors := OrderedCollection new ]. 
+    TypeFromContentsDetectors add:aMimeTypeFromContentsDetectorBlock.
+!
+
 initialize
     "initialize wellKnown facts"
     
@@ -113,7 +127,7 @@
     self initializeImageReaderMappings.
     self initializeCommentStringMappings.
     self initializeParenthesisSpecMappings.
-
+    
     "
      self initialize
     "
@@ -1011,16 +1025,27 @@
 mimeTypeOfData:someData suffix:fileNameSuffixOrNilIfUnknown
     "this tries to guess the mime type of contents of someData.
      Returns nil, if unknown.
-     This is done using some heuristics, and may need some improvement"
+     In addition to registered detectors (see addMimeTypeDetector:),
+     this is done using some heuristics, and may need some improvement"
 
     |buffer lcBuffer size idx idx2|
 
     someData isEmptyOrNil ifTrue:[^ nil].
 
+    TypeFromContentsDetectors notNil ifTrue:[
+        TypeFromContentsDetectors do:[:eachDetector |
+            |m|
+            
+            m := eachDetector value:someData value:fileNameSuffixOrNilIfUnknown.
+            m notNil ifTrue:[^ m]
+        ]
+    ].    
+    
     size := 2048 min:someData size.
 
     "/ read some data from the file ...
     buffer := (someData copyTo:size) asString.
+
     lcBuffer := buffer asLowercase.
 
     (idx := lcBuffer findString:'mimetype:') ~~ 0 ifTrue:[
@@ -1092,7 +1117,7 @@
             ^ MIMEType fromString:what
         ]
     ].
-
+    
     (idx := lcBuffer findString:'<h') ~~ 0 ifTrue:[
         ((lcBuffer continuesWith:'<head' startingAt:idx)
         or:[(lcBuffer continuesWith:'<html' startingAt:idx)