egghelp.org community Forum Index
[ egghelp.org home | forum home ]
egghelp.org community
Discussion of eggdrop bots, shell accounts and tcl scripts.
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Eggdrop RSS Syndication (rss-synd) v0.5b1
Goto page Previous  1, 2, 3 ... 23, 24, 25, 26  Next
 
Post new topic   Reply to topic    egghelp.org community Forum Index -> Script Support & Releases
View previous topic :: View next topic  
Author Message
speechles
Revered One


Joined: 26 Aug 2006
Posts: 1398
Location: emerald triangle, california (coastal redwoods)

PostPosted: Sun May 12, 2013 5:18 pm    Post subject: Reply with quote

littledaga wrote:
Output in channel is
Req 3962 - The_History_Channel_Battle_For_The_Pacific_EUR_PS3-Googlecus PAL BLURAY ggl-thcbftpe 48x50MB

Script is
"output" "\0037[a.b.console.ps3]\003 @@item!title@@"

How can I remove the req ID and PAL BLURAY ggl-thcbftpe 48x50MB.


"output" "\00307\\\[a.b.console.ps3\\\]\003 \[lindex \[split \"@@item!link@@\" =\] end\]"
"evaluate-tcl" "1"

Easier to grab the link since the dirname is attached on the end. Simple is better. ^_^
_________________
speechles' eggdrop tcl archive
Back to top
View user's profile Send private message
littledaga
Voice


Joined: 12 May 2013
Posts: 6
Location: Amsterdam

PostPosted: Mon May 13, 2013 8:33 am    Post subject: Reply with quote

Speechless thanks for your help.

If I wanted to catch the req ID from

http://abmoovee.allfilled.com/rss.php

Channel Output - [a.b.teevee] Unit.One.S01.DVDRip.XviD-ARCHiViST

Script - "output" "\00310[a.b.teevee]\003 @@item!title@@"

and if I wanted the req ID from

http://www.abgx.net/rss/abcp/posted.rss

How would I change the script

Script - "output" "\00307\\\[a.b.console.ps3\\\]\003 \[lindex \[split \"@@item!link@@\" =\] end\]"

Again thanks for your help, made my day.
Back to top
View user's profile Send private message Yahoo Messenger
speechles
Revered One


Joined: 26 Aug 2006
Posts: 1398
Location: emerald triangle, california (coastal redwoods)

PostPosted: Thu May 16, 2013 1:38 am    Post subject: Reply with quote

littledaga wrote:
Speechless thanks for your help.

If I wanted to catch the req ID from

http://abmoovee.allfilled.com/rss.php

Channel Output - [a.b.teevee] Unit.One.S01.DVDRip.XviD-ARCHiViST

Script - "output" "\00310[a.b.teevee]\003 @@item!title@@"

Code:
"output"      "\00310\\\[a.b.teevee\\\]\003 ReqID:\[string trim \[lindex \[split "@@item!link@@" =\] 1\]\] @@item!title@@"
"evaluate-tcl"    1


littledaga wrote:
and if I wanted the req ID from

http://www.abgx.net/rss/abcp/posted.rss

How would I change the script

Script - "output" "\00307\\\[a.b.console.ps3\\\]\003 \[lindex \[split \"@@item!link@@\" =\] end\]"

Code:
"output"    "\00307\\\[a.b.console.ps3\\\]\003 \[string trim \[lindex \[split "@@item!title@@" -\] 0\]\] \[lindex \[split \"@@item!link@@\" =\] end\]"
"evaluate-tcl"    1


littledaga wrote:
Again thanks for your help, made my day.

Enjoys.. Wink
_________________
speechles' eggdrop tcl archive
Back to top
View user's profile Send private message
littledaga
Voice


Joined: 12 May 2013
Posts: 6
Location: Amsterdam

PostPosted: Thu May 16, 2013 11:23 am    Post subject: Reply with quote

Hi Speechless

When I add the output you provided my eggdrop crashes with the following message

[17:21:14] list element in quotes followed by "@@item!title@@"" instead of space

while executing
"array set tmp $rss($feed)"
(procedure "::rss-synd::init" line 17)
invoked from within
"::rss-synd::init"
(file "scripts/rss-synd.tcl" line 1070)
invoked from within
"source scripts/rss-synd.tcl"
(file "eggdrop.conf" line 1477)

Please advise.
Back to top
View user's profile Send private message Yahoo Messenger
speechles
Revered One


Joined: 26 Aug 2006
Posts: 1398
Location: emerald triangle, california (coastal redwoods)

PostPosted: Thu May 16, 2013 2:00 pm    Post subject: Reply with quote

Code:
"output"      "\00310\\\[a.b.teevee\\\]\003 ReqID:\[string trim \[lindex \[split \"@@item!link@@\" =\] 1\]\] @@item!title@@"
"evaluate-tcl"    1


Code:
"output"    "\00307\\\[a.b.console.ps3\\\]\003 \[string trim \[lindex \[split \"@@item!title@@\" -\] 0\]\] \[lindex \[split \"@@item!link@@\" =\] end\]"
"evaluate-tcl"    1


Forgot to escape all the " sorries....
_________________
speechles' eggdrop tcl archive
Back to top
View user's profile Send private message
DoubleB
Voice


Joined: 19 May 2013
Posts: 1

PostPosted: Sun May 19, 2013 9:22 am    Post subject: Filter <em> </em> Reply with quote

Hi All.

Code:
# -*- tab-width: 4; indent-tabs-mode: t; -*-
# rss-synd.tcl -- 0.5.1
#
#   Highly configurable asynchronous RSS & Atom feed reader for Eggdrops
#     written in TCL. Supports multiple feeds, gzip compressed feeds,
#     automatically messaging channels with updates at set intervals,
#     custom private/channel triggers and more.
#
# Copyright (c) 2011 Andrew Scott, HM2K
#
# Name: RSS & Atom Syndication Script for Eggdrop
# Author: Andrew Scott <andrew.scott@wizzer-it.com>
# Author: HM2K <irc@hm2k.org>
# License: See LICENSE file
# Link: http://code.google.com/p/rss-synd/
# Tags: rss, atom, syndication
# Updated: 05-Jan-2011
#
###Usage
# See README file
#
###Revisions
# See HISTORY file

