From: Brian Tillman [tillman_brian@notnoone.notnohow.com] Sent: Monday, February 11, 2002 6:34 PM To: Info-VAX@Mvb.Saic.Com Subject: Re: FIND vs. DFU We use ANALYZE/DISK/USAGE to generate a usage file and then process that. The format of the usage file is documented. Here's a program that will do this for you. -- Brian Tillman Internet: tillman_brian at si.com Smiths Aerospace tillman at swdev.si.com 3290 Patterson Ave. SE, MS Addresses modified to prevent Grand Rapids, MI 49512-1991 SPAM. Replace "at" with "@" This opinion doesn't represent that of my company ! FBO.CLD define verb fbo image sys$common:[sysmgr.tools]fbo parameter p1, label=disk_name, prompt="Disk", value (required) qualifier summary, default, nonnegatable qualifier uic, nonnegatable, value (required,type=$uic) qualifier identifier, nonnegatable, value (required) qualifier new_uf, label=new_file, nonnegatable qualifier output, label=out_file, nonnegatable, default, value (default=sys$output) disallow summary and uic ! disallow summary and identifier disallow uic and identifier program fbo implicit none include '($ssdef)' logical summary integer id_value integer disk_name_len character*255 disk_name call get_disk_name( disk_name, disk_name_len ) call create_usage_file( disk_name, disk_name_len ) call open_files( disk_name, disk_name_len ) call get_id_to_find( summary, id_value ) call print_header( summary, id_value, disk_name, disk_name_len ) call read_usage_file( summary, id_value ) call close_files stop 'ok' end subroutine get_disk_name( disk_name, disk_name_len ) implicit none include '($ssdef)' include '($clidef)' include '($lnmdef)' logical done integer cli$get_value integer disk_name_len integer len integer status integer sys$trnlnm character*255 logical_name character*255 disk_name structure /item_descriptor/ integer*2 buf_len integer*2 item_code integer buf_addr integer ret_len_addr end structure record /item_descriptor/ item_list(2) c get the disk name input on the fbo command status = cli$get_value( 'disk_name', logical_name ) if( status .ne. SS$_NORMAL ) call lib$signal( %val(status) ) call str$trim( logical_name, logical_name, len ) disk_name = logical_name disk_name_len = len c translate the possible logical name to a real disk name item_list(1).item_code = LNM$_STRING item_list(1).buf_addr = %loc( disk_name ) item_list(1).buf_len = 255 item_list(1).ret_len_addr = %loc( disk_name_len ) item_list(2).item_code = 0 done = .false. dowhile( .not. done ) if( logical_name(len:len) .eq. ':' ) len = len - 1 status = sys$trnlnm( 1 LNM$M_CASE_BLIND, !attributes 1 'LNM$FILE_DEV', !table name 1 logical_name(:len), !logical name 1 , !access mode 1 item_list ) !item list if( status .eq. SS$_NOLOGNAM ) then done = .true. elseif( status .ne. SS$_NORMAL ) then call lib$signal( %val(status) ) endif logical_name = disk_name len = disk_name_len enddo if( disk_name(disk_name_len:disk_name_len) .ne. ':' ) then disk_name = disk_name(:disk_name_len) // ':' disk_name_len = disk_name_len + 1 endif return end subroutine create_usage_file( disk_name, disk_name_len ) implicit none include '($ssdef)' include '($clidef)' integer CLI$_PRESENT parameter ( CLI$_PRESENT = '3fd19'x ) integer cli$present integer disk_name_len integer lib$spawn integer status character*(*) disk_name character*255 spawn_command status = cli$present( 'new_file' ) if( status .eq. CLI$_PRESENT ) then spawn_command = 1 '$ analyze/disk/usage=' // 1 disk_name(:disk_name_len-1) // 1 '.usage ' // 1 disk_name(:disk_name_len) type *, spawn_command status = lib$spawn( 1 spawn_command, !command string 1 'nl:', !input file 1 'nl:' !output file 1 ) if( status .ne. SS$_NORMAL ) call lib$signal( %val(status) ) endif return end subroutine open_files( disk_name, disk_name_len ) implicit none include '($ssdef)' integer cli$present integer cli$get_value integer disk_name_len integer status character*(*) disk_name character*255 out_file open( unit=1, file=disk_name(:disk_name_len-1)//'.usage', 1 status='old' ) status = cli$get_value( 'out_file', out_file ) if( status .ne. SS$_NORMAL ) call lib$signal( %val(status) ) open( unit=2, file=out_file, status='new', carriagecontrol='list' ) return end subroutine get_id_to_find( summary, id_value ) implicit none include '($clidef)' include '($ssdef)' integer CLI$_PRESENT parameter ( CLI$_PRESENT = '3fd19'x ) logical summary integer attrib integer cli$get_value integer cli$present integer comma integer group integer id_value integer lb integer len integer lib$matchc integer member integer rb integer status integer sys$asctoid character*14 input_uic character*31 id_name summary = .true. status = cli$present( 'uic' ) if( status .eq. CLI$_PRESENT ) then status = cli$get_value( 'uic', input_uic ) if( status .ne. SS$_NORMAL ) call lib$signal( %val(status) ) call str$trim( input_uic, input_uic, len ) lb = lib$matchc( '[', input_uic(:len) ) comma = lib$matchc( ',', input_uic(:len) ) rb = lib$matchc( ']', input_uic(:len) ) if( comma .eq. 0 ) stop 'Invalid uic format' if( rb .eq. 0 ) rb = len+1 read( unit=input_uic(lb+1:comma-1), fmt=1 ) group read( unit=input_uic(comma+1:rb-1), fmt=1 ) member id_value = member + group * 65536 summary = .false. else status = cli$present( 'identifier' ) if( status .eq. CLI$_PRESENT ) then status = cli$get_value( 'identifier', id_name ) call str$trim( id_name, id_name, len ) status = sys$asctoid( id_name(:len), id_value, attrib ) if( status .ne. SS$_NORMAL ) call lib$signal( %val(status) ) summary = .false. endif endif return 1 format( o6 ) end subroutine print_header( summary, id_value, disk_name, disk_name_len ) implicit none include '($ssdef)' logical summary integer disk_name_len integer group integer id_name_len integer id_value integer member integer status integer sys$idtoasc character*(*) disk_name character*31 id_name if( summary ) then write( unit=2, fmt=1 ) disk_name(:disk_name_len) else status = sys$idtoasc( 1 %val( id_value ), !identifier value 1 id_name_len, !identifier name length 1 id_name, !identifier name 1 , !resultant id value 1 , !attributes 1 ) !context if( status .eq. SS$_NOSUCHID ) then id_name = 'No ID Name' call str$trim( id_name, id_name, id_name_len ) elseif( status .ne. SS$_NORMAL ) then call lib$signal( %val(status) ) endif if( id_value .le. 0 ) then write( unit=2, fmt=2 ) id_name(:id_name_len), id_value, 1 disk_name(:disk_name_len) else group = id_value / 65536 member = id_value - group * 65536 write( unit=2, fmt=3 ) group, member, id_name(:id_name_len), 1 disk_name(:disk_name_len) endif endif return 1 format( // ' Summary of Disk Usage on ', a // ) 2 format( // ' Disk Usage by ', a, ' (',z8, ') on ', a // ) 3 format( // ' Disk Usage by [', o5.5, ',', o6.6, '] (', a, 1 ') on ', a // ) end subroutine read_usage_file( summary, id_value ) implicit none logical eof logical summary byte type integer*2 dir_len integer*2 spec_len integer allocated integer file_owner integer i integer id_table(0:9999) integer id_value integer index integer index2 integer iostat integer lib$skpc integer max integer num_files(0:9999) integer total_allocated(0:9999) integer total_used(0:9999) integer used character*7 alloc character*255 file_spec character*7 num_f character*272 rec equivalence ( type, rec(1:1) ) equivalence ( file_owner, rec(2:2) ) equivalence ( allocated, rec(6:6) ) equivalence ( used, rec(10:10) ) equivalence ( dir_len, rec(14:14) ) equivalence ( spec_len, rec(16:16) ) equivalence ( file_spec, rec(18:18) ) call get_index( id_value, i, id_table ) eof = .false. dowhile( .not. eof ) read( unit=1, fmt=1, iostat=iostat ) rec if( iostat .eq. 0 ) then if( type .eq. 2 ) then if( summary ) then call get_index( file_owner, i, id_table ) num_files(i) = num_files(i) + 1 total_allocated(i) = total_allocated(i) + allocated total_used(i) = total_used(i) + used elseif( file_owner .eq. id_value ) then num_files(i) = num_files(i) + 1 total_allocated(i) = total_allocated(i) + allocated total_used(i) = total_used(i) + used write( unit=alloc, fmt=3 ) allocated index = max( lib$skpc( ' ', alloc ), 1 ) write( unit=2, fmt=2 ) used, alloc(index:), 1 file_spec(:spec_len) endif endif else eof = .true. endif enddo if( summary ) then call print_summary( total_used, total_allocated, num_files, 1 id_table ) else write( unit=2, fmt=4 ) write( unit=alloc, fmt=3 ) total_allocated(i) index = max( lib$skpc( ' ', alloc ), 1 ) write( unit=num_f, fmt=3 ) num_files(i) index2 = max( lib$skpc( ' ', num_f ), 1 ) write( unit=2, fmt=5 ) total_used(i), alloc(index:), 1 num_f(index2:) endif return 1 format( a ) 2 format( i7, ' / ', a, t20, a ) 3 format( i7 ) 4 format( '----------------------------------------', 1 '---------------------------------------' ) 5 format( i7, ' / ', a, ' blocks in ', a, ' files.' ) end subroutine close_files implicit none close( unit=1 ) close( unit=2 ) return end subroutine get_index( id_value, i, id_table ) implicit none integer abs integer first_try integer i integer id_table(0:9999) integer id_value integer mod i = mod( abs(id_value), 10000 ) first_try = i dowhile( id_table(i) .ne. id_value ) if( id_table(i) .eq. 0 ) then id_table(i) = id_value else i = i + 1 if( i .eq. 10000 ) i = 0 if( i .eq. first_try ) stop ' ID table full' endif enddo return end subroutine print_summary( total_used, total_allocated, num_files, 1 id_table ) implicit none include '($ssdef)' integer group integer i integer id_name_len integer id_table(0:9999) integer index integer j integer lib$skpc integer max integer member integer next_value integer num_files(0:9999) integer num_values integer sorted_id_table(0:9999) integer status integer sys$idtoasc integer temp integer total_allocated(0:9999) integer total_used(0:9999) character*7 alloc character*31 id_name next_value = 0 do i = 0, 9999 if( id_table(i) .ne. 0 ) then sorted_id_table(next_value) = id_table(i) next_value = next_value + 1 endif enddo num_values = next_value do i = 0, num_values - 2 do j = i+1, num_values - 1 if( sorted_id_table(j) .lt. sorted_id_table(i) ) then temp = sorted_id_table(i) sorted_id_table(i) = sorted_id_table(j) sorted_id_table(j) = temp endif enddo enddo do i = 0, num_values - 1 status = sys$idtoasc( 1 %val( sorted_id_table(i) ), !identifier value 1 id_name_len, !identifier name length 1 id_name, !identifier name 1 , !resultant id value 1 , !attributes 1 ) !context if( status .eq. SS$_NOSUCHID ) then id_name = 'No ID Name' call str$trim( id_name, id_name, id_name_len ) elseif( status .ne. SS$_NORMAL ) then call lib$signal( %val(status) ) endif call get_index( sorted_id_table(i), j, id_table ) write( unit=alloc, fmt=3 ) total_allocated(j) index = max( lib$skpc( ' ', alloc ), 1 ) if( sorted_id_table(i) .le. 0 ) then write( unit=2, fmt=1 ) 1 total_used(j), 1 alloc(index:), 1 sorted_id_table(i), 1 id_name(:id_name_len) else group = sorted_id_table(i) / 65536 member = sorted_id_table(i) - group * 65536 write( unit=2, fmt=2 ) 1 total_used(j), 1 alloc(index:), 1 group, 1 member, 1 id_name(:id_name_len) endif enddo return 1 format( 1x, i7, ' / ', a, t23, z8, t38, a ) 2 format( 1x, i7, ' / ', a, t20, '[', o5.5, ',', o6.6, ']', t38, a ) 3 format( i7 ) end