path: root/web/cgi/alpine/2.0/newlist.tcl

#!./tclsh
# $Id: newlist.tcl 1266 2009-07-14 18:39:12Z hubert@u.washington.edu $
# ========================================================================
# Copyright 2008 University of Washington
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# ========================================================================

#  newlist.tcl
#
#  Purpose:  CGI script that generates a page displaying a message
#            list of the indicated folder. 
#
#  Input:    PATH_INFO: [/<col_number>]/<folder_name>[/<uid_of_first_msg>
#            along with possible search parameters:
set newlist_args {
  {op		{}	""}
  {df		{}	""}
  {uid		{}	""}
  {type		{}	""}
  {zoom		{}	""}
  {page		{}	""}
  {criteria	{}	""}
  {scope	{}	"new"}
}

# inherit global config
source ./alpine.tcl
source ./common.tcl
source ./foldercache.tcl

# default newlist state
set c 0
set f "INBOX"

# TEST
proc cgi_suffix {args} {
  return ""
}

set dmsgs ""
proc dm {s} {
  global dmsgs

  lappend dmsgs $s
}

proc focusOnResult {_focused} {
  upvar 1 $_focused focused

  if {[catch {WPCmd PEMailbox focus 1} focused]} {
    WPCmd PEInfo statmsg "Cannot focus: $focused"
    set focused 0
  } else {
    WPCmd PEInfo statmsg "Displaying $focused search results"
  }
}

# grok PATH_INFO for collection, 'c', and folder 'f'
if {[info exists env(PATH_INFO)] && [string length $env(PATH_INFO)]} {
  if {[regexp {^/([0-9]+)/(.*)$} $env(PATH_INFO) dummy c f]} {
    # Import data validate it and get session id
    if {[catch {WPGetInputAndID sessid} result]} {
      set harderr "Session Invalid: $result"
      set deadsession 1
    } else {
      # grok parameters
      foreach item $newlist_args {
	if {[catch {eval WPImport $item} result]} {
	  set harderr "Cannot Read Input: $result"
	  break;
	}
      }

      if {[catch {WPCmd PEMailbox messagecount} mc]} {
	set harderr $mc
	if {[regexp {[Ii]nactive [Ss]ession$} $mc]} {
	  set deadsession 1
	}
      }

    }
  } else {
    set harderr "Invalid Folder: $env(PATH_INFO)"
  }
} else {
  set harderr "No folder specified"
}

cgi_puts "Content-type: text/html; charset=\"UTF-8\"\n"

if {[info exists harderr]} {
  if {[info exists deadsession]} {
    cgi_division class=contentDeadSession {
      cgi_puts "This Web Alpine session is no longer active.<p>Click [cgi_url "here to restart your session." "$_wp(serverpath)/"] </div>"
    }
    
    exit
  } else {
    catch { WPCmd PEInfo statmsg "$harderr" }
    set c 0
    set f INBOX
  }
}

set defc [WPCmd PEFolder defaultcollection]
set focused [WPCmd PEMailbox focus]

# set uid to "current" message?
if {0 == [catch {WPCmd PEMailbox current} cm]} {
  set n [lindex $cm 0]
  set u [lindex $cm 1]
} else {
  if {$mc > 0} {
    WPCmd PEInfo statmsg "BOTCH: No current message"
  }

  # non given, set to first message in folder
  set n 1
  if {[catch {
    set n [WPCmd PEMailbox first]
    set u [WPCmd PEMailbox uid $n]
  } result]} {
    if {$mc > 0} {
      WPCmd PEInfo statmsg "No first message: $result"
    }

    set n 0
    set u 0
  }
}

# lines per page
if {[catch {WPCmd PEInfo indexlines} ppg] || $ppg <= 0} {
  set ppg $_wp(indexlines)
} elseif {$ppg > $_wp(indexlinesmax)} {
  set ppg $_wp(indexlinesmax)
}