#
# Include Settings
#
if {[catch {source scripts/rss-synd-settings.tcl} err]} {
  putlog "Error: Could not load 'rss-synd-settings.tcl file.'";
}

proc ::rss-synd::init {args} {
   variable rss
   variable default
   variable version
   variable packages

   set version(number)   0.5.1
   set version(date)   "2012-02-27"

   package require http
   set packages(base64) [catch {package require base64}]; # http auth
   set packages(tls) [catch {package require tls}]; # https
   set packages(trf) [catch {package require Trf}]; # gzip compression

   foreach feed [array names rss] {
      array set tmp $default
      array set tmp $rss($feed)

      set required [list "announce-output" "trigger-output" "max-depth" "update-interval" "timeout" "channels" "output" "user-agent" "url" "database" "trigger-type" "announce-type"]
      foreach {key value} [array get tmp] {
         if {[set ptr [lsearch -exact $required $key]] >= 0} {
            set required [lreplace $required $ptr $ptr]
         }
      }

      if {[llength $required] == 0} {
         regsub -nocase -all -- {@@feedid@@} $tmp(trigger) $feed tmp(trigger)

         set ulist [regexp -nocase -inline -- {(http(?:s?))://(?:(.[^:]+:.[^@]+)?)(?:@?)(.*)} $tmp(url)]

         if {[llength $ulist] == 0} {
            putlog "\002RSS Error\002: Unable to parse URL, Invalid format for feed \"$feed\"."
            unset rss($feed)
            continue
         }

         set tmp(url) "[lindex $ulist 1]://[lindex $ulist 3]"

         if {[lindex $ulist 1] == "https"} {
            if {$packages(tls) != 0} {
               putlog "\002RSS Error\002: Unable to find tls package required for https, unloaded feed \"$feed\"."
               unset rss($feed)
               continue
            }

            ::http::register https 443 ::tls::socket
         }

         if {(![info exists tmp(url-auth)]) || ($tmp(url-auth) == "")} {
            set tmp(url-auth) ""

            if {[lindex $ulist 2] != ""} {
               if {$packages(base64) != 0} {
                  putlog "\002RSS Error\002: Unable to find base64 package required for http authentication, unloaded feed \"$feed\"."
                  unset rss($feed)
                  continue
               }

               set tmp(url-auth) [::base64::encode [lindex $ulist 2]]
            }
         }

         if {[regexp {^[0123]{1}:[0123]{1}$} $tmp(trigger-type)] != 1} {
            putlog "\002RSS Error\002: Invalid 'trigger-type' syntax for feed \"$feed\"."
            unset rss($feed)
            continue
         }

         set tmp(trigger-type) [split $tmp(trigger-type) ":"]

         if {([info exists tmp(charset)]) && ([lsearch -exact [encoding names] [string tolower $tmp(charset)]] < 0)} {
            putlog "\002RSS Error\002: Unable to load feed \"$feed\", unknown encoding \"$tmp(charset)\"."
            unset rss($feed)
            continue
         }
         
         if {([info exists tmp(feedencoding)]) && ([lsearch -exact [encoding names] [string tolower $tmp(feedencoding)]] < 0)} {
            putlog "\002RSS Error\002: Unable to load feed \"$feed\", unknown feedencoding \"$tmp(feedencoding)\"."
            unset rss($feed)
            continue
         }

         set tmp(updated) 0
         if {([file exists $tmp(database)]) && ([set mtime [file mtime $tmp(database)]] < [unixtime])} {
            set tmp(updated) [file mtime $tmp(database)]
         }

         set rss($feed) [array get tmp]
      } else {
         putlog "\002RSS Error\002: Unable to load feed \"$feed\", missing one or more required settings. \"[join $required ", "]\""
         unset rss($feed)
      }

      unset tmp
   }

   bind evnt -|- prerehash [namespace current]::deinit
   bind time -|- {* * * * *} [namespace current]::feed_get
   bind pubm -|- {* *} [namespace current]::trigger
   bind msgm -|- {*} [namespace current]::trigger

   putlog "\002RSS Syndication Script v$version(number)\002 ($version(date)): Loaded."
}

proc ::rss-synd::deinit {args} {
   catch {unbind evnt -|- prerehash [namespace current]::deinit}
   catch {unbind time -|- {* * * * *} [namespace current]::feed_get}
   catch {unbind pubm -|- {* *} [namespace current]::trigger}
   catch {unbind msgm -|- {*} [namespace current]::trigger}

   foreach child [namespace children] {
      catch {[set child]::deinit}
   }

   namespace delete [namespace current]
}

#
# Trigger Function
##

proc ::rss-synd::trigger {nick user handle args} {
   variable rss
   variable default

   set i 0
   set chan ""
   if {[llength $args] == 2} {
      set chan [lindex $args 0]
      incr i
   }
   set text [lindex $args $i]

   array set tmp $default

   if {[info exists tmp(trigger)]} {
      regsub -all -- {@@(.*?)@@} $tmp(trigger) "" tmp_trigger
      set tmp_trigger [string trimright $tmp_trigger]

      if {[string equal -nocase $text $tmp_trigger]} {
         set list_feeds [list]
      }
   }

   unset -nocomplain tmp tmp_trigger

   foreach name [array names rss] {
      array set feed $rss($name)

      if {(![info exists list_feeds]) && \
          ([string equal -nocase $text $feed(trigger)])} {
         if {(![[namespace current]::check_channel $feed(channels) $chan]) && \
             ([string length $chan] != 0)} {
            continue
         }

         set feed(nick) $nick

         if {$chan != ""} {
            set feed(type) [lindex $feed(trigger-type) 0]
            set feed(channels) $chan
         } else {
            set feed(type) [lindex $feed(trigger-type) 1]
            set feed(channels) ""
         }

         if {[catch {set data [[namespace current]::feed_read]} error] == 0} {
            if {![[namespace current]::feed_info $data]} {
               putlog "\002RSS Error\002: Invalid feed database file format ($feed(database))!"
               return
            }

            if {$feed(trigger-output) > 0} {
               set feed(announce-output) $feed(trigger-output)

               [namespace current]::feed_output $data
            }
         } else {
            putlog "\002RSS Warning\002: $error."
         }
      } elseif {[info exists list_feeds]} {
         if {$chan != ""} {
            # triggered from a channel
            if {[[namespace current]::check_channel $feed(channels) $chan]} {
               lappend list_feeds $feed(trigger)
            }
         } else {
            # triggered from a privmsg
            foreach tmp_chan $feed(channels) {
               if {([catch {botonchan $tmp_chan}] == 0) && \
                   ([onchan $nick $tmp_chan])} {
                  lappend list_feeds $feed(trigger)
                  continue
               }
            }
         }
      }
   }

   if {[info exists list_feeds]} {
      if {[llength $list_feeds] == 0} {
         lappend list_feeds "None"
      }

      lappend list_msgs "Available feeds: [join $list_feeds ", "]."

      if {$chan != ""} {
         set list_type [lindex $feed(trigger-type) 0]
         set list_targets $chan
      } else {
         set list_type [lindex $feed(trigger-type) 1]
         set list_targets ""
      }

      [namespace current]::feed_msg $list_type $list_msgs list_targets $nick
   }
}

#
# Feed Retrieving Functions
##

proc ::rss-synd::feed_get {args} {
   variable rss

   set i 0
   foreach name [array names rss] {
      if {$i == 3} { break }

      array set feed $rss($name)

      if {$feed(updated) <= [expr { [unixtime] - ($feed(update-interval) * 60) }]} {
         ::http::config -useragent $feed(user-agent)

         set feed(type) $feed(announce-type)
         set feed(headers) [list]

         if {$feed(url-auth) != ""} {
            lappend feed(headers) "Authorization" "Basic $feed(url-auth)"
         }

         if {([info exists feed(enable-gzip)]) && ($feed(enable-gzip) == 1)} {
            lappend feed(headers) "Accept-Encoding" "gzip"
         }

         catch {::http::geturl "$feed(url)" -command "[namespace current]::feed_callback {[array get feed] depth 0}" -timeout $feed(timeout) -headers $feed(headers)} debug

         set feed(updated) [unixtime]
         set rss($name) [array get feed]
         incr i
      }

      unset feed
   }
}

proc ::rss-synd::feed_callback {feedlist args} {
   set token [lindex $args end]
   array set feed $feedlist

   upvar 0 $token state

   if {[set status $state(status)] != "ok"} {
      if {$status == "error"} { set status $state(error) }
      putlog "\002RSS HTTP Error\002: $state(url) (State: $status)"
      ::http::cleanup $token
      return 1
   }

   array set meta $state(meta)

   if {([::http::ncode $token] == 302) || ([::http::ncode $token] == 301)} {
      set feed(depth) [expr {$feed(depth) + 1 }]

      if {$feed(depth) < $feed(max-depth)} {
         catch {::http::geturl "$meta(Location)" -command "[namespace current]::feed_callback {$feedlist}" -timeout $feed(timeout) -headers $feed(headers)}
      } else {
         putlog "\002RSS HTTP Error\002: $state(url) (State: timeout, max refer limit reached)"
      }

      ::http::cleanup $token
      return 1
   } elseif {[::http::ncode $token] != 200} {
      putlog "\002RSS HTTP Error\002: $state(url) ($state(http))"
      ::http::cleanup $token
      return 1
   }

   set data [::http::data $token]
   
   if {[info exists feed(feedencoding)]} {
      set data [encoding convertfrom [string tolower $feed(feedencoding)] $data]
   }

   if {[info exists feed(charset)]} {
      if {[string tolower $feed(charset)] == "utf-8" && [is_utf8_patched]} {
         #do nothing, already utf-8
      } else {
         set data [encoding convertto [string tolower $feed(charset)] $data]
      }
   }

   if {([info exists meta(Content-Encoding)]) && \
       ([string equal $meta(Content-Encoding) "gzip"])} {
      if {[catch {[namespace current]::feed_gzip $data} data] != 0} {
         putlog "\002RSS Error\002: Unable to decompress \"$state(url)\": $data"
         ::http::cleanup $token
         return 1
      }
   }

   if {[catch {[namespace current]::xml_list_create $data} data] != 0} {
      putlog "\002RSS Error\002: Unable to parse feed properly, parser returned error. \"$state(url)\""
      ::http::cleanup $token
      return 1
   }

   if {[string length $data] == 0} {
      putlog "\002RSS Error\002: Unable to parse feed properly, no data returned. \"$state(url)\""
      ::http::cleanup $token
      return 1
   }

   set odata ""
   if {[catch {set odata [[namespace current]::feed_read]} error] != 0} {
      putlog "\002RSS Warning\002: $error."
   }

   if {![[namespace current]::feed_info $data]} {
      putlog "\002RSS Error\002: Invalid feed format ($state(url))!"
      ::http::cleanup $token
      return 1
   }

   ::http::cleanup $token

   if {[catch {[namespace current]::feed_write $data} error] != 0} {
      putlog "\002RSS Database Error\002: $error."
      return 1
   }

   if {$feed(announce-output) > 0} {
      [namespace current]::feed_output $data $odata
   }
}

proc ::rss-synd::feed_info {data {target "feed"}} {
   upvar 1 $target feed
   set length [[namespace current]::xml_get_info $data [list -1 "*"]]

   for {set i 0} {$i < $length} {incr i} {
      set type [[namespace current]::xml_get_info $data [list $i "*"] "name"]

      # tag-name: the name of the element that contains each article and its data
      # tag-list: the position in the xml structure where all 'tag-name' reside
      switch [string tolower $type] {
         rss {
            # RSS v0.9x & x2.0
            set feed(tag-list) [list 0 "channel"]
            set feed(tag-name) "item"
            break
         }
         rdf:rdf {
            # RSS v1.0
            set feed(tag-list) [list]
            set feed(tag-name) "item"
            break
         }
         feed {
            # ATOM
            set feed(tag-list) [list]
            set feed(tag-name) "entry"
            break
         }
      }
   }

   if {![info exists feed(tag-list)]} {
      return 0
   }

   set feed(tag-feed) [list 0 $type]

   return 1
}

# decompress gzip formatted data
proc ::rss-synd::feed_gzip {cdata} {
   variable packages

   if {(![info exists packages(trf)]) || \
       ($packages(trf) != 0)} {
      error "Trf package not found."
   }

   # remove the 10 byte gzip header and 8 byte footer
   set cdata [string range $cdata 10 [expr { [string length $cdata] - 9 } ]]

   # decompress the raw data
   if {[catch {zip -mode decompress -nowrap 1 $cdata} data] != 0} {
      error $data
   }

   return $data
}

proc ::rss-synd::feed_read { } {
   upvar 1 feed feed

   if {[catch {open $feed(database) "r"} fp] != 0} {
      error $fp
   }

   set data [read -nonewline $fp]

   close $fp

   return $data
}

proc ::rss-synd::feed_write {data} {
   upvar 1 feed feed

   if {[catch {open $feed(database) "w+"} fp] != 0} {
      error $fp
   }

   set data [string map { "\n" "" "\r" "" } $data]

   puts -nonewline $fp $data

   close $fp
}

#
# XML Functions
##

proc ::rss-synd::xml_list_create {xml_data} {
   set xml_list [list]
   set ns_current [namespace current]

   set ptr 0
   while {[set tag_start [${ns_current}::xml_get_position $xml_data $ptr]] != ""} {
      set tag_start_first [lindex $tag_start 0]
      set tag_start_last [lindex $tag_start 1]

      set tag_string [string range $xml_data $tag_start_first $tag_start_last]

      # move the pointer to the next character after the current tag
      set last_ptr $ptr
      set ptr [expr { $tag_start_last + 2 }]

      array set tag [list]
      # match 'special' tags that dont close
      if {[regexp -nocase -- {^!(\[CDATA|--|DOCTYPE)} $tag_string]} {
         set tag_data $tag_string

         regexp -nocase -- {^!\[CDATA\[(.*?)\]\]$} $tag_string -> tag_data
         regexp -nocase -- {^!--(.*?)--$} $tag_string -> tag_data

         if {[info exists tag_data]} {
            set tag(data) [${ns_current}::xml_escape $tag_data]
         }
      } else {
         # we should only ever encounter opening tags, if we hit a closing one somethings wrong
         if {[string match {[/]*} $tag_string]} {
            putlog "\002RSS Malformed Feed\002: Tag not open: \"<$tag_string>\" ($tag_start_first => $tag_start_last)"
            continue
         }

         # split up the tag name and attributes
         regexp -- {(.[^ \/\n\r]*)(?: |\n|\r\n|\r|)(.*?)$} $tag_string -> tag_name tag_args
         set tag(name) [${ns_current}::xml_escape $tag_name]

         # split up all of the tags attributes
         set tag(attrib) [list]
         if {[string length $tag_args] > 0} {
            set values [regexp -inline -all -- {(?:\s*|)(.[^=]*)=["'](.[^"']*)["']} $tag_args]

            foreach {r_match r_tag r_value} $values {
               lappend tag(attrib) [${ns_current}::xml_escape $r_tag] [${ns_current}::xml_escape $r_value]
            }
         }

         # find the end tag of non-self-closing tags
         if {(![regexp {(\?|!|/)(\s*)$} $tag_args]) || \
             (![string match "\?*" $tag_string])} {
            set tmp_num 1
            set tag_success 0
            set tag_end_last $ptr

            # find the correct closing tag if there are nested elements
            #  with the same name
            while {$tmp_num > 0} {
               # search for a possible closing tag
               set tag_success [regexp -indices -start $tag_end_last -- "</$tag_name>" $xml_data tag_end]

               set last_tag_end_last $tag_end_last

               set tag_end_first [lindex $tag_end 0]
               set tag_end_last [lindex $tag_end 1]

               # check to see if there are any NEW opening tags within the
               #  previous closing tag and the new closing one
               incr tmp_num [regexp -all -- "<$tag_name\(\[\\s\\t\\n\\r\]+\(\[^/>\]*\)?\)?>" [string range $xml_data $last_tag_end_last $tag_end_last]]

               incr tmp_num -1
            }

            if {$tag_success == 0} {
               putlog "\002RSS Malformed Feed\002: Tag not closed: \"<$tag_name>\""
               return
            }

            # set the pointer to after the last closing tag
            set ptr [expr { $tag_end_last + 1 }]

            # remember tag_start*'s character index doesnt include the tag start and end characters
            set xml_sub_data [string range $xml_data [expr { $tag_start_last + 2 }] [expr { $tag_end_first - 1 }]]

            # recurse the data within the currently open tag
            set result [${ns_current}::xml_list_create $xml_sub_data]

            # set the list data returned from the recursion we just performed
            if {[llength $result] > 0} {
               set tag(children) $result

            # set the current data we have because we're already at the end of a branch
            #  (ie: the recursion didnt return any data)
            } else {
               set tag(data) [${ns_current}::xml_escape $xml_sub_data]
            }
         }
      }

      # insert any plain data that appears before the current element
      if {$last_ptr != [expr { $tag_start_first - 1 }]} {
         lappend xml_list [list "data" [${ns_current}::xml_escape [string range $xml_data $last_ptr [expr { $tag_start_first - 2 }]]]]
      }

      # inset tag data
      lappend xml_list [array get tag]

      unset tag
   }

   # if there is still plain data left add it
   if {$ptr < [string length $xml_data]} {
      lappend xml_list [list "data" [${ns_current}::xml_escape [string range $xml_data $ptr end]]]
   }

   return $xml_list
}

# simple escape function
proc ::rss-synd::xml_escape {string} {
   regsub -all -- {([\{\}])} $string {\\\1} string

   return $string
}

# this function is to replace:
#  regexp -indices -start $ptr {<(!\[CDATA\[.+?\]\]|!--.+?--|!DOCTYPE.+?|.+?)>} $xml_data -> tag_start
# which doesnt work correctly with tcl's re_syntax
proc ::rss-synd::xml_get_position {xml_data ptr} {
   set tag_start [list -1 -1]

   regexp -indices -start $ptr {<(.+?)>} $xml_data -> tmp(tag)
   regexp -indices -start $ptr {<(!--.*?--)>} $xml_data -> tmp(comment)
   regexp -indices -start $ptr {<(!DOCTYPE.+?)>} $xml_data -> tmp(doctype)
   regexp -indices -start $ptr {<(!\[CDATA\[.+?\]\])>} $xml_data -> tmp(cdata)

   # 'tag' regexp should be compared last
   foreach name [lsort [array names tmp]] {
      set tmp_s [split $tmp($name)]
      if {( ([lindex $tmp_s 0] < [lindex $tag_start 0]) && \
            ([lindex $tmp_s 0] > -1) ) || \
            ([lindex $tag_start 0] == -1)} {
         set tag_start $tmp($name)
      }
   }

   if {([lindex $tag_start 0] == -1) || \
       ([lindex $tag_start 1] == -1)}  {
      set tag_start ""
   }

   return $tag_start
}

# recursivly flatten all data without tags or attributes
proc ::rss-synd::xml_list_flatten {xml_list {level 0}} {
   set xml_string ""

   foreach e_list $xml_list {
      if {[catch {array set e_array $e_list}] != 0} {
         return $xml_list
      }

      if {[info exists e_array(children)]} {
         append xml_string [[namespace current]::xml_list_flatten $e_array(children) [expr { $level + 1 }]]
      } elseif {[info exists e_array(data)]} {
         append xml_string $e_array(data)
      }

      unset e_array
   }

   return $xml_string
}

# returns information on a data structure when given a path.
#  paths can be specified using: [struct number] [struct name] <...>
proc ::rss-synd::xml_get_info {xml_list path {element "data"}} {
   set i 0

   foreach {t_data} $xml_list {
      array set t_array $t_data

      # if the name doesnt exist set it so we can still reference the data
      #  using the 'stuct name' *
      if {![info exists t_array(name)]} {
         set t_array(name) ""
      }

      if {[string match -nocase [lindex $path 1] $t_array(name)]} {

         if {$i == [lindex $path 0]} {
            set result ""

            if {([llength $path] == 2) && \
                ([info exists t_array($element)])} {
               set result $t_array($element)
            } elseif {[info exists t_array(children)]} {
               # shift the first path reference of the front of the path and recurse
               set result [[namespace current]::xml_get_info $t_array(children) [lreplace $path 0 1] $element]
            }

            return $result
         }

         incr i
      }

      unset t_array
   }

   if {[lindex $path 0] == -1} {
      return $i
   }
}

# converts 'args' into a list in the same order
proc ::rss-synd::xml_join_tags {args} {
   set list [list]

   foreach tag $args {
      foreach item $tag {
         if {[string length $item] > 0} {
            lappend list $item
         }
      }
   }

   return $list
}

#
# Output Feed Functions
##

proc ::rss-synd::feed_output {data {odata ""}} {
   upvar 1 feed feed
   set msgs [list]

   set path [[namespace current]::xml_join_tags $feed(tag-feed) $feed(tag-list) -1 $feed(tag-name)]
   set count [[namespace current]::xml_get_info $data $path]

   for {set i 0} {($i < $count) && ($i < $feed(announce-output))} {incr i} {
      set tmpp [[namespace current]::xml_join_tags $feed(tag-feed) $feed(tag-list) $i $feed(tag-name)]
      set tmpd [[namespace current]::xml_get_info $data $tmpp "children"]

      if {[[namespace current]::feed_compare $odata $tmpd]} {
         break
      }

      set tmp_msg [[namespace current]::cookie_parse $data $i]
      if {(![info exists feed(output-order)]) || \
          ($feed(output-order) == 0)} {
         set msgs [linsert $msgs 0 $tmp_msg]
      } else {
         lappend msgs $tmp_msg
      }
   }

   set nick [expr {[info exists feed(nick)] ? $feed(nick) : ""}]

   [namespace current]::feed_msg $feed(type) $msgs $feed(channels) $nick
}

proc ::rss-synd::feed_msg {type msgs targets {nick ""}} {
   # check if our target is a nick
   if {(($nick != "") && \
        ($targets == "")) || \
       ([regexp -- {[23]} $type])} {
      set targets $nick
   }

   foreach msg $msgs {
      foreach chan $targets {
         if {([catch {botonchan $chan}] == 0) || \
             ([regexp -- {^[#&]} $chan] == 0)} {
            foreach line [split $msg "\n"] {
               if {($type == 1) || ($type == 3)} {
                  putserv "NOTICE $chan :$line"
               } else {
                  putserv "PRIVMSG $chan :$line"
               }
            }
         }
      }
   }
}

proc ::rss-synd::feed_compare {odata data} {
   if {$odata == ""} {
      return 0
   }

   upvar 1 feed feed
   array set ofeed [list]
   [namespace current]::feed_info $odata "ofeed"

   if {[array size ofeed] == 0} {
      putlog "\002RSS Error\002: Invalid feed format ($feed(database))!"
      return 0
   }

   if {[string equal -nocase [lindex $feed(tag-feed) 1] "feed"]} {
      set cmp_items [list {0 "id"} "children" "" 3 {0 "link"} "attrib" "href" 2 {0 "title"} "children" "" 1]
   } else {
      set cmp_items [list {0 "guid"} "children" "" 3 {0 "link"} "children" "" 2 {0 "title"} "children" "" 1]
   }

   set path [[namespace current]::xml_join_tags $ofeed(tag-feed) $ofeed(tag-list) -1 $ofeed(tag-name)]
   set count [[namespace current]::xml_get_info $odata $path]

   for {set i 0} {$i < $count} {incr i} {
      # extract the current article from the database
      set tmpp [[namespace current]::xml_join_tags $ofeed(tag-feed) $ofeed(tag-list) $i $ofeed(tag-name)]
      set tmpd [[namespace current]::xml_get_info $odata $tmpp "children"]

      set w 0; # weight value
      set m 0; # item tag matches
      foreach {cmp_path cmp_element cmp_attrib cmp_weight} $cmp_items {
         # try and extract the tag info from the current article
         set oresult [[namespace current]::xml_get_info $tmpd $cmp_path $cmp_element]
         if {$cmp_element == "attrib"} {
            array set tmp $oresult
            catch {set oresult $tmp($cmp_attrib)}
            unset tmp
         }

         # if the tag doesnt exist in the article ignore it
         if {$oresult == ""} { continue }

         incr m

         # extract the tag info from the current article
         set result [[namespace current]::xml_get_info $data $cmp_path $cmp_element]
         if {$cmp_element == "attrib"} {
            array set tmp $result
            catch {set result $tmp($cmp_attrib)}
            unset tmp
         }

         if {[string equal -nocase $oresult $result]} {
            set w [expr { $w + $cmp_weight }]
         }
      }

      # value of 100 or more means its a match
      if {($m > 0) && \
          ([expr { round(double($w) / double($m) * 100) }] >= 100)} {
         return 1
      }
   }

   return 0
}

#
# Cookie Parsing Functions
##

proc ::rss-synd::cookie_parse {data current} {
   upvar 1 feed feed
   set output $feed(output)

   set eval 0
   if {([info exists feed(evaluate-tcl)]) && ($feed(evaluate-tcl) == 1)} { set eval 1 }
   set variable_index 0

   set matches [regexp -inline -nocase -all -- {@@(.*?)@@} $output]
   foreach {match tmpc} $matches {
      set tmpc [split $tmpc "!"]
      set index 0
      set cookie [list]
      incr variable_index
      foreach piece $tmpc {
         set tmpp [regexp -nocase -inline -all -- {^(.*?)\((.*?)\)|(.*?)$} $piece]

         if {[lindex $tmpp 3] == ""} {
            lappend cookie [lindex $tmpp 2] [lindex $tmpp 1]
         } else {
            lappend cookie 0 [lindex $tmpp 3]
         }
      }

      # replace tag-item's index with the current article
      if {[string equal -nocase $feed(tag-name) [lindex $cookie 1]]} {
         set cookie [[namespace current]::xml_join_tags $feed(tag-list) [lreplace $cookie $index $index $current]]
      }

      set cookie [[namespace current]::xml_join_tags $feed(tag-feed) $cookie]

      if {[set tmp [[namespace current]::cookie_replace $cookie $data]] != ""} {
         set tmp [[namespace current]::xml_list_flatten $tmp]

         regsub -all -- {([\"\$\[\]\{\}\(\)\\])} $match {\\\1} match
         set feed_data "[string map { "&" "\\\x26" } [[namespace current]::html_decode $eval $tmp]]"
         if {$eval == 1} {
            # We are going to eval this string so we can't insert untrusted
            # text. Instead create variables and insert references to those
            # variables that will be expanded in the subst call below.
            set cookie_val($variable_index) $feed_data
            regsub -- $match $output "\$cookie_val($variable_index)" output
         } else {
            regsub -- $match $output $feed_data output
         }
      }
   }

   # remove empty cookies
   if {(![info exists feed(remove-empty)]) || ($feed(remove-empty) == 1)} {
      regsub -nocase -all -- "@@.*?@@" $output "" output
   }

   # evaluate tcl code
   if {$eval == 1} {
      if {[catch {set output [subst $output]} error] != 0} {
         putlog "\002RSS Eval Error\002: $error"
      }
   }

   return $output
}

proc ::rss-synd::cookie_replace {cookie data} {
   set element "children"

   set tags [list]
   foreach {num section} $cookie {
      if {[string equal "=" [string range $section 0 0]]} {
         set attrib [string range $section 1 end]
         set element "attrib"
         break
      } else {
         lappend tags $num $section
      }
   }

   set return [[namespace current]::xml_get_info $data $tags $element]

   if {[string equal -nocase "attrib" $element]} {
      array set tmp $return

      if {[catch {set return $tmp($attrib)}] != 0} {
         return
      }
   }

   return $return
}

#
# Misc Functions
##

proc ::rss-synd::html_decode {eval data {loop 0}} {
   if {![string match *&* $data]} {return $data}
   array set chars {
          nbsp   \x20 amp   \x26 quot   \x22 lt      \x3C
          gt      \x3E iexcl   \xA1 cent   \xA2 pound   \xA3
          curren   \xA4 yen   \xA5 brvbar   \xA6 brkbar   \xA6
          sect   \xA7 uml   \xA8 die   \xA8 copy   \xA9
          ordf   \xAA laquo   \xAB not   \xAC shy   \xAD
          reg   \xAE hibar   \xAF macr   \xAF deg   \xB0
          plusmn   \xB1 sup2   \xB2 sup3   \xB3 acute   \xB4
          micro   \xB5 para   \xB6 middot   \xB7 cedil   \xB8
          sup1   \xB9 ordm   \xBA raquo   \xBB frac14   \xBC
          frac12   \xBD frac34   \xBE iquest   \xBF Agrave   \xC0
          Aacute   \xC1 Acirc   \xC2 Atilde   \xC3 Auml   \xC4
          Aring   \xC5 AElig   \xC6 Ccedil   \xC7 Egrave   \xC8
          Eacute   \xC9 Ecirc   \xCA Euml   \xCB Igrave   \xCC
          Iacute   \xCD Icirc   \xCE Iuml   \xCF ETH   \xD0
          Dstrok   \xD0 Ntilde   \xD1 Ograve   \xD2 Oacute   \xD3
          Ocirc   \xD4 Otilde   \xD5 Ouml   \xD6 times   \xD7
          Oslash   \xD8 Ugrave   \xD9 Uacute   \xDA Ucirc   \xDB
          Uuml   \xDC Yacute   \xDD THORN   \xDE szlig   \xDF
          agrave   \xE0 aacute   \xE1 acirc   \xE2 atilde   \xE3
          auml   \xE4 aring   \xE5 aelig   \xE6 ccedil   \xE7
          egrave   \xE8 eacute   \xE9 ecirc   \xEA euml   \xEB
          igrave   \xEC iacute   \xED icirc   \xEE iuml   \xEF
          eth   \xF0 ntilde   \xF1 ograve   \xF2 oacute   \xF3
          ocirc   \xF4 otilde   \xF5 ouml   \xF6 divide   \xF7
          oslash   \xF8 ugrave   \xF9 uacute   \xFA ucirc   \xFB
          uuml   \xFC yacute   \xFD thorn   \xFE yuml   \xFF
          ensp   \x20 emsp   \x20 thinsp   \x20 zwnj   \x20
          zwj   \x20 lrm   \x20 rlm   \x20 euro   \x80
          sbquo   \x82 bdquo   \x84 hellip   \x85 dagger   \x86
          Dagger   \x87 circ   \x88 permil   \x89 Scaron   \x8A
          lsaquo   \x8B OElig   \x8C oelig   \x8D lsquo   \x91
          rsquo   \x92 ldquo   \x93 rdquo   \x94 ndash   \x96
          mdash   \x97 tilde   \x98 scaron   \x9A rsaquo   \x9B
          Yuml   \x9F apos   \x27
         }

   regsub -all -- {<(.[^>]*)>} $data " " data

   if {$eval != 1} {
      regsub -all -- {([\$\[\]\{\}\(\)\\])} $data {\\\1} data
   } else {
      regsub -all -- {([\$\[\]\{\}\(\)\\])} $data {\\\\\\\1} data
   }

   regsub -all -- {&#(\d+);} $data {[subst -nocomm -novar [format \\\u%04x [scan \1 %d]]]} data
   regsub -all -- {&#x(\w+);} $data {[format %c [scan \1 %x]]} data
   regsub -all -- {&([0-9a-zA-Z#]*);} $data {[if {[catch {set tmp $chars(\1)} char] == 0} { set tmp }]} data
   regsub -all -- {&([0-9a-zA-Z#]*);} $data {[if {[catch {set tmp [string tolower $chars(\1)]} char] == 0} { set tmp }]} data

   regsub -nocase -all -- "\\s{2,}" $data " " data

   set data [subst $data]
   if {[incr loop] == 1} {
      set data [[namespace current]::html_decode 0 $data $loop]
   }

   return $data
}

proc ::rss-synd::is_utf8_patched {} { catch {queuesize a} err1; catch {queuesize \u0754} err2; expr {[string bytelength $err2]!=[string bytelength $err1]} }

proc ::rss-synd::check_channel {chanlist chan} {
   foreach match [split $chanlist] {
      if {[string equal -nocase $match $chan]} {
         return 1
      }
   }

   return 0
}

proc ::rss-synd::urldecode {str} {
   regsub -all -- {([\"\$\[\]\{\}\(\)\\])} $str {\\\1} str

   regsub -all -- {%([aAbBcCdDeEfF0-9][aAbBcCdDeEfF0-9]);?} $str {[format %c [scan \1 %x]]} str

   return [subst $str]
}

::rss-synd::init

proc maketiny {url} {
   set ua "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.9.0.5) Gecko/2008120122 Firefox/3.0.5"
   set http [::http::config -useragent $ua]
   set token [http::geturl "http://tinyurl.com/api-create.php?[http::formatQuery url $url]" -timeout 3000]
   upvar #0 $token state
   if {[string length $state(body)]} { return $state(body) }
   return $url
}


This code is working well and tinyurl integration is nice. One thing though is in @@item!title@@ I've noticed some <em></em> coming across.

How could I filter those?

Thanks for the help. Cool

- DoubleB
Back to top
View user's profile Send private message
speechles
Revered One


Joined: 26 Aug 2006
Posts: 1398
Location: emerald triangle, california (coastal redwoods)

PostPosted: Mon May 20, 2013 3:47 pm    Post subject: Re: Filter <em> </em> Reply with quote

DoubleB wrote:
Hi All.

This code is working well and tinyurl integration is nice. One thing though is in @@item!title@@ I've noticed some <em></em> coming across.

How could I filter those?


look in procedure --> ::rss-synd::html_decode
Remove the line below from it:
Code:
   if {![string match *&* $data]} {return $data}

Presto. Wallah. It's magic. Smile

Note: within the procedure to decode is a function to strip extraneous html tags from the text. Without having &'s found in the text this won't be accomplished. I would assume that line's existence as a bug, not a feature to save time. It is going beyond merely replacing &entities; with their charset equivalent, into removing html tagging in the text as well. Constraining the feature of html tag removal to only lines which contain the character & in them. Crying or Very sad ... but, remvoing that line eliminates that constraint making it strip html tags in any text now. Smile
_________________
speechles' eggdrop tcl archive
Back to top
View user's profile Send private message
nik-k
Voice


Joined: 17 Dec 2008
Posts: 2

PostPosted: Wed May 22, 2013 12:35 pm    Post subject: Decompressing using built-in zlib tcl > 8.6 Reply with quote

TCL 8.6.x and package trf does not work together.

I'm using latest git version: https://github.com/hm2k/rss-synd/blob/master/rss-synd.tcl

I've already tried some things around line 428-433, but I can't get it working.

Does anybody know, how to use built-in zlib for decompressing feeds?
Back to top
View user's profile Send private message
speechles
Revered One


Joined: 26 Aug 2006
Posts: 1398
Location: emerald triangle, california (coastal redwoods)

PostPosted: Wed May 22, 2013 2:27 pm    Post subject: Re: Decompressing using built-in zlib tcl > 8.6 Reply with quote

nik-k wrote:
Does anybody know, how to use built-in zlib for decompressing feeds?


Indeed. With tcl8.6b2 and higher, http Package handles gzip internally. It also doesn't alter the content-encoding after it has decompressed the data. So rss-synd attempts to decompress it again, and obviously this fails. To fix it, remove the decompression routine from rss-synd. Alter the procedure found removing almost everything it does, then it will work.. Here is how the procedure should look after you alter it.

Code:
# decompress gzip formatted data
proc ::rss-synd::feed_gzip {cdata} {
   return $cdata
}


Notice it does nothing now, simply returns the value the procedure was given. This is how tcl8.6's gzip requires it to be.
_________________
speechles' eggdrop tcl archive
Back to top
View user's profile Send private message
nik-k
Voice


Joined: 17 Dec 2008
Posts: 2

PostPosted: Thu May 23, 2013 8:52 am    Post subject: Well done Reply with quote

Thanks a lot, speechless.

I have not expected that it is so easy Very Happy
Back to top
View user's profile Send private message
neocharles
Voice


Joined: 23 Apr 2013
Posts: 34

PostPosted: Sun May 26, 2013 3:34 pm    Post subject: Reply with quote

Here goes some fun for you!

RSS Feed: http://www.reddit.com/r/aww/new/.rss

current "output":
Code:
\\\[\002/r/\[reddittwo @@item!link@@\]\002\\\] @@item!title@@ - @@item!url@@@@entry!link!=href@@"


Output in IRC:
[/r/aww] Post Title - http://www.reddit.com/r/aww/comments/url_continued/etc_etc_etc


What I am looking to have, instead of the comments URL, I'd like to be able to have the submitted URL (in these cases, typically the imgur album link). Is there a method to be able to do that?
Back to top
View user's profile Send private message
speechles
Revered One


Joined: 26 Aug 2006
Posts: 1398
Location: emerald triangle, california (coastal redwoods)

PostPosted: Sun May 26, 2013 6:52 pm    Post subject: Reply with quote

neocharles wrote:
Here goes some fun for you!

...snipped a few parts with code and such...

What I am looking to have, instead of the comments URL, I'd like to be able to have the submitted URL (in these cases, typically the imgur album link). Is there a method to be able to do that?


Code:
"output"    "\\\[\002/r/\[reddittwo @@item!link@@\]\002\\\] @@item!title@@ - \[lindex \[regexp -inline \{(http://i.imgur.*?(?:jpg|png|gif|bmp))\} \"@@item!description@@\"\] 0\]"
"evaluate-tcl"      1


That was fun. Laughing
_________________
speechles' eggdrop tcl archive
Back to top
View user's profile Send private message
neocharles
Voice


Joined: 23 Apr 2013
Posts: 34

PostPosted: Mon May 27, 2013 11:02 am    Post subject: Reply with quote

speechles wrote:
neocharles wrote:
Here goes some fun for you!

...snipped a few parts with code and such...

What I am looking to have, instead of the comments URL, I'd like to be able to have the submitted URL (in these cases, typically the imgur album link). Is there a method to be able to do that?


Code:
"output"    "\\\[\002/r/\[reddittwo @@item!link@@\]\002\\\] @@item!title@@ - \[lindex \[regexp -inline \{(http://i.imgur.*?(?:jpg|png|gif|bmp))\} \"@@item!description@@\"\] 0\]"
"evaluate-tcl"      1


That was fun. Laughing



Thanks! I hate regex by the way. How will this work if the link submitted is an album? Usually that is http://imgur.com/a/letters_and_numbers

<edit>

Did you happen to test this? It seems to still have only output the title...
Back to top
View user's profile Send private message
speechles
Revered One


Joined: 26 Aug 2006
Posts: 1398
Location: emerald triangle, california (coastal redwoods)

PostPosted: Sat Jun 01, 2013 5:39 am    Post subject: Reply with quote

neocharles wrote:
Did you happen to test this? It seems to still have only output the title...


Just an update, seeing as this thread leaves off as if I didn't solve the fellows problem...

Segments of a chat from iRC wrote:
<neocharles> speechles, what if someone has www.imgur.com/lettersandnumbers for the url in the rss feed?
<neocharles> instead of http://imgur.com or http://i.imgur.com
<neocharles> haha
<speechles> it will still show up neocharles
<neocharles> it didnt?
<speechles> http://imgur*
<speechles> oh the www
<neocharles> http://www.imgur
<speechles> i can add that
<neocharles> yeah
<neocharles> if you do that, that'll be a solid output.
<neocharles> I don't think imgur has links any other method.
<speechles> so neocharles, is it works proper now? Razz
<neocharles> Yeah. Unless you know a way to not execute it at all if it's not an imgur link lmao
<neocharles> but that I'm not too concerned with tbh
<speechles> it wont capture anything then
<neocharles> bc I think that's outside the scope of what this script is supposed to do
<speechles> it will just have empty
<speechles> isnt that what you wanted?
<neocharles> I mean not even sending the title at all either haha
<neocharles> OR ....
<neocharles> maybe if it isn't one of those three.... send the reddit comment link lol
<speechles> that would be tricky tricky
<neocharles> haha
<speechles> you would have to nest [if] in there
<speechles> its doable though
<neocharles> if it will take you more than like 2 seconds, don't worry abou tit
<neocharles> about it
<speechles> so if, no urls, give that one?
<neocharles> if not imgur, give that instead.
<neocharles> so like, the /r/fiftyfifty subreddit people post from all different places
<speechles> "\\\[\002/r/\[reddittwo @@item!link@@\]\002\\\] @@item!title@@ - \[if \{\[string length \[set a \[lindex \[split \[lindex \[regexp -inline {(http://(?:i.imgur|imgur|www.imgur).*?$)} \"@@item!description@@\"\] 0\] \\\"\] 0\]\]\]\} \{set a\} else \{set a \[reddit @@item!link@@\]\}\]"
<neocharles> you need to make a website or something for donations lol
<speechles> donate to thommey, or simple, or pixelz
<speechles> eggdrop itself
<speechles> i dont need the $$$
<speechles> or egghelp forums
<speechles> keeping those alive is the priority rather than feeding me
<speechles> i feed myself rather well Smile


So neocharles, if you read this... for legacy purposes I don't want it to appear your problem was never solved. It gives the impression I just left you hanging which is far from the truth. Smile

Code:
"output"   "\\\[\002/r/\[reddittwo @@item!link@@\]\002\\\]  @@item!title@@ - \[if \{\[string length \[set a \[lindex \[split \[lindex \[regexp -inline {(http://(?:i.imgur|imgur|www.imgur).*?$)} \"@@item!description@@\"\] 0\] \\\"\] 0\]\]\]\} \{set a\} else \{set a \[reddit @@item!link@@\]\}\]"
"evaluate-tcl"   1

_________________
speechles' eggdrop tcl archive
Back to top
View user's profile Send private message
rogerw
Voice


Joined: 30 Nov 2012
Posts: 3

PostPosted: Tue Jun 04, 2013 5:13 pm    Post subject: Reply with quote

Hi speechless...

Since you seem to be the go to guy for Andrew Scott's rss-synd et al, I was wondering if you can help me with this problem...

Each time the script tries to get a feed it produces this error:
Quote:
Tcl error [::rss-synd::feed_get]: can't read "feed(updated)": no such element in array


When I do it manually, as in "!rss", it produces this error:
Quote:
Tcl error [::rss-synd::trigger]: can't read "feed(trigger-type)": no such element in array


I've downloaded fresh copies of the scripts from (https://github.com/hm2k/rss-synd), both rss-synd.tcl and rss-synd-settings.tcl added the links, uploaded the scripts then rehashed the bot and that has done nothing to stop the error. I used only two rss links to test it. Finally, I killed the bot and restarted it, just to be sure.

I've checked the eggdrop.conf to make sure the scripts were in their proper sequence when loading (after egghttp.tcl). And they were good. Every other script that requires http is working properly.

If you like I can post the scripts.

Thanks for your help.

RW
_________________
Roger
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    egghelp.org community Forum Index -> Script Support & Releases All times are GMT - 4 Hours
Goto page Previous  1, 2, 3 ... 23, 24, 25, 26  Next
Page 24 of 26

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Forum hosting provided by Reverse.net

Powered by phpBB © 2001, 2005 phpBB Group
subGreen style by ktauber