rebol [ file: %application-sizer.r title: "Estimate size of a REBOL application" date: 6-dec-2008 Author: "Sunanda" Version: 0.0.3 History: [ 0.0.0 1-dec-2008 "initial release" 0.0.1 3-dec-2008 "various improvements (see documentation)" 0.0.2 4-dec-2008 "/csv and /config refinements (see documentation)" 0.0.3 6-dec-2008 "/preprocess refinement (see documentation)" ] ] ;; Documentation is here: ;; --------------------- http://www.rebol.org/documentation.r?script=application-sizer.r app-sizer: make object! [ ;; configuration/installation options ;; ---------------------------------- configuration: make object! [ app-name: "No name" ;; The name of your application app-version: "None" ;; The version of your application app-folders: %./ ;; folders to search (use block if more than one) exclude-files: [%application-sizer.r] ;; files to ignore source-suffixes: [%.r] ;; what's a script? add-header?: false ;; do they all have headers? minimal-chars: "{}[]" ;; lines with only these are ignored csv-file-name: %application-sizer.csv ;; csv file name ] configuration-reset: construct/with [] configuration files-seen: copy [] all-data: copy "" app-data: make object! [ app-sizer-version: 0.0.2 run-date: now/date app-name: configuration/app-name app-version: none folders: 0 files: 0 raw-bytes: 0.0 compressed-size: 0.0 raw-lines: 0.0 code-lines: 0.0 elements: make object! [ string: [0 0.0] ;; occurances + total length datatype: [0 0.0] number: [0 0.0] refinement: [0 0.0] function: [0 0.0] operator: [0 0.0] native: [0 0.0] action: [0 0.0] object: [0 0.0] image: [0 0.0] comment: [0 0.0] body: [0 0.0] whitespace: [0 0.0] ] element-definitions: none ;; inverted from color-code/colors ] init-app-data: first reduce load mold app-data pp-func: none ;; preprocessing function ;; ============================================================ ;; color-coder and color-code ;; -------------------------- ;; adapted from Carl's color ;; coding script in the Library. ;; We use them to characterise ;; the parts of a script. Originals ;; are here: ;; http://www.rebol.org/view-script.r?script=color-code.r ;; ============================================================ color-coder: make object! [ ; Set the color you want for each datatype: colors: sort/skip [ char! "string" date! "datatype" decimal! "number" email! "string" file! "string" integer! "number" issue! "datatype" money! "datatype" pair! "datatype" string! "string" tag! "string" time! "datatype" tuple! "datatype" url! "string" refinement! "refinement" cmt "comment" ] 2 out: copy [] text: none emit: func [data] [repend out data] emit-color: func [value start stop /local color][ either none? :value [color: select colors 'cmt][ if path? :value [value: first :value] color: either word? :value [ any [ all [value? :value image? get :value "image"] all [value? :value action? get :value "action"] all [value? :value op? get :value "operator"] all [value? :value object? get :value "object"] all [value? :value native? get :value "native"] all [value? :value any-function? get :value "function"] all [value? :value datatype? get :value "datatype"] ] ][ any [select colors type?/word :value] ] ] text: copy/part start stop either color [ emit [ to-word color text 'whitespace ] ][ emit ['body text 'whitespace] ;; something else ] ] ] color-code: func [ "Return color source code as HTML." text [string!] "Source code text" /local str new value temp ][ color-coder/out: copy [] set [value text] load/next/header detab text color-coder/emit copy/part head text text spc: charset [#"^(1)" - #" "] ; treat like space parse/all text blk-rule: [ some [ str: some spc new: (color-coder/emit copy/part str new) | newline (color-coder/emit newline)| #";" [thru newline | to end] new: (color-coder/emit-color none str new) | [#"[" | #"("] (color-coder/emit first str) blk-rule | [#"]" | #")"] (color-coder/emit first str) break | skip ( set [value new] load/next str color-coder/emit-color :value str new ) :new ] ] return color-coder/out ] run: func [ ;; ======================================== /config user-config [object!] /csv /preprocess pp-function [function!] /local cap-err ][ ;; Initialise the configuration object ;; ----------------------------------- either config [ configuration: construct/with third user-config configuration-reset ][ configuration: construct/with [] configuration-reset ] ;; initialise the preprocessing function ;; ------------------------------------- pp-func: func [ ;; do nothing function for default folder [file!] name [file!] scr [string!] ][ return scr ] if preprocess [ pp-func: :pp-function ;; user supplied function ] ;; Initialise the app-data object ;; ------------------------------ app-data: first reduce load mold init-app-data app-data/app-version: configuration/app-version app-data/app-name: configuration/app-name app-data/element-definitions: copy [] foreach [element type] color-coder/colors [ either none? ptr: select app-data/element-definitions type [ insert/only app-data/element-definitions reduce [element] insert app-data/element-definitions type ][ append ptr element ] ] sort/skip app-data/element-definitions 2 ;; Reset other data areas ;; ---------------------- all-data: make string! 512000 files-seen: copy [] ;; Count the files! ;; ---------------- if not block? configuration/app-folders [ configuration/app-folders: reduce [configuration/app-folders] ] foreach folder configuration/app-folders [ app-data/folders: app-data/folders + 1 foreach file read folder [ if error? cap-err: try [ handle-file folder file ][ print ["app-sizer: problem with " clean-path join folder file "..." mold disarm cap-err ] ] ] ] app-data/compressed-size: length? compress trim/lines all-data all-data: none ;; Emit a CSV if requested ;; ----------------------- ;; Header row written for new ;; file, otherwise we add a new ;; row for these results if csv [ if not exists? configuration/csv-file-name [ write-csv-header ] write-csv-data ] return app-data ] handle-file: func [ ;; ========================================= folder [file!] file [file!] /local target-file-name file-contents file-lines cs post-processed nn ][ ;; Handles one file ;; ---------------- ;; File may be expanded into more than one ;; by the preprocessing. target-file-name: join folder file ;; Ignore if not a proper target ;; ----------------------------- if dir? target-file-name [return true] ;; no subfolder search, yet if not find configuration/source-suffixes suffix? file [return true] ;; wrong suffix if find configuration/exclude-files file [return true] ;; excluded file file-contents: read target-file-name ;; do not count if it is a duplicate file ;; -------------------------------------- if find files-seen checksum/secure file-contents [return true] ;; Run preprocessing ;; ----------------- ;; This may expand the file to more than one file post-processed: do reduce [pp-func folder file file-contents] if none? post-processed [return true] ;; preprocess says ignore ;; Size each file ;; resulting from the ;; preprocessing ;; --------------------- if not block? post-processed [ post-processed: reduce [post-processed] ] nn: 0 foreach target-script post-processed [ nn: nn + 1 ;; for error messages ;; ignore if already seen ;; ---------------------- if not find files-seen cs: checksum/secure target-script [ append files-seen cs ;; add a header if: ;; 1. needed ;; 2. add-header option is enabled ;; ------------------------------- if configuration/add-header? [ if error? try [load/header target-script] [ insert target-script {REBOL [] ^/} print ["app-sizer: header added to [" nn "] " clean-path target-file-name] ] ] ;; count the file ;; -------------- append all-data target-script file-lines: parse/all target-script to-string newline app-data/files: app-data/files + 1 app-data/raw-bytes: app-data/raw-bytes + length? target-script app-data/raw-lines: app-data/raw-lines + length? file-lines count-code-lines file-lines count-elements target-script ] ] return true ] count-code-lines: func [ ;; ==================================== file-lines [block!] ][ ;; bumps a count for lines ;; that are not blank, or minimal ;; ------------------------------ foreach line file-lines [ trim/all line if all [ "" <> line ;; ignore blank #";" <> line/1 ;; ignore comment "" <> exclude line configuration/minimal-chars ;; ignore if only minimal chars not all [find configuration/minimal-chars line/1 ;; something like "] ;end of func" line/2 = #";" ] ][ app-data/code-lines: app-data/code-lines + 1 ] ] return true ] count-elements: func [ ;; ==================================== script [string!] /local latest-type target ][ ;; uses color-code to ;; analyse the script and ;; count its various elements ;; --------------------------- latest-type: 'whitespace foreach item app-sizer/color-code script [ either word? item [ latest-type: item target: get in app-data/elements latest-type poke target 1 target/1 + 1 ;; one more of this type ][ if char? item [item: to-string item] target: get in app-data/elements latest-type poke target 2 target/2 + length? item ;; total length of this type ] ] return true ] write-csv-header: func [ ;; ========================== /local rec ][ rec: copy "" foreach [label value] flatten-app-data-object [ append rec mold label append rec "," ] rec: copy/part rec (length? rec) - 1 write/lines configuration/csv-file-name rec return true ] write-csv-data: func [ ;; ========================== /local rec ][ rec: copy "" foreach [label value] flatten-app-data-object [ append rec value append rec "," ] rec: copy/part rec (length? rec) - 1 write/lines/append configuration/csv-file-name rec return true ] flatten-app-data-object: func [ ;; ================================= /recurs prefix target /local data item-value ][ data: copy [] either recurs [ prefix: join prefix "-" ][ prefix: copy "" target: app-data ] foreach item next first target [ item-value: get in target item either object? item-value [ append data flatten-app-data-object/recurs form item item-value ][ either block? item-value [ for nn 1 length? item-value 1 [ append data rejoin [prefix to-string item "-" nn] append data form item-value/:nn ] ][ append data rejoin [prefix to-string item] append data form get in target item ] ] ] return data ] ]