DocScript SVN

342 lines (293 with data), 13.1 kB

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Export" script:language="StarBasic">REM  *****  BASIC  *****

&apos; DocScript export script

&apos; Copyright (C) 2009
&apos; Andreas Harnack (ah8 at freenet dot de)

&apos; This software is distributed in the hope that it will be useful,
&apos; but WITHOUT ANY WARRANTY; without even the implied warranty of
&apos; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
&apos; GNU General Public License for more details.

&apos; You should have received a copy of the GNU General Public License along
&apos; with this library; see the file COPYING.  If not, write to the Free
&apos; Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
&apos; USA.

&apos; As a special exception, you may use this file as part of a free software
&apos; library without restriction.  Specifically, if other files instantiate
&apos; templates or use macros or inline functions from this file, or you compile
&apos; this file and link it with other files to produce an executable, this
&apos; file does not by itself cause the resulting executable to be covered by
&apos; the GNU General Public License.  This exception does not however
&apos; invalidate any other reasons why the executable file might be covered by
&apos; the GNU General Public License.


Function shift(sShift as String) as String
    shift = sShift &amp; &quot;	&quot;
End Function


Function quoteStr(str as String) as String
    quoteStr = &quot;&apos;&quot; &amp;  join(split(str, &quot;&apos;&quot;), &quot;&apos;&quot;&amp;CHR(34)&amp;&quot;&apos;&quot;&amp;CHR(34)&amp;&quot;&apos;&quot;) &amp; &quot;&apos;&quot;
End Function


Function ooVersion() As String
	&apos;Retrieves the running OOo version
	&apos;Author : Laurent Godard
	&apos;e-mail : listes.godard@laposte.net
	Dim oSet, oConfigProvider
	Dim sProvider$, sAccess$
	Dim oParm(0) As New com.sun.star.beans.PropertyValue
	sProvider = &quot;com.sun.star.configuration.ConfigurationProvider&quot;
	sAccess = &quot;com.sun.star.configuration.ConfigurationAccess&quot;
	oParm(0).Name = &quot;nodepath&quot;
	oParm(0).Value = &quot;/org.openoffice.Setup/Product&quot;
	oConfigProvider = createUnoService(sProvider)
	oSet = oConfigProvider.createInstanceWithArguments(sAccess, oParm())
	ooVersion=oSet.getByName(&quot;ooSetupVersion&quot;)
End Function


Function charStyle(oText as Objec, oPara as Object) as String
    Dim sStyle as String
    REM get the character style properties
    If oText.CharStyleName &lt;&gt; &quot;&quot; Then
        REM check for style name first
        sStyle = &quot; &apos;&quot; + join(split(oText.CharStyleName),&quot;_&quot;) +&quot;&apos;&quot;
    Else
        Dim iItalic, iBold, iFixed as Integer
        iItalic = com.sun.star.awt.FontSlant.ITALIC
        iBold =  com.sun.star.awt.FontWeight.BOLD
        iFixed = com.sun.star.awt.FontPitch.FIXED
        sStyle = &quot;&quot;
        If oText.CharPosture=iItalic And oPara.CharPosture &lt;&gt; iItalic Then 
            sStyle = sStyle + &quot; italic&quot;
        End If
        If oText.CharWeight =iBold And oPara.CharWeight &lt;&gt; iBold Then
            sStyle = sStyle + &quot; bold&quot;
        End If
        If  oText.CharFontPitch = iFixed And oPara.CharFontPitch &lt;&gt; iFixed Then
            sStyle = sStyle + &quot; fixedfont&quot;
        End If
    End If
    charStyle = sStyle
End Function


Sub exportText(iFile%, oPara as Object, oText as Object, sShift$)
    If len( oText.getString()) &gt; 0 Then
        Dim sText, sAttributes as String
        sText = quoteStr(oText.getString())
        sAttributes = charStyle(oText, oPara)
        print #iFile sShift &amp; &quot;text&quot; &amp; sAttributes &amp; &quot; &apos;&apos; &quot; &amp; sText
    End If
End Sub


Sub exportParagraphContent(iFile%, oPara as Object, sShift$)
    Dim oTextEnum
    otextEnum = oPara.createEnumeration()

    REM iterat through all text portions of a paragraph
    Do While otextEnum.hasMoreElements()
        Dim oText as Object
        Dim sType as String
        REM get next portion
        oText = oTextEnum.nextElement()
        REM get portion type
        sType = LCase(oText.TextPortionType)

        If sType = &quot;text&quot; Then 
            exportText(iFile, oPara, oText, sShift)
        Else
            print #iFile &quot;debug &quot; + stype + &quot; &lt;&lt; _END_&quot;
            print #iFile join(oText.SupportedServiceNames, CHR(10))
            print #iFile &quot;_END_&quot;
            print #iFile
        End If
    Loop
