Posted to tcl by saedelaere at Thu Nov 19 17:34:43 GMT 2009view raw

  1. #!/usr/bin/env tclsh
  2.  
  3. # recorder.tcl
  4. # © Copyright 2007-2009 Christian Rapp <saedelaere@arcor.de>
  5. #
  6. # This program is free software; you can redistribute it and/or modify
  7. # it under the terms of the GNU General Public License as published by
  8. # the Free Software Foundation; either version 2 of the License, or
  9. # (at your option) any later version.
  10. #
  11. # This program is distributed in the hope that it will be useful,
  12. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. # GNU General Public License for more details.
  15. #
  16. # You should have received a copy of the GNU General Public License
  17. # along with this program; if not, write to the Free Software
  18. # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
  19. # MA 02110-1301, USA.
  20.  
  21. package require Tcl 8.5
  22.  
  23. #~ wm withdraw .
  24.  
  25. set ::option(appname) tv-viewer_recorder
  26.  
  27. #set processing_folder [file dirname [file normalize [info script]]]
  28. if {[file type [info script]] == "link" } {
  29. set where_is [file dirname [file normalize [file readlink [info script]]]]
  30. } else {
  31. set where_is [file dirname [file normalize [info script]]]
  32. }
  33. set where_is_home "$::env(HOME)/.tv-viewer"
  34.  
  35. proc recorderShowProgress { fdin fdout size bytes {error ""} } {
  36. if { $error != "" } {
  37. catch { chan close $fdin }
  38. catch { chan close $fdout }
  39. puts "$error"
  40. exit 1
  41. }
  42. if { [eof $fdin] } {
  43. catch { chan close $fdin }
  44. catch { chan close $fdout }
  45. } else {
  46. after idle [list fcopy $fdin $fdout -size $size \
  47. -command [list recorderShowProgress $fdin $fdout $size]]
  48. }
  49. }
  50.  
  51. set filename [lindex $::argv 0]
  52. set bufsize 8192
  53. set lifespan [lindex $::argv 2]
  54. set fdin [open [lindex $::argv 1] r]
  55. set fdout [open $filename w]
  56.  
  57. foreach chan [list $fdin $fdout] {
  58. chan configure $chan -encoding binary \
  59. -translation binary -buffersize $bufsize
  60. }
  61. chan copy $fdin $fdout -size $bufsize \
  62. -command [list recorderShowProgress $fdin $fdout $bufsize]
  63. if {"$lifespan" != "infinite"} {
  64. after [expr {$lifespan * 1000}] {
  65. catch { chan close $fdin }
  66. catch { chan close $fdout }
  67. exit 0
  68. }
  69. }