# deal with page change
if {$mc > 0} {
  switch -regexp -- $op {
    ^next$ {
      set n [WPCmd PEMailbox next $n $ppg]

      if {[catch {WPCmd PEMailbox uid $n} u]} {
	set n [WPCmd PEMailbox first]
	set u [WPCmd PEMailbox uid $n]
      }
    }
    ^prev$ {
      if {$ppg >= $n} {
	set n [WPCmd PEMailbox first]
      } else {
	set n [WPCmd PEMailbox next $n -$ppg]
      }

      if {[catch {WPCmd PEMailbox uid $n} u]} {
	set n [WPCmd PEMailbox first]
	set u 0
      }
    }
    ^first$ {
      set n [WPCmd PEMailbox first]
      if {[catch {WPCmd PEMailbox uid $n} u]} {
	set n 1
	set u 0
      }
    }
    ^last$ {
      set n [WPCmd PEMailbox last]
      if {[catch {WPCmd PEMailbox uid $n} u]} {
	set n 1
	set u 0
      }
    }
    ^delete$ {
      if {[catch {WPCmd PEMailbox apply count new} trashed_new]} {
	set trashed_new 0
      }

      if {[catch {WPCmd PEMailbox apply flag ton del} result]} {
	WPCmd PEInfo statmsg "Delete failed: $result"
      } else {
	WPCmd PEInfo statmsg "$result message[WPplural $result] moved to Trash"
	if {$trashed_new > 0} {
	  set trashed $trashed_new
	}
      }
    }
    ^trash$ {
      if {[catch {WPCmd PEFolder empty $c [wpLiteralFolder $c $f] selected} result]} {
	WPCmd PEInfo statmsg "Cannot Remove: $result"
      } else {
	WPCmd PEInfo statmsg "$result message[WPplural $result] deleted forever"
	if {0 == [WPCmd PEMailbox messagecount]} {
	  set n 0
	  set u 0
	}
	set trashed [expr {$result * -1}]
      }
    }
    ^trashall$ {
      if {[catch {WPCmd PEFolder empty $c [wpLiteralFolder $c $f] all} result]} {
	WPCmd PEInfo statmsg "Cannot Remove: $result"
      } else {
	WPCmd PEInfo statmsg "$result message[WPplural $result] deleted forever"
	set n 0
	set u 0
	set trashed [expr {$result * -1}]
      }
    }
    ^spam$ {
      set numspam [WPCmd PEMailbox selected]
      if {$numspam > 0} {
	# aggregate save 
	if {[info exists _wp(spamsubj)] && [string length $_wp(spamsubj)]} {
	  set spamsubj $_wp(spamsubj)
	} else {
	  set spamsubj "Spam Report"
	}

	# aggregate delete
	if {[info exists _wp(spamfolder)] && [string length $_wp(spamfolder)]
	    && [catch {
	      if {[WPCmd PEFolder exists $defc $_wp(spamfolder)] == 0} {
		WPCmd PEFolder create $defc $_wp(spamfolder)
	      }

	      WPCmd PEMailbox apply save $defc $_wp(spamfolder)
	    } result]} {
	  WPCmd PEInfo statmsg "Error Reporting Spam: $result"
	} elseif {[info exists _wp(spamaddr)] && [string length $_wp(spamaddr)]
		  && [catch {WPCmd PEMailbox apply spam $_wp(spamaddr) $spamsubj} reason]} {
	  WPCmd PEInfo statmsg "Error Sending Spam Notice: $reason"
	} elseif {[catch {WPCmd PEMailbox apply delete} reason]} {
	  WPCmd PEInfo statmsg "Error marking Spam Deleted: $reason"
	} else {
	  WPCmd PEInfo statmsg "$numspam spam message[WPplural $numspam] reported"
	}
      }
    }
    ^copy$ {
      if {[string length $df] && [regexp {^([0-9]+)/(.*)$} $df dummy dfc dfn] && [string length $dfn]} {
	if {[catch {WPCmd PEMailbox apply count new} cpmv_new]} {
	  set cpmv_new 0
	}

	if {[catch {WPCmd PEMailbox apply copy $dfc $dfn} result]} {
	  WPCmd PEInfo statmsg "Cannot copy messages: $result"
	} else {
	  if {$dfc == $defc
	      && !(([info exists _wp(spamfolder)] && 0 == [string compare $f $_wp(spamfolder)])
		   || 0 == [string compare $f Trash])} {
	    addSaveCache $dfn
	    set savecachechange $dfn
	    set cpmvdest [cgi_quote_html $dfn]
	    if {$result > 0 && $cpmv_new > 0} {
	      set cpmv $cpmv_new
	    }
	  }

	  WPCmd PEInfo statmsg "Copied $result message[WPplural $result] to $dfn"
	}
      } else {
	WPCmd PEInfo statmsg "Cannot copy to $df"
      }
    }
    ^move$ {
      if {[string length $df] && [regexp {^([0-9]+)/(.*)$} $df dummy dfc dfn] && [string length $dfn]} {
	if {[catch {WPCmd PEMailbox apply count new} cpmv_new]} {
	  set cpmv_new 0
	}

	if {[catch {WPCmd PEMailbox apply move $dfc $dfn} result]} {
	  WPCmd PEInfo statmsg "Move Failure: $result"
	} else {
	  # if needed, empty what was moved
	  if {$c == [WPCmd PEFolder defaultcollection]
	      && (([info exists _wp(spamfolder)] && 0 == [string compare $f $_wp(spamfolder)])
		  || 0 == [string compare $f Trash])
	      && [catch {WPCmd PEFolder empty $c $f selected} result]} {
	    WPCmd PEInfo statmsg "Move Failure: $result"
	  } else {
	    if {$dfc == $defc
		&& !(([info exists _wp(spamfolder)] && 0 == [string compare $f $_wp(spamfolder)])
		     || 0 == [string compare $f Trash])} {
	      addSaveCache $dfn
	      set savecachechange $dfn
	      set cpmvdest [cgi_quote_html $dfn]
	      if {$result > 0 && $cpmv_new > 0} {
		set cpmv $cpmv_new
	      }
	    }

	    # clean up moved messages so they don't get tossed in Trash as well
	    if {[catch {WPCmd PEMailbox expunge} blasted] || [string length $blasted]} {
	      WPCmd PEInfo statmsg "Move Failure: $blasted"
	    } else {
	      WPCmd PEInfo statmsg "Moved $result message[WPplural $result] to $dfn"
	    }
	  }
	}
      } else {
	WPCmd PEInfo statmsg "Cannot move: to $df"
      }
    }
    ^movemsg$ {
      if {[regexp {^[0-9]+$} $uid] && $uid > 0 && [string length $df] && [regexp {^([0-9]+)/(.*)$} $df dummy dfc dfn] && [string length $dfn]} {
	if {[catch {
	  # destination Trash? just delete and let regular delete process move it
	  if {$dfc == $defc && 0 == [string compare Trash $dfn]} {
	    WPCmd PEMessage $uid flag deleted 1
	  } else {
	    WPCmd PEMessage $uid move $dfc $dfn
	  }

	  # source is trash/junk, remove explicitly
	  if {$c == $defc
	      && (([info exists _wp(spamfolder)] && 0 == [string compare $f $_wp(spamfolder)])
		  || 0 == [string compare $f Trash])} {
	    WPCmd PEFolder empty $c $f $uid
	  }

	  WPCmd PEInfo statmsg "Moved message to $dfn"
	  set cpmvdest [cgi_quote_html $dfn]
	  if {0 != [WPCmd PEMessage $uid flag new]} {
	    set cpmv 1
	  }
	} result]} {
	  WPCmd PEInfo statmsg "Move Failure: $result"
	}
      } else {
	WPCmd PEInfo statmsg "Cannot move: to $df"
      }
    }
    ^sort[A-Za-z]+$ {
      if {[regexp {^sort([[Rr]ev|)(.*)$} $op dummy rev sname]} {
	set sort [string tolower $sname]
	set rval [expr {[string length $rev] > 0}]
	if {[catch {WPCmd PEMailbox sort $sort $rval} cursort]} {
	  WPCmd PEInfo statmsg "Cannot set sort: $cursor"
	  set cursort [list nonsense 0]
	} else {
	  # store result 
	  WPCmd set sort [list $sort $rval]
	}
      } else {
	WPCmd PEInfo statmsg "Unrecognized Sort: $op"
      }
    }
    ^search$ {
      if {![regexp {broad|narrow} $scope]} {
	WPCmd PEMailbox focus 0
	WPCmd PEMailbox search none
	set scope broad
      }

      switch -- $type {
	none {
	  WPCmd PEMailbox focus 0
	  WPCmd PEMailbox search none
	}
	any {
	  if {![string length $criteria]} {
	    WPCmd PEInfo statmsg "No search criteria provided"
	  } elseif {[catch {WPCmd PEMailbox search $scope text ton any $criteria} result]} {
	      WPCmd PEInfo statmsg "Search failed: $result"
	  } else {
	    if {$result == 0} {
	      WPCmd PEInfo statmsg "No messages matched your search"
	      cgi_html_comment "SCOPE: $scope"
	      if {0 == [string compare new $scope]} {
		WPCmd PEMailbox focus 0
		WPCmd PEMailbox search none
	      }
	    } else {
	      set n [WPCmd PEMailbox first]
	      if {[catch {WPCmd PEMailbox uid $n} u]} {
		set n 1
		set u 0
	      }

	      focusOnResult focused
	    }
	  }
	}
	compound {
	  if {![string length $criteria]} {
	    WPCmd PEInfo statmsg "No search criteria provided"
	  } elseif {[catch {WPCmd PEMailbox search $scope compound $criteria} result]} {
	    WPCmd PEInfo statmsg "Search failed: $result"
	  } else {
	    if {$result == 0} {
	      WPCmd PEInfo statmsg "No messages matched your search"
	      if {0 == [string compare new $scope]} {
		WPCmd PEMailbox focus 0
		WPCmd PEMailbox search none
	      }
	    } else {
	      set n [WPCmd PEMailbox first]
	      if {[catch {WPCmd PEMailbox uid $n} u]} {
		set n 1
		set u 0
	      }

	      focusOnResult focused
	    }
	  }
	}
	default {
	  WPCmd PEInfo statmsg "Unrecognized search: $type"
	}
      }
    }
    ^focus$ {
      focusOnResult focused
    }
    ^unfocus$ {
      if {[catch {WPCmd PEMailbox focus 0} result]} {
	WPCmd PEInfo statmsg "Cannot unfocus: $result"
      } elseif {$focused > 0} {
	WPCmd PEInfo statmsg "All messages displayed"
	set focused 0
      }
    }
    noop -
    ^$ {
    }
    default {
    }
  }
}

if {$focused} {
  set mc $focused
}

# page framing (note maybe changed by actions above)
wpInitPageFraming u n mc ppg pn pt

cgi_puts [WPCmd cgi_buffer "drawMessageList $c {$f} $n $ppg"]

cgi_puts "<script>"
cgi_put "updateBrowseLinksAndSuch(\{"
cgi_put "u:$u,selected:[WPCmd PEMailbox selected],"
cgi_put "unread:[WPCmd PEMailbox flagcount [list unseen undeleted]],"
cgi_put "page:$pn,pages:$pt,count:$mc,"
cgi_put "searched:[WPCmd PEMailbox searched],focused:$focused,"
cgi_put "sort:'[lindex [WPCmd PEMailbox sort] 0]'"
if {[info exists trashed] && $trashed != 0} {
  cgi_put ",trashed:$trashed"
}
if {[info exists cpmv] && $cpmv != 0} {
  cgi_put ",cpmv:{f:'$cpmvdest',n:$cpmv}"
}
cgi_puts "\});"
if {0 == [string compare $page new]} {
  cgi_puts "showBrowseMenus();"
  cgi_puts "initMenus();"
  cgi_puts "initMorcButton('listMorcButton');"
  cgi_puts "initSelection();"
  wpSaveMenuJavascript "browse" $c $f [WPCmd PEFolder defaultcollection] morcInBrowseDone
  wpSetMessageListNewMailCheck
  cgi_puts "if(self.loadDDElements) loadDDElements();"
}
if {[info exists savecachechange]} {
  wpSaveMenuJavascript browse $c $f $defc morcInBrowseDone $savecachechange
}
wpStatusAndNewmailJavascript
cgi_puts "if(self.loadDDElements) loadDDElements();"
cgi_puts "</script>"