End Sub


Function listType(iType as Integer) as String
    Select Case iType
        Case com.sun.star.style.NumberingType.ARABIC:
            listType = &quot;arabic&quot;
        Case com.sun.star.style.NumberingType.ROMAN_UPPER:
            listType = &quot;roman_upper&quot;
        Case com.sun.star.style.NumberingType.ROMAN_LOWER:
            listType = &quot;roman_lower&quot;
        Case com.sun.star.style.NumberingType.CHARS_UPPER_LETTER:
            listType = &quot;letter_upper&quot;
        Case com.sun.star.style.NumberingType.CHARS_LOWER_LETTER:
            listType = &quot;letter_lower&quot;
        Case com.sun.star.style.NumberingType.CHAR_SPECIAL:
            listType = &quot;char_special&quot;
        Case com.sun.star.style.NumberingType.BITMAP:
            listType = &quot;bitmap&quot;
        Case Else
            listType = str(iType)
    End Select
End Function


Function paragraphListType(oPara as Object) as Integer
    paragraphListType = 0
    If oPara.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
        If Not isEmpty(oPara.NumberingRules) Then
            Dim oRules
            oRules = oPara.NumberingRules
            If Not oRules.NumberingIsOutline Then
                Dim oRule()
                Dim i As Integer
                oRule() = oRules.getByIndex(oPara.NumberingLevel )
                For i = LBound(oRule()) To Ubound(oRule())
                    If oRule(i).Name = &quot;NumberingType&quot; Then
                        paragraphListType = oRule(i).Value
                    End If
                Next
            End If
        End If
    End If
End Function


Function paragraphListLevel(oPara as Object, iListType as Integer) as Integer
    If ( iListType &gt; 0 ) Then
        paragraphListLevel = oPara.NumberingLevel + 1
    Else
        paragraphListLevel = 0
    End If
End Function


Function paragraphStyle(oPara as Object) as String
    Dim oOptions as String
    Dim oStyles, oStyle as Object

    oOptions = &quot;&apos;&quot; + join(split(oPara.ParaStyleName),&quot;_&quot;) + &quot;&apos;&quot;
    oStyles = ThisComponent.StyleFamilies.getByName(&quot;ParagraphStyles&quot;)
    oStyle = oStyles.getByName(oPara.ParaStyleName)
    If oPara.ParaAdjust &lt;&gt; oStyle.ParaAdjust Then
        If oPara.ParaAdjust = com.sun.star.style.ParagraphAdjust.CENTER Then
            oOptions = oOptions + &quot; `align center`&quot;
        ElseIf oPara.ParaAdjust = com.sun.star.style.ParagraphAdjust.LEFT Then
            oOptions = oOptions + &quot; `align left`&quot;
        ElseIf oPara.ParaAdjust = com.sun.star.style.ParagraphAdjust.RIGHT Then
            oOptions = oOptions + &quot; `align right`&quot;
        End If
    End If
    paragraphStyle = oOptions
End Function


Sub exportParagraph(iFile%, oPara as Object, sShift$)
    If len(trim(oPara.getString())) &gt; 0 Then
        print #iFile sShift &amp; &quot;(&quot;
        exportParagraphContent(iFile, oPara, shift(sShift))
        print #iFile
        print #iFile sShift &amp; &quot;) | paragraph &quot; + paragraphStyle(oPara)
        print #iFile
    End If
End Sub


Sub exportTable(iFile%, oTable as Object, sShift0$)
    iRows% = oTable.getRows().getCount()
    iColumns% = oTable.getColumns().getCount()
    sShift1$ = shift(sShift0)
    sShift2$ = shift(sShift1)
    sShift3$ = shift(sShift2)
    print #iFile sShift0 &amp; &quot;( :&quot;
    For i = 0 to iRows-1
        print #iFile sShift1 &amp; &quot;( :&quot;
        For j = 0 to iColumns-1
            print #iFile sShift2 &amp; &quot;( :&quot;
            exportContent(iFile, oTable.getCellByPosition(j,i), sShift3)
            print #iFile sShift2 &amp; &quot;) | column&quot;
        Next
        print #iFile sShift1 &amp; &quot;) | row&quot;
    Next
    print #iFile sShift0 &amp; &quot;) | table&quot;
    print #iFile
End Sub


