Example

#####################################################################
# Name:           httpQuery
# Purpose:       Basic Message-driven HTTP query
# UPoC type:   tps
# Args:             tps keyedlist containing these keys:    
#                       MODE    run mode ("start", "run" or "test")
#                       MSGID   message handle
#                       ARGS    user-supplied arguments:
#####################################################################
proc httpQuery { args } {
     global cfgs
          keylget args MODE mode 
          set dispList {}
          switch -exact -- $mode {
               start 
               {
                    echo "I AM IN HTTPQUERY START\r"

                         # grab and store CFGS values for run mode -- 
                         # CFGS are only available in start mode.
                         keylget args CFGS cfgs
                    }

                    run 
                    {
                         echo "I AM IN HTTPQUERY RUN\r"

                         # fetch and process msgid
                         keylget args MSGID inMsg

                         # fetch the URL using the specified method
                         keylget cfgs METHOD method
                         switch -exact -- $method {
                              PUT {
                                   echo "HTTPPUT\r"
                                   set res [httpput $cfgs]
                                   }
                              POST {
                                   echo "HTTPPOST\r"
                                   set res [httppost $cfgs]
                              }
                              default {
                                   echo "DEFAULT (GET) \r"
                                   set res [httpget $cfgs]
                              }
                         }

                         # parse out the response
                         set status [keylget res "STATUS"]
                         set statCode [lindex $status 1]
                         set body [keylget res "BODY"]
 
                         if {$statCode == 200} {
                              # if OK, place msg into IB queue
                              set outMsg [msgcreate -type data $body]
                              lappend dispList "KILL $inMsg"
                              lappend dispList "OVER $outMsg"

                         } else {
                              # otherwise, report the error and send orig msg to error DB
                              echo "ERROR: Failed to fetch resource '$url'.\r"
                              echo "Fetch returned:\r$status\r"
                              error $inMsg
                         }
                    }
                    time 
                    {
                         echo "I AM IN HTTPQUERY TIME\r"
                         # Timer-based processing
                    }

                    default {
                    }
               }
     return $dispList
}
######################################################################
# Name:           httpFilesetFetch
# Purpose:       Fileset-style directory contents fetch for HTTP
# UPoC type:   tps
# Args:             tps keyedlist containing these keys:
#                       MODE    run mode ("start", "run" or "test")
#                       MSGID   message handle
#                       ARGS    user-supplied arguments:
#
######################################################################
proc httpFilesetFetch { args } {
     global srcDir
          global cfgs
               keylget args MODE mode
               keylget args CFGS cfgs
               keylget args ARGS userargs
               keylget userargs FOO foo
               set dispList {}
               switch -exact -- $mode {
                    start 
                        {
                        # Perform special init functions
                             echo "I AM IN FILESETFETCH START\r"
                             # grab and store CFGS values for run mode -- 
                             # CFGS are only available in start mode.
                        }
                   run
                        {
                             # Not used...
                             # httpFilesetFetch is timer-based, NOT message-driven.
                             echo "I AM IN FILESETFETCH RUN\r"
                         }
                   time 
                   {
                        echo "I AM IN FILESETFETCH TIME\r"
                        # Get a list of fetchable URLs contained in the directory
                        set urlList [httpDirParse $cfgs]
                        # Fetch each URL in the list
                        foreach url $urlList {
                             set new [list "URL" $url]
                             set res [httpget [linsert $cfgs 0 $new ]]
                             set status [keylget res "STATUS"]
                             set statCode [lindex $status 1]
                             set body [keylget res "BODY"]
                             if {$statCode == 200} {
                                  lappend dispList "OVER [msgcreate -type data $body]"
                             } else {
                                  error "ERROR: Failed to fetch resource '$url'.\rFetch returned:\r$status\r"
                                  }
                             }
                  }
                  default {
                  }
             }
     return $dispList
}


##############################################################
# Function for parsing a standard Apache-style web-server- 
#  generated HTML directory listing.  The function takes 
#  the same arguments as the httpget function, passing them
#  as-is to httpget.  It fetches the HTML directory index 
#  at the specified URL and returns a list of URLs that can
#  then be fetched individually. 
#################################################################
proc httpDirParse { args } {
          set arg0 [lindex $args 0]
          keylget arg0 URL url
          set resp [httpget $arg0 ]
          set dir1 [keylget resp "BODY"]
          set dir1 [string toupper $dir1]
          set p1 [string first "<A HREF" $dir1]
          while {$p1 >= 0} {
               set dir1 [string range $dir1 $p1 end]
               set p2 [string first "/A>" $dir1]
               set href [string range $dir1 0 $p2]
               set dir1 [string range $dir1 $p2 end]
               set q1 [string first "\"" $href]
               set q2 [string last "\"" $href]
               set ref [string range $href $q1 $q2]
               set ref [string trim $ref "\""]
                    if { [regexp {^[A-Z]} $ref] == 1} {
                              set eref $url
                              append eref [string tolower $ref]
                              lappend urls $eref
                    }
                    set p1 [string first "<A HREF" $dir1]
               }
               return $urls
}