english version "1.0" identify "wxyz" #: Copyright (c) 1995, 2002 by Wayne C. Gramlich. #, All rights reserved. #, #, Permission to use, copy, modify, distribute, and sell this software #, for any purpose is hereby granted without fee provided that the above #, copyright notice and this permission are retained. The author makes #, no representations about the suitability of this software for any purpose. #, It is provided "as is" without express or implied warranty. module svms #: This module implements the top-level Source Version Management System #, command. import address character chunk command_parse command_types data_io delta differ directory errors file_name file_system format history in_stream logical misc out_stream project resources set slice status string system table timer unsigned user vector version define comment_type #: Type of comment enumeration none #: There is no comment pipe #: Read the comment from standard ina prompt #: Prompt for a comment generate print define diffs_options #: Options for `svms diffs' command record file_list vector[string] #: file_list ... => files to check generate allocate, erase, print define file_operation #: Type of file operation enumeration close #: Close an open file create #: Create a new file get #: Get a read-only version of a file open #: Open a file for editing unedit #: Revert to previous unedited file generate equal, print define file_options #: Options for `svms close' command record binary logical #: [-b] => force files into binary mode file_list vector[string] #: file_list ... => files to work on force logical #: [-f] => force symbolic link accept no_comment logical #: [-n] => do not record a comment use_pipe logical #: [-p] => use stdin (pipe) for comment text logical #: [-t] => force files into text mode timestamp string #" [-T timestamp] => force to timestamp generate allocate, erase, print define global #: Stuff needed to execute a command record arguments vector[string] #: Command arguments data_out_delays data_out_delays #: Delayed file renaming debug_stream out_stream #: Debugging stream errors errors #: {errors} object error_stream out_stream #: Error stream object executable_directory string #: Executable directory file_system file_system #: File system in_stream in_stream #: Standard input stream out_stream out_stream #: Standard output stream project_name_table set[project_name] #: {project_name} sharing table project_names vector[project_name] #: All {project_name}'s resources resources #: Memory manager system system #: System object timer_top timer #: Top-most timer generate allocate, erase, identical, print define history_options #: Options for `svms history' command: record file_list vector[string] #: file_list ... => files to list generate allocate, erase, print define merge_options #: Options for `svms bringover/putback' record slice_list vector[string] #: slice ... => slices to bring over no_action logical #: [-n] => no action generate allocate, erase, print define mkdir_options #: Options for `svms mkdir' command record create logical #: [-c] => create file_list vector[string] #: file_list ... => dir's to create duplicates_ok logical #: [-d] => dupliates ok generate allocate, erase, print define new_options #: Options for `svms new' command record recursive logical #: [-R] => recursively create sub-dirs project_directory string #: Project directory (required) nickname string #: Project nickname (required) generate allocate, erase, print define parent_options #: Options for `svms parent' command record eager logical #: [-e] => do eager bringovers file_list vector[string] #: parent_directory (or empty) lazy logical #: [-l] => do lazy bringovers parent_directory string #: [-d dir] => parent directory parent_url string #: [-h url] => parent URL proxy_url string #: [-p url] => proxy URL tell logical #: [-t] => tell current parent info unparent logical #: [-u] => unparent project generate allocate, erase, print define refresh_options #: Options for `svms refresh' command record delete logical #: [-d] => delete extraneous files no_action logical #: [-n] => no action slice_list vector[string] #: slice_list ... => slices to refresh verbose logical #: [-v] => verbose mode generate allocate, erase, print define tell_options #: Options for `svms tell' command: record slice_list vector[string] #: slice_list ... => slices to list generate allocate, erase, print procedure main takes system system returns unsigned #: This procedure will test out the printed circuit board layout module. in_stream :@= system.standard_in_stream out_stream :@= system.standard_out_stream timers :@= xcreate@timers('svms', out_stream) error_stream :@= system.error_out_stream errors :@= xcreate@errors(error_stream) file_name :@= file_name_convert@("/tmp/data_out_delays") initialize global:: global := allocate@global() global.arguments := system.arguments global.data_out_delays := create@data_out_delays(file_name, error_stream) global.debug_stream := system.error_out_stream global.errors := errors global.resources := create@resources(false, global) global.error_stream := error_stream global.executable_directory := executable_directory@(system) global.file_system := system.file_system global.in_stream := in_stream global.out_stream := out_stream global.project_name_table := xcreate@set[project_name](10) global.project_names := allocate@vector[project_name]() global.timer_top := timers.top global.system := system assert global == global.resources.global assert global.resources == global.resources.global.resources timer_enable:: logical := false # Process any -T option: arguments :@= system.arguments hypen :@= "-"[0] size :@= arguments.size if size = 0 help_print(out_stream) return 0 command :@= arguments[0] if command = "-T" timer_enable := true enable@(global.timer_top) delete@(arguments, 0) size :-= 1 if size = 0 help_print(out_stream) return 0 command := arguments[0] else disable@(global.timer_top) delete@(arguments, 0) size :-= 1 timer :@= global.timer_top # The help command is a little special: if command = "-?" || command = "-??" || command = "help" if size = 0 help_print(out_stream) return 0 append@(arguments, "-??") # Fake a help option command := arguments[0] delete@(arguments, 0) size :-= 1 if command = "help" help_print(out_stream) return 0 error:: logical := false if command = "bringover" error := merge_command@(global, true, timer) else_if command = "close" error := file_command@(global, close, timer) else_if command = "create" error := file_command@(global, create, timer) else_if command = "diffs" error := diffs_command@(global, timer) else_if command = "get" error := file_command@(global, get, timer) else_if command = "history" error := history_command@(global) else_if command = "mkdir" error := mkdir_command@(global) else_if command = "new" error := new_command@(global) else_if command = "parent" error := parent_command@(global, timer) else_if command = "open" error := file_command@(global, open, timer) else_if command = "putback" error := merge_command@(global, false, timer) else_if command = "refresh" error := refresh_command@(global, timer) else_if command = "tell" error := tell_command@(global) else_if command = "unedit" error := file_command@(global, unedit, timer) else format@format1[string](out_stream, 'Unrecognized command %ds%!\n\', command) error := true if leaks_check@(global.resources, errors) error := true if timer_enable dump@(timers, global.error_stream) if errors.exist || error #abort@(global.data_out_delays) return 1 commit@(global.data_out_delays, errors) return 0 procedure merge_command@global takes global global bringover logical timer timer returns logical #: This procedure implements the "svms bringover" and the #, "svms putback" command: # Parse options: errors :@= global.errors out_stream :@= global.out_stream debug_stream :@= global.debug_stream merge_parse :@= create@command_parse[merge_options]( bringover ? 'svms bringover' : 'svms putback') option_logical@(merge_parse, '-n', 'No action', no_action_set@merge_options) arguments_required@(merge_parse, 'slice', 'Slice list', slice_list_set@merge_options) merge_options :@= parse@(merge_parse, global.arguments, out_stream, true, true) # Find {child_project}: child_project :@= find@project(false, global) if child_project == ?? deallocate@(global) return true parent_project:: project := ?? parent_project_directory :@= child_project.parent_project_directory if parent_project_directory !== ?? parent_project :@= lookup@project(parent_project_directory, false, global) if child_project.host_url != "" format@errors1[string](errors, 'HTTP bringover for %ds% is not implemented yet!\n\', child_project.host_url) assert false if parent_project == ?? deallocate@(child_project) deallocate@(global) return true parent_slice :@= expand@slice(merge_options.slice_list, parent_project, true, false) if parent_slice == ?? deallocate@(parent_project) deallocate@(child_project) deallocate@(global) return true show@(parent_slice, debug_stream) assert false procedure diffs_command@global takes global global timer timer returns logical #: This procedure implements the "svms create" command. # Parse options: child_next@(timer, "parse") errors :@= global.errors out_stream :@= global.out_stream diffs_parse :@= create@command_parse[diffs_options]('svms diffs') arguments_required@(diffs_parse, 'file_list', 'File list', file_list_set@diffs_options) diffs_options :@= parse@(diffs_parse, global.arguments, out_stream, true, true) #debug_stream :@= global.debug_stream # Get ready to process command: child_next@(timer, "slice") project :@= find@project(false, global) if project == ?? deallocate@(global) return true resources :@= project.global.resources slice :@= expand@slice(diffs_options.file_list, project, false, false) if slice == ?? deallocate@(project) deallocate@(global) return true # Check for bogus files: if no_links@(slice, "svms diffs") || no_deleted@(slice, "svms diffs") deallocate@(slice) deallocate@(project) deallocate@(global) return true out_stream :@= global.out_stream contents :@= string_allocate@(resources) differ_table :@= create@differ_table[chunk]() data_in_stream:: data_in_stream := ?? history:: history := ?? loop_timer :@= child_next@(timer, "loop") project_files :@= slice.project_files size :@= project_files.size index :@= 0 loop while index < size project_file :@= project_files[index] actual_file_name :@= project_file.actual_file_name # Slurp in the history file: history_timer :@= child_next@(loop_timer, "history read") history_file_name :@= project_file.history_file_name if data_in_stream !== ?? # Close out previous {data_in_stream}: close@(data_in_stream) deallocate@(data_in_stream) data_in_stream :@= xallocate@data_in_stream(resources) if open@(data_in_stream, history_file_name, project, errors) break if history !== ?? # Release {history} from previous iteration: deallocate@(history) history := read@history(data_in_stream, project_file, history_timer) assert history !== ?? deltas :@= history.deltas old_chunks :@= deltas[deltas.size - 1].version.contents # Slurp in the file contents and stuff into a temporary version: child_next@(loop_timer, "contents read") trim@(contents, 0) if contents_read@(actual_file_name, contents, errors) break version :@= xallocate@version(history) line_contents_insert@(version, contents) new_chunks :@= version.contents # Compute the differences: child_next@(loop_timer, "compute differences") aligns :@= aligns_find@(differ_table, old_chunks.list, new_chunks.list) child_next@(loop_timer, "compute print") aligns_size :@= aligns.size aligns_index :@= 0 if size > 1 format@format1[project_file](out_stream, 'File: %ds%\n\', project_file) loop while aligns_index < aligns_size align :@= aligns[aligns_index] if align.type = differ sequence1 :@= align.sequence1 sequence2 :@= align.sequence2 # Print out the first difference: format@format4[unsigned, unsigned, unsigned, unsigned]( out_stream, "======== <%d%!%d% %d%!%d%>\n\", sequence1.start, sequence1.length, sequence2.start, sequence2.length) show_prefixed@(sequence1, "<\t\", out_stream) # Print out the second difference: put@("----\n\", out_stream) show_prefixed@(sequence2, ">\t\", out_stream) aligns_index :+= 1 if size > 1 put@("\n,n\", out_stream) deallocate@(version) index :+= 1 child_next@(timer, "deallocate") if history !== ?? deallocate@(history) if data_in_stream !== ?? close@(data_in_stream) deallocate@(data_in_stream) string_deallocate@(resources, contents) deallocate@(slice) deallocate@(project) deallocate@(global) child_next@(timer, "done") return false procedure file_command@global takes global global file_operation file_operation timer timer returns logical #: This procedure is the workhorse procedure that is responsible for #, managing most file operations (create, open, close, get, unedit, #, etc.) # Do some initialization: #debug_stream :@= global.debug_stream errors :@= global.errors out_stream :@= global.out_stream user_name :@= "Wayne C. Gramlich" # Extract the file name: command_name :@= "" switch file_operation case close command_name := 'svms close' case create command_name := 'svms create' case get command_name := 'svms get' case open command_name := 'svms open' case unedit command_name := 'svms unedit' default assert false # Parse the options: command_parse :@= create@command_parse[file_options](command_name) switch file_operation case close option_logical@(command_parse, '-n', 'Do not record a comment', no_comment_set@file_options) default file_operation := file_operation #FIXME: do_nothing switch file_operation case close option_logical@(command_parse, '-p', 'Read comments from stdin (pipe)', use_pipe_set@file_options) default file_operation := file_operation #FIXME: do_nothing switch file_operation case close, create option_argument_optional@(command_parse, '-T YYYY/MM/DD@hh:mm:ssGMT', 'Force file timestamp to be YYYY/MM/DD@hh:mm:ssGMT', timestamp_set@file_options) default file_operation := file_operation #FIXME: do_nothing if file_operation = create option_logical@(command_parse, '-b', 'Force files in file list into binary mode', binary_set@file_options) option_logical@(command_parse, '-f', 'Force acceptance of all symbolic links', force_set@file_options) option_logical@(command_parse, '-t', 'Force files in file list into text mode', text_set@file_options) arguments_required@(command_parse, 'file_list', 'File list', file_list_set@file_options) file_options :@= parse@(command_parse, global.arguments, out_stream, true, true) # Look for inconsistent file options: if file_options.binary && file_options.text format@errors1[unsigned](errors, 'Do not specify both -b and -t options on same command.\n\', 0) deallocate@(global) return false comment_type:: comment_type := prompt if file_options.no_comment comment_type := none if file_options.use_pipe format@errors1[string](global.errors, 'The -n and -p options are incompatible one another!\n\', "") deallocate@(global) return false else_if file_options.use_pipe comment_type := pipe # Check for bogus files: project :@= find@project(false, global) if project == ?? return true expand_trees :@= file_operation != create slice :@= expand@slice(file_options.file_list, project, expand_trees, false) if slice == ?? deallocate@(global) deallocate@(project) return true if file_operation != get && no_deleted@(slice, command_name) || no_directories@(slice, command_name) deallocate@(global) deallocate@(slice) deallocate@(project) return true # Figure out timestamp: resources :@= global.resources timestamp :@= 0 if file_options.timestamp != "" buffer :@= string_allocate@(resources) string_append@(buffer, file_options.timestamp) timestamp := timestamp_lop@(buffer) string_deallocate@(resources, buffer) # Now it is time to get the prompt (if needed): comments :@= string_allocate@(resources) switch file_operation case close prompt_timer :@= child_create_current@(timer, 'prompt') in_stream :@= global.in_stream switch comment_type case none comments := comments #FIXME: do_nothing case pipe contents_read@(in_stream, comments) case prompt out_stream := global.out_stream put@('Please enter some comments followed by a blank line.\n\', out_stream) paragraph_prompt@(in_stream, out_stream, 'Comments: ', comments) # Iterate over all of the files: data_in_stream:: data_in_stream := ?? contents :@= string_allocate@(resources) history:: history := ?? project_files :@= slice.project_files size :@= project_files.size index :@= 0 loop # If any errors occur, we just "break" out of this loop. All # allocated resources are deallocated. while index < size project_file :@= project_files[index] # Get the file status: actual_file_name :@= project_file.actual_file_name status_update@(actual_file_name) status :@= actual_file_name.status # Slurp in the file contents: trim@(contents, 0) switch file_operation case create, close if contents_read@(actual_file_name, contents, errors) break default #FIXME: do_nothing contents := contents # Slurp in the history file (if appropriate): history_file_name :@= project_file.history_file_name switch file_operation case create status_update@(history_file_name) history_status :@= history_file_name.status if history_status.mode != deleted format@errors1[file_name](errors, '%ds% should not exist!\n\', history_file_name) break case close, open, unedit, get if data_in_stream !== ?? # Close out previous {data_in_stream}: close@(data_in_stream) deallocate@(data_in_stream) data_in_stream :@= xallocate@data_in_stream(resources) if open@(data_in_stream, history_file_name, project, errors) break if history !== ?? # {history} was allocated from previous loop iteration: deallocate@(history) history := read@history(data_in_stream, project_file, timer) default assert false ancestor:: delta := ?? switch status.mode case deleted, regular_file # {deleted} files are only allowed for the "get" operation: switch file_operation case close if status.access & 0222 = 0 format@errors1[file_name](errors, '%ds% is read-only!\n\', actual_file_name) break # Go through the {deltas}: deltas :@= history.deltas deltas_size :@= deltas.size assert deltas_size != 0 delta :@= history.deltas[deltas_size - 1] switch delta.type case deleted, directory assert false case file version :@= xallocate@version(history) line_contents_insert@(version, contents) line_comments_insert@(version, comments) version.is_binary := false if timestamp = 0 timestamp := status.modification_time version.timestamp := timestamp ancestor :@= deltas[history.deltas.size - 1] default assert false case create switch status.mode case regular_file history :@= create@history(project_file) version :@= xallocate@version(history) line_contents_insert@(version, contents) version.is_binary := false if timestamp = 0 timestamp := status.modification_time version.timestamp := timestamp project_file.timestamp := timestamp assert history.resources !== ?? default assert false case get if project_file.lock_hash != 0 format@errors1[file_name](errors, '%ds% is open!\n\', actual_file_name) break if status.access & 0222 != 0 format@errors1[file_name](errors, '%ds% is writable!\n\', actual_file_name) break # We've got a live one: deltas :@= history.deltas deltas_size :@= deltas.size delta :@= history.deltas[deltas_size - 1] switch delta.type case deleted, directory assert false #FIXME: delete file or make directory case file # Cool delta := delta #FIXME: do_nothing default assert false case open if status.access & 0222 != 0 format@errors1[file_name](errors, '%ds% is writable!\n\', actual_file_name) break deltas :@= history.deltas deltas_size :@= deltas.size delta :@= history.deltas[deltas_size - 1] switch delta.type case deleted, directory assert false case file # Cool delta := delta #FIXME: do_nothing default assert false case unedit if project_file.lock_hash = 0 format@errors1[file_name](errors, '%ds% is not open!\n\', actual_file_name) break # We've got a live one: deltas :@= history.deltas deltas_size :@= deltas.size delta :@= history.deltas[deltas_size - 1] switch delta.type case deleted, directory assert false #FIXME: delete file or make directory case file # Cool delta := delta #FIXME: do_nothing default assert false default # Not {close}, {create}, or {open}: assert false case symbolic_link assert false default assert false # Write out any files and change any access modes: switch file_operation case close, create # Append a new {version} and {delta} object: assert timestamp != 0 delta :@= delta_allocate@delta(version, project.project_name, timestamp, user_name, ancestor, ??) version_append@(history, version) delta_append@(history, delta) # Save out the history file: if save@(history, timer) break if access_mode_change@(actual_file_name, 0444, errors) break lock_remove@(project_file) project_file.modified := true project_file.parent.modified := true case get, unedit trim@(contents, 0) string_append@(delta, contents) out_stream :@= write_open@(actual_file_name, errors) if out_stream == ?? break put@(contents, out_stream) close@(out_stream) if access_mode_change@(actual_file_name, 0444, errors) break lock_remove@(project_file) project_file.modified := true project_file.parent.modified := true case open if access_mode_change@(actual_file_name, 0666, errors) break lock_write@(project_file) project_file.modified := true project_file.parent.modified := true default assert false index :+= 1 #put@("project after:\n\", out_stream) #show@(project, out_stream) #put@("After show\n\", out_stream) # Free up some resources: free_timer :@= child_create_current@(timer, 'free') if contents !== ?? string_deallocate@(resources, contents) if history !== ?? deallocate@(history) if data_in_stream !== ?? close@(data_in_stream) deallocate@(data_in_stream) string_deallocate@(resources, comments) #put@("before project flush\n\", out_stream); flush@(project) #put@("after project flush\n\", out_stream); deallocate@(slice) #put@("before project deallocate\n\", out_stream); deallocate@(project) #put@("after project deallocate\n\", out_stream); deallocate@(global) # If we iterated through the whole list, there were no errors: result :@= index < size return result procedure help_print takes out_stream out_stream returns_nothing #: This procedure print the help contents to {out_stream}. put@('bringover - Bring over files from parent project\n\', out_stream) put@('close - Close an open history file\n\', out_stream) put@('create - Create new history file\n\', out_stream) put@('diffs - Compute differences between file versions\n\', out_stream) put@('get - Refetch a closed history file\n\', out_stream) put@('help - List all available commands\n\', out_stream) put@('history - Print history information\n\', out_stream) put@('mkdir - Make a new source directory\n\', out_stream) put@('new - Create new project\n\', out_stream) put@('open - Open a closed history file\n\', out_stream) put@('putback - Put back files into parent project\n\', out_stream) put@('refresh - Refresh data structures\n\', out_stream) put@('tell - List open files\n\', out_stream) put@('unedit - Unedit an open history file\n\', out_stream) procedure history_command@global takes global global returns logical #: This procedure implements the "svms history" command. # Parse options: history_timer :@= child_create_current@(global.timer_top, 'history_command') resources :@= global.resources errors :@= global.errors out_stream :@= global.out_stream command_name :@= 'svms history' command_parse :@= create@command_parse[history_options](command_name) arguments_required@(command_parse, 'file_list', 'File_list', file_list_set@history_options) history_options :@= parse@(command_parse, global.arguments, out_stream, true, true) # Check for bogus files: project :@= find@project(false, global) if project == ?? deallocate@(global) return true slice :@= expand@slice(history_options.file_list, project, true, false) if slice == ?? deallocate@(global) deallocate@(project) return true if no_deleted@(slice, command_name) || no_directories@(slice, command_name) deallocate@(global) deallocate@(slice) deallocate@(project) return true # Iterate over all of the files: data_in_stream:: data_in_stream := ?? history:: history := ?? project_files :@= slice.project_files size :@= project_files.size index :@= 0 loop # If any errors occur, we just "break" out of this loop. All # allocated resources are deallocated. while index < size project_file :@= project_files[index] if size > 1 # Output a file banner: put@("-------------------------------------------\n\", out_stream) format@format1[project_file](out_stream, "%ds%\n\", project_file) put@("-------------------------------------------\n\", out_stream) # Slurp in the history file (if appropriate): history_file_name :@= project_file.history_file_name if data_in_stream !== ?? # Close out previous {data_in_stream}: close@(data_in_stream) deallocate@(data_in_stream) data_in_stream :@= xallocate@data_in_stream(resources) if open@(data_in_stream, history_file_name, project, errors) break if history !== ?? # {history} was allocated from previous loop iteration: deallocate@(history) history := read@history(data_in_stream, project_file, history_timer) deltas :@= history.deltas deltas_size :@= deltas.size deltas_index :@= 0 loop while deltas_index < deltas_size delta :@= deltas[deltas_index] if delta.type = file # Print out the comment: project_name :@= delta.project_name format@format2[string, unsigned](out_stream, "Version %s%.%d%:\n\", project_name.nickname, delta.number) version :@= delta.version show@(version.comments, out_stream) put@("\n\", out_stream) deltas_index :+= 1 index :+= 1 if history !== ?? deallocate@(history) if data_in_stream !== ?? close@(data_in_stream) deallocate@(data_in_stream) deallocate@(global) deallocate@(slice) deallocate@(project) return false procedure mkdir_command@global takes global global returns logical #: This procedure implements the "svms create" command. #debug_stream :@= global.debug_stream #put@("mkdir_command 0\n\", debug_stream) # Parse options: mkdir_timer :@= child_create_current@(global.timer_top, 'mkdir_command') errors :@= global.errors out_stream :@= global.out_stream command_parse :@= create@command_parse[mkdir_options]('svms create') option_logical@(command_parse, '-c', 'Create the directory', create_set@mkdir_options) option_logical@(command_parse, '-d', 'Force acceptance of all symbolic links', duplicates_ok_set@mkdir_options) arguments_required@(command_parse, 'file_list', 'File list', file_list_set@mkdir_options) mkdir_options :@= parse@(command_parse, global.arguments, out_stream, true, true) # Get ready to process command: project :@= find@project(false, global) if project == ?? deallocate@(global) return true slice :@= expand@slice(mkdir_options.file_list, project, false, false) if slice == ?? deallocate@(project) deallocate@(global) return true create :@= mkdir_options.create duplicates_ok :@= mkdir_options.duplicates_ok # Check for bogus files: if no_files@(slice, "svms mkdir") || no_links@(slice, "svms mkdir") || !create && no_deleted@(slice, "svms mkdir") deallocate@(slice) deallocate@(project) deallocate@(global) return true user_number :@= global.system.user_number user :@= user_number_lookup@user(user_number) user_name :@= user.full_name # Create any directories first: save_timer :@= child_create@(mkdir_timer, 'save') project_files :@= slice.project_files size :@= project_files.size have_error:: logical := false index :@= 0 loop while !have_error && index < size project_file :@= project_files[index] if directory_create@(project_file, create, duplicates_ok) have_error := true break history :@= create@history(project_file) timestamp :@= history.create_timestamp delta :@= directory_allocate@delta(history, project.project_name, timestamp, user_name) delta_append@(history, delta) current_set@(save_timer) if save@(history, save_timer) have_error := true deallocate@(history) index :+= 1 flush@(project) deallocate@(slice) deallocate@(project) deallocate@(global) # Return any error condition: return have_error procedure new_command@global takes global global returns logical #: This procedure implements the "svms new" command. A new project #, directory is created along with other associated files and #, sub-directories. # Parse options: timer :@= child_create_current@(global.timer_top, 'new_command') out_stream :@= global.out_stream command_parse :@= create@command_parse[new_options]('svms new') option_logical@(command_parse, '-R', 'Recusively create and needed directories', recursive_set@new_options) argument_required@(command_parse, 'project_directory', 'Project directory', project_directory_set@new_options) argument_required@(command_parse, 'project_nickname', 'Project nickname', nickname_set@new_options) new_options :@= parse@(command_parse, global.arguments, out_stream, true, true) errors :@= global.errors project_directory_string :@= new_options.project_directory project_directory_name :@= file_name_convert@(project_directory_string) svms_directory_name :@= svms_directory_find@project(project_directory_name) if svms_directory_name !== ?? format@errors2[file_name, file_name](errors, 'Nested project at %ds% not allowed in project %ds%!\n\', project_directory_name, svms_directory_name) return true status_update@(project_directory_name) status :@= project_directory_name.status recursive :@= new_options.recursive switch status.mode case deleted if recursive # Attempt to create the project directory: if directory_create_recursive@(project_directory_name, errors) return true else format@errors1[file_name](errors, 'Project directory %ds% does not preexist!\n\', project_directory_name) return true case directory #FIXME:do_nothing status := status default format@errors1[file_name](errors, '%ds% is not a directory!\n\', project_directory_name) return true svms_directory_name :@= name_append@(project_directory_name, 'SVMS') status_update@(svms_directory_name) status := svms_directory_name.status switch status.mode case directory format@errors1[file_name](errors, 'SVMS directory %ds% already exists!\n\', svms_directory_name) return true case deleted # Let's create the SVMS directory: if directory_create@(svms_directory_name, errors) return true # Create the project: timestamp :@= current_time@(global.system) resources :@= global.resources project_name :@= create@project_name(new_options.nickname, timestamp, resources) current_directory_name :@= canonicalize@(global.file_system.relative) project :@= create@project(project_name, project_directory_name, current_directory_name, false, global) # Create project file: flush@(project) deallocate@(project) default format@errors1[file_name](errors, 'SVMS directory %ds% is not a directory!\n\', svms_directory_name) return true deallocate@(global) return false procedure parent_command@global takes global global timere timer returns logical #: This procedure implement the "svms parent" command: # Parse options: errors :@= global.errors out_stream :@= global.out_stream parent_parse :@= create@command_parse[parent_options]('svms parent') option_logical@(parent_parse, '-e', 'Do eager bringovers', eager_set@parent_options) option_logical@(parent_parse, '-l', 'Do eager bringovers', lazy_set@parent_options) option_argument_optional@(parent_parse, '-d parent_dir', 'Parent directory', parent_directory_set@parent_options) option_argument_optional@(parent_parse, '-h parent_http_url', 'Parent HTTP URL', parent_url_set@parent_options) option_argument_optional@(parent_parse, '-p proxy_url', 'Proxy URL', proxy_url_set@parent_options) option_logical@(parent_parse, '-t', 'Tell current parent information', tell_set@parent_options) option_logical@(parent_parse, '-u', 'Unparent project', unparent_set@parent_options) parent_options :@= parse@(parent_parse, global.arguments, out_stream, true, true) # Verity that the options make sense: option1 :@= "" option2 :@= "" if parent_options.unparent # Unparent option does not work with any of the other options #, except -t: if parent_options.lazy option2 := "-l" if parent_options.eager option2 := "-e" if parent_options.parent_directory != "" option2 := "-d" if parent_options.parent_url != "" option2 := "-h" if parent_options.proxy_url != "" option2 := "-p" if option2 != "" option1 := "-u" if option1 = "" && parent_options.parent_directory != "" # Verify that -d option is not used with -h or -p options: if parent_options.parent_url != "" option2 := "-h" if parent_options.proxy_url != "" option2 := "-p" if option2 != "" option1 := "-d" if option1 = "" && parent_options.lazy && parent_options.eager # Can't specify -l and -e at the same time: option1 := "-e" option2 := "-l" if option1 != "" # Print out the error message and return: format@errors2[string, string](errors, 'The %ds% option can not be used with %ds% option!\n\', option1, option2) return true # Update the parent information in {project}: project :@= find@project(false, global) changed:: logical := false if parent_options.unparent # Unparent: project.parent_project_directory := ?? trim@(project.host_url, 0) trim@(project.proxy_url, 0) changed := true else # Do some parent operations: parent_directory :@= parent_options.parent_directory if parent_directory != "" project.parent_project_directory := parse@file_name(parent_directory, global.file_system) trim@(project.host_url, 0) trim@(project.proxy_url, 0) project.lazy := true parent_url :@= parent_options.parent_url if parent_url != "" trim@(project.host_url, 0) string_append@(project.host_url, parent_url) project.lazy := false project.parent_project_directory := ?? proxy_url :@= parent_options.proxy_url if proxy_url != "" if project.host_url = "" # Oops, no host specified yet! format@errors1[string](errors, 'You need to specify -h hosturl in addtion to -p %s%\n\', proxy_url) deallocate@(project) deallocate@(global) return true trim@(project.proxy_url, 0) string_append@(project.proxy_url, proxy_url) project.lazy := false project.parent_project_directory := ?? if parent_options.lazy project.lazy := true if parent_options.eager project.lazy := false changed := true if changed save@(project) # Do -t option: if parent_options.tell if project.parent_project_directory == ?? && project.host_url = "" && project.proxy_url = "" # No parent: put@("-u\n\", out_stream) else # There is a parent: put@(project.lazy ? "-l" : "-e", out_stream) if project.parent_project_directory != ?? format@format1[file_name](out_stream, " -d %s%", project.parent_project_directory) if project.host_url != "" format@format1[string](out_stream, " -h %s%", project.host_url) if project.proxy_url != "" format@format1[string](out_stream, " -p %s%", project.proxy_url) put@("\n\", out_stream) deallocate@(project) deallocate@(global) return false procedure refresh_command@global takes global global timer timer returns logical #: This procedure will implement the refresh command: command_name :@= 'svms refresh' refresh_timer :@= child_create_current@(global.timer_top, command_name) resources :@= global.resources errors :@= global.errors out_stream :@= global.out_stream refresh_parse :@= create@command_parse[refresh_options](command_name) option_logical@(refresh_parse, "-d", 'Delete extraneous files', delete_set@refresh_options) option_logical@(refresh_parse, "-n", 'Do no actual refreshing (report problems only)', no_action_set@refresh_options) option_logical@(refresh_parse, "-v", 'Verbose mode', verbose_set@refresh_options) arguments_required@(refresh_parse, 'slice_list', 'Slice_list', slice_list_set@refresh_options) refresh_options :@= parse@(refresh_parse, global.arguments, out_stream, true, true) # Check for bogus files: project :@= find@project(true, global) if project == ?? deallocate@(global) return true # Iterate through the slices: slice_list :@= refresh_options.slice_list size :@= slice_list.size assert size != 0 index :@= 0 loop while index < size slice_string :@= slice_list[index] if slice_string = ":/..." delete :@= refresh_options.delete no_action :@= refresh_options.no_action verbose :@= refresh_options.verbose refresh@(project, delete, no_action, verbose, refresh_timer) if no_action abort@(global.data_out_delays) else format@errors1[string](errors, "Can only refresh ':/...', not %ds%\n\", slice_string) deallocate@(project) deallocate@(global) return true index :+= 1 deallocate@(project) deallocate@(global) return false procedure tell_command@global takes global global returns logical #: This procedure implements the "svms tell" command. # Parse options: command_name :@= 'svms tell' tell_timer :@= child_create_current@(global.timer_top, command_name) resources :@= global.resources errors :@= global.errors out_stream :@= global.out_stream tell_parse :@= create@command_parse[tell_options](command_name) arguments_required@(tell_parse, 'slice_list', 'Slice_list', slice_list_set@tell_options) tell_options :@= parse@(tell_parse, global.arguments, out_stream, true, true) # Check for bogus files: project :@= find@project(false, global) if project == ?? deallocate@(global) return true #show@(project, out_stream) slice :@= expand@slice(tell_options.slice_list, project, true, true) if slice == ?? deallocate@(global) deallocate@(project) return true if no_deleted@(slice, command_name) deallocate@(global) deallocate@(slice) deallocate@(project) return true project_files :@= slice.project_files size :@= project_files.size index :@= 0 loop while index < size project_file :@= project_files[index] format@format1[project_file](out_stream, "%s%\n\", project_file) index :+= 1 deallocate@(global) deallocate@(slice) deallocate@(project) return false #: {global} procedures: procedure deallocate@global takes global global returns_nothing #: This procedure will deallocate any storage maintained by {global}. assert global !== ?? project_names :@= global.project_names size :@= project_names.size index :@= 0 loop while index < size project_name :@= project_names[index] deallocate@(project_name) index :+= 1