program tcs !++ ! ! Program : TCS.BAS ! ! Purpose : Tape Cataloguing System ! ! Author : Don Stokes ! ! Date : 25-May-1989 ! ! Description : This program provides a tape cataloguing system. ! See the user documentation for further information. ! ! Ammendments : ! ! !-- option type = explicit ! ! External declarations ! external long constant SS$_NORMAL, & RMS$_EOF, & STR$_NOMATCH external long function SYS$BINTIM, & SYS$NUMTIM, & LIB$GET_INPUT, & LIB$GET_SYMBOL, & LIB$DATE_TIME, & STR$MATCH_WILD, & CLI$PRESENT, & CTRLC_TRAP_ON external sub LIB$STOP( long by value) external long CTRLC_PRESSED ! ! Maps for catalogue file and output ! map (CATALOGUE) & string cat.bay = 1, & cat.slot = 5, & cat.tape_label = 10, & cat.date_written = 8, & cat.date_entered = 8, & cat.master_slot = 5, & cat.volume = 3, & cat.set_size = 3, & cat.description = 80 map (CATALOGUE) & string cat.key = 6, & cat.record =117 map (OUTLINE) & string out.bay = 1, & out.slot = 5, & fill = 1, & out.label = 10, & fill = 1, & out.volumes = 3, & fill = 1, & out.date_written = 11, & fill = 1, & out.date_entered = 11, & fill = 1, & out.description = 80 map (OUTLINE) & string out.baylist = 6 map (OUTLINE) & string out.line_80 = 79 map (OUTLINE) & string out.line = 126 map (OUTLINE1) & string fill = 22, & out1.date_written = 11, & fill = 1, & out1.date_entered = 11 map (OUTLINE1) & string out1.line = 45 ! ! Constants ! declare long constant TRUE = -1, & FALSE = 0, & cat.chnl = 1, & siz.chnl = 2, & out.chnl = 3 ! ! Variables ! declare long read_only, & baysize(100), & bays, & bay, & bay_slot_exists, & go_back, & go_out, & sort_key, & lines_printed, & matches, & selection_complete, & selection_valid, & selection_usable, & full_width, & page_count, & volumes, & saved_slot, & slot, & sts, & inter, & n, x, y, z declare string command, & cmd_prompt, & cursor_line(24), & label, & description, & date_e_lo, date_e_hi, & date_w_lo, date_w_hi, & saved_bay, & baychar(100), & last_bay, & outfile, & today, & baylist, & s declare string reverse, & bold, & normal, & window, & nowindow, & cls, & clw, & errpos, & menu_pos, & cleol, & cleos declare double bintim ! Double is a quadword declare word numtim(1 to 7) ! ! Get string from screen. Input is taken from line 23, ! which is reverse video. The prompt string is displayed ! on line 24. ! def string get_input( string prmpt) declare string gi_i, gi_p unlock #cat.chnl CTRLC_PRESSED = FALSE if inter then print cursor_line(23); gi_p = cursor_line(23) + cleol + normal + prmpt & + cursor_line(22) + reverse + cr + string$(80%,32%) & + cursor_line(22) + " " else gi_p = prmpt + cr + lf + ":" end if sts = LIB$GET_INPUT( gi_i, gi_p ) print normal + cursor_line(23) + cleos if inter go_back = edit$(gi_i, -1%) = "\" get_input = "" if go_back go_out = sts = RMS$_EOF go_out = TRUE if CTRLC_PRESSED gi_i = edit$(gi_i, 1%+4%+8%+16%+128%) if left(gi_i,1%)="'" and right(gi_i,len(gi_i))="'" and not inter then sts = LIB$GET_SYMBOL(mid(gi_i, 2, len(gi_i) - 2), gi_p) gi_i = gi_p if sts and SS$_NORMAL end if get_input = gi_i end def ! ! Search for record in catalogue file. Return a blank ! if no record found. ! def long get_bay_slot( string bay, long slot) bay_slot_exists = TRUE cat.bay = bay rset cat.slot = num1$(slot) when error in get #cat.chnl, key #0 eq cat.key use sleep 1% if err = 154% retry if err = 154% exit handler if err <> 155% cat.record = "" bay_slot_exists = FALSE end when get_bay_slot = bay_slot_exists end def ! ! Convert a string to number, return -1 if invalid ! def long get_val(string v) when error in get_val = val%(v) use get_val = -1% end when end def ! ! Get a numeric value from user, check if valid and >0 ! def long get_integer(string prmpt) declare string gin_s declare long gin_x gin_do_it_again: gin_s = get_input(prmpt) exit def 0% if go_back or go_out gin_x = get_val(gin_s) select gin_x case 0% print errpos + "Must be > 0" goto gin_do_it_again case -1% print errpos + "Invalid number" goto gin_do_it_again case else get_integer = gin_x end select end def ! ! Convert DD-MON-YYYY date to YYYYMMDD format for storage ! def string date_ymd( string dmony) dmony = edit$(dmony, 1%+4%+8%+16%+32%+128%) if dmony = "" then sts = SYS$NUMTIM( numtim(1), 0% by value) call LIB$STOP( sts ) unless sts and SS$_NORMAL else sts = SYS$BINTIM( dmony, bintim ) goto dy_bad_date unless sts and SS$_NORMAL sts = SYS$NUMTIM( numtim(1), bintim) call LIB$STOP( sts ) unless sts and SS$_NORMAL end if date_ymd = format$( numtim(1), "<0>###") & + format$( numtim(2), "<0>#") & + format$( numtim(3), "<0>#") exit def dy_bad_date: exit def "" end def ! ! Convert YYYYMMDD format date to DD-MON-YYYY for display ! def string date_dmony( string ymd) declare string dd_dmony exit def "" if ymd = "" when error in dd_dmony = right(ymd, 7) + "-" & + mid("JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC", & val%(mid(ymd, 5, 2)) * 3 - 2, 3) & + "-" + left(ymd, 4) use continue dd_bad_date end when sts = SYS$BINTIM( dd_dmony, bintim) exit def dd_dmony if sts and SS$_NORMAL dd_bad_date: exit def "" end def sts = CLI$PRESENT("BATCH") inter = (sts and SS$_NORMAL) = 0% if inter then reverse = esc + "[7m" bold = esc + "[1m" normal = esc + "[m" window = esc + "[2;21r" nowindow = esc + "[r" cls = esc + "[H" + esc + "[J" clw = esc + "[2H" + esc + "[20M" errpos = esc + "[24H" + bel menu_pos = esc + "[1;70H"+esc+"[1;7m" cleol = esc + "[K" cleos = esc + "[J" else reverse = "" bold = "" normal = "" window = "" nowindow = "" cls = "" clw = "" errpos = "" menu_pos = "" cleol = "" cleos = "" end if ! ! Display the top line of the display and set up text window ! set no prompt print cls + reverse + "B Slot Label Vol Written Entered" & + " Description " & + window + normal & if inter ! ! Open catalogue file ! sts = CLI$PRESENT("READONLY") read_only = (sts and SS$_NORMAL) <> 0% if not read_only then when error in open "TCS_CATALOGUE" for input as file cat.chnl, & defaultname ".DAT", & organization indexed, & recordsize 123, & access modify, & allow modify, & map catalogue use read_only = TRUE end when end if if read_only then open "TCS_CATALOGUE" for input as file cat.chnl, & defaultname ".DAT", & organization indexed, & recordsize 123, & access read, & allow modify, & map catalogue print errpos; "File Read Only" end if ! ! Read sizes of bays ! open "TCS_BAYSIZE" for input as file siz.chnl, & defaultname ".DAT", & access read, & allow modify for bays = 1% until FALSE when error in input #siz.chnl, baychar(bays), baysize(bays) use exit handler if err <> 11% bays = bays - 1% continue bay_sizes_read end when next bays bay_sizes_read: close siz.chnl ! ! Get today's date (DD-MON-YYYY) ! sts = LIB$DATE_TIME( today) call LIB$STOP( sts ) unless sts and SS$_NORMAL today = left(today, 11%) ! ! Set up cursor positioning sequences ! cursor_line(n) = "" for n = 1 to 24 cursor_line(n) = esc + "[" + num1$(n) + "H" for n = 1 to 24 if inter ! ! Ctrl/C trap ! if inter then sts = CTRLC_TRAP_ON call LIB$STOP( sts ) unless sts and SS$_NORMAL end if ! ! Main loop ! main_loop: while TRUE ! ! Display main menu, get response ! print menu_pos + " MAIN MENU " + normal if inter cmd_prompt = "Add,Search,Usage" cmd_prompt = cmd_prompt + ",View,Print,Labels" & if selection_usable cmd_prompt = cmd_prompt + ",Delete" & if selection_usable and matches = 1% command = get_input("Command (" + cmd_prompt + ",Exit)") exit main_loop if go_back or go_out or command = "" command = left(edit$(command, -1%), 1%) ! ! List and Print commands can only be used if there is a valid ! selection. Delete can only be used if there is only one ! item in the selection. ! if instr(0%, "VLPD", command) and not selection_usable then print errpos; "No selection" iterate main_loop end if if instr(0%, "D", command) and matches <> 1% then print errpos; "Too many in selection" iterate main_loop end if ! ! Check read-only flag ! if instr(0%, "AD", command) and read_only then print errpos; "File Read Only" iterate main_loop end if ! ! Dispatch to appropriate routine ! select command case "A" gosub add_record case "D" gosub delete_record case "E", "" exit main_loop case "L" gosub print_labels case "P" gosub print_selection case "S" gosub search_records case "U" gosub usage_map case "V" gosub list_records case else print errpos + "Invalid command" end select next print nowindow + cursor_line(22) if inter close cat.chnl exit program ! ! Subroutine to add a tape to the library ! add_record: ! ! Display menu info ! Signal that selection is not valid ! selection_usable = FALSE out.line = "" print clw + menu_pos + " ADD " + normal if inter ! ! Ask for bay to use ! No default ! ar_get_bay: s = get_input("Enter bay(s) to insert tapes into") goto ar_abort if go_back or go_out s = edit$(s, -1%) baylist = "" baylist = baylist + mid(s,n,1) if mid(s,n,1) <> "," for n=1 to len(s) for z = 1 to len(s) bay = 0 bay = n if baychar(n) = mid(baylist, z, 1) for n = 1 to bays if bay = 0% then print errpos; "Invalid bay" goto ar_get_bay end if next z ! ! Ask number of volumes in the set of tapes ! ar_get_volumes: out.baylist = baylist print cursor_line(2); trm$(out.line_80) + cleol if inter volumes = get_integer("Enter number of volumes in set") goto ar_get_bay if go_back goto ar_abort if go_out ! ! Search for a contiguous space in the bay ! Error, and go back to bay selection if no space was found ! for y = 1 to len(baylist) bay = n if baychar(n) = mid(baylist,y,1) for n = 1 to bays slot, x = 0% for n = 1% to baysize(bay) z = get_bay_slot( baychar(bay), n) if val%(cat.set_size) = 0% then slot = n if slot = 0% x = x + 1% else slot, x = 0% end if goto ar_found_slot if x = volumes next n next y print errpos; "No space for set." goto ar_get_bay ! ! Slot was found. ! Construct a default label to use. The label is in the form ! bsssssc, where b=bay, sssss=slot (zero filled) and ! c=check letter. Check letter is constructed as follows: ! checksum = character code of bay, where A=1 & Z=26 ! checksum = checksum + slot digit[n] * n for n = 1 to 4 ! check letter = letter(checksum mod 26) ! eg for bay B, slot 147, ! checksum = 2 (B) ! checksum = checksum + 0*1 + 0*2 + 1*3 + 4*4 ! = 2+0+0+3+16 = 21 ! check = checksum mod 26 ! = 21 = U ! label = B0147U ! ar_found_slot: label = baychar(bay) + format$(slot, "<0>###") x = ascii(left(label, 1%)) - ascii("@") x = x + val%(mid(label, n, 1)) * (n - 1) for n = 2% to 5% label = label + chr$(mod(x, 26) + ascii("A")) out.label = label lset out.baylist = baychar(bay) rset out.slot = num1$(slot) rset out.volumes = num1$(volumes) print cursor_line(2); trm$(out.line_80) + cleol if inter ! ! Ask for label ! Default is above magic code ! ar_get_label: s = get_input("Enter tape label") goto ar_get_volumes if go_back goto ar_abort if go_out label = edit$(s, 32%) if s <> "" out.date_written = today out.date_entered = today out.label = label print cursor_line(2); trm$(out.line_80) + cleol if inter ! ! Get the date the tape was written ! Default is today ! ar_get_date: s = get_input("Enter date tape was written") goto ar_get_label if go_back goto ar_abort if go_out s = today if s = "" date_w_lo = date_ymd(s) if date_w_lo = "" then print errpos + "Invalid date" goto ar_get_date end if date_w_hi = date_w_lo out.date_written = date_dmony(date_w_lo) print cursor_line(2); trm$(out.line_80) + cleol if inter ! ! Get description ! ar_get_description: description = get_input("Enter description") goto ar_get_date if go_back goto ar_abort if go_out out.description = description print cursor_line(2); trm$(out.line_80) + cleol if inter ! ! Get confirmation from user ! (ie a last chance to get it right) ! Default is Yes ! ar_get_confirm: s = left(get_input("OK to add record? (Y/n)"), 1) goto ar_get_description if go_back goto ar_abort if go_out s = left(edit$(s, -1%), 1%) if instr(0%, "YN", s) = 0% then print errpos; "Yes or No" goto ar_get_confirm end if goto ar_abort if s <> "Y" ! ! Add the set of tapes to the library ! for n = 1% to volumes z = get_bay_slot(baychar(bay), slot + n - 1) cat.bay = baychar(bay) rset cat.slot = num1$(slot + n - 1%) cat.tape_label = label cat.date_written = date_w_lo cat.date_entered = date_ymd(today) rset cat.master_slot = num1$(slot) rset cat.volume = num1$(n) rset cat.set_size = num1$(volumes) cat.description = description when error in if bay_slot_exists then update #cat.chnl else put #cat.chnl end if use sleep 1% if err = 154% retry if err = 154% exit handler end when next n ! ! Make this a valid selection, so that we can delete the record ! or print it. ! selection_usable = TRUE matches = 1% saved_bay = baychar(bay) saved_slot = slot return ar_abort: selection_usable = FALSE print clw if inter return ! ! Ask for search criteria to select records to print or display ! search_records: ! ! Display menu info, clear out search criteria ! print clw; menu_pos + " SEARCH " + normal if inter out.line = "" out1.line = "" matches = 0% bay = 0% slot = 0% label = "" date_e_lo, date_e_hi = "" date_w_lo, date_w_hi = "" description = "" outfile = "" ! ! Ask for bay to search ! Default is all. ! sr_get_bay: s = get_input("Enter bay to search (return for all, '.' to end)") goto sr_abort if go_back or go_out goto sr_get_order if s = "." s = edit$(s, -1%) if s <> "" then bay = 0 bay = n if baychar(n) = s for n = 1 to bays if bay = 0% then print errpos; "Invalid bay" goto sr_get_bay end if out.bay = baychar(bay) else bay = 0% out.bay = "" end if print cursor_line(2); trm$(out.line_80) + cleol if inter ! ! Ask for slot if a valid bay was enterered. ! If a slot is entered, then skip other criteria, and ! do the search. ! sr_get_slot: if bay > 0% then s=get_input("Enter slot to search (return for all, '.' to end)") goto sr_abort if go_out goto sr_get_bay if go_back goto sr_get_order if s = "." slot = get_val(s) if slot <> 0% then if slot < 0 or slot > baysize(bay) then print errpos; "Invalid slot" goto sr_get_slot end if rset out.slot = num1$(slot) print cursor_line(2); trm$(out.line_80) + cleol if inter goto sr_do_search end if end if ! ! Ask for label. Labels searches allow wildcards. ! Default is all. ! sr_get_label: s = get_input("Enter label to search (return for all, '.' to end)") goto sr_get_bay if go_back goto sr_abort if go_out goto sr_get_order if s = "." label = edit$(s, 32%) out.label = label print cursor_line(2); trm$(out.line_80) + cleol if inter ! ! Ask for writing date. ! Default is all ! Two dates can be entered in comma separated list, will be ! processed as a range. ! sr_get_date_w: s=get_input("Enter writing date to search (return for all, '.' to end)") goto sr_get_label if go_back goto sr_abort if go_out goto sr_get_order if s = "." z = instr(0,s,",") if z = 0 then date_w_lo = edit$(s, -1%) date_w_hi = date_w_lo else date_w_lo = edit$(left(s, z - 1%), -1%) date_w_hi = edit$(right(s, z + 1%), -1%) end if if date_w_lo <> "" or date_w_hi <> "" then date_w_lo = "18-NOV-1858" if date_w_lo = "" date_w_hi = today if date_w_hi = "" date_w_lo = date_ymd(date_w_lo) date_w_hi = date_ymd(date_w_hi) if date_w_lo = "" or date_w_hi = "" then print errpos + "Invalid date" goto sr_get_date_w end if if date_w_lo > date_w_hi then s = date_w_lo date_w_lo = date_w_hi date_w_hi = s end if end if out.date_written = date_dmony(date_w_lo) out1.date_written = "" out1.date_written = date_dmony(date_w_hi) if date_w_hi <> date_w_lo print cursor_line(2); trm$(out.line_80) + cleol if inter print cursor_line(3); trm$(out1.line) + cleol if inter ! ! Get entered date ! Two dates can be entered in comma separated list, will be ! processed as a range. ! sr_get_date_e: s = get_input("Enter entry date to search (return for all, '.' to end)") goto sr_get_date_w if go_back goto sr_abort if go_out goto sr_get_order if s = "." z = instr(0,s,",") if z = 0 then date_e_lo = edit$(s, -1%) date_e_hi = date_e_lo else date_e_lo = edit$(left(s, z - 1%), -1%) date_e_hi = edit$(right(s, z + 1%), -1%) end if if date_e_lo <> "" or date_e_hi <> "" then date_e_lo = "18-NOV-1858" if date_e_lo = "" date_e_hi = today if date_e_hi = "" date_e_lo = date_ymd(date_e_lo) date_e_hi = date_ymd(date_e_hi) if date_e_lo = "" or date_e_hi = "" then print errpos + "Invalid date" goto sr_get_date_w end if if date_e_lo > date_e_hi then s = date_e_lo date_e_lo = date_e_hi date_e_hi = s end if end if out.date_entered = date_dmony(date_e_lo) out1.date_entered = "" out1.date_entered = date_dmony(date_e_hi) if date_e_hi <> date_e_lo print cursor_line(2); trm$(out.line_80) + cleol if inter print cursor_line(3); trm$(out1.line) + cleol if inter ! ! Get description. The entered string is searched for within ! the description to get a match. Search is case insensitive, ! sr_get_description: description = get_input("Enter description to search (return for all)") goto sr_get_date_e if go_back goto sr_abort if go_out description = "" if description = "." description = edit$(description, 1%+4%+8%+16%+32%+128%) out.description = description print cursor_line(2); trm$(out.line_80) + cleol if inter ! ! Get search order. This selects the key to use when starting ! a search. No actual sorting takes place. ! sr_get_order: s = get_input("Enter sort order (Bay/slot, Label, Date)") select left(edit$(s, -1%), 1%) case "B", "" sort_key = 0% case "L" sort_key = 1% case "D" sort_key = 2% case else print errpos; "Invalid order" goto sr_get_order end select ! ! Call the list routine to display the selection ! and count records ! sr_do_search: gosub list_records return sr_abort: selection_usable = FALSE print clw if inter return ! ! Routine to list selected records ! list_records: ! ! Set things up, and set the search up on the appropriate key ! print clw; menu_pos + " VIEW " + normal + cursor_line(1); if inter lines_printed = 0% matches = 0% gosub start_selection lr_search_loop: while TRUE ! ! Get a record. If that record didn't match, then go ! around again. If at end of file then exit the loop ! gosub do_select exit lr_search_loop if CTRLC_PRESSED exit lr_search_loop if selection_complete iterate lr_search_loop unless selection_valid ! ! Insert record info into display map ! out.line = "" out.bay = cat.bay out.slot = cat.master_slot out.label = cat.tape_label out.date_written = date_dmony(cat.date_written) out.date_entered = date_dmony(cat.date_entered) out.volumes = cat.set_size out.description = cat.description ! ! If we are at the bottom of the screen then stop and ask ! for a continuation. "\" or Ctrl/Z will go back to the menu. ! if lines_printed = 20% then s = get_input("Press return for more") exit lr_search_loop if go_back or go_out lines_printed = 0% print cursor_line(21); if inter end if ! ! Print a line, count them and the matches ! print lf + trm$(out.line_80) + cr; lines_printed = lines_printed + 1% matches = matches + 1% ! ! Drop out if we were looking at a specific bay/slot ! The search routine will do a direct key lookup for us. ! exit lr_search_loop if slot <> 0% next ! ! Decide if the selection is usable ! selection_usable = TRUE if matches = 0% then out.line = "" out.description = "No matches found" print cursor_line(2) + trm$(out.line_80) + cleol if inter selection_usable = FALSE end if lr_exit: return ! ! Print the selection out to a file ! print_selection: print menu_pos + " PRINT " + normal if inter ! ! Ask which file to print to ! ps_get_outfile: outfile = get_input("Enter output file (default is CATALOGUE.LIS)") return if go_back or go_out when error in open outfile for output as file out.chnl, recordsize 132, & defaultname "CATALOGUE.LIS" use print errpos; "Can't open file" continue ps_get_outfile end when ! ! Find out about the width of the report to print ! "Full width" = 132 col paper, otherwise 80 (well, 79 really). ! Default is full width ! ps_get_width: s = get_input("Full width report (Y/n)? ") goto ps_get_outfile if go_back return if go_out s = left(edit$(s, -1%), 1%) if instr(0%, "YN", s) = 0% then print errpos; "Yes or No" goto ps_get_width end if full_width = s <> "N" ! ! Set up page count, line count (55 to cause immediate ! page break), last bay so that new bays start on a new page ! and start the search on the appropriate key. ! print cursor_line(20%) if inter page_count = 0% lines_printed = 55% last_bay = "" gosub start_selection ps_print_loop: while TRUE ! ! Get record, exit if eof, round again if it doesn't match ! gosub do_select exit ps_print_loop if CTRLC_PRESSED exit ps_print_loop if selection_complete iterate ps_print_loop unless selection_valid ! ! Prepare the output ! out.line = "" out.bay = cat.bay out.slot = cat.master_slot out.label = cat.tape_label out.date_written = date_dmony(cat.date_written) out.date_entered = date_dmony(cat.date_entered) out.volumes = cat.set_size out.description = cat.description ! ! If 55 lines printed (or first time thru), or change of bay ! and key 0 selected (ie search in bay/slot order), then throw ! page and print headings ! if lines_printed = 55% or & (sort_key = 0% and cat.bay <> last_bay) then last_bay = cat.bay print #out.chnl; ff; if page_count > 0% page_count = page_count + 1% n = 29% z = 71% n = 53% if full_width z = 118% if full_width print #out.chnl; today; & tab(n); "Tape Catalogue Report"; & tab(z); "Page"; page_count print #out.chnl print #out.chnl; "B Slot Label Vol Written " & + "Entered Description" z = 33% z = 80% if full_width print #out.chnl; "- ---- ---------- --- ----------- " & + "----------- " + string$(z, 45%) lines_printed = 0% end if ! ! Print a line of appropriate length ! print #out.chnl; trm$(out.line) if full_width print #out.chnl; trm$(out.line_80) unless full_width lines_printed = lines_printed + 1% ! ! Don't loop if a bay/slot lookup was performed ! exit ps_print_loop if slot <> 0% next close out.chnl return ! ! Print labels for the selection ! print_labels: print menu_pos + " LABELS " + normal if inter ! ! Ask which file to print to ! pl_get_outfile: outfile = get_input("Enter output file (default is LABELS.LIS)") return if go_back or go_out outfile = "LABELS.LIS" if outfile = "" ! ! Open output file for append ! If file not found then go and create a new file. ! when error in open outfile for input as file out.chnl, access append use ! ! Create new labels file if error was not file not found ! if err <> 5% then print errpos; "Can't open file" continue pl_get_outfile end if open outfile for output as file out.chnl end when ! ! Reset file according to selected key ! print cursor_line(20%) if inter gosub start_selection pl_print_loop: while TRUE ! ! Get record, exit if eof, round again if it doesn't match ! gosub do_select exit pl_print_loop if selection_complete exit pl_print_loop if CTRLC_PRESSED iterate pl_print_loop unless selection_valid ! ! Print the labels. ! Labels are intended to be cut in two, the top half goes on ! the ring, the bottom half on the tape reel. !----------------------------------------! ! ! ! xxxlabelxxx Vol 999/999 B 99999 ! ! DD-MON-YYYY xxxxxxxxxxxxxxxxxxxxxxxxxx ! ! ! ! C00015J___ Vol 999/999 Bay B ! ! Date DD-MON-YYYY Slot 99999 ! ! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ! ! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ! ! ! !----------------------------------------! ! for n = 1 to val%(cat.set_size) z = val%(cat.master_slot) s = left(edit$(cat.set_size, -1%) + " ", 3) print #out.chnl print #out.chnl, cat.tape_label + " Vol" & + format$(n, "####") + "/" & + s + " " & + cat.bay + format$(z+n-1%, "######") print #out.chnl, date_dmony(cat.date_written) + " " & + trm$(left(cat.description, 26%)) print #out.chnl print #out.chnl, cat.tape_label + " Vol" & + format$(n, "####") + "/" & + s + " Bay " + cat.bay print #out.chnl, "Date " & + date_dmony(cat.date_written) & + " Slot" & + format$(z+n-1%, "######") ! ! Split the description line cleanly ! x = 39% if len(trm$(cat.description)) > 38% then x = z if mid(cat.description, z, 1) = " " & for z = 1 to 38% end if print #out.chnl, trm$(left(cat.description, x - 1%)) print #out.chnl, trm$(right(cat.description, x + 1%)) print #out.chnl next n ! ! Don't loop if a bay/slot lookup was performed ! exit pl_print_loop if slot <> 0% next close out.chnl return ! ! Kill the selected set ! delete_record: print menu_pos + " DELETE " + normal if inter dr_get_confirm: ! ! Confirm the deletion. Default is no ! s = get_input("Are you sure you want to remove this item?") goto dr_get_confirm if go_back return if go_out s = left(edit$(s, -1%), 1%) if instr(0%, "YN", s) = 0% then print errpos; "Yes or No" goto dr_get_confirm end if return if s <> "Y" ! ! Get the bay/slot into memory ! Go through and blank each record associated with this ! volume set. ! z = get_bay_slot(saved_bay, saved_slot) for n = saved_slot to saved_slot + val%(cat.set_size) - 1% z = get_bay_slot(saved_bay, n) cat.record = "" when error in update #cat.chnl use sleep 1% if err = 154% retry if err = 154% exit handler end when next n ! ! Selection is no longer usable. ! print clw if inter selection_usable = FALSE return ! ! Print/display slot usage ! usage_map: selection_usable = FALSE print clw + menu_pos + " USAGE " + normal ! ! Ask for the bay to display, default = all ! um_get_bay: s = get_input("Bay to display (return for all)") return if go_back or go_out bay = 0% if s <> "" then bay = n if baychar(n) = edit$(s, -1%) for n = 1 to bays if bay = 0% then print errpos; "Invalid bay" goto um_get_bay end if end if ! ! Ask output file, default = terminal ! um_get_outfile: outfile = get_input("Enter output file (return for screen)") goto um_get_bay if go_back return if go_out lines_printed = 0% if outfile <> "" then when error in open outfile for output as file out.chnl, recordsize 132 use print errpos; "Can't open file" continue um_get_outfile end when lines_printed = 55% ! ! If output file specified, then ask whether a full report ! is required, default = yes ! um_get_width: s = get_input("Full width report (Y/n)? ") goto um_get_outfile if go_back return if go_out s = left(edit$(s, -1%), 1%) if instr(0%, "YN", s) = 0% then print errpos; "Yes or No" goto um_get_width end if full_width = s <> "N" end if ! ! Clear everything out ! last_bay = "" page_count = 0% print cursor_line(1); if inter ! ! Loop through bays & slots ! Note that we cheat slightly if only one bay was requested ! um_search_loop: for x = 1% to bays x = bay if bay <> 0% for y = 1% to baysize(x) ! ! Get a bay/slot ! If set size field is blank then show an empty slot ! out.line = "" z = get_bay_slot(baychar(x), y) if cat.set_size = "" then out.bay = baychar(x) rset out.slot = num1$(y) out.label = "(empty)" else ! ! Otherwise show the contents of the slot ! out.bay = cat.bay out.slot = cat.slot out.label = cat.tape_label out.date_written = date_dmony(cat.date_written) out.date_entered = date_dmony(cat.date_entered) out.description = cat.description out.volumes = cat.volume end if if outfile = "" then ! ! Display to screen - stop every 20 lines and ask for ! continuation. ! if lines_printed = 20% then s = get_input("Press return for more") exit um_search_loop if go_back or go_out lines_printed = 0% print cursor_line(21); if inter end if print lf + trm$(out.line_80) + cr; else ! ! Display to file ! Throw page every 55 lines or on change of bay ! if lines_printed = 55% or cat.bay<>last_bay then last_bay = cat.bay print #out.chnl; ff; if page_count > 0% page_count = page_count + 1% n = 24% z = 71% n = 47% if full_width z = 118% if full_width print #out.chnl; today; & tab(n); "Tape Catalogue " & + "Slot Usage Report"; & tab(z); "Page"; page_count print #out.chnl print #out.chnl; & "B Slot Label Vol " & + "Written Entered " & + "Description" z = 33% z = 80% if full_width print #out.chnl; & "- ---- ---------- --- " & + "----------- ----------- " & + string$(z, 45%) lines_printed = 0% end if print #out.chnl; trm$(out.line) if full_width print #out.chnl; trm$(out.line_80) & unless full_width end if lines_printed = lines_printed + 1% next y ! ! Exit the loop if we were doing a sngle bay lookup ! exit um_search_loop if bay <> 0% next x close #out.chnl if outfile <> "" return ! ! Selection routine ! do_select: selection_complete = FALSE selection_valid = TRUE if slot = 0% then ! ! If this is not a single bay/slot lookup, then get a record ! signal all done if eof ! when error in get #cat.chnl use sleep 1% if err = 154% retry if err = 154% exit handler if err <> 11% selection_complete = TRUE selection_valid = FALSE continue ds_exit end when ! ! Check all selection criteria, signal a failed selection ! if any of them don't match, or the record is not the first ! item in each set. ! bay - straight comparison ! label - wildcard match ! date written - straight comparison ! date entered - straight comparison ! description - case-insensitive substring search ! if bay > 0% and sort_key = 0% and cat.bay <> baychar(bay) then selection_valid = FALSE selection_complete = TRUE end if selection_valid = FALSE if cat.set_size = "" selection_valid = FALSE if cat.slot <> cat.master_slot selection_valid = FALSE if bay > 0% and cat.bay <> baychar(bay) selection_valid = FALSE if label <> "" & and STR$MATCH_WILD(trm$(cat.tape_label), label)& = STR$_NOMATCH selection_valid = FALSE if date_w_lo <> "" & and (cat.date_written < date_w_lo or & cat.date_written > date_w_hi) selection_valid = FALSE if date_e_lo <> "" & and (cat.date_entered < date_e_lo or & cat.date_entered > date_e_hi) selection_valid = FALSE if description <> "" & and instr(0%, edit$(cat.description, 16%+32%), & description) = 0% else ! ! If a bay/slot lookup was requested then get bay/slot ! Return invalid selection and selection complete if the record ! was blank or non-existant ! z = get_bay_slot(baychar(bay), slot) if z = FALSE or cat.set_size = "" then selection_valid = FALSE selection_complete = TRUE end if end if ds_exit: ! ! extract the final slot/bay for single matches (ie delete) ! if selection_valid then saved_slot = val%(cat.master_slot) saved_bay = cat.bay end if return start_selection: if bay > 0% and sort_key = 0% then find #cat.chnl, key #0 eq baychar(bay) else if label <> "" and sort_key = 1% and & instr(0%, label, "%") + instr(0%, label, "*") = 0% then find #cat.chnl, key #1 ge label else if date_w_lo <> "" and sort_key = 2% then find #cat.chnl, key #2 ge date_w_lo else reset #cat.chnl, key #sort_key end if end if end if return end program