xotcl.wu-wien.ac.at
Begin main content
Methods: Source: Variables:
[All Methods | Documented Methods | Hide Methods] [Display Source | Hide Source] [Show Variables | Hide Variables]

::xo::Module[i] ::xowiki::utility

::xo::Module create ::xowiki::utility

Methods

  • proc get_page_order_items

    ::2018064 proc get_page_order_items {-parent_id page_orders} {
        set likes [list]
        foreach page_order $page_orders {
          if {[::xowiki::page_order_uses_ltree]} {
            lappend likes "p.page_order <@ '$page_order'" 
          } else {
            lappend likes "p.page_order = '$page_order'" "p.page_order like '$page_order.%'"
          }
        }
        set sql "select p.page_order, p.page_id, cr.item_id, ci.name
              from xowiki_page p, cr_items ci, cr_revisions cr   where p.page_id = ci.live_revision  and p.page_id = cr.revision_id   and ci.publish_status <> 'production'  and ci.parent_id = $parent_id  and ([join $likes { or }])"
        #my log $sql
        set pages [::xo::db_list_of_lists get_pages_with_page_order $sql]
        return $pages
      }
    
  • proc incr_page_order

    ::2018064 proc incr_page_order p {
        regexp {^(.*[.]?)([^.])$} $p _ prefix suffix
        if {[string is integer -strict $suffix]} {
          incr suffix
        } elseif {[string is lower -strict $suffix]} {
          regexp {^(.*)(.)$} $suffix _ before last
          if {$last eq "z"} {
            set last "aa"
          } else {
            set last [format %c [expr {[scan $last %c] + 1}]]
          }
          set suffix $before$last
        } elseif {[string is upper -strict $suffix]} {
          regexp {^(.*)(.)$} $suffix _ before last
          if {$last eq "Z"} {
            set last "AA"
          } else {
            set last [format %c [expr {[scan $last %c] + 1}]]
          }
          set suffix $before$last
        }
        return $prefix$suffix
      }
    
  • proc page_order_compute_new_names

    ::2018064 proc page_order_compute_new_names {start page_orders} {
        lappend pairs [lindex $page_orders 0] $start
        foreach p [lrange $page_orders 1 end] {
          lappend pairs $p [set start [my incr_page_order $start]]
        }
        return $pairs
      }
    
  • proc page_order_renames

    ::2018064 proc page_order_renames {-parent_id -start -from -to} {
        set pages [my get_page_order_items -parent_id $parent_id $to]
        #my log "pages=$pages"
        array set npo [::xowiki::utility page_order_compute_new_names $start $to]
        #my log npo=[array get npo]=>to='$to'
        set renames [list]
        foreach tuple $pages {
          foreach {old_page_order page_id item_id name} $tuple break
          if {[info exists npo($old_page_order)]} {
            #
            # We have a name in the translation list
            #
            if {$npo($old_page_order) eq $old_page_order} {
              # Nothing to do
              #my log "--cpo name $old_page_order not changed"
            } else {
              #my log "--cpo name $old_page_order changed to '$npo($old_page_order)'"
              lappend renames $page_id $item_id $name $old_page_order $npo($old_page_order)
            }
          } else {
            # 
            # We have no translation in the list. This must be an item
            # from a subtree of changed page_orders.
            #
            #my log "--cpo no translation for $old_page_order, check prefix"
            foreach new_name [array names npo] {
              if {[string match $new_name.* $old_page_order]} {
                #
                # The name matches. Add to the rename list if the prefix name actually changed.
                #
                if {$npo($new_name) ne $new_name} {
                  set l [string length $new_name]
                  set new_page_order "$npo($new_name)[string range $old_page_order $l end]"
                  my log "--cpo tree name $old_page_order changed to '$new_page_order'"
                  lappend renames $page_id $item_id $name $old_page_order $new_page_order
                }
                break
              }
            }
          }
        }
        return $renames
      }
    
  • proc pretty_age

    ::2018064 proc pretty_age {-timestamp:required -timestamp_base {-locale ""} {-levels 1}} {
    
        #
        # This is an internationalized pretty age functions, which prints
        # the rough date in a user friendly fashion.
        #
        #todo: caching?
        
        #     outlook categories:
        #     Unknown
        #     Older
        #     Last Month
        #     Earlier This Month
        #     Three Weeks Ago
        #     Two Weeks Ago
        #     Last Week
        #     Yesterday
        #     Today
        #     This Week
        #     Tomorrow
        #     Next Week
        #     Two Weeks Away
        #     Three Weeks Away
        #     Later This Month
        #     Next Month
        #     Beyond Next Month
        
        #     Another possibilty: no ago, but "Today 10:00", "Yesterday 10:00", within a
        #     week: "Thursday 10:00", older than about 30 days "13 May 2005" and
        #     if anything else (ie. > 7 and < 30 days) it shows date and time "13-Oct 2005 10:00".
        
        if {![info exists timestamp_base]} {set timestamp_base [clock seconds]}
        set age_seconds [expr {$timestamp_base - $timestamp}]
        
        set pos 0
        set msg ""
        my instvar age
        foreach {interval unit unit_plural} $age {
          set base [expr {int($age_seconds / $interval)}]
          if {$base > 0} {
            set label [expr {$base == 1 ? $unit : $unit_plural}]
            set localized_label [::lang::message::lookup $locale xowiki.$label]
            set msg "$base $localized_label"
            # $pos < 5: do not report details under a minute
            if {$pos < 5 && $levels > 1} {
              set remaining_age [expr {$age_seconds-$base*$interval}]
              set interval    [lindex $age [expr {($pos+1)*3}]]
              set unit        [lindex $age [expr {($pos+1)*3+1}]]
              set unit_plural [lindex $age [expr {($pos+1)*3+2}]]
              set base [expr {int($remaining_age / $interval)}]
              if {$base > 0} {
                set label [expr {$base == 1 ? $unit : $unit_plural}]
                set localized_label [::lang::message::lookup $locale xowiki.$label]
                append msg " $base $localized_label"
              }
            }
            set time $msg
            set msg [::lang::message::lookup $locale xowiki.ago [list [list time $msg]]]
            break
          }
          incr pos
        }
        if {$msg eq ""} {
          set time "0 [::lang::message::lookup $locale xowiki.seconds]"
          set msg [::lang::message::lookup $locale xowiki.ago [list [list time $time]]]
        }
        return $msg
      }
    
  • proc urlencode

    ::2018064 proc urlencode string {string map [my set ue_map] $string}
    
  • proc user_is_active (public)

    ::xowiki::utility[i] user_is_active [ -asHTML on|off ] uid

    Switches:
    -asHTML (boolean) (defaults to "false") (optional)
    Parameters:
    uid
    ::2018064 proc user_is_active {{-asHTML:boolean false} uid} {
        if {[info command ::throttle] ne "" && 
    	[::throttle info methods user_is_active] ne ""} {
          set active [throttle user_is_active $uid]
          if {$asHTML} {
    	array set color {1 green 0 red}
    	array set state {1 active 0 inactive}
    	return "<span class='$state($active)' style='background: $color($active);'>&nbsp;</span>"
          } else {
    	return $active
          }
        } else {
          ns_log notice "user_is_active requires xotcl-request monitor in a recent version"
          return 0
        }
      }
    

Methods: Source: Variables:
[All Methods | Documented Methods | Hide Methods] [Display Source | Hide Source] [Show Variables | Hide Variables]