Index: openacs-4/packages/acs-admin/tcl/apm-admin-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/tcl/apm-admin-procs.tcl,v diff -u -r1.18 -r1.19 --- openacs-4/packages/acs-admin/tcl/apm-admin-procs.tcl 13 Feb 2009 20:28:08 -0000 1.18 +++ openacs-4/packages/acs-admin/tcl/apm-admin-procs.tcl 27 Oct 2014 16:38:51 -0000 1.19 @@ -33,7 +33,7 @@ } } -ad_proc apm_header { { -form "" } args } { +ad_proc -deprecated apm_header { { -form "" } args } { Generates HTML for the header of a page (including context bar). Must only be used for APM admin pages (under /acs-admin/apm). @@ -59,10 +59,10 @@ # this is rather a hack, but just needed for streaming output # a more general solution can be provided at some later time... regsub "#acs-kernel.Main_Site#" $context_bar \ - [_ acs-kernel.Main_Site] context_bar + [_ acs-kernel.Main_Site] context_bar } - set header [ad_header $title ""] - append body "$header\n" + + append body [ad_header $title ""] "\n" if {$form ne ""} { append body "
" } @@ -74,7 +74,10 @@ " } -ad_proc apm_shell_wrap { cmd } { Returns a command string, wrapped it shell-style (with backslashes) in case lines get too long. } { +ad_proc apm_shell_wrap { cmd } { + Returns a command string, wrapped it shell-style (with backslashes) + in case lines get too long. +} { set out "" set line_length 0 foreach element $cmd { @@ -91,94 +94,57 @@ ad_proc -private apm_package_selection_widget { - -install_enable:boolean pkg_info_list {to_install ""} - {to_enable ""} } { Provides a widget for selecting packages. Displays dependency information if available. - - @param intall_enable Set this flag if you want separate install and enable checkboxes to be displayed. If you don't set it, - only the enable checkbox will be displayed, and the resulting page is expected to assume that enable also means install. + @param pkg_info_list list of package infos for all packages to be listed + @param to_install list of package_keys to install } { if {$pkg_info_list eq ""} { return "" } - - set checkbox_count 0 + set counter 0 - set band_colors { white "#ececec" } - set widget "
-[ad_decode $install_enable_p 1 "" ""] - " + set widget "
InstallEnablePackageDirectoryComment
+ " foreach pkg_info $pkg_info_list { incr counter set package_key [pkg_info_key $pkg_info] set package_path [pkg_info_path $pkg_info] - set package_rel_path [string range $package_path [string length [acs_root_dir]] end] set spec_file [pkg_info_spec $pkg_info] array set package [apm_read_package_info_file $spec_file] set version_name $package(name) ns_log Debug "Selection widget: $package_key, Dependency: [pkg_info_dependency_p $pkg_info]" - - append widget " " - if { [pkg_info_dependency_p $pkg_info] eq "t" } { + append widget " " + if { [pkg_info_dependency_p $pkg_info] == "t" } { # Dependency passed. - if { $install_enable_p } { - if { ([lsearch -exact $to_install $package_key] != -1) } { - append widget " " - } else { - append widget " " - } - } - if { [lsearch -exact $to_enable $package_key] != -1 } { + if { $package_key in $to_install } { append widget " - - - + + " - } elseif { [pkg_info_dependency_p $pkg_info] eq "f" } { + } elseif { [pkg_info_dependency_p $pkg_info] == "f" } { #Dependency failed. - if { $install_enable_p } { - append widget " " - } append widget " - + - - + " } else { - # No dependency information. + # No dependency information. # See if the install is already installed with a higher version number. if {[apm_package_registered_p $package_key]} { set higher_version_p [apm_higher_version_installed_p $package_key $version_name] - } else { - set higher_version_p 2 - } - if {$higher_version_p == 2 } { - set comment "New install." - } elseif {$higher_version_p == 1 } { - set comment "Upgrade." - } elseif {$higher_version_p == 0} { - set comment "Package version already installed." - } else { - set comment "Installing older version of package." - } - - append widget " " - - if { ([lsearch -exact $to_install $package_key] != -1) } { - set install_checked "checked" - } else { - set install_checked "" + } else { + set higher_version_p 2 } - if { ([lsearch -exact $to_enable $package_key] != -1) } { - set enable_checked "checked" - } else { - set enable_checked "" - } - - if { $install_enable_p } { - append widget " - " + if {$higher_version_p == 2 } { + set comment "New install." + } elseif {$higher_version_p == 1 } { + set comment "Upgrade." + } elseif {$higher_version_p == 0} { + set comment "Package version already installed." } else { - append widget " - " + set comment "Installing older version of package." } - + + set install_checked [lindex {"" checked} [expr {$package_key in $to_install}]] append widget " - - + + + " } - incr checkbox_count 2 } - append widget "
InstallPackagePackage KeyComment
$package(package-name) $package(name)$package_rel_pathDependencies satisfied.$package_keyDependencies satisfied.
$package(package-name) $package(name)$package_rel_path + $package_key " foreach comment [pkg_info_comment $pkg_info] { append widget "$comment
" @@ -188,55 +154,33 @@
$package(package-name) $package(name)$package_rel_path$package(package-name) $package(name)$package_key $comment
" + append widget "\n" return $widget } @@ -250,12 +194,12 @@ @param version_name The name of the currently installed version. @return The return value of this procedure doesn't really fit with its name. - What it returns is: + What it returns is: } { @@ -265,47 +209,52 @@ # LARS: Default to 1 (the package_key/version_name you supplied was higher than what's on the system) # for the case where nothing it returned, because this implies that there was no highest version installed, # i.e., no version at all of the package was installed. + return [db_string apm_higher_version_installed_p {} -default 1] } ad_proc -private apm_build_repository { - {debug_p 0} - {head_channel 5-2} + {-debug:boolean 0} + {-channels *} + {-head_channel 5-9} } { - Rebuild the repository on the local machine. Only useful for the openacs.org site. Adapted from Lars' build-repository.tcl page. - @param debug_p Set to 1 to test with only a small subset of packages instead of the whole cvs tree. + Rebuild the repository on the local machine. + Only useful for the openacs.org site. + Adapted from Lars' build-repository.tcl page. + @param debug Set to 1 to test with only a small subset of packages instead of the whole cvs tree. @param head_channel The artificial branch label to apply to HEAD. Should be one minor version past the current release. + @param channels Generate apm files for the matching channels only @author Lars Pind (lars@collaboraid.biz) - @return 0 for success. Also outputs debug strings to log. + @return 0 for success. Also outputs debug messages to log. } { #---------------------------------------------------------------------- # Configuration Settings #---------------------------------------------------------------------- - set cvs_command "cvs" - set cvs_root ":pserver:anonymous@cvs.openacs.org:/cvsroot" + set cd_helper $::acs::rootdir/bin/cd-helper - set work_dir "[acs_root_dir]/repository-builder/" + set cvs_command cvs + set cvs_root :pserver:anonymous@cvs.openacs.org:/cvsroot - set repository_dir "[acs_root_dir]/www/repository/" - set repository_url "http://openacs.org/repository/" + set work_dir $::acs::rootdir/repository-builder/ - set channel_index_template "/packages/acs-admin/www/apm/repository-channel-index" - set index_template "/packages/acs-admin/www/apm/repository-index" + set repository_dir $::acs::rootdir/www/repository/ + set repository_url http://openacs.org/repository/ + set channel_index_template /packages/acs-admin/www/apm/repository-channel-index + set index_template /packages/acs-admin/www/apm/repository-index + set exclude_package_list {} #---------------------------------------------------------------------- # Prepare output #---------------------------------------------------------------------- - ReturnHeaders - ns_log Debug [ad_header "Building repository"] ns_log Debug "Repository: Building Package Repository" #---------------------------------------------------------------------- @@ -316,257 +265,348 @@ file mkdir $work_dir cd $work_dir - catch { exec $cvs_command -d $cvs_root -z3 co openacs-4/readme.txt } + catch { exec $cd_helper $work_dir $cvs_command -d $cvs_root -z3 co openacs-4/readme.txt } msg + catch { exec $cd_helper $work_dir $cvs_command -d $cvs_root -z3 log -h openacs-4/readme.txt } output - catch { exec $cvs_command -d $cvs_root -z3 log -h openacs-4/readme.txt } output - set lines [split $output \n] for { set i 0 } { $i < [llength $lines] } { incr i } { - if { [string equal [string trim [lindex $lines $i]] "symbolic names:"] } { - incr i - break - } + if { [string trim [lindex $lines $i]] eq "symbolic names:" } { + incr i + break + } } array set channel_tag [list] array set channel_bugfix_version [list] for { } { $i < [llength $lines] } { incr i } { - # Tag lines have the form tag: cvs-version - # openacs-5-0-0-final: 1.25.2.5 + # Tag lines have the form tag: cvs-version + # openacs-5-0-0-final: 1.25.2.5 - if { ![regexp {^\s+([^:]+):\s+([0-9.]+)} [lindex $lines $i] match tag_name version_name] } { - break - } - - # Look for tags named 'openacs-x-y-compat' - if { [regexp {^openacs-([1-9][0-9]*-[0-9]+)-compat$} $tag_name match oacs_version] } { - - set major_version [lindex [split $oacs_version "-"] 0] - set minor_version [lindex [split $oacs_version "-"] 1] - - if { $major_version >= 5 } { - set channel "${major_version}-${minor_version}" - - ns_log Debug "Repository: Found channel $channel using tag $tag_name" - - set channel_tag($channel) $tag_name - } - } + if { ![regexp {^\s+([^:]+):\s+([0-9.]+)} [lindex $lines $i] match tag_name version_name] } { + break + } + + # Look for tags named 'openacs-x-y-compat' + if { [regexp {^openacs-([1-9][0-9]*-[0-9]+)-compat$} $tag_name match oacs_version] } { + lassign [split $oacs_version "-"] major_version minor_version + if { $major_version >= 5 && $minor_version >= 3} { + set channel "${major_version}-${minor_version}" + ns_log Notice "Repository: Found channel $channel using tag $tag_name" + set channel_tag($channel) $tag_name + } + } } set channel_tag($head_channel) HEAD + ns_log Notice "Repository: Channels are: [array get channel_tag]" - ns_log Debug "Repository: Channels are: [array get channel_tag]" - #---------------------------------------------------------------------- # Read all package .info files, building manifest file #---------------------------------------------------------------------- # Wipe and re-create the working directory file delete -force $work_dir file mkdir ${work_dir} - cd $work_dir + set update_pretty_date [lc_time_fmt [clock format [clock seconds] -format "%Y-%m-%d %T"] %c] + #cd $work_dir + foreach channel [lsort -decreasing [array names channel_tag]] { - ns_log Debug "Repository:

Channel $channel using tag $channel_tag($channel)