1##############################################################################
2##############################################################################
3#                               Commands.tcl
4##############################################################################
5##############################################################################
6# Here you will implemented a few helpful procedures that don't quite fit
7# anywhere else.
8##############################################################################
9##############################################################################
10# Copyright 2000-2001 Andr�s Garc�a Garc�a  -- fandom@telefonica.net
11# Distributed under the terms of the GPL v2
12##############################################################################
13##############################################################################
14
15namespace eval Commands {
16
17set sedIndex 0
18
19##############################################################################
20# PlaceWindow
21#    Places a given window in the screen, it makes sure the window won't go
22#    out of the screen, unless it is way too big of course.
23#
24# Parameters:
25#    win: Path of the window.
26#    x,y: The coordinates where we want the top-left corner to be placed,
27#         unless that wouldn't allow the the whole window to be seen.
28#    width,height: Width and height of the window.
29##############################################################################
30proc PlaceWindow {win x y width height} {
31
32    set screenWidth  [winfo screenwidth  $win]
33    set screenHeight [winfo screenheight $win]
34
35    if {[expr $x + $width + 15]>$screenWidth} {
36        set x [expr {$screenWidth - $width - 15}]
37    }
38    if {[expr $y + $height + 30]>$screenHeight} {
39
40        set y [expr {$screenHeight - $height - 30}]
41    }
42    if {$x<0} {
43        set x 0
44    }
45    if {$y<0} {
46        set y 0
47    }
48    wm geometry $win ${width}x$height+$x+$y
49    return
50}
51
52##############################################################################
53# Touch
54#    This procedure will create an empty file
55#
56# Parameters:
57#    fileName: The file to create.
58##############################################################################
59proc Touch {fileName} {
60
61    if {![file exists "$fileName"]} {
62        set handle [open "$fileName" w]
63        close $handle
64    }
65    return
66}
67
68##############################################################################
69# SedReadFile
70#    Reads a given file into memory for the pseudosed command to work on.
71#
72# Parameters:
73#    fileName: The file to read.
74#
75# Returns:
76#    - '0' if all went well.
77#    - '1' if not.
78##############################################################################
79proc SedReadFile {fileName} {
80    variable workFile
81    variable workFileLines
82
83    catch {unset workFile}
84    if {[catch {open "$fileName" r} handle]} {
85        return 1
86    }
87    set workFileLines ""
88    for {set i 0} {![eof $handle]} {incr i} {
89        set workFile($i) [gets $handle]
90        if {[regexp {=} $workFile($i)]} {
91            lappend workFileLines $i
92        }
93    }
94    close $handle
95
96    return 0
97}
98
99##############################################################################
100# SedWriteFile
101#     Saves whatever is in the workFile array into the given file. The file
102#     must not already exist.
103#
104# Parameter:
105#     fileName: file to use to save the data.
106#
107# Returns:
108#    - '0' if all went well.
109#    - '1' if not.
110##############################################################################
111proc SedWriteFile {fileName} {
112    variable workFile
113
114    if {[catch {open "$fileName" w} handle]} {
115        return 1
116    }
117    for {set i 0} {![catch "set workFile($i)"]} {incr i} {
118        puts $handle "$workFile($i)"
119    }
120    close $handle
121
122    return 0
123}
124
125##############################################################################
126# DeRexString
127#     Prepares a string so that it is safe to use it in a regular expresion,
128#     for example, all '+' are changed to '\+'.
129#
130# Parameters:
131#    - old: The string to make safe.
132#
133# Returns:
134#    The string now safe.
135##############################################################################
136proc DeRexString {old} {
137
138    set old [string map {../ \\.\\./ ./ \\./ * \\* + \\+ ? \\? ) \\)      \
139            ( \\( ] \\] [ \\[ $ \\$} $old]
140
141    return $old
142}
143
144##############################################################################
145# SedChangeEnter
146#     Enters a new change in to the 'sedChanges' array.
147#
148# Parameters:
149#    - old: The regular expresion to subtitute.
150#    - new: The substitute.
151##############################################################################
152proc SedChangeEnter {old new} {
153    variable sedChanges
154    variable sedIndex
155
156    if {$old eq $new} {
157        return
158    }
159
160    if {$new eq ""} {
161        set sedChanges($sedIndex,old) $old
162        set sedChanges($sedIndex,new) $new
163
164        incr sedIndex
165
166        set sedChanges($sedIndex,old) ""
167        set sedChanges($sedIndex,new) ""
168
169        incr sedIndex
170
171        return
172    }
173
174    set old [DeRexString $old]
175    regsub -all {&}   $new {\\&}  new
176
177    set oldLink "(href|src)(\\s*)(=)(\\s*)(\'|\")($old)(\"|\')"
178    set newLink "\\1=\"$new\""
179
180    set sedChanges($sedIndex,old) $oldLink
181    set sedChanges($sedIndex,new) $newLink
182
183    set oldLink "(href|src)(\\s*)(=)(\\s*)($old)(\ |>)"
184    set newLink "\\1=\"$new\"\\6"
185
186    incr sedIndex
187
188    set sedChanges($sedIndex,old) $oldLink
189    set sedChanges($sedIndex,new) $newLink
190
191    incr sedIndex
192
193    return
194}
195
196##############################################################################
197# SedChange
198#     Goes through the file in 'workFile' chaging one link.
199#
200# Parameter:
201#     index: The index of the link to change in the sedChanges variable.
202#
203# Returns:
204#    - '0' if there was no change.
205#    - '1' if a change was found.
206##############################################################################
207proc SedChange {index} {
208    variable workFile
209    variable sedChanges
210    variable startLine
211    variable workFileLines
212
213    set old $sedChanges($index,old)
214    set new $sedChanges($index,new)
215    for {set i $startLine} {1} {incr i} {
216        set line [lindex $workFileLines $i]
217        if {$line==""} {
218            break
219        }
220        if {[regsub -nocase "$old" $workFile($line) "$new" workFile($line)]} {
221            set startLine $i
222            return 1
223        }
224    }
225    return 0
226}
227
228############################################################################
229# Sed
230#     Goes through a given file and makes the requested changes to it.
231#
232# Parameter:
233#     fileName: file to change.
234#
235# Returns:
236#    - '0' if all went well.
237#    - '1' if not.
238##############################################################################
239proc Sed {fileName} {
240    variable workFile
241    variable sedChanges
242    variable sedIndex
243    variable startLine
244
245    if {[file exists $fileName.html]} {
246        set fileName $fileName.html
247    }
248    if {[SedReadFile $fileName]==1} {return 1}
249
250    for {set i 0 ; set startLine 0} {![catch "set sedChanges($i,old)"]} {incr i} {
251        if {([SedChange $i]==1)&&([expr {$i%2}]==0)} {
252            incr i
253        }
254    }
255
256    catch {unset sedChanges}
257    set sedIndex 0
258
259    if {[SedWriteFile $fileName]==1} {return 1}
260
261    return 0
262}
263
264###############################################################################
265# ChangePage
266#    Changes a html page, so that there is consistency with the local
267#    directories. After this procedure is run through a page all it's links
268#    should be between double qoutes ("), the ones that have been downloaded
269#    will be relative to the the current directory and the ones that where
270#    not downloaded will have the complete url.
271#
272# Parameters
273#    url: The url of the page about to be changed.
274###############################################################################
275proc ChangePage {url} {
276    global siteUrl
277    global directories
278
279    if {$HtmlParser::baseTag!=""} {
280        Commands::SedChangeEnter <$HtmlParser::baseTag> ""
281    }
282
283    for {set i 1} {$i<$HtmlParser::nLinks} {incr i} {
284        set link    $HtmlParser::links($i,file)
285        # Even if we now filter the file out, it may already be there
286        # due to a former download.
287        set file    [UrlToFile $HtmlParser::links($i,url) $directories(base)]
288        if {($HtmlParser::links($i,ok)==1)||([file exists $file])} {
289            set tag ""
290            regexp {(#)(.*)} $HtmlParser::links($i,url) tag
291            set newLink [RelativePath $url $HtmlParser::links($i,url)]
292            Commands::SedChangeEnter $link $newLink$tag
293        } else {
294	        set newLink $HtmlParser::links($i,url)
295            if {$link!=$newLink} {
296                Commands::SedChangeEnter $link $newLink
297            }
298        }
299    }
300
301    set fileName [UrlToFile $url $directories(base)]
302    if {[file exists $fileName.orig]} {
303        file copy -force $fileName.orig $fileName
304    } elseif {[file exists $fileName.html.orig]} {
305        file copy -force $fileName.html.orig $fileName.html
306    } elseif {[file exists $fileName.html]} {
307        file copy $fileName.html $fileName.html.orig
308    } else {
309        file copy $fileName $fileName.orig
310    }
311
312    Commands::Sed $fileName
313
314    return
315}
316
317###############################################################################
318# UrlToFile
319#    Given an Url this procedure will return the file in which it will be
320#    saved.
321#
322#    Extra care since Windows doesn't like certain names for directories.
323#
324# Parameters
325#    url: The url to process.
326#    baseDir: The local directory into which the site is saved.
327#
328# Returns:
329#    The file in which it will be saved complete with full path.
330###############################################################################
331proc UrlToFile {url {baseDir ""}} {
332    global getleftState
333
334    set parsedUrl [HtmlParser::ParseUrl $url]
335    set prot      [lindex $parsedUrl 0]
336    set domain    [string tolower [lindex $parsedUrl 1]]
337    set dir       [lindex $parsedUrl 2]
338    set file      [lindex $parsedUrl 3]
339
340    if {$file==""} {
341        if {$prot=="ftp"} {
342            set file index.txt
343        } else {
344            set file index.html
345        }
346    }
347
348    set fileName ${domain}$dir/$file
349    set fileName [TidyNames $fileName]
350    if {$baseDir==""} {
351        set baseDir $::directories(base)
352    }
353    set fileName [file join $baseDir $fileName]
354
355
356    while {[regexp {(?:%)([0-9ABCDEFabcdef][0-9ABCDEFabcdef])} $fileName nada tmp]} {
357        if {$tmp=="26"} {
358            set newTmp \\&
359        } else {
360            set newTmp [format "%c" "0x$tmp"]
361        }
362        regsub -all "%$tmp" $fileName "$newTmp" fileName
363    }
364
365    if {$getleftState(os)=="win"} {
366        regsub -nocase {(/)(com[1-9]|aux|nul|con|lpt[1-9])(/|\.|$)} $fileName    \
367                {/g\2\3} fileName
368    }
369
370    return $fileName
371}
372
373###############################################################################
374# TidyNames
375#    Removes from the name and path of files things like '?' '~' '+' '-'
376#
377# Returns
378#    The filename without those characters.
379###############################################################################
380proc TidyNamesOld {nombre} {
381
382    regsub -all {~}  $nombre {} nombre
383    regsub -all {\*} $nombre {} nombre
384    if {[regexp {(?:^.:)(.*)} $nombre nada filename]} {
385        regsub -all {:}  $filename {} filename
386        set nombre $filename
387    } else {
388        regsub -all {:} $nombre {} nombre
389    }
390    if {[regexp {([^\?]+)(?:\?)(.*)} $nombre nada uno dos]} {
391        regsub -all {\?} $dos {} dos
392        regsub -all {\+} $dos {} dos
393        regsub -all {/}  $dos {} dos
394        regsub -all {\\} $dos {} dos
395        set nombre $uno$dos
396    }
397    return $nombre
398}
399
400proc TidyNames {nombre} {
401    set nombre [string map     {~ "" * ""} $nombre]
402    regsub {(^.:)(.*)} $nombre {}           nombre
403    set nombre [string map     {: ""}      $nombre]
404
405    if {[regexp {([^\?]+)(?:\?)(.*)} $nombre nada uno dos]} {
406        set dos [string map {? "" + "" / "" \\ ""} $dos]
407        set nombre $uno$dos
408    }
409    return $nombre
410}
411
412###############################################################################
413# RelativePath
414#    The function returns the relative path from the referer page to the linked
415#    page.
416#
417# Parameter:
418#    urlRef. The referer page.
419#    urlNew: The url whose link we are calculating.
420#
421# Returns:
422#    The link for the changed page.
423###############################################################################
424proc RelativePath {urlRef urlNew} {
425    global directories siteUrl
426
427    set fileRef [UrlToFile $urlRef $directories(base)]
428    set fileNew [UrlToFile $urlNew $directories(base)]
429
430    regexp -nocase "(?:^$directories(base)/)(.*)" $fileRef nada fileRef
431    regexp -nocase "(?:^$directories(base)/)(.*)" $fileNew nada fileNew
432
433    set listDirRef [split [file dirname $fileRef] /]
434    foreach dir $listDirRef {
435        regsub -all {\+} $dir {\\+} dir
436        if {[regexp "(?:^$dir/)(.*)" $fileNew nada fileNew]} {
437             regexp "(?:^$dir/)(.*)" $fileRef nada fileRef
438        } else {
439            break
440        }
441    }
442    set jumps [regsub -all {/} $fileRef {} nada]
443    for {set i 0} {$i<$jumps} {incr i} {
444        set fileNew ../$fileNew
445    }
446
447    return $fileNew
448}
449
450}
451