"{ Package: 'stx:goodies/builder/reports' }"

"{ NameSpace: Builder }"

ReportFormat subclass:#CoverageReportFormat

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'Builder-Reports-Formats'

!

CoverageReportFormat subclass:#Cobertura

	instanceVariableNames:'currentPackage currentClass currentMethod infos'

	classVariableNames:''

	poolDictionaries:''

	privateIn:CoverageReportFormat

!

!CoverageReportFormat class methodsFor:'testing'!

isAbstract

    ^self == CoverageReportFormat

    "Created: / 04-08-2011 / 11:44:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 25-06-2013 / 01:26:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CoverageReportFormat::Cobertura class methodsFor:'accessing'!

symbolicNames

    "Returns a collection of symbolic names for this format"

    ^ self shouldImplement

! !

!CoverageReportFormat::Cobertura class methodsFor:'documentation'!

documentation

" }

 Replace 'Object', 'NewClass1' and

 the empty string arguments by true values.

 Install (or change) the class by 'accepting',

 either via the menu or the keyboard (usually CMD-A).

 You can also change the category simply by editing

 the categoryString and accepting.

 To be nice to others (and yourself later), do not forget to

 add some documentation; preferably under the classes documentation

 protocol.

 (see the `create documentation stubs' item in the methodList menu;

  switch from instance to class to find this menu item.)

 Notice, that ST/X uses the convention to document the class using

 comment-only class methods (however, ST80 comments are supported and

 can be changed via the class-documentation menu).

"

! !

!CoverageReportFormat::Cobertura methodsFor:'accessing - defaults'!

defaultFileSuffix

    "superclass Builder::ReportFormat says that I am responsible to implement this method"

    ^ 'xml'

    "Modified: / 25-06-2013 / 02:02:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CoverageReportFormat::Cobertura methodsFor:'writing'!

write: instrumentedMethods

    | packageMap |

    packageMap := Dictionary new.

    infos := Dictionary new.

    instrumentedMethods do:[:method|

        | classMap methodMap |

        classMap := packageMap at: method package ifAbsentPut: [ Dictionary new ].

        methodMap := classMap at: method mclass ifAbsentPut: [ Dictionary new ].

        methodMap at: method selector put: method.

    ].

    packageMap keys asSortedCollection do:[:package|

        | classMap |            

        self writePackage: package with:[            

            ((classMap := packageMap at: package) keys asSortedCollection:[:a :b| a name < b name ]) do:[:class|

                | methodMap |

                self writeClass: class with:[

                    (methodMap := classMap at: class) keys asSortedCollection do:[:selector|

                        | method |

                        method := methodMap at: selector.

                        self writeMethod: method.

                    ]                    

                ]

            ]

        ]

    ]

    "Created: / 25-06-2013 / 13:17:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

writeClass: class with: content

    | className classFileName classPathName |

    className := class name.

    classFileName := class isPrivate 

    class package ~~ currentPackage ifTrue:[

        classFileName := 'extensions.st'

    ].

    classPathName := ((currentPackage copyReplaceAll: $: with: Filename separator) replaceAll: $/ with: Filename separator) 

                        , Filename separator , classFileName.

    stream nextPutAll:'        <class name="'; nextPutAll: className; nextPutAll: '" filename="'; nextPutAll: classPathName; nextPutLine:'" line-rate="1.0" branch-rate="1.0" complexity="1.0">'.

    stream nextPutLine:'          <methods>'.

    currentClass := class.

    content value.               

    currentClass := nil.

    stream nextPutLine:'          </methods>'.

    stream nextPutLine:'        </class>'

    "Created: / 25-06-2013 / 12:29:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

writeFooter

    stream nextPutAll:'  </packages>

</coverage>'

    "Modified: / 25-06-2013 / 11:57:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

writeHeader

    stream nextPutAll:'<?xml version="1.0"?>

<!!--DOCTYPE coverage SYSTEM "http://cobertura.sourceforge.net/xml/coverage-03.dtd"-->

!

writeLine: lineNr hits: nhits

    stream nextPut:'            <line number="'; nextPutAll: lineNr printString; nextPutAll:'" hits="'; nextPutAll: nhits printString; nextPutLine:'" branch="false" />'.

    "Created: / 25-06-2013 / 13:04:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 25-06-2013 / 14:23:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

writeMethod: method

    | info firstCharOffset firstLineNr lastLineNr lines  |

    stream nextPutAll:'        <method name="'; nextPutAll: method selector; nextPutLine: '" signature="()" line-rate="1.0" branch-rate="1.0" complexity="1.0">'.

    stream nextPutLine:'          <lines>'.

    currentMethod := method.

    info := infos at: method mclass ifAbsentPut:[ReportSourceInfo for: method mclass].

    firstCharOffset := info offsetOfMethod: method.

    firstLineNr := (info lineAndColumnOfOffset: firstCharOffset) x.

    lastLineNr := (info lineAndColumnOfOffset: firstCharOffset + method source size) x.

    lines := Array new: lastLineNr - firstLineNr + 1 withAll: method methodInvocationInfo count.

    (method blockInvocationInfo copy sort:[:a :b | a startPosition < b startPosition]) do:[:eachBlockInfo |

        | startLine endLine |

        startLine := (info lineAndColumnOfOffset: firstCharOffset + eachBlockInfo startPosition - 1) x.

        endLine := (info lineAndColumnOfOffset: firstCharOffset + eachBlockInfo endPosition - 1) x.

        startLine to: endLine do:[:lineNr|

            lines at: (lineNr - firstLineNr + 1) put: ((lines at: (lineNr - firstLineNr + 1)) min: eachBlockInfo count)

        ]            

    ].

    1 to: lines size do:[:i|

        self writeLine: (i + firstLineNr - 1) hits: (lines at: i)

    ].

    currentMethod := nil.

    stream nextPutLine:'          </lines>'.

    stream nextPutLine:'        </method>'

    "Created: / 25-06-2013 / 13:17:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 25-06-2013 / 14:51:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

writeMethod: method with: content

    stream nextPutLine:'          <lines>'.

    currentMethod := method.

    content value.          

    currentMethod := nil.

    stream nextPutLine:'          </lines>'.

    stream nextPutLine:'        </method>'

    "Created: / 25-06-2013 / 12:59:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

writePackage: packageName with: aBlock

    stream nextPutAll:'    <package name="'; nextPutAll: packageName; nextPutLine: '" line-rate="1.0" branch-rate="1.0" complexity="1.0">'.

    stream nextPutLine:'      <classes>'.

    currentPackage := packageName.

    aBlock value.               

    currentPackage := nil.

    stream nextPutLine:'      </classes>'.

    stream nextPutLine:'    </package>'

    "Created: / 25-06-2013 / 11:55:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 25-06-2013 / 13:24:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CoverageReportFormat class methodsFor:'documentation'!

version

    ^ '$Header$'

!

version_CVS

    ^ '$Header$'

! !