# -*- tcl -*-
#
# Testing "fumagic" (FileUtil Magic). Filetype recognizer.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 2005      by Andreas Kupries <andreas_kupries@users.sourceforge.net>
# All rights reserved.
#
# RCS: @(#) $Id: filetypes.test,v 1.4 2005/09/28 04:51:19 andreas_kupries Exp $

# -------------------------------------------------------------------------
# Initialise the test package
#
if {[lsearch [namespace children] ::tcltest] == -1} {
    set auto_path [linsert $auto_path 0 .]
    package require tcltest
    namespace import ::tcltest::*
}

proc makeBinaryFile {data f} {
    set path [makeFile {} $f]
    # Tcltest 1.0 returns list of all paths generated so far.
    if {[llength $path]} {set path [lindex $path end]}

    set ch [open $path w]
    fconfigure $ch -translation binary
    puts -nonewline $ch $data
    close $ch
    return $path
}

# -------------------------------------------------------------------------
# Ensure we test _this_ local copy and not one installed somewhere else.
# All helper packages have to come from the local directory tree as well.
#
package forget fileutil::magic::filetype
package forget fileutil::magic::rt

catch {namespace delete ::fileutil::magic}
catch {namespace delete ::fileutil::magic::rt}

if { [lsearch $auto_path [file dirname [info script]]] == -1 } {
    set auto_path [linsert $auto_path 0 [file dirname [info script]]]
}

if {[catch {source [file join [file dirname [info script]] rtcore.tcl]} msg]} {
    puts "skipped [file tail [info script]] (rtcore.tcl): $msg"
    return
}

if {[catch {source [file join [file dirname [info script]] filetypes.tcl]} msg]} {
    puts "skipped [file tail [info script]]: $msg"
    return
}

# -------------------------------------------------------------------------
# Setup any constraints

# -------------------------------------------------------------------------
# Now the package specific tests....
# -------------------------------------------------------------------------

puts "- tcltest [package present tcltest]"
puts "- fileutil::magic::filetype [package present fileutil::magic::filetype]"
puts "  - fileutil::magic::rt     [package present fileutil::magic::rt]"

# -------------------------------------------------------------------------
set dir $::tcltest::temporaryDirectory

catch {removeDirectory fileTypeTest} ; # start with a clean structure!
makeDirectory fileTypeTest
# Can't use for tcl < 8.3
#fileutil::touch [file join $dir fileTypeTest emptyFile]
set _f [open [file join $dir fileTypeTest emptyFile] a] ; close $_f

makeBinaryFile "\u0000" [file join $dir fileTypeTest binaryFile]

set elfData "\x7F"
append elfData "ELF"
append elfData "\x01\x01\x01\x00\x00"
makeBinaryFile $elfData [file join $dir fileTypeTest elfFile]

set bzipData "BZh91AY&SY"
append bzipData "\x01\x01\x01\x00\x00"
makeBinaryFile $bzipData [file join $dir fileTypeTest bzipFile]

set gzipData "\x1f\x8b"
append gzipData "\x01\x01\x01\x00\x00"
makeBinaryFile $gzipData [set f [file join $dir fileTypeTest gzipFile]]
set fh [open $f w] ; fconfigure $fh -encoding binary ; puts -nonewline $fh $gzipData ; close $fh

set jpgData "\xFF\xD8\xFF\xE0\x00\x10JFIF"
append jpgData "\x00\x01\x02\x01\x01\x2c"
makeBinaryFile $jpgData [file join $dir fileTypeTest jpegFile]

set gifData "GIF89a\x2b\x00\x40\x00\xf7\xff\x00"
makeBinaryFile $gifData [file join $dir fileTypeTest gifFile]

set pngData "\x89PNG"
append pngData "\x00\x01\x02\x01\x01\x2c"
makeBinaryFile $pngData [set f [file join $dir fileTypeTest pngFile]]
set fh [open $f w] ; fconfigure $fh -encoding binary ; puts -nonewline $fh $pngData ; close $fh

set tiffData "MM\x00\*"
append tiffData "\x00\x01\x02\x01\x01\x2c"
makeBinaryFile $tiffData [file join $dir fileTypeTest tiffFile]

set psData "%!PS-"
append psData "ADOBO-123 EPSF-1.4"
makeFile $psData [file join $dir fileTypeTest psFile]

set pdfData "%PDF-"
append pdfData "1.2 \x00\x01\x02\x01\x01\x2c"
makeBinaryFile $pdfData [file join $dir fileTypeTest pdfFile]

set epsData $psData
makeFile $psData [file join $dir fileTypeTest epsFile]

set igwdData "IGWD"
append igwdData "\x00\x01\x02\x01\x01\x2c"
makeBinaryFile $igwdData [file join $dir fileTypeTest igwdFile]

makeFile "simple text" [file join $dir fileTypeTest textFile]
makeFile "#!/bin/tclsh" [file join $dir fileTypeTest scriptFile]
makeFile "<html></html>" [file join $dir fileTypeTest htmlFile]

