#!/usr/bin/tclsh
# This insert contents into the PaGEN database
# It is the most important file of the PaGEN system, because makes easy to
# insert more content.
 
# Version history:      0.0.1a LMA 10.10.2001 Original version
#                       0.0.2  LMA 18.10.2001 X-uid and x-date automated generation
# 			0.0.3  LMA 19.10.2001 Rewritten almost completely to support many types of content
# 			0.1.0  LMA 29.10.2001 Tested and debugged. New version number issued. 
#			0.2.0  LMA 28.11.2001 Added the insertion split when the text is too big. (>7000 bytes)
#
# Note:
# permission to rewrite the original files must be granted.
 
# Load configuration variables
 
source "pagen.config"
 
# Load first the database libraries.
source "db_lib.tcl"

# Libraries

source "pagen.lib"
 
 
proc Pusage {} {
 
 puts "PaGEN content inserter."
 puts "usage:"
 puts "      content_insert.tcl file"
 puts " "
 puts "where \"file\" is the complete name of a file in PaGEN content format"
 
 
}

proc Pcheck_file {} {
global Vall_content Vglobal
 # This procedure checks that the input file is ok!

 set Vfile $Vglobal(file) 
 set Vreturn_value 0
 if {[ file exists $Vfile ] && [ file readable $Vfile ]} {
    if [ file writable $Vfile ] {
	set Vreturn_value 0      
    } else {
        set Vreturn_value 4
        puts "ERR4: While checking file $Vfile for writing permissions."
    }
 } else {
    set Vreturn_value 1
    Pdebug "Pcheck_file" "ERR1: While reading file ($Vfile)." 
    Pdebug "Pcheck_file" "      Either it does not exists or permission to read is denied."
 }
 return $Vreturn_value
}

proc Pshutdown Vmess {

  Pdebug "Pshutdown" "-------- FATAL ----------"
  Pdebug "Pshutdown" "The program found an error and will be closed inmediately"
  Pdebug "Pshutdown" "$Vmess"
  exit

}


proc Pchunk_mount_memory {} {
global Vglobal Vchunk
	
	# This procedure sets everything in memory and splits every chunk separated
	# in lines. 
	
	for { set i [ expr $Vglobal(count) -1 ] } { $i >= 0 } { incr i -1 } {
		set Vline_counter 0
		foreach line [ split "$Vglobal($i,chunk)" \n] {
                        regsub -all -- "'" $line "`" line
			set Vchunk($i,$Vline_counter) $line                        
			incr Vline_counter 1
		}
		set Vchunk($i,lines) $Vline_counter
        }
	return 0
}

proc Pheader_exists {Vheader_list} {
global Vcontent
 
	set Vreturn_value 0
 
	foreach Vaux_header "$Vheader_list" {

		if ![ info exists Vcontent($Vaux_header) ] {
			incr Vreturn_value 1
			Pdebug "Pheader_exists" "Missing header $Vaux_header."
		} 
	}
	return $Vreturn_value
}


proc Ppage_exists {Vpage_name} {

	set Vreturn_value 0

        array set Vpage [ Pdb_exec "select name from pages where name='$Vpage_name'" ]
        if {$Vpage(0,tups) < 1 } {
                 set Vreturn_value 3
                 Pdebug "Ppage_exists" "Error while looking for page \"$Vpage_name\", as parent page"
        }
	return $Vreturn_value
}

proc Pcategory_exists {Vcat_name} {
 
        set Vreturn_value 0
 
        array set Vpage [ Pdb_exec "select * from categories where category='$Vcat_name'" ]
        if {$Vpage(0,tups) < 1 } {
                 set Vreturn_value 67
                 Pdebug "Pcategory_exists" "Error while looking for category \"$Vcat_name\""
        }
        return $Vreturn_value
}

proc Pupdate_page {} {
global Vcontent
	set Vreturn_value 0 

	set    Vquery "update pages "
	append Vquery " set     name='$Vcontent(x-name)',"
	append Vquery "       parent='$Vcontent(x-parent)',"
	append Vquery "     category='$Vcontent(x-category)',"
	append Vquery "        title='$Vcontent(x-title)',"
	append Vquery "         icon='$Vcontent(x-icon)',"
        append Vquery "		file='$Vcontent(x-file)',"
	append Vquery "last_modified='[Pdate_now]' "
	append Vquery " where id='$Vcontent(x-pid)'";    

	array set Vresult [ Pdb_exec $Vquery ]
        if ![ string match "" $Vresult(0,error) ] { 
		set Vreturn_value 297 
		Pdebug "Pupdate_page" "Update failed, database returned: $Vresult(0,error)"
		Pdebug "Pupdate_page" "while running: $Vquery"
	}
        return $Vreturn_value
}


