1 # transmogrify.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1997-2002 The Regents of the University of California.
6 # All rights reserved.
7 #
8 # Redistribution and use in source and binary forms, with or without
9 # modification, are permitted provided that the following conditions are met:
10 #
11 # A. Redistributions of source code must retain the above copyright notice,
12 # this list of conditions and the following disclaimer.
13 # B. Redistributions in binary form must reproduce the above copyright notice,
14 # this list of conditions and the following disclaimer in the documentation
15 # and/or other materials provided with the distribution.
16 # C. Neither the names of the copyright holders nor the names of its
17 # contributors may be used to endorse or promote products derived from this
18 # software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30
31
32 Class Transmog
33
34
35 Transmog instproc parse_args { argv } {
36 $self instvar infile_ outfile_
37
38 set len [llength $argv]
39 set idx 0
40 while { $idx < $len } {
41 set option [lindex $argv $idx]
42 incr idx
43 switch -exact -- $option {
44 -in {
45 if { $idx >= $len } {
46 error "missing argument for\
47 -in"
48 }
49 set arg [lindex $argv $idx]
50 set infile_ [lindex $arg 0]
51 puts $infile_
52 incr idx
53 }
54 -out {
55 if { $idx >= $len } {
56 error "missing argument for\
57 -out"
58 }
59 set arg [lindex $argv $idx]
60 set outfile_ [lindex $arg 0]
61 puts $outfile_
62 incr idx
63 }
64
65
66 }
67 }
68 }
69
70 Transmog instproc run { } {
71 $self instvar infile_ outfile_
72
73 set df [new ArchiveFile/Data]
74 $df open "$infile_.dat"
75 set if [new ArchiveFile/Index]
76 $if open "$infile_.idx"
77
78 set odf [new ArchiveFile/Data]
79 $odf open "$outfile_.dat" "w" 0644
80 set idf [new ArchiveFile/Index]
81 $idf open "$outfile_.idx" "w" 0644
82
83 $df header hdr
84
85 set session [new Edit/$hdr(protocol) ]
86
87 $session datafile $df
88 $session indexfile $if
89 $session outdata $odf
90 $session outindex $idf
91
92 $session find_cut cuts
93 puts "Cuts: $cuts(875045939)"
94 #return $cuts
95 return 1
96 }
97
98
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.