Sub exportContent(iFile%, oContent as Object, sShift$)
    Dim oParaEnum, oPara as Object
    oParaEnum = oContent.getText().createEnumeration()

    Dim iListLevel as Integer
    Dim iListType(32) as Integer
    Dim sListShift(32) as String
    Dim sListType as String

    REM iterate through all paragraphs
    iListLevel = 0
    sListShift(0) = sShift
    Do While oParaEnum.hasMoreElements()
        Dim iParagarphListLevel, iParagraphListType as Integer
        oPara = oParaEnum.nextElement()
        iParagraphListType = paragraphListType(oPara)
        iParagarphListLevel = paragraphListLevel(oPara, iParagraphListType)
        While iListLevel &lt; iParagarphListLevel &apos;open a new list
            print #iFile sListShift(iListLevel) &amp; &quot;(&quot;
            iListType(iListLevel) = iParagraphListType
            iListLevel = iListLevel + 1
            sListShift(iListLevel) = shift(sListShift(iListLevel-1))
        Wend
        While iListLevel &gt; iParagarphListLevel &apos;close current list
            iListLevel = iListLevel - 1
            sListType =  listType(iListType(iListLevel))
            print #iFile sListShift(iListLevel) &amp; &quot;) | list &quot; + sListType
            print #iFile
        Wend
        If iListLevel &gt; 0 Then &apos;we are still in a list
            If iListType(iListLevel-1) &lt;&gt; iParagraphListType Then
                sListType = listType(iListType(iListLevel-1))
                print #iFile sListShift(iListLevel-1) &amp; &quot;) | list &quot; &amp; sListType
                iListType(iListLevel-1) = iParagraphListType
                print #iFile sListShift(iListLevel-1) &amp; &quot;(&quot;
            End If
            print #iFile sShift &amp; sListShift(iListLevel) &amp; &quot;(&quot;
            exportParagraphContent(iFile, oPara, shift(sListShift(iListLevel)))
            print #iFile sShift &amp; sListShift(iListLevel) &amp; &quot;) | item&quot;
        ElseIf oPara.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
            REM normal paragraphs
            exportParagraph(iFile, oPara, sShift)
        ElseIf oPara.supportsService(&quot;com.sun.star.text.TextTable&quot;) Then
            REM Tables 
            exportTable(iFile, oPara, sShift)
        Else
            REM anything else, should not happen
            MsgBox &quot;Unsupported Text Element&quot;
        End If
    Loop
End Sub


Sub exportDocument(iFile%, oDoc as Object)
    print #iFile &quot;#!/bin/bash&quot;
    print #iFile
    print #iFile &quot;source oo2html.styles&quot;
    print #iFile

    print #iFile &quot;export OPENOFFICE_SOLAR_VERSION=&quot; + GetSolarVersion()
    print #iFile &quot;export OPENOFFICE_VERSION=&quot; + ooVersion()
    print #iFile &quot;export OPENOFFICE_GUI=&quot; + GetGUIType()
    print #iFile &quot;export LANG=&quot; + Environ(&quot;LANG&quot;)
    print #iFile

    REM export document content
    exportContent(iFile, oDoc, &quot;&quot;)
    print #iFile
End Sub


Sub exportToFile(sFileName as String, oDoc as Object)
    Dim iFile as Integer
    iFileNumber = FreeFile
    Open sFileName for Output as #iFileNumber
    exportDocument(iFileNumber, oDoc)
    Close #iFileNumber
End Sub


Function fileName(sDocName as String, sExtension as String) as String
    Dim vPath as Variant
    Dim vName as Variant
    vPath = split(sDocName, &quot;/&quot;)
    vName = split(vPath(UBound(vPath())), &quot;.&quot;)
    If LBound(vName) &lt; UBound(vName) Then
        vName(UBound(vName)) = sExtension
    Else
        vName(LBound(vName)) = vName(LBound(vName)) &amp; sExtension
    End If
    vPath(UBound(vPath())) = join(vName, &quot;.&quot;)
    fileName = join(vPath, &quot;/&quot;)
End Function


Sub Batch(sDocName as String)
    Dim sURL as String
    Dim oDoc as Object
    sURL = ConvertToURL(sDocName)
    oDoc = StarDesktop.LoadComponentFromURL(sURL, &quot;_blank&quot;, 0, Array())
    exportToFile(fileName(sDocName, &quot;sh&quot;), oDoc)
    oDoc.close(true)
End Sub


Sub Main
    Dim sDocName, sFileName as String
    Dim oDialog as Object
    DialogLibraries.LoadLibrary(&quot;DocScript&quot;)
    sDocName = convertFromURL(ThisComponent.URL)
    if len(sDocName) &gt; 0 then
        sFileName = fileName(sDocName, &quot;sh&quot;)
    end if
    oDialog = createUnoDialog(DialogLibraries.DocScript.FileOpen)
    oDialog.getControl(&quot;FileName&quot;).text = sFileName
    If oDialog.execute() = 1 Then
        exportToFile(oDialog.getControl(&quot;FileName&quot;).text, ThisComponent)
    End If
End Sub

</script:module>