proc Pinsert_page {} {
global Vcontent
	set Vreturn_value 0
	set Vquery    " insert into pages values ('$Vcontent(x-pid)',"
	append Vquery "'$Vcontent(x-name)','$Vcontent(x-parent)','$Vcontent(x-category)',"
	append Vquery "'$Vcontent(x-title)','$Vcontent(x-icon)','$Vcontent(x-file)',"
	append Vquery "'[Pdate_now]','$Vcontent(x-render)')"
	array set Vresult [ Pdb_exec $Vquery ]
	if ![ string match "" $Vresult(0,error) ] { set Vreturn_value 283 }  	
	return $Vreturn_value	
}

proc Pheader_list {} { 
global Vglobal

   	set Vglobal(headers_ah,page) "x-content x-name x-category x-file"
	set Vglobal(headers_op,page) "x-parent x-icon x-title x-render" 
	set Vglobal(headers_ah,text) "x-content x-page x-title"
	set Vglobal(headers_op,text) "x-author x-icon x-date x-priority"	
	set Vglobal(headers_ah,child) "x-content x-child_id x-parent_id x-text"
return 0 
}

proc Pchild {} {
global Vcontent Vglobal
    set Vreturn_value 0
    if [ Pheader_exists $Vglobal(headers_ah,child) ] { 
		Pdebug "Pchild" "Not all needed headers where found"
		return 819
    }
    # Checkings for children

    # None now. 

    # End of checkings. 
    set    Vquery "update child_contents set content='$Vcontent(x-text)' where "
    append Vquery " id_child='$Vcontent(x-child_id)'"
    array set Vmake [ Pdb_exec $Vquery ]
    return $Vreturn_value
}

proc Ppage {} {
global Vcontent Vglobal

	set Vreturn_value 0
	# Text is the basic content of a page. The necessary fields are as follows
	set Vahuevo "$Vglobal(headers_ah,page)"
	if [ Pheader_exists $Vahuevo] { # Not all obligatory headers are present 
					Pdebug "Ppage" "Not all needed headers where found"
					return 80
				       }

	# Default values
	if ![info exists Vcontent(x-parent)] 	{ set Vcontent(x-parent) "" }
	if ![info exists Vcontent(x-icon)]      { set Vcontent(x-icon) "" }
	if ![info exists Vcontent(x-render)]    { set Vcontent(x-render) "yes" }
	if ![info exists Vcontent(x-pid)]	{ set Vcontent(x-pid) [Pget_new_content_uid] }
	# Checkings for pages:
	# Check1 : Parent page must exists (except for index page).

        if ![ string match "index" $Vcontent(x-name) ] { 	
		if [ Ppage_exists $Vcontent(x-parent) ] { 
								Pdebug "Ppage" "Could not find a parent of page $Vcontent(x-name)"
								return 81
							}
	}

	# Check2 :  Category exists
	if [ Pcategory_exists $Vcontent(x-category) ] { return 82 }
	
	if { $Vreturn_value < 1 } {   
		# If no errors
        	# What kind of insert is this ?
	  if { [Ppage_id_exist $Vcontent(x-pid)] > 0 } {
		# This page exists, it is only an update
		Pdebug "Ppage" "Updating page with PID $Vcontent(x-pid)"
		set Vreturn_value [Pupdate_page]	
	  } else {
		# Everything went ok
                Pdebug "Ppage" "All checkings passed. Inserting the page into the database"
		set Vreturn_value [Pinsert_page]
	  }
	}
	return $Vreturn_value
}

proc Ppage_id_exist {Vid} {
	array set Vresult [ Pdb_exec "select * from pages where id='$Vid'" ]
	return $Vresult(0,tups) 
}

proc Ptext {} {
global Vcontent
        set Vreturn_value 0
	set Vahuevo "x-page x-title x-content "

        if [ Pheader_exists $Vahuevo] { # Not all obligatory headers are present
                                        Pdebug "Ptext" "Not all needed headers where found"
                                        return 804
                                       }
        

	# Put default values
	if ![ info exists Vcontent(x-date)   ] {
        	set Vcontent(x-date) [ clock format [ clock seconds ] -format "%d/%m/%Y %H:%M"]}
        if ![ info exists Vcontent(x-author)  ] { set Vcontent(x-author) "" }
	if ![ info exists Vcontent(x-icon)    ] { set Vcontent(x-icon) "" } 
        if ![ info exists Vcontent(x-priority)] { set Vcontent(x-priority) 50 }
        if ![ info exists Vcontent(x-uid)     ] { set Vcontent(x-uid) [Pget_new_content_uid] }

	# Checkings for text:
	
	# Check 1: Page exists
	if [ Ppage_exists $Vcontent(x-page) ] {
                                                  Pdebug "Ptext" "Could not find a parent of page $Vcontent(x-page)"
                                                  return 816
                                                 }	

	# Check 2: UID (complicated)
	
	if [ Pcontent_exists $Vcontent(x-uid) ] {
		# This is an old content. Check that everything is the same. 
		if [ string match "ok" [ Pcontent_compare ]] {
			# uid and everything is the same! 			
			# nothing to be done. Vaction is "" 
			set Vaction ""
		} else {
			# content changed, but uid is the same 
			set Vaction "Pupdate_content"
		} 
        } else {
		set Vaction "Pinsert_text"
	}
	


	if { $Vreturn_value < 1 } {
                # Everything went ok
                Pdebug "Ptext" "All checkings passed. ($Vaction)"
                if  ![ string match "" $Vaction ] {
	                set Vreturn_value       [$Vaction]
                } else {
			return 0
		}
        }

	return $Vreturn_value
}

proc Pcontent_exists {Vid} {
	array set Vresult [ Pdb_exec "select * from content where id = '$Vid'" ]
	return $Vresult(0,tups)
}

proc Pinsert_text {} {
global Vcontent

	# If the text is larger than 8000 characters, split it into several pieces. 
        set Vres_text        [ string range $Vcontent(x-text) 7000 end ]
        set Vcontent(x-text) [ string range $Vcontent(x-text) 0 6999   ] 
	while { [ string length $Vres_text ] > 0 } {
		# Generate child uid and insert into the uid link table
		set Vchild_id [Pget_new_content_uid]
		set Vquery "insert into extra_content values ('$Vcontent(x-uid)','$Vchild_id')"            
		Pdb_exec $Vquery
 
                # Now insert the remaining text
		set Vcur_text [ string range $Vres_text 0 6999 ]
		set Vquery "insert into child_contents values ('$Vchild_id','$Vres_text')"
                Pdb_exec $Vquery

	        # Rip remaining text, if any. 
                set Vres_text [ string range $Vres_text 7000 end ]
        }


	set        Vquery  "insert into content values ("
        append     Vquery  "'$Vcontent(x-uid)','$Vcontent(x-page)','$Vcontent(x-title)','$Vcontent(x-icon)'"
        append     Vquery  ",'$Vcontent(x-author)','$Vcontent(x-date)','$Vcontent(x-text)','[Pdate_now]','1',"
	append 	   Vquery  "'$Vcontent(x-priority)')"
        #puts $Vquery
        array set Vdb_insert [ Pdb_exec $Vquery    ]
        if { [ string length $Vdb_insert(0,error) ] > 1 } {
          Pdebug "Pinsert_text" "Vdb_insert returned: $Vdb_insert(0,error)"         
        }
        Pupdate_page_time $Vcontent(x-page)
	return 0
}

proc Pupdate_content  {} {
global Vcontent
	set Vquery "update content set "
                append Vquery "page='$Vcontent(x-page)', "
                append Vquery "title='$Vcontent(x-title)',"
                append Vquery "icon='$Vcontent(x-icon)',"
                append Vquery "author='$Vcontent(x-author)', "
                append Vquery "date='$Vcontent(x-date)', "
                append Vquery "content='$Vcontent(x-text)', "
                append Vquery "last_modified='[Pdate_now]', "
		append Vquery "priority='$Vcontent(x-priority)' "
                append Vquery "where id='$Vcontent(x-uid)'"
                Pdb_exec $Vquery

        # New rule: whenever updating some comment, update also the page
        Pupdate_page_time $Vcontent(x-page)
	return 0
}

proc Pupdate_page_time {Vpage} {

	set    Vquery "update pages set last_modified='[Pdate_now]' "
	append Vquery "  where name='$Vpage'" 
        Pdb_exec $Vquery
}

proc Pcontent_compare {} {
global Vcontent
        set Vquery    "select * from content where "
        append Vquery "id='$Vcontent(x-uid)' and "
        append Vquery "page='$Vcontent(x-page)' and "
        append Vquery "title='$Vcontent(x-title)' and "
        append Vquery "icon='$Vcontent(x-icon)' and "
        append Vquery "author='$Vcontent(x-author)' and "
        append Vquery "date='$Vcontent(x-date)' and "
        append Vquery "content='$Vcontent(x-text)' and "
	append Vquery "priority='$Vcontent(x-priority)'"
        #Pdebug "Pcontent_compare" "Comparing previous content"
	#puts "$Vquery" 
        array set Vcompare [ Pdb_exec $Vquery ]
	if  { $Vcompare(0,tups) > 0 } {
		return "ok"
	} else {
		return "wrong"
	}	
} 

proc Pget_new_content_uid {} {
  array set Vaux [ Pdb_exec "select nextval('content_seq')" ]
  Pdebug "Pget_new_content_id" "New ID generated: \[$Vaux(0,nextval)\]"
  return $Vaux(0,nextval)
}

proc Pheader_split {Vchunk_number} {
global Vchunk Vcontent

	Pdebug "Pheader_split" "Parsing Chunk $Vchunk_number, looking for headers ($Vchunk($Vchunk_number,lines) lines)"

	# Prepare!

	# Insert into variables
        set Vlast_header "."
	for { set j 0 } { $j < $Vchunk($Vchunk_number,lines) } { incr j 1} {
                set line $Vchunk($Vchunk_number,$j) 
		if ![ string match "" $line ] {

   		  if  [ string match "x-*" $line ] {
			# looks like a header
			set Vfunny_counter 0
                	foreach split_value [ split $line ":" ] {
                          # funny stuff to prevent errors if more than one ":" sign is present
                          switch -exact -- $Vfunny_counter {
                                0  {set key $split_value}
                                1  {set value [string trim $split_value]}
                                default {set value "$value:[string trim $split_value]"}
                          }
                          incr Vfunny_counter
			}
			#Pdebug "Pheader_split" "Found header $key : Value $value"
			set Vcontent($key) "[ string trim $value]"
			set Vlast_header $key
                  } else {
			# not a header, put it on the last one
			if [ info exists Vcontent($Vlast_header) ] { 
				append Vcontent($Vlast_header) "\n$line"
			} else {
				set Vcontent($Vlast_header) "\n$line"
	 		}
		  } 
 		  # end if
		}
		# end if of blank line
	} 
	#puts [ array get Vcontent ]

	# end for
} 

proc Pchunk_parse {} {
global Vglobal Vchunk Vcontent
        # This procedure decides what kind of parsing it would be. 

	set Vreturn_value 0

	for { set i [ expr $Vglobal(count) -1] } { $i > -1 } { incr i -1 } {
		# First, get it into memory divided by headers.
		array unset  Vcontent
		Pheader_split $i

  		# the FIRST label must be CONTENT! PaGEN format says so. 
		
		switch -exact -- $Vcontent(x-content) {
			text    { # content box
				   #Pdebug "Pchunk_parse" "A valid TEXT chunk found ($i). Processing"	
				   set Vreturn_value [ Ptext ]
				}
			page	{ # Parse a page
				   #Pdebug "Pchunk_parse" "A valid PAGE chunk found ($i). Processing"
                                   set Vreturn_value [ Ppage ] 
				}
			child   {
				   #Pdebug "Pchunk_parse" "A valid CHILD CONTENT chunk found ($i). Processing"
				   set Vreturn_value [ Pchild ]
				}          
			default { 
					Pdebug "Pchunk_parse" "Unknown content type : $Vchunk($i,0)"
					Pdebug "Pchunk_parse" "While parsing chunk : $i"
					return 99
				}
		}
		# Break the procedure if an error is found
		if { $Vreturn_value > 0 }	{ 
			return $Vreturn_value 
		} else {
    			# All is ok, dump this chunk with all new values
			Pdump_content 
		} 
  	}

	return $Vreturn_value
}

proc Popen_dump {} {
global Vglobal
	Pdebug "Popen_dump" "Opening new content file"
	set Vglobal(file_dump) [ open "$Vglobal(file).dump" w  ] 
return 0
}

proc Pclose_dump {} {
global Vglobal

	#Pdebug "Pclose_dump" "Closing new file and subst $Vglobal(file) with $Vglobal(file).dump"
	close $Vglobal(file_dump)
	catch { file rename -force -- "$Vglobal(file).dump" "$Vglobal(file)" } result

return $result
}

proc Pdump_content {} {
global Vglobal Vcontent
set Vreturn_value 0

	#puts "---DUMP----"
	#Content type always first!
	puts $Vglobal(file_dump) "x-content: $Vcontent(x-content)"
	
	foreach header "$Vglobal(headers_ah,$Vcontent(x-content))" {
           if ![ string match "x-content" $header  ] { 
	      puts $Vglobal(file_dump) "$header: $Vcontent($header)"
	   }
	}
        # dynamic header output. I dont use the fixed headers_op, because I want 
	# this to be *VERY* dynamic
	foreach header "[ array names Vcontent "x-*" ]" {
		if ![ string match "*$header*" "$Vglobal(headers_ah,$Vcontent(x-content))" ] {
			puts $Vglobal(file_dump) "$header: $Vcontent($header)"
		}
	}

	# Separate each record with a new line
	puts $Vglobal(file_dump) ""
	#puts "---/DUMP---"

return $Vreturn_value
}

proc Pchunk_split {} {
global Vglobal
 # This procedure is the one that splits the content of the file in
 # "chunks" of information. 

  Pdebug "Pchunk_split" "Parsing content..."
  set Vinput_file [ open $Vglobal(file) r ]
  set Vfile_content [ read $Vinput_file ]
 
 
  # Look for the last x-content
  set Vlast_content [ string last "x-content:" $Vfile_content ]
  if { $Vlast_content == -1 } {
    Pdebug "Pchunk_split" "ERR2: While parsing the input file. No content markers \"x-content:\" where found."
    Pdebug "Pchunk_split" "      Be sure the input file is in PaGEN format."
    return 2
  } else {
    Pdebug  "Pchunk_split" "Content found, dividing chunks. ($Vlast_content)"
    set Vcounter 0
    set Vglobal(count) 0
    # This parsing procedure came after three cigarettes. *MUST* be reformulated, I find it
    # very jalada de los pelos. Sorry for the non-spanish speakers. I dont know a term for this in 
    # English. 
 
    set Vstring_left [ string length $Vfile_content ];  # what is to be parsed.
    while { ( $Vstring_left > 0 ) && ( $Vlast_content > -1 ) } {
       set Vglobal($Vglobal(count),chunk) "[ string range $Vfile_content $Vlast_content end ]"
       set Vfile_content [ string range $Vfile_content 0 [ expr $Vlast_content -1] ]
       set Vlast_content [ string last "x-content:" $Vfile_content ]
       set Vstring_left [ string length $Vfile_content ]
       incr Vglobal(count) 1
    }
  }
  close $Vinput_file
  Pdebug "Pchunk_split" "$Vglobal(count) chunks found and read"
  return 0
}

proc main {argv argc} {
global Vglobal
 
  if { $argc != 1 } {
      Pusage
  } else {
      Pdb_connect
      set Vglobal(file) $argv
      foreach Vaux_phase "Pcheck_file Pheader_list Pchunk_split Pchunk_mount_memory Popen_dump Pchunk_parse Pclose_dump" {
         set Vreturn [ $Vaux_phase ]
         set Vmess   "Program_phase: $Vaux_phase"
         if  { $Vreturn > 0 } {
           append Vmess " \t\t\t\tERROR:QUIT:$Vreturn"
           Pshutdown $Vmess 
         } else {
 	   Pdebug "Main" "OK | $Vmess"
	 } 
      
      }
      Pdb_disconnect
  }
}
 
main $argv $argc
