Changeset 193


Ignore:
Timestamp:
Feb 19, 2006, 8:10:19 PM (19 years ago)
Author:
mmc
Message:
  • Added "Upload..." capability to the <loader> widget. You can now add an <upload> directive containing the path of the control that will receive data. A file is uploaded from the desktop and saved in the specified control.
  • Fixed download capability to work properly for all result types, including contour plots and molecules.
  • Added rappture::signal so we can catch SIGHUP and clean up the upload/download spool directory.
Location:
trunk/gui
Files:
3 added
18 edited

Legend:

Unmodified
Added
Removed

  • trunk/gui/Makefile.in

    r171 r193  
    2222  src/RpInit.c \
    2323  src/RpRlimit.c \
    24   src/RpRusage.c
     24  src/RpRusage.c \
     25  src/RpSignal.c
    2526SOURCES = $(RapptureGUI_SOURCES)
    2627
    … …  
    3536  RpInit.$(OBJEXT) \
    3637  RpRlimit.$(OBJEXT) \
    37   RpRusage.$(OBJEXT)
     38  RpRusage.$(OBJEXT) \
     39  RpSignal.$(OBJEXT)
    3840OBJECTS = $(RapptureGUI_OBJECTS)
    3941
    … …  
    266268RpRusage.$(OBJEXT): $(srcdir)/src/RpRusage.c
    267269        $(COMPILE) -c `@CYGPATH@ $(srcdir)/src/RpRusage.c` -o $@
     270
     271RpSignal.$(OBJEXT): $(srcdir)/src/RpSignal.c
     272        $(COMPILE) -c `@CYGPATH@ $(srcdir)/src/RpSignal.c` -o $@
    268273
    269274
    … …  
    342347        $(mkinstalldirs) $(pkglibdir)/filexfer
    343348        @for i in $(srcdir)/filexfer/filexfer.jar \
    344               $(srcdir)/filexfer/*.class; do \
     349              $(srcdir)/filexfer/*.class \
     350              $(srcdir)/filexfer/upload.html; do \
    345351            echo "Installing $$i" ; \
    346352            $(INSTALL_DATA) $$i $(DESTDIR)$(pkglibdir)/filexfer ; \

  • trunk/gui/scripts/analyzer.tcl

    r173 r193  
    5454    public method load {file}
    5555    public method clear {}
    56     public method download {}
     56    public method download {option}
    5757
    5858    protected method _plot {args}
    … …  
    198198        itk_component add download {
    199199            button $w.top.dl -text "Download..." -anchor w \
    200                 -command [itcl::code $this download]
     200                -command [itcl::code $this download now]
    201201        }
    202202        pack $itk_component(download) -side right -padx {4 0}
    … …  
    204204
    205205NOTE:  Your web browser must allow pop-ups from this site.  If your output does not appear, look for a 'pop-up blocked' message and enable pop-ups."
     206
     207        bind $itk_component(download) <Enter> \
     208            [itcl::code $this download coming]
    206209    }
    207210
    … …  
    521524
    522525# ----------------------------------------------------------------------
    523 # USAGE: download
     526# USAGE: download coming
     527# USAGE: download now
    524528#
    525529# Spools the current result so the user can download it.
    526530# ----------------------------------------------------------------------
    527 itcl::body Rappture::Analyzer::download {} {
     531itcl::body Rappture::Analyzer::download {option} {
    528532    if {[Rappture::filexfer::enabled]} {
    529533        set title [$itk_component(resultselector) value]
    530534        set page [$itk_component(resultselector) translate $title]
    531         if {$page != ""} {
    532             set ext ""
    533             set f [$itk_component(resultpages) page $page]
    534             foreach {ext data} [$f.rviewer download] break
    535             if {"" == $ext} {
    536                 Rappture::Tooltip::cue $itk_component(download) \
    537                     "Can't download this result."
    538                 return
    539             }
    540             regsub -all {[\ -\/\:-\@\{-\~]} $title {} title
    541             set file "$title$ext"
    542         } else {
    543             # this shouldn't happen
    544             set file error.html
    545             set data "<h1>Not Found</h1>There is no result selected."
    546         }
    547 
    548         if {[catch {Rappture::filexfer::spool $data $file} result]} {
    549             if {"no clients" == $result} {
    550                 Rappture::Tooltip::cue $itk_component(download) \
    551                     "Can't download this result.  Looks like you might be having trouble with the version of Java installed for your browser."
    552             } else {
    553                 error $result "    (while spooling result \"$title\")"
     535
     536        switch -- $option {
     537            coming {
     538                #
     539                # Warn result that a download is coming, in case
     540                # it needs to take a screen snap.
     541                #
     542                if {$page != ""} {
     543                    set f [$itk_component(resultpages) page $page]
     544                    $f.rviewer download coming
     545                }
     546            }
     547            now {
     548                #
     549                # Perform the actual download.
     550                #
     551                if {$page != ""} {
     552                    set ext ""
     553                    set f [$itk_component(resultpages) page $page]
     554                    foreach {ext data} [$f.rviewer download now] break
     555                    if {"" == $ext} {
     556                        Rappture::Tooltip::cue $itk_component(download) \
     557                            "Can't download this result."
     558                        return
     559                    }
     560                    regsub -all {[\ -\/\:-\@\{-\~]} $title {} title
     561                    set file "$title$ext"
     562                } else {
     563                    # this shouldn't happen
     564                    set file error.html
     565                    set data "<h1>Not Found</h1>There is no result selected."
     566                }
     567
     568                if {[catch {Rappture::filexfer::spool $data $file} result]} {
     569                    if {"no clients" == $result} {
     570                        Rappture::Tooltip::cue $itk_component(download) \
     571                            "Can't download this result.  Looks like you might be having trouble with the version of Java installed for your browser."
     572                    } else {
     573                        error $result "    (while spooling result \"$title\")"
     574                    }
     575                }
     576            }
     577            default {
     578                error "bad option \"$option\": should be coming, now"
    554579            }
    555580        }

  • trunk/gui/scripts/contourresult.tcl

    r136 r193  
    1717package require vtkinteraction
    1818package require BLT
     19package require Img
    1920
    2021blt::bitmap define ContourResult-reset {
    … …  
    8889    public method delete {args}
    8990    public method scale {args}
    90     public method download {}
     91    public method download {option}
    9192
    9293    protected method _rebuild {}
    … …  
    112113    private variable _limits       ;# autoscale min/max for all axes
    113114    private variable _view         ;# view params for 3D view
     115    private variable _download ""  ;# snapshot for download
    114116}
    115117
    … …  
    342344    pack $itk_component(legend) -side bottom -fill x
    343345
     346    #
     347    # Create a photo for download snapshots
     348    #
     349    set _download [image create photo]
     350
    344351    eval itk_initialize $args
    345352}
    … …  
    359366    rename $this-ren2 ""
    360367    rename $this-iren2 ""
     368
     369    image delete $_download
    361370}
    362371
    … …  
    486495
    487496# ----------------------------------------------------------------------
    488 # USAGE: download
     497# USAGE: download coming
     498# USAGE: download now
    489499#
    490500# Clients use this method to create a downloadable representation
    … …  
    493503# "string" is the data itself.
    494504# ----------------------------------------------------------------------
    495 itcl::body Rappture::ContourResult::download {} {
    496     return ""
     505itcl::body Rappture::ContourResult::download {option} {
     506    switch $option {
     507        coming {
     508            blt::winop snap $itk_component(area) $_download
     509        }
     510        now {
     511            #
     512            # Hack alert!  Need data in binary format,
     513            # so we'll save to a file and read it back.
     514            #
     515            set tmpfile /tmp/image[pid].jpg
     516            $_download write $tmpfile -format jpeg
     517            set fid [open $tmpfile r]
     518            fconfigure $fid -encoding binary -translation binary
     519            set bytes [read $fid]
     520            close $fid
     521            file delete -force $tmpfile
     522
     523            return [list .jpg $bytes]
     524        }
     525        default {
     526            error "bad option \"$option\": should be coming, now"
     527        }
     528    }
    497529}
    498530

  • trunk/gui/scripts/controlOwner.tcl

    r115 r193  
    2323    public method load {newobj}
    2424    public method widgetfor {path args}
     25    public method valuefor {path args}
    2526    public method changed {path}
    2627    public method notify {option owner args}
    … …  
    8485    } else {
    8586        unset _path2widget($path)
     87    }
     88}
     89
     90# ----------------------------------------------------------------------
     91# USAGE: valuefor <path> ?<newValue>?
     92#
     93# Used by embedded widgets such as a Loader to query or set the
     94# value of another control.  With no extra args, it returns the
     95# value of the widget at the <path> in the XML.  Otherwise, it
     96# sets the value of the widget to <newValue>.
     97# ----------------------------------------------------------------------
     98itcl::body Rappture::ControlOwner::valuefor {path args} {
     99    # if this is a query operation, then look for the path
     100    if {[llength $args] == 0} {
     101        if {[info exists _path2widget($path)]} {
     102            return [$_path2widget($path) value]
     103        }
     104        return ""
     105    }
     106
     107    # otherwise, set the value
     108    if {[llength $args] > 1} {
     109        error "wrong # args: should be \"valuefor path ?newValue?\""
     110    }
     111
     112    if {[info exists _path2widget($path)]} {
     113        $_path2widget($path) value [lindex $args 0]
     114    } else {
     115        error "bad path \"$path\": should be one of [join [lsort [array names _path2widget]] {, }]"
    86116    }
    87117}

  • trunk/gui/scripts/deviceEditor.tcl

    r168 r193  
    2727
    2828    public method value {args}
     29    public method download {option}
    2930
    3031    protected method _redraw {}
    … …  
    9899
    99100# ----------------------------------------------------------------------
     101# USAGE: download coming
     102# USAGE: download now
     103#
     104# Clients use this method to create a downloadable representation
     105# of the plot.  Returns a list of the form {ext string}, where
     106# "ext" is the file extension (indicating the type of data) and
     107# "string" is the data itself.
     108# ----------------------------------------------------------------------
     109itcl::body Rappture::DeviceEditor::download {option} {
     110    if {"" != $_current} {
     111        return [$_current download $option]
     112    }
     113    return ""
     114}
     115
     116# ----------------------------------------------------------------------
    100117# USAGE: _redraw
    101118#

  • trunk/gui/scripts/deviceViewer1D.tcl

    r115 r193  
    3333
    3434    public method controls {option args}
     35    public method download {option}
    3536                                                                               
    3637    protected method _loadDevice {}
    … …  
    161162        default {
    162163            error "bad option \"$option\": should be insert"
     164        }
     165    }
     166}
     167
     168
     169# ----------------------------------------------------------------------
     170# USAGE: download coming
     171# USAGE: download now
     172#
     173# Clients use this method to create a downloadable representation
     174# of the plot.  Returns a list of the form {ext string}, where
     175# "ext" is the file extension (indicating the type of data) and
     176# "string" is the data itself.
     177# ----------------------------------------------------------------------
     178itcl::body Rappture::DeviceViewer1D::download {option} {
     179    switch $option {
     180        coming {
     181            # nothing to do
     182        }
     183        now {
     184            return ""  ;# not implemented yet!
     185        }
     186        default {
     187            error "bad option \"$option\": should be coming, now"
    163188        }
    164189    }

  • trunk/gui/scripts/deviceresult.tcl

    r115 r193  
    2828    public method delete {args}
    2929    public method scale {args}
    30     public method download {}
     30    public method download {option}
    3131
    3232    set _dataobj ""  ;# data object currently being displayed
    … …  
    116116
    117117# ----------------------------------------------------------------------
    118 # USAGE: download
     118# USAGE: download coming
     119# USAGE: download now
    119120#
    120121# Clients use this method to create a downloadable representation
    … …  
    123124# "string" is the data itself.
    124125# ----------------------------------------------------------------------
    125 itcl::body Rappture::DeviceResult::download {} {
    126     return ""
     126itcl::body Rappture::DeviceResult::download {option} {
     127    return [$itk_component(viewer) download $option]
    127128}

  • trunk/gui/scripts/filexfer.tcl

    r171 r193  
    3333    variable buffer                    ;# request buffer for each client
    3434    variable access                    ;# maps spooled file => access cookie
     35    variable uploadcmds                ;# callbacks for upload forms
     36
     37    variable sitelogo ""               ;# HTML for site logo in upload form
     38    variable stylesheet ""             ;# URL for stylesheet address
    3539
    3640    # used to generate cookies -- see bakeCookie for details
    … …  
    5559        text/html                 .html   ascii
    5660        image/gif                 .gif    binary
    57         image/jpeg                .jpeg   binary
     61        image/jpeg                .jpg    binary
    5862        application/postscript    .ps     ascii
    5963        application/pdf           .pdf    binary
    … …  
    7882    $optionParser alias filexfer_port Rappture::filexfer::option_port
    7983    $optionParser alias filexfer_cookie Rappture::filexfer::option_cookie
     84    $optionParser alias filexfer_sitelogo Rappture::filexfer::option_sitelogo
     85    $optionParser alias filexfer_stylesheet Rappture::filexfer::option_stylesheet
    8086}
    8187
    … …  
    129135        }
    130136        set enabled 1
     137
     138        #
     139        # Clean up all spooled files when this program shuts down.
     140        # If we're running on nanoHUB, we'll get a SIGHUP signal
     141        # when it's time to quit.  On the desktop, we'll get a
     142        # <Destroy> event on the main window.
     143        #
     144        Rappture::signal SIGHUP filexfer Rappture::filexfer::cleanup
     145
     146        bind RapptureFilexfer <Destroy> Rappture::filexfer::cleanup
     147        set btags [bindtags .]
     148        set i [lsearch $btags RapptureFilexfer]
     149        if {$i < 0} {
     150            set btags [linsert $btags 0 RapptureFilexfer]
     151            bindtags . $btags
     152        }
    131153    }
    132154    return $enabled
    … …  
    163185
    164186    if {$enabled} {
    165         set dir ~/data/sessions/$env(SESSION)
     187        # make a spool directory, if we don't have one already
     188        set dir ~/data/sessions/$env(SESSION)/spool
     189        if {![file exists $dir]} {
     190            catch {file mkdir $dir}
     191        }
     192
    166193        if {[file exists [file join $dir $filename]]} {
    167194            #
    … …  
    182209
    183210        set fid [open [file join $dir $filename] w]
    184         puts $fid $string
     211        fconfigure $fid -encoding binary -translation binary
     212        puts -nonewline $fid $string
    185213        close $fid
    186214
    … …  
    203231
    204232# ----------------------------------------------------------------------
     233# USAGE: Rappture::filexfer::upload <description> <callback>
     234#
     235# Clients use this to prompt the user to upload a file.  The string
     236# <description> is sent to the user in a web form, and the user is
     237# given the opportunity to upload a file.  If successful, the
     238# <callback> is invoked to handle the uploaded information.
     239# ----------------------------------------------------------------------
     240proc Rappture::filexfer::upload {desc callback} {
     241    variable enabled
     242    variable sitelogo
     243    variable stylesheet
     244    variable uploadcmds
     245
     246    if {$enabled} {
     247        set file [file join $RapptureGUI::library filexfer upload.html]
     248        set fid [open $file r]
     249        set html [read $fid]
     250        close $fid
     251
     252        set cookie [bakeCookie]
     253        set uploadcmds($cookie) $callback
     254
     255        set style ""
     256        if {"" != $stylesheet} {
     257            set style "<link rel=\"stylesheet\" type=\"text/css\" media=\"screen\" href=\"$stylesheet\"/>"
     258        }
     259
     260        set html [string map [list \
     261            @COOKIE@ $cookie \
     262            @DESCRIPTION@ $desc \
     263            @LOGO@ $sitelogo \
     264            @STYLESHEET@ $style \
     265        ] $html]
     266
     267        spool $html upload.html
     268    }
     269}
     270
     271# ----------------------------------------------------------------------
     272# USAGE: Rappture::filexfer::cleanup
     273#
     274# Called when the application is shutting down to clean up
     275# port and start acting like a filexfer server.  Returns 1 if the
     276# server was enabled, and 0 otherwise.
     277# ----------------------------------------------------------------------
     278proc Rappture::filexfer::cleanup {} {
     279    global env
     280    set spool [file join ~/data/sessions $env(SESSION) spool]
     281    file delete -force $spool
     282}
     283
     284# ----------------------------------------------------------------------
    205285# USAGE: Rappture::filexfer::accept <clientId> <address> <port>
    206286#
    … …  
    223303        fileevent $cid readable [list Rappture::filexfer::handler $cid]
    224304        #
    225         # Use auto cr/lf translation for input, but always use
    226         # binary mode for output.  Otherwise, we'll put out a
    227         # particular byte count for the body of a response, and
    228         # it will be wrong after Tcl transforms cr/lf.  Also, some
    229         # of our data is binary, and it has to be left alone.
    230         #
    231         fconfigure $cid -buffering line -translation {auto binary}
     305        # Use binary mode for both input and output, so the
     306        # byte counts (as in Content-Length:) are correct.
     307        #
     308        fconfigure $cid -buffering line -translation binary
    232309    }
    233310}
    … …  
    244321    if {[gets $cid line] < 0} {
    245322        # eof from client -- clean up
    246         cleanup $cid
     323        shutdown $cid
    247324    } else {
     325        # clip out trailing carriage returns
     326        regsub -all {\r$} $line "" line
     327
    248328        #
    249329        # Is the first line of the request?  Then make sure
    … …  
    256336        } elseif {[info exists buffer($cid)]} {
    257337            set line [string trim $line]
    258             if {"" != $line} {
     338            if {"" == $line} {
     339                regexp {^ *([A-Z]+) +} $buffer($cid) match type
     340                if {$type == "POST"} {
     341                    if {[regexp {Content-Length: *([0-9]+)} $buffer($cid) match len]} {
     342                        set buffer($cid-post) [read $cid $len]
     343                    }
     344                    # finished post... process below...
     345                } else {
     346                    # finished get or other op... process below...
     347                }
     348            } else {
    259349                append buffer($cid) "\n" $line
    260350                return
    … …  
    266356        } else {
    267357            response $cid error -message "Your browser sent a request that this server could not understand.<P>Malformed request: $line"
    268             cleanup $cid
     358            shutdown $cid
    269359            return
    270360        }
    271361
    272362        #
    273         # If a buffer already exists, then we're adding on
    274         # to it.  Look for optional header information.  Don't
    275         # parse it now--just add it to the buffer.  When we see
    276         # a blank line, we process the request all at once.
     363        # We've seen a blank line at the end of a request.
     364        # Time to process it...
    277365        #
    278366        set errmsg ""
    … …  
    318406                        request_GET $cid $url headers
    319407                    }
     408                    POST {
     409                        set postdata ""
     410                        if {[info exists buffer($cid-post)]} {
     411                            set postdata $buffer($cid-post)
     412                            unset buffer($cid-post)
     413                        }
     414                        request_POST $cid $url headers $postdata
     415                    }
    320416                    default {
    321417                        response $cid header \
    … …  
    327423            }
    328424            if {$headers(Connection) == "close"} {
    329                 cleanup $cid
     425                shutdown $cid
    330426            }
    331427        } elseif {$protocol == "RAPPTURE"} {
    … …  
    375471            if {[llength [split $part =]] == 2} {
    376472                foreach {key val} [split $part =] break
    377                 set post($key) $val
     473                set post($key) [urlDecode $val]
    378474            }
    379475        }
    … …  
    422518</html>
    423519} $port $user $cookie]
    424     } elseif {[regexp {^/?spool\/(.+)$} $url match tail]} {
     520    } elseif {[regexp {^/?spool\/([0-9]+)/(.+)$} $url match session tail]} {
    425521        #
    426522        # Send back a spooled file...
    427523        #
    428         set file [file join ~/data/sessions $tail]
     524        set file [file join ~/data/sessions $session spool $tail]
    429525        set fname [file tail $file]
    430526
    … …  
    438534        } else {
    439535            response $cid file -path $file -connection $headers(Connection)
    440             file delete -force $file
    441             unset access($fname)
    442536        }
    443537    } elseif {[regexp {^/?[a-zA-Z0-9_]+\.[a-zA-Z]+$} $url match]} {
    … …  
    462556
    463557# ----------------------------------------------------------------------
     558# USAGE: Rappture::filexfer::request_POST <clientId> <url> \
     559#          <headerVar> <postdata>
     560#
     561# Used internally to handle POST requests on this server.  Looks for
     562# the requested <url> and sends it back to <clientId> according to
     563# the headers in the <headerVar> array in the calling scope.
     564# ----------------------------------------------------------------------
     565proc Rappture::filexfer::request_POST {cid url headerVar postData} {
     566    global env
     567    variable access
     568    upvar $headerVar headers
     569
     570    #
     571    # Look for any ?foo=1&bar=2 data embedded in the URL...
     572    #
     573    if {[regexp -indices {\?[a-zA-Z0-9_]+\=} $url match]} {
     574        foreach {s0 s1} $match break
     575        set args [string range $url [expr {$s0+1}] end]
     576        set url [string range $url 0 [expr {$s0-1}]]
     577
     578        foreach part [split $args &] {
     579            if {[llength [split $part =]] == 2} {
     580                foreach {key val} [split $part =] break
     581                set post($key) [urlDecode $val]
     582            }
     583        }
     584    } elseif {[string length $postData] > 0} {
     585        #
     586        # If we have explicit POST data, then it is one of two
     587        # kinds.  It is either key=value&key=value&... or a
     588        # multipart key/value assignment with -------boundary
     589        # separators.
     590        #
     591        set part "single"
     592        if {[info exists headers(Content-Type)]} {
     593            set data $headers(Content-Type)
     594            regsub -all { *; *} $data "\n" data
     595            set type [lindex [split $data \n] 0]
     596            if {$type == "multipart/form-data"} {
     597                set part "multi"
     598                foreach assmt [lrange [split $data \n] 1 end] {
     599                    foreach {key val} [split $assmt =] break
     600                    if {$key == "boundary"} {
     601                        set boundary [string trimleft $val -]
     602                    }
     603                }
     604            }
     605        }
     606
     607        switch -- $part {
     608            single {
     609                # simple key=value&key=value&... case
     610                foreach assmt [split $postData &] {
     611                    if {[regexp {([^=]+)=(.*)} $assmt match key val]} {
     612                        set post($key) [urlDecode $val]
     613                    }
     614                }
     615            }
     616            multi {
     617                #
     618                # Multipart data:
     619                #  ----------------------------406765868666254505654602083
     620                #  Content-Disposition: form-data; name="key"
     621                #
     622                #  value
     623                #  ----------------------------406765868666254505654602083
     624                #  ...
     625                #
     626                regsub -all {\r\n} $postData "\n" postData
     627                set state "starting"
     628                foreach line [split $postData \n] {
     629                    switch $state {
     630                      starting {
     631                        if {[regexp "^-+$boundary" $line]} {
     632                          catch {unset element}
     633                          set state "header"
     634                        }
     635                      }
     636                      header {
     637                        if {"" == $line} {
     638                          set state "body"
     639                        } else {
     640                          if {[regexp {Content-Disposition:} $line]} {
     641                            regsub -all { *; *} $line "\n" line
     642                            foreach assmt [lrange [split $line \n] 1 end] {
     643                              foreach {key val} [split $assmt =] break
     644                              set element($key) [string trim $val \"]
     645                            }
     646                          }
     647                        }
     648                      }
     649                      body {
     650                        if {[regexp "^-+$boundary" $line]} {
     651                          if {[info exists element(name)]} {
     652                            set post($element(name)) $element(data)
     653                          }
     654                          catch {unset element}
     655                          set state "header"
     656                        } else {
     657                          if {[info exists element(data)]} {
     658                            append element(data) "\n"
     659                          }
     660                          append element(data) $line
     661                        }
     662                      }
     663                      default {
     664                        error "unknown state $state in post data"
     665                      }
     666                    }
     667                }
     668            }
     669            default {
     670                error "unknown content type"
     671            }
     672        }
     673    }
     674
     675    #
     676    # Interpret the URL and fulfill the request...
     677    #
     678    if {$url == "/upload"} {
     679        variable port
     680        variable cookie
     681        variable uploadcmds
     682
     683        if {[info exists post(callback)]
     684              && [info exists uploadcmds($post(callback))]} {
     685            # get the data -- either text or file
     686            set data $post($post(which))
     687
     688            # get the upload callback command
     689            set cmd $uploadcmds($post(callback))
     690            if {[catch "$cmd [list $data]" result]} {
     691                bgerror $result
     692            }
     693            unset uploadcmds($post(callback))
     694        }
     695
     696        #
     697        # Send back a response that closes the window that
     698        # posted this form.
     699        #
     700        response $cid header -status "200 OK" \
     701            -connection $headers(Connection)
     702        set s [clock seconds]
     703        set date [clock format $s -format {%a, %d %b %Y %H:%M:%S %Z}]
     704        puts $cid "Last-Modified: $date"
     705        response $cid body -type text/html -string {<html>
     706<head>
     707  <title>Upload Complete</title>
     708  <script language="JavaScript">
     709    setTimeout("window.close()",100);
     710  </script>
     711</head>
     712<body>
     713<b>Data uploaded successfully.  This window will now close.</b><br/>
     714If this window doesn't close automatically, feel free to close it manually.
     715</body>
     716</html>}
     717    } else {
     718        #
     719        # BAD FILE REQUEST:
     720        #   The user is trying to ask for a file outside of
     721        #   the normal filexfer installation.  Treat it the
     722        #   same as file not found.
     723        response $cid header \
     724            -status "404 Not Found" \
     725            -connection $headers(Connection)
     726        response $cid error -status "404 Not Found" -message "The requested URL $url was not found on this server."
     727    }
     728}
     729
     730# ----------------------------------------------------------------------
    464731# USAGE: request_REGISTER <clientId> <user> <address> <cookie>
    465732#
    … …  
    555822
    556823# ----------------------------------------------------------------------
    557 # USAGE: Rappture::filexfer::cleanup <clientId>
     824# USAGE: Rappture::filexfer::shutdown <clientId>
    558825#
    559826# Used internally to close and clean up a client connection.
    560827# Clears any data associated with the client.
    561828# ----------------------------------------------------------------------
    562 proc Rappture::filexfer::cleanup {cid} {
     829proc Rappture::filexfer::shutdown {cid} {
    563830    variable clients
    564831    variable buffer
    … …  
    715982
    716983# ----------------------------------------------------------------------
     984# USAGE: Rappture::filexfer::urlDecode <string>
     985#
     986# Used internally to decode a string in URL-encoded form back to
     987# its normal ASCII equivalent.  Returns the input string, but with
     988# any %XX characters translated back to their ASCII equivalents.
     989# ----------------------------------------------------------------------
     990proc Rappture::filexfer::urlDecode {string} {
     991    while {[regexp -indices {%[0-9A-Fa-f][0-9A-Fa-f]} $string match]} {
     992        foreach {p0 p1} $match break
     993        set hex [string range $string [expr {$p0+1}] $p1]
     994        set char [binary format c [scan $hex "%x"]]
     995        set string [string replace $string $p0 $p1 $char]
     996    }
     997    return $string
     998}
     999
     1000# ----------------------------------------------------------------------
    7171001# USAGE: isbinary <string>
    7181002#
    … …  
    7681052    set cookie $newcookie
    7691053}
     1054
     1055# ----------------------------------------------------------------------
     1056# USAGE: Rappture::filexfer::option_sitelogo <html>
     1057#
     1058# Called when the "filexfer_sitelogo" directive is encountered while
     1059# parsing the "resources" file.  Stores the html text for later use
     1060# in the filexfer upload form.  The site logo appears at the top of
     1061# the form to identify the hub site that issued the form.
     1062# ----------------------------------------------------------------------
     1063proc Rappture::filexfer::option_sitelogo {html} {
     1064    variable sitelogo
     1065    set sitelogo $html
     1066}
     1067
     1068# ----------------------------------------------------------------------
     1069# USAGE: Rappture::filexfer::option_stylesheet <url>
     1070#
     1071# Called when the "filexfer_stylesheet" directive is encountered while
     1072# parsing the "resources" file.  Stores the url for later use in the
     1073# filexfer upload form.  The style sheet customizes the form to have
     1074# a particular look for the hub site that issued the form.
     1075# ----------------------------------------------------------------------
     1076proc Rappture::filexfer::option_stylesheet {url} {
     1077    variable stylesheet
     1078    set stylesheet $url
     1079}

  • trunk/gui/scripts/imageresult.tcl

    r132 r193  
    1414package require Itk
    1515package require BLT
     16package require Img
    1617
    1718option add *ImageResult.width 3i widgetDefault
    … …  
    5657    public method delete {args}
    5758    public method scale {args}
    58     public method download {}
     59    public method download {option}
    5960
    6061    protected method _rebuild {args}
    … …  
    289290
    290291# ----------------------------------------------------------------------
    291 # USAGE: download
     292# USAGE: download coming
     293# USAGE: download now
    292294#
    293295# Clients use this method to create a downloadable representation
    … …  
    296298# "string" is the data itself.
    297299# ----------------------------------------------------------------------
    298 itcl::body Rappture::ImageResult::download {} {
    299     set top [_topimage]
    300     if {$top == ""} {
    301         return ""
    302     }
    303     return [list jpg [image data $top -format jpg]]
     300itcl::body Rappture::ImageResult::download {option} {
     301    switch $option {
     302        coming {
     303            # nothing to do
     304        }
     305        now {
     306            set top [_topimage]
     307            if {$top == ""} {
     308                return ""
     309            }
     310
     311            #
     312            # Hack alert!  Need data in binary format,
     313            # so we'll save to a file and read it back.
     314            #
     315            set tmpfile /tmp/image[pid].jpg
     316            $top write $tmpfile -format jpeg
     317            set fid [open $tmpfile r]
     318            fconfigure $fid -encoding binary -translation binary
     319            set bytes [read $fid]
     320            close $fid
     321            file delete -force $tmpfile
     322
     323            return [list .jpg $bytes]
     324        }
     325        default {
     326            error "bad option \"$option\": should be coming, now"
     327        }
     328    }
    304329}
    305330

  • trunk/gui/scripts/loader.tcl

    r120 r193  
    2929
    3030    protected method _newValue {}
     31    protected method _uploadValue {string}
    3132    protected method _tooltip {}
    3233
    3334    private variable _owner ""    ;# thing managing this control
    3435    private variable _path ""     ;# path in XML to this loader
     36
     37    private variable _uppath ""   ;# path to Upload... component
     38    private variable _updesc ""   ;# description for Upload... data
     39    private variable _upfilter "" ;# filter used for upload data
    3540}
    3641
    … …  
    6267
    6368    eval itk_initialize $args
     69
     70    #
     71    # If this loader has an <upload> section, then create that
     72    # entry first.
     73    #
     74    foreach comp [$_owner xml children -type upload $path] {
     75        set topath [$_owner xml get $path.$comp.to]
     76        if {"" != $topath} {
     77            set _uppath $topath
     78
     79            set desc [$_owner xml get $path.$comp.prompt]
     80            if {"" == $desc} {
     81                set desc "Use this form to upload data"
     82                set dest [$owner xml get $_uppath.about.label]
     83                if {"" != $dest} {
     84                    append desc " into the $dest area"
     85                }
     86                append desc "."
     87            }
     88            set _updesc $desc
     89
     90            $itk_component(combo) choices insert end @upload "Upload..."
     91            break
     92        }
     93    }
    6494
    6595    #
    … …  
    201231    set newval [$itk_component(combo) value]
    202232    set obj [$itk_component(combo) translate $newval]
    203     if {$obj != "" && $itk_option(-tool) != ""} {
     233    if {$obj == "@upload"} {
     234        if {[Rappture::filexfer::enabled]} {
     235            set status [catch {Rappture::filexfer::upload \
     236                $_updesc [itcl::code $this _uploadValue]} result]
     237            if {$status != 0} {
     238                if {$result == "no clients"} {
     239                    Rappture::Tooltip::cue $itk_component(combo) \
     240                        "Can't upload files.  Looks like you might be having trouble with the version of Java installed for your browser."
     241                } else {
     242                    bgerror $result
     243                }
     244            }
     245        } else {
     246            Rappture::Tooltip::cue $itk_component(combo) \
     247                "Can't upload data.  Upload is not enabled.  Is your SESSION variable set?  Is there an error in your session resources file?"
     248        }
     249    } elseif {$obj != "" && $itk_option(-tool) != ""} {
    204250        $itk_option(-tool) load $obj
    205251    }
    … …  
    222268    set obj [$itk_component(combo) translate $newval]
    223269    if {$obj != ""} {
    224         set label [$obj get about.label]
    225         if {[string length $label] > 0} {
    226             append str "\n\n$label"
    227         }
    228 
    229         set desc [$obj get about.description]
    230         if {[string length $desc] > 0} {
     270        if {$obj == "@upload"} {
     271            append str "\n\nUse this option to upload data from your desktop."
     272        } else {
     273            set label [$obj get about.label]
    231274            if {[string length $label] > 0} {
    232                 append str ":\n"
    233             } else {
    234                 append str "\n\n"
    235             }
    236             append str $desc
     275                append str "\n\n$label"
     276            }
     277
     278            set desc [$obj get about.description]
     279            if {[string length $desc] > 0} {
     280                if {[string length $label] > 0} {
     281                    append str ":\n"
     282                } else {
     283                    append str "\n\n"
     284                }
     285                append str $desc
     286            }
    237287        }
    238288    }
    239289    return [string trim $str]
     290}
     291
     292# ----------------------------------------------------------------------
     293# USAGE: _uploadValue
     294#
     295# Invoked automatically whenever the user has uploaded data from
     296# the "Upload..." option.  Takes the data value (passed as an
     297# argument) and loads into the destination widget.
     298# ----------------------------------------------------------------------
     299itcl::body Rappture::Loader::_uploadValue {string} {
     300    $itk_option(-tool) valuefor $_uppath $string
    240301}
    241302

  • trunk/gui/scripts/mainwin.tcl

    r115 r193  
    126126        -menu $itk_component(filemenu)
    127127    $itk_component(filemenu) add command -label "Exit" -underline 1 \
    128         -command exit
     128        -command {destroy .}
    129129
    130130    #

  • trunk/gui/scripts/meshresult.tcl

    r115 r193  
    4444    public method delete {args}
    4545    public method scale {args}
    46     public method download {}
     46    public method download {option}
    4747
    4848    protected method _rebuild {}
    … …  
    274274# "string" is the data itself.
    275275# ----------------------------------------------------------------------
    276 itcl::body Rappture::MeshResult::download {} {
    277     set psdata [$itk_component(plot) postscript output -maxpect 1]
    278 
    279     set cmds {
    280         set fout "mesh[pid].pdf"
    281         exec ps2pdf - $fout << $psdata
    282 
    283         set fid [open $fout r]
    284         fconfigure $fid -translation binary -encoding binary
    285         set pdfdata [read $fid]
    286         close $fid
    287 
    288         file delete -force $fout
    289     }
    290     if {[catch $cmds result] == 0} {
    291         return [list .pdf $pdfdata]
    292     }
    293     return [list .ps $psdata]
     276itcl::body Rappture::MeshResult::download {option} {
     277    switch $option {
     278        coming {
     279            # nothing to do
     280        }
     281        now {
     282            set psdata [$itk_component(plot) postscript output -maxpect 1]
     283
     284            set cmds {
     285                set fout "mesh[pid].pdf"
     286                exec ps2pdf - $fout << $psdata
     287
     288                set fid [open $fout r]
     289                fconfigure $fid -translation binary -encoding binary
     290                set pdfdata [read $fid]
     291                close $fid
     292
     293                file delete -force $fout
     294            }
     295            if {[catch $cmds result] == 0} {
     296                return [list .pdf $pdfdata]
     297            }
     298            return [list .ps $psdata]
     299        }
     300        default {
     301            error "bad option \"$option\": should be coming, now"
     302        }
     303    }
    294304}
    295305

  • trunk/gui/scripts/moleculeViewer.tcl

    r172 r193  
    1616package require vtkinteraction
    1717package require BLT
     18package require Img
    1819
    1920option add *MoleculeViewer.width 3i widgetDefault
    … …  
    6364
    6465    public method emblems {option}
     66    public method download {option}
    6567
    6668    protected method _clear {}
    … …  
    7981    private variable _limits     ;# limits of x/y/z axes
    8082    private variable _click      ;# info used for _move operations
     83    private variable _download "";# snapshot for download
    8184}
    8285                                                                               
    … …  
    213216
    214217    emblems on
     218
     219    # create a photo for download snapshots
     220    set _download [image create photo]
    215221}
    216222
    … …  
    225231    rename $this-map ""
    226232    rename $this-xyzconv ""
     233
     234    image delete $_download
     235}
     236
     237# ----------------------------------------------------------------------
     238# USAGE: download coming
     239# USAGE: download now
     240#
     241# Clients use this method to create a downloadable representation
     242# of the plot.  Returns a list of the form {ext string}, where
     243# "ext" is the file extension (indicating the type of data) and
     244# "string" is the data itself.
     245# ----------------------------------------------------------------------
     246itcl::body Rappture::MoleculeViewer::download {option} {
     247    switch $option {
     248        coming {
     249            blt::winop snap $itk_component(area) $_download
     250        }
     251        now {
     252            #
     253            # Hack alert!  Need data in binary format,
     254            # so we'll save to a file and read it back.
     255            #
     256            set tmpfile /tmp/image[pid].jpg
     257            $_download write $tmpfile -format jpeg
     258            set fid [open $tmpfile r]
     259            fconfigure $fid -encoding binary -translation binary
     260            set bytes [read $fid]
     261            close $fid
     262            file delete -force $tmpfile
     263
     264            return [list .jpg $bytes]
     265        }
     266        default {
     267            error "bad option \"$option\": should be coming, now"
     268        }
     269    }
    227270}
    228271

  • trunk/gui/scripts/resultviewer.tcl

    r136 r193  
    3333
    3434    public method plot {option args}
    35     public method download {}
     35    public method download {option}
    3636
    3737    protected method _plotAdd {xmlobj {settings ""}}
    … …  
    339339
    340340# ----------------------------------------------------------------------
    341 # USAGE: download
     341# USAGE: download coming
     342# USAGE: download now
    342343#
    343344# Clients use this method to create a downloadable representation
    … …  
    346347# "string" is the data itself.
    347348# ----------------------------------------------------------------------
    348 itcl::body Rappture::ResultViewer::download {} {
     349itcl::body Rappture::ResultViewer::download {option} {
    349350    if {"" == $_mode} {
    350351        return ""
    351352    }
    352     return [$_mode2widget($_mode) download]
     353    return [$_mode2widget($_mode) download $option]
    353354}
    354355

  • trunk/gui/scripts/textresult.tcl

    r115 r193  
    3131    public method delete {args}
    3232    public method scale {args}
    33     public method download {}
     33    public method download {option}
    3434
    3535    public method select {option args}
    … …  
    247247
    248248# ----------------------------------------------------------------------
    249 # USAGE: download
     249# USAGE: download coming
     250# USAGE: download now
    250251#
    251252# Clients use this method to create a downloadable representation
    … …  
    254255# "string" is the data itself.
    255256# ----------------------------------------------------------------------
    256 itcl::body Rappture::TextResult::download {} {
    257     return [list .txt [$itk_component(text) get 1.0 end]]
     257itcl::body Rappture::TextResult::download {option} {
     258    switch $option {
     259        coming {
     260            # nothing to do
     261        }
     262        now {
     263            return [list .txt [$itk_component(text) get 1.0 end]]
     264        }
     265        default {
     266            error "bad option \"$option\": should be coming, now"
     267        }
     268    }
    258269}
    259270

  • trunk/gui/scripts/valueresult.tcl

    r115 r193  
    2828    public method delete {args}
    2929    public method scale {args}
    30     public method download {}
     30    public method download {option}
    3131
    3232    set _dataobj ""  ;# data object currently being displayed
    … …  
    147147
    148148# ----------------------------------------------------------------------
    149 # USAGE: download
     149# USAGE: download coming
     150# USAGE: download now
    150151#
    151152# Clients use this method to create a downloadable representation
    … …  
    154155# "string" is the data itself.
    155156# ----------------------------------------------------------------------
    156 itcl::body Rappture::ValueResult::download {} {
    157     return ""
     157itcl::body Rappture::ValueResult::download {option} {
     158    switch $option {
     159        coming {
     160            # nothing to do
     161        }
     162        now {
     163            set lstr [$itk_component(label) cget -text]
     164            set vstr [$itk_component(value) cget -text]
     165            return [list .txt "$lstr: $vstr"]
     166        }
     167        default {
     168            error "bad option \"$option\": should be coming, now"
     169        }
     170    }
    158171}

  • trunk/gui/scripts/xyresult.tcl

    r134 r193  
    6565    public method delete {args}
    6666    public method scale {args}
    67     public method download {}
     67    public method download {option}
    6868
    6969    protected method _rebuild {}
    … …  
    415415
    416416# ----------------------------------------------------------------------
    417 # USAGE: download
     417# USAGE: download coming
     418# USAGE: download now
    418419#
    419420# Clients use this method to create a downloadable representation
    … …  
    422423# "string" is the data itself.
    423424# ----------------------------------------------------------------------
    424 itcl::body Rappture::XyResult::download {} {
    425     set psdata [$itk_component(plot) postscript output -maxpect 1]
    426 
    427     set cmds {
    428         set fout "xy[pid].pdf"
    429         exec ps2pdf - $fout << $psdata
    430 
    431         set fid [open $fout r]
    432         fconfigure $fid -translation binary -encoding binary
    433         set pdfdata [read $fid]
    434         close $fid
    435 
    436         file delete -force $fout
    437     }
    438     if {[catch $cmds result] == 0} {
    439         return [list .pdf $pdfdata]
    440     }
    441     return [list .ps $psdata]
     425itcl::body Rappture::XyResult::download {option} {
     426    switch $option {
     427        coming {
     428            # nothing to do
     429        }
     430        now {
     431            set psdata [$itk_component(plot) postscript output -maxpect 1]
     432
     433            set cmds {
     434                set fout "xy[pid].pdf"
     435                exec ps2pdf - $fout << $psdata
     436
     437                set fid [open $fout r]
     438                fconfigure $fid -translation binary -encoding binary
     439                set pdfdata [read $fid]
     440                close $fid
     441
     442                file delete -force $fout
     443            }
     444            if {[catch $cmds result] == 0} {
     445                return [list .pdf $pdfdata]
     446            }
     447            return [list .ps $psdata]
     448        }
     449        default {
     450            error "bad option \"$option\": should be coming, now"
     451        }
     452    }
    442453}
    443454

  • trunk/gui/src/RpInit.c

    r158 r193  
    2727        return TCL_ERROR;
    2828    }
     29    if (RpSignal_Init(interp) != TCL_OK) {
     30        return TCL_ERROR;
     31    }
    2932    return TCL_OK;
    3033}
Note: See TracChangeset for help on using the changeset viewer.