Object ::xowiki::utility (public)

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

Defined in

Testcases:

No testcase defined.

Source code:

namespace eval ::xowiki {}
::nsf::object::alloc ::xo::Module ::xowiki::utility {set :age {31536000 year years 2592000 month months 604800 week weeks 86400 day days 3600 hour hours 60 minute minutes 1 second seconds}}
::xowiki::utility 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 possibility: not 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 (i.e. > 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}]

    if {$age_seconds < 0} {
      set msg_key xowiki.future_interval
      set age_seconds [expr {0 - $age_seconds}]
    } else {
      set msg_key xowiki.ago
    }

    set pos 0
    set msg ""
    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 $msg_key [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
  }
::xowiki::utility 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 [:incr_page_order $start]]
    }
    return $pairs
  }
::xowiki::utility proc get_page_order_items {-parent_id:integer {-publish_status "production"} page_orders} {
    set likes [list]
    foreach page_order $page_orders {
      if {[::xowiki::page_order_uses_ltree]} {
        lappend likes "p.page_order <@ [ns_dbquotevalue $page_order]"
      } else {
        lappend likes  "p.page_order = [ns_dbquotevalue $page_order]"  "p.page_order like [ns_dbquotevalue $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   [::xowiki::Includelet publish_status_clause $publish_status]  and ci.parent_id = $parent_id  and ([join $likes { or }])"
    #:log $sql
    set pages [::xo::dc list_of_lists get_pages_with_page_order $sql]
    return $pages
  }
::xowiki::utility proc publish_status_next_state publish_status {
    if {$publish_status eq "ready"} {
      set CSSclass green
      set state "production"
    } elseif {$publish_status eq "expired"} {
      set CSSclass black
      set state "production"
    } else {
      set CSSclass red
      set state "ready"
    }
    return [list CSSclass $CSSclass state $state]
  }
::xowiki::utility proc change_page_order {-from:required -to:required {-clean ""} -folder_id:required -package_id:required {-publish_status "ready|live|expired"}} {

    #set from {1.2 1.3 1.4}; set to {1.3 1.4 1.2}; set clean {...}
    #set from {1.2 1.3 1.4}; set to {1.3 1.4 2.1 1.2}; set clean {2.1}
    #set from {1 2}; set to {1 1.2 2}; set clean {1.2 1.3 1.4}

    if {$from eq ""
        || $to eq ""
        || [llength $to]-[llength $from] > 1
        || [llength $to]-[llength $from] < 0
      } {
      ad_log warning "unreasonable request to change page_order from='$from', to='$to'"
      return
    }

    #ns_log notice "--cpo from=$from, to=$to, clean=$clean"
    set gap_renames [list]
    #
    # We distinguish two cases:
    # - pure reordering: length(to) == length(from)
    # - insert from another section: length(to) == length(from)+1
    #
    if {[llength $to] == [llength $from]} {
      #ns_log notice "--cpo reorder"
    } elseif {[llength $clean] > 1} {
      #ns_log notice "--cpo insert"
      #
      # We have to fill the gap. First, find the newly inserted
      # element in $to.
      #
      foreach e $to {
        if {$e ni $from} {
          set inserted $e
          break
        }
      }
      if {![info exists inserted]} {
        error "invalid 'to' list (no inserted element detected)"
      }
      #
      # Compute the remaining list.
      #
      set remaining [list]
      foreach e $clean {
        if {$e ne $inserted} {
          lappend remaining $e
        }
      }
      #
      # Compute rename commands for it.
      #
      set gap_renames [::xowiki::utility page_order_renames -parent_id $folder_id  -publish_status $publish_status  -start [lindex $clean 0] -from $remaining -to $remaining]
      foreach {page_id item_id name old_page_order new_page_order} $gap_renames {
        ns_log notice "--cpo gap $page_id (name) rename $old_page_order to $new_page_order"
      }
    }
    #
    # Compute the rename commands for the drop target.
    #
    set drop_renames [::xowiki::utility page_order_renames -parent_id $folder_id  -publish_status $publish_status  -start [lindex $from 0] -from $from -to $to]
    #ns_log notice "--cpo drops l=[llength $drop_renames]"
    foreach {page_id item_id name old_page_order new_page_order} $drop_renames {
      #ns_log notice "--cpo drop $page_id ($name) rename $old_page_order to $new_page_order"
    }

    #
    # Perform the actual renames.
    #
    set temp_obj [::xowiki::Page new -name dummy -volatile]
    set slot [$temp_obj find_slot page_order]
    ::xo::dc transaction {
      foreach {page_id item_id name old_page_order new_page_order} [concat $drop_renames $gap_renames] {
        #ns_log notice "--cpo UPDATE $page_id new_page_order $new_page_order"
        $temp_obj item_id $item_id
        $temp_obj update_attribute_from_slot -revision_id $page_id $slot $new_page_order
        ::xo::xotcl_object_cache flush $item_id
        ::xo::xotcl_object_cache flush $page_id
      }
    }
    #
    # Flush the page fragment caches (page fragments based on
    # page_order might be sufficient).
    ::$package_id flush_page_fragment_cache -scope agg
  }
::xowiki::utility proc urlencode string {ns_urlencode $string}
::xowiki::utility proc user_is_active {{-asHTML:boolean false} uid} {
    if {[info commands ::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
    }
  }
::xowiki::utility proc page_order_renames {-parent_id {-publish_status "production"} -start -from -to} {
    set pages [:get_page_order_items -parent_id $parent_id -publish_status $publish_status $to]
    #:log "pages=$pages"
    array set npo [::xowiki::utility page_order_compute_new_names $start $to]
    #:log npo=[array get npo]=>to='$to'
    set renames [list]
    foreach tuple $pages {
      lassign $tuple old_page_order page_id item_id name
      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
          #:log "--cpo name $old_page_order not changed"
        } else {
          #: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.
        #
        #: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]"
              :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
  }
::xowiki::utility proc incr_page_order p {
    lassign [list "" $p] prefix suffix
    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
  }
::xowiki::utility proc formCSSclass form_name {
    set CSSname $form_name
    regexp {^..:(.*)$} $CSSname _ CSSname
    regsub {[.].*$} $CSSname "" CSSname
    return "Form-$CSSname"
  }

namespace eval ::xowiki {::namespace export Menu YUIMenuBar YUIMenuBarItem YUIMenu YUIMenuItem YUIMenuItemList YUIContextMenu YUIContextMenuItem}

XQL Not present:

Generic, PostgreSQL, Oracle