set xmlData {<?xml version="1.0" encoding="ISO-8859-1"?>

<foobar></foobar>
}

set xmlDataWithDTD {<?xml version="1.0" encoding="ISO-8859-1"?>

<!DOCTYPE foobar SYSTEM bogus.dtd>
<foobar></foobar>
}

makeFile $xmlData [file join $dir fileTypeTest xmlFile]
makeFile $xmlDataWithDTD [file join $dir fileTypeTest xmlWithDTDFile]

set pgpData {-----BEGIN PGP MESSAGE-----
Version: PGP 6.5.8

abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
}

makeFile $pgpData [file join $dir fileTypeTest pgpFile]



test fumagic.filetype-1.1 {test file non-existance} {
    set f [file join $dir fileTypeTest bogus]
    set res [catch {fileutil::magic::filetype $f} msg]
    list $res $msg
} [list 1 "file not found: \"[file join $dir fileTypeTest bogus]\""]

test fumagic.filetype-1.2 {test file directory} {
    set f [file join $dir fileTypeTest]
    set res [catch {fileutil::magic::filetype $f} msg]
    regsub {file[0-9]+} $msg {fileXXX} msg
    list $res $msg
} {1 {error reading "fileXXX": illegal operation on a directory}}

test fumagic.filetype-1.3 {test file empty} {
    set f [file join $dir fileTypeTest emptyFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    list $res $msg
} {0 {}}

test fumagic.filetype-1.4 {test simple binary} {
    set f [file join $dir fileTypeTest binaryFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    list $res $msg
} {0 {}}

test fumagic.filetype-1.5 {test elf executable} {
    set f [file join $dir fileTypeTest elfFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    list $res $msg
} {0 {ELF 32-bit LSB AT&T WE32100 - invalid byte order, relocatable, \(\) \(SYSV\)}}

test fumagic.filetype-1.6 {test simple text} {
    set f [file join $dir fileTypeTest textFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    list $res $msg
} {0 {}}

test fumagic.filetype-1.7 {test script file} {
    set f [file join $dir fileTypeTest scriptFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    list $res $msg
} {0 {a /bin/tclsh script text executable}}

test fumagic.filetype-1.8 {test html text} {
    set f [file join $dir fileTypeTest htmlFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    list $res $msg
} {0 {HTML document text}}

# 1.9/.10 possibly broken output.
test fumagic.filetype-1.9 {test xml text} {
    set f [file join $dir fileTypeTest xmlFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    list $res $msg
} {0 {XML document text \"	XML XML %.3s document text broken XML document text}}

test fumagic.filetype-1.10 {test xml with dtd text} {
    set f [file join $dir fileTypeTest xmlWithDTDFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    list $res $msg
} {0 {XML document text \"	XML XML %.3s document text broken XML document text}}

test fumagic.filetype-1.11 {test PGP message} {
    set f [file join $dir fileTypeTest pgpFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    list $res $msg
} {0 {PGP armored data message}}

test fumagic.filetype-1.12 {test binary graphic jpeg} {
    set f [file join $dir fileTypeTest jpegFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    list $res $msg
} {0 {JPEG image data , JFIF standard  1. %02d , thumbnail 2x 2}}

test fumagic.filetype-1.13 {test binary graphic gif} {
    set f [file join $dir fileTypeTest gifFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    list $res $msg
} {0 {GIF image data , version 89a,}}

test fumagic.filetype-1.14 {test binary graphic png} {
    set f [file join $dir fileTypeTest pngFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    list $res $msg
} {0 {PNG image data, CORRUPTED, PNG image data, CORRUPTED}}

test fumagic.filetype-1.15 {test binary graphic tiff} {
    set f [file join $dir fileTypeTest tiffFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    list $res $msg
} {0 {TIFF image data, big-endian}}

# 1.16 output possibly broken, missing substs.
test fumagic.filetype-1.16 {test binary pdf} {
    set f [file join $dir fileTypeTest pdfFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    list $res $msg
} {0 {PDF document , version %c .%c}}

test fumagic.filetype-1.17 {test text ps} {
    set f [file join $dir fileTypeTest psFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    list $res $msg
} {0 {PostScript document text}}

test fumagic.filetype-1.18 {test text eps} {
    set f [file join $dir fileTypeTest epsFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    list $res $msg
} {0 {PostScript document text}}

test fumagic.filetype-1.19 {test binary gravity_wave_data_frame} {
    set f [file join $dir fileTypeTest igwdFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    list $res $msg
} {0 {}}

test fumagic.filetype-1.20 {test binary compressed bzip} {
    set f [file join $dir fileTypeTest bzipFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    list $res $msg
} {0 {bzip2 compressed data bzip compressed data , version: %c , compression block size 900k}}

test fumagic.filetype-1.21 {test binary compressed gzip} {
    set f [file join $dir fileTypeTest gzipFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    list $res $msg
} {0 {gzip compressed data , unknown method , ASCII , from MS-DOS}}


::tcltest::cleanupTests
return