- merged b2-0 changes

- /admin/menus missing

checkout-all.sh

 #!/bin/bash
 
+#
+# checkout-all.sh
+# V1.1, 2004-07-30
+#
+# Checks out all packages that make up P/O
+#
+
 cvs checkout intranet-big-brother
 cvs checkout intranet-core
 cvs checkout intranet-cost

intranet-core.info

@@ -8,13 +8,16 @@
     <singleton-p>t</singleton-p>
     <auto-mount>intranet</auto-mount>
 
-    <version name="2.1.0" url="http://openacs.org/repository/download/apm/intranet-core-2.1.0.apm">
-        <owner url="mailto:fraber@project-open.com">Frank Bergmann</owner>
-        <release-date>2004-02-17</release-date>
-        <vendor url="http://www.project-open.com/">Project/Open</vendor>
+    <version name="2.1.1" url="http://openacs.org/repository/download/apm/intranet-core-2.1.1.apm">
+    <owner url="mailto:fraber@project-open.com">Frank Bergmann</owner>
+
+
+    <release-date>2004-08-17</release-date>
+    <vendor url="http://www.project-open.com/">Project/Open</vendor>
+
+    <provides url="intranet-core" version="2.1.1"/>
+    <requires url="acs-subsite" version="5.0"/>
 
-        <provides url="intranet-core" version="2.1.1"/>
-        <requires url="acs-subsite" version="5.0"/>
 
         <callbacks>
         </callbacks>
@@ -28,6 +31,7 @@
             <parameter datatype="string"  min_n_values="1"  max_n_values="1"  name="SystemLogoLink"  default="http://www.project-open.org/" description="SystemLogoLink"/>
             <parameter datatype="number"  min_n_values="1"  max_n_values="1"  name="SystemNavbarGifPath"  default="/intranet/images/navbar_default" description="Where are the GIFs located for the navbar?"/>
             <parameter datatype="number"  min_n_values="1"  max_n_values="1"  name="TestDemoDevServer"  default="0" description="TestDemoDevServer"/>
+
         </parameters>
 
     </version>

sql/oracle/intranet-menus.sql

@@ -247,6 +247,7 @@ declare
 	v_admin_matrix_menu	integer;
 	v_admin_parameters_menu	integer;
 	v_admin_profiles_menu	integer;
+	v_admin_menus_menu	integer;
 	v_admin_home_menu	integer;
 
 	-- Groups
@@ -544,6 +545,16 @@ begin
 	label =>	'admin_profiles',
 	name =>		'Profiles',
 	url =>		'/intranet/admin/profiles/',
+	sort_order =>	15,
+	parent_menu_id => v_admin_menu
+    );
+    acs_permission.grant_permission(v_admin_profiles_menu, v_admins, 'read');
+
+    v_admin_menus_menu := im_menu.new (
+	package_name =>	'intranet',
+	label =>	'admin_menus',
+	name =>		'Menus',
+	url =>		'/intranet/admin/menus/',
 	sort_order =>	20,
 	parent_menu_id => v_admin_menu
     );

sql/oracle/intranet-projects.sql

@@ -44,8 +44,7 @@ create table im_projects (
 				primary key 
 				constraint im_project_prj_fk 
 				references acs_objects,
-	project_name		varchar(1000) not null
-				constraint im_projects_name_un unique,
+	project_name		varchar(1000) not null,
 	project_nr		varchar(100) not null
 				constraint im_projects_nr_un unique,
 	project_path		varchar(100) not null
@@ -88,7 +87,11 @@ create table im_projects (
 	requires_report_p	char(1) default('t')
 				constraint im_project_requires_report_p 
 				check (requires_report_p in ('t','f')),
-	project_budget		number(12,2)
+	project_budget		number(12,2),
+		-- Don't allow the same name for the same customer+level
+		constraint im_projects_name_un 
+		unique(project_name, customer_id, parent_id)
+
 );
 
 create index im_project_parent_id_idx on im_projects(parent_id);

sql/oracle/upgrade/upgrade-2.0.0-2.0.1.sql

-------------------------------------------------------------------------------
--- packages/intranet-core/sql/oracle/upgrade-2.0.0-2.0.1.sql
---
--- @author frank.bergmann@project-open.com
--- @creation-date 2004-08-01
---
 
-update im_view_columns set column_name='Company' where column_id=1;
+alter table im_view_columns add
+	extra_from		varchar(4000);
 
 @../intranet-customers.sql
 @../intranet-categories.sql
@@ -14,3 +9,5 @@ update im_view_columns set column_name='Company' where column_id=1;
 alter table im_view_columns add
 	extra_from             varchar(4000);
 
+alter table im_view_columns add 
+	order_by_clause         varchar(4000);

tcl/intranet-design-procs.tcl

@@ -55,6 +55,7 @@ ad_proc -public im_gif { name {alt ""} { border 0} {width 0} {height 0} } {
 	"tick"		{ return "<img src=$url/tick.gif width=14 heigth=15 border=$border alt='$alt'>" }
 	"wrong"		{ return "<img src=$url/delete.gif width=14 heigth=15 border=$border alt='$alt'>" }
 	"turn"		{ return "<img src=$url/turn.gif widht=15 height=15 border=$border alt='$alt'>" }
+	"tool"		{ return "<img src=$url/tool.15.gif widht=20 height=15 border=$border alt='$alt'>" }
 	"exp-folder"	{ return "<img src=$url/exp-folder.gif width=19 heigth=16 border=$border alt='$alt'>" }
 	"exp-minus"	{ return "<img src=$url/exp-minus.gif width=19 heigth=16 border=$border alt='$alt'>" }
 	"exp-unknown"	{ return "<img src=$url/exp-unknown.gif width=19 heigth=16 border=$border alt='$alt'>" }
@@ -162,11 +163,13 @@ ad_proc -public im_table_with_title { title body } {
 # Navigation Bars
 # --------------------------------------------------------
 
-ad_proc -public im_user_navbar { default_letter base_url next_page_url prev_page_url export_var_list } {
+ad_proc -public im_user_navbar { default_letter base_url next_page_url prev_page_url export_var_list {select_label ""} } {
     Returns rendered HTML code for a horizontal sub-navigation
     bar for /intranet/users/.
     The lower part of the navbar also includes an Alpha bar.<br>
     Default_letter==none marks a special behavious, printing no alpha-bar.
+
+    @param select_label Label of a menu item to highlight
 } {
     # -------- Defaults -----------------------------
     set user_id [ad_get_user_id]
@@ -200,7 +203,7 @@ ad_proc -public im_user_navbar { default_letter base_url next_page_url prev_page
     # Get the Subnavbar
     set parent_menu_sql "select menu_id from im_menus where name='Users'"
     set parent_menu_id [db_string parent_admin_menu $parent_menu_sql]
-    set navbar [im_sub_navbar $parent_menu_id "" $alpha_bar "tabnotsel"]
+    set navbar [im_sub_navbar $parent_menu_id "" $alpha_bar "tabnotsel" $select_label]
 
     return $navbar
 }
@@ -482,7 +485,7 @@ ad_proc -public im_admin_navbar { } {
 
 
 
-ad_proc -public im_sub_navbar { parent_menu_id {bind_vars ""} {title ""} {title_class "pagedesriptionbar"} } {
+ad_proc -public im_sub_navbar { parent_menu_id {bind_vars ""} {title ""} {title_class "pagedesriptionbar"} {select_label ""} } {
     Setup a sub-navbar with tabs for each area, highlighted depending
     on the local URL and enabled depending on the user permissions.
     @param parent_menu_id id of the parent menu in im_menus
@@ -490,6 +493,8 @@ ad_proc -public im_sub_navbar { parent_menu_id {bind_vars ""} {title ""} {title_
     @title string to go into the line below the menu tabs
     @title_class CSS class of the title line
 } {
+    ns_log Notice "im_sub_navbar: parent_menu_id=$parent_menu_id, bind_vars=$bind_vars, title=$title, select_label=$select_label"
+
     set user_id [ad_get_user_id]
     set url_stub [ns_conn url]
 
@@ -530,7 +535,12 @@ ad_proc -public im_sub_navbar { parent_menu_id {bind_vars ""} {title ""} {title_
         set selected 0
         set url_length [expr [string length $url] - 1]
         set url_stub_chopped [string range $url_stub 0 $url_length]
-        if {!$found_selected && [string equal $url_stub $url]} {
+
+	ns_log Notice "im_sub_navbar: check select for label='$label' against select_label='$select_label'"
+
+        if {[string equal $label $select_label]} {
+	    
+	    ns_log Notice "im_sub_navbar: highlight menu_name='$name'"
             # Make sure we only highligh one menu item..
             set found_selected 1
             # Set for the gif

tcl/intranet-menu-procs.tcl

+# /packages/intranet-core/tcl/intranet-menu-procs.tcl
+#
+# Copyright (C) 2004 Project/Open
+#
+# This program is free software. You can redistribute it
+# and/or modify it under the terms of the GNU General
+# Public License as published by the Free Software Foundation;
+# either version 2 of the License, or (at your option)
+# any later version. This program is distributed in the
+# hope that it will be useful, but WITHOUT ANY WARRANTY;
+# without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.
+# See the GNU General Public License for more details.
+
+ad_library {
+    Library with auxillary routines related to im_menus.
+
+    @author frank.bergmann@project-open.com
+}
+
+ad_proc -public im_menu_parent_options { {include_empty 0} } {
+    Returns a list of all menus,
+    ordered and indented according to hierarchy.
+} {
+
+    set start_menu_id [db_string start_menu_id "select menu_id from im_menus where label='main'" -default 0]
+
+    set parent_options_sql "
+	select
+		m.name,
+		m.menu_id,
+		m.label,
+		(level-1) as indent_level
+	from
+		im_menus m
+	start with
+		menu_id = :start_menu_id
+	connect by
+		parent_menu_id = PRIOR menu_id"
+
+    set parent_options [list]
+    db_foreach parent_options $parent_options_sql {
+	set spaces ""
+	for {set i 0} {$i < $indent_level} { incr i } {
+	    append spaces "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"
+	}
+	lappend parent_options [list "$spaces$name - $label" $menu_id]
+    }
+    return $parent_options
+}
+
+
+

www/admin/backup/backup.tcl

@@ -13,6 +13,7 @@ set user_id [ad_maybe_redirect_for_registration]
 set page_title "Backup"
 set context_bar [ad_context_bar $page_title]
 set page_body "<H1>$page_title</H1>"
+set today [db_string today "select to_char(sysdate, 'YYYY-MM-DD') from dual"]
 
 set user_admin_p [im_is_user_site_wide_or_intranet_admin $user_id]
 if {!$user_admin_p} {
@@ -20,6 +21,7 @@ if {!$user_admin_p} {
     return
 }
 
+
 set sql "
 select
 	v.*
@@ -30,14 +32,48 @@ where
 	and view_id < 200
 "
 
+# Prepare the path for the export
+#
+if {![file isdirectory $path]} {
+    if { [catch {
+	ns_log Notice "/bin/mkdir $path"
+	exec /bin/mkdir "$path"
+    } err_msg] } {
+	ad_return_complaint 1 "Error creating subfolder $path:<br><pre>$err_msg\m</pre>"
+	return
+    }
+}
+
+append path "$today/"
+if {![file isdirectory $path]} {
+    if { [catch {
+	ns_log Notice "/bin/mkdir $path"
+	exec /bin/mkdir "$path"
+    } err_msg] } {
+	ad_return_complaint 1 "Error creating subfolder $path:<br><pre>$err_msg\m</pre>"
+	return
+    }
+}
+
 append page_body "<ul>\n"
 db_foreach foreach_report $sql {
     append page_body "<li>Exporting $view_name ..."
     set report [im_backup_report $view_id]
-    set stream [open /tmp/$view_name.csv w]
-    puts $stream $report
-    close $stream
+    
+    if { [catch {
+	ns_log Notice "/intranet/admin/backup/backup: writing report to $path"
+	
+	set stream_name "$path$view_name.csv"
+	set stream [open $stream_name w]
+	puts $stream $report
+	close $stream
+	
+    } err_msg] } {
+	ad_return_complaint 1 "Error writing report to file $stream_name:<br><pre>$err_msg\m</pre>"
+	return
+    }
 }
+
 append page_body "
 </ul>
 Successfully finished

www/admin/index.adp

@@ -12,6 +12,13 @@
       <li>
 	<A href="../users/">Manage Individual Users</A><br>
 	Here you can manage users one-by-one.
+      <li>
+	<A href="profiles/">Manage Profiles</A><br>
+	Configure site-wide defaults on what a group of users ("profile")
+	can do and what they shouldn't do.
+      <li>
+	<A href="menus/">Manage Menus</A><br>
+	Edit menus and change their permissions.
       <li>
 	<A href="parameters/">Manage Global System Parameters</A><br>
 	Change the system parametrization such as directories, URLs, etc...
@@ -33,13 +40,22 @@
 	Here you find advance software configuration options
 	of the underlying 
 	<A href=http://www.openacs.org>OpenACS platform</A>.
-	<li>
-	  <a href=/intranet/projects/import-project-txt>Import Projects from H:\\</a>
 
+<if [db_table_exists im_dynval_vars]>
+      <li>
+	<a href=/intranet-dynvals/admin/>Administer DynVals</a><br>
+	Modify the access permissions for "dynamic variables" or add
+	new dynamic (custom) variables.
+</if>
+
+      <li>
+	<a href=/intranet/projects/import-project-txt>
+	  Import Projects from H:\\
+      </a>
+    </ul>
 
-      </ul>
 <b>Dangerous!!</b>
-      <ul>
+    <ul>
 	<li>
 	  <a href=/intranet/anonymize>Anonymize this server (Test servers only)</a>
 	  This command destroys your entire server, replacing all strings (project

www/admin/user_matrix/index.tcl

@@ -33,7 +33,7 @@ set context [list "Groups"]
 set this_url [ad_conn url]
 set subsite_id [ad_conn subsite_id]
 
-set group_url "/intranet/admin/user_matrix/group"
+set group_url "/admin/groups/one"
 set toggle_url "/intranet/admin/user_matrix/toggle"
 
 set group_list_sql {

www/admin/user_matrix/toggle.tcl

@@ -90,7 +90,7 @@ switch $action {
 	    end;
 	"
     }
-    other {
+    default {
 	ad_return_complaint 1 "Unknown 'action': $action"
 	return
     }

www/projects/view.adp

@@ -35,11 +35,13 @@
 
   <%= [im_component_insert "Project Filestorage Component"] %>
 
+<% } elseif {[string equal "sales" $view_name]} { %>
+
+  <%= [im_component_insert "Project Sales Filestorage Component"] %>
+
 <% } elseif {[string equal "status" $view_name]} { %>
 
   <%= [im_component_insert "Project Translation Error Component"] %>
   <%= [im_component_insert "Project Translation Task Status"] %>
 
 <% } %>
-
-

www/style/style.default.css

@@ -24,6 +24,10 @@
     .rowodd {font-size: 8pt; background-color: #EEEEEE;}
     .rowplain {font-size: 8pt; background-color: #FFFFFF;}
 
+    .form-label {font-size: 8pt; background-color: #DDDDDD;}
+    .form-widget {font-size: 8pt; background-color: #EEEEEE;}
+    .form-required-mark {color: #FF0000;}
+
     .rowgreen {font-size:8pt; background-color: #00FF00 }
     .rowyellow {font-size:8pt; background-color: #FFFF00}
     .rowred {font-size:8pt; background-color: #FF0000}

www/users/index.tcl

@@ -444,7 +444,7 @@ set table_continuation_html ""
 
 set page_body "
 <br>
-[im_user_navbar $letter "/intranet/users/index" $next_page_url $previous_page_url [list start_idx order_by how_many view_name user_group_name letter]]
+[im_user_navbar $letter "/intranet/users/index" $next_page_url $previous_page_url [list start_idx order_by how_many view_name user_group_name letter] $menu_select_label]
 
 <table width=100% cellpadding=2 cellspacing=2 border=0>
   $table_header_html

www/users/view.tcl

@@ -23,6 +23,7 @@ ad_page_contract {
 } {
     { user_id:integer 0}
     { object_id:integer 0}
+    { user_id_from_search 0}
     { view_name "user_view" }
     { contact_view_name "user_contact" }
     { freelance_view_name "user_view_freelance" }
@@ -37,7 +38,18 @@ set current_url $return_url
 set td_class(0) "class=roweven"
 set td_class(1) "class=rowodd"
 
-if {0 == $user_id} {set user_id $object_id}
+# user_id is a bad variable for the object,
+# because it is overwritten by SQL queries.
+# So first find out which user we are talking
+# about...
+
+set vars_set [expr ($user_id > 0) + ($object_id > 0) + ($user_id_from_search > 0)]
+if {$vars_set > 1} {
+    ad_return_complaint 1 "<li>You have set the user_id in more then one of the following parameters: <br>user_id=$user_id, <br>object_id=$object_id and <br>user_id_from_search=$user_id_from_search."
+    return
+}
+if {$object_id} {set user_id_from_search $object_id}
+if {$user_id} {set user_id_from_search $user_id}
 if {0 == $user_id} {
     # The "Unregistered Vistior" user
     # Just continue and show his data...
@@ -46,8 +58,8 @@ if {0 == $user_id} {
 set current_user_id [ad_maybe_redirect_for_registration]
 set subsite_id [ad_conn subsite_id]
 
-# Check the permissions that the current_user has on user_id
-im_user_permissions $current_user_id $user_id view read write admin
+# Check the permissions 
+im_user_permissions $current_user_id $user_id_from_search view read write admin
 
 # ToDo: Cleanup component to use $write instead of $edit_user
 set edit_user $write
@@ -77,12 +89,12 @@ select
 from
 	cc_users u
 where
-	u.user_id = :user_id
+	u.user_id = :user_id_from_search
 "]
 
 if { $result != 1 } {
     ad_return_complaint "Bad User" "
-    <li>We couldn't find user #$user_id; perhaps this person was nuked?"
+    <li>We couldn't find user #$user_id_from_search; perhaps this person was nuked?"
     return
 }
 
@@ -114,11 +126,7 @@ order by
 	sort_order"
 
 
-set ttt "
-<input type=\"hidden\" name=\"form:mode\" value=\"display\" />
-<input type=\"hidden\" name=\"form:id\" value=\"user_info\" />
-"
-
+set user_id $user_id_from_search
 set user_basic_info_html "
 <form method=POST action=new>
 [export_form_vars user_id return_url]
@@ -154,7 +162,7 @@ append user_basic_info_html "
 <tr $td_class([expr $ctr % 2])>
   <td>Profile</td>
   <td>
-    [im_user_profile_component $user_id "disabled"]
+    [im_user_profile_component $user_id_from_search "disabled"]
   </td>
 </tr>
 <tr>
@@ -170,16 +178,6 @@ append user_basic_info_html "
 </table>
 </form>\n"
 
-set ttt "
-<form method=POST action=profile-update>
-[export_form_vars user_id return_url]
-
-<table cellspacing=1 cellpadding=1>
-<tr><td align=center class=rowtitle>Profiles</td></tr>
-</table>
-</form>
-"
-
 set profile_html ""
 
 # ---------------------------------------------------------------
@@ -215,7 +213,7 @@ from
         country_codes ha_cc,
         country_codes wa_cc
 where
-	c.user_id = :user_id
+	c.user_id = :user_id_from_search
 	and c.ha_country_code = ha_cc.iso(+)
 	and c.wa_country_code = wa_cc.iso(+)
 "]
@@ -240,6 +238,7 @@ where
 order by
 	sort_order"
 
+    set user_id $user_id_from_search
     set contact_html "
 <form method=POST action=contact-edit>
 [export_form_vars user_id return_url]
@@ -266,6 +265,7 @@ order by
     # There is no contact information specified
     # => allow the user to set stuff up. "
 
+    set user_id $user_id_from_search
     set contact_html "
 <form method=POST action=contact-edit>
 [export_form_vars user_id return_url]
@@ -294,7 +294,7 @@ from
 	im_projects p,
 	acs_rels r
 where 
-	r.object_id_two = :user_id
+	r.object_id_two = :user_id_from_search
 	and r.object_id_one = p.project_id
 order by p.project_nr desc
 "
@@ -318,7 +318,7 @@ if { [empty_string_p $projects_html] } {
 }
 
 if {$ctr > $max_projects} {
-    append projects_html "<li><A HREF='/intranet/projects/index?user_id_from_search=$user_id&status_id=0'>more projects...</A>\n"
+    append projects_html "<li><A HREF='/intranet/projects/index?user_id_from_search=$user_id_from_search&status_id=0'>more projects...</A>\n"
 }
 
 
@@ -349,6 +349,7 @@ if { [info exists registration_ip] && ![empty_string_p $registration_ip] } {
 
 # append admin_links "<li> User state: $user_state"
 
+set user_id $user_id_from_search
 set change_pwd_url "/intranet/users/password-update?[export_url_vars user_id return_url]"
 
 # Return a pretty member state (no normal user understands "banned"...)
@@ -361,11 +362,11 @@ case $member_state {
 append admin_links "
           <li>Member state: $user_state (<a href=/acs-admin/users/member-state-change?member_state=approved&[export_url_vars user_id return_url]>activate</a>, <a href=/acs-admin/users/member-state-change?member_state=banned&[export_url_vars user_id return_url]>delete</a>)
           <li><a href=$change_pwd_url>Update this user's password</a>
-          <li><a href=become?user_id=$user_id>Become this user!</a>
+          <li><a href=become?user_id=$user_id_from_search>Become this user!</a>
 <!--
           <li>
               <form method=POST action=search>
-              <input type=hidden name=u1 value=$user_id>
+              <input type=hidden name=u1 value=$user_id_from_search>
               <input type=hidden name=target value=/admin/users/merge/merge-from-search.tcl>
               <input type=hidden name=passthrough value=u1>
                   Search for an account to merge with this one: 
@@ -399,7 +400,7 @@ from
 	cr_items c
 where 
 	a.object_id_two = c.item_id
-	and a.object_id_one = :user_id
+	and a.object_id_one = :user_id_from_search
 	and a.rel_type = 'user_portrait_rel'"] 
     || [empty_string_p $revision_id]
 } {
@@ -441,7 +442,7 @@ if {$portrait_p} {
 	set widthheight ""
     }
     
-    set portrait_gif "<img $widthheight src=\"/shared/portrait-bits.tcl?user_id=$user_id\" alt=\"$portrait_alt\">"
+    set portrait_gif "<img $widthheight src=\"/shared/portrait-bits.tcl?user_id=$user_id_from_search\" alt=\"$portrait_alt\">"
 
 } else {
 
@@ -451,7 +452,7 @@ if {$portrait_p} {
     if {$admin} { append description "<br>\nPlease upload a portrait."}
 }
 
-
+set user_id $user_id_from_search
 set portrait_admin "
 <li><a href=\"/intranet/users/portrait/upload?$export_vars\">Upload portrait</a></li>
 <li><a href=\"/intranet/users/portrait/erase?$export_vars\">Delete portrait</a></li>\n"