summaryrefslogtreecommitdiff
path: root/testautomation/global/tools/compressstatus.bas
blob: 679b322096b0286a9fed8aaf556630cf39a95dca (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
'encoding UTF-8  Do not remove or change this line!
'**************************************************************************
' DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
' 
' Copyright 2000, 2010 Oracle and/or its affiliates.
'
' OpenOffice.org - a multi-platform office productivity suite
'
' This file is part of OpenOffice.org.
'
' OpenOffice.org is free software: you can redistribute it and/or modify
' it under the terms of the GNU Lesser General Public License version 3
' only, as published by the Free Software Foundation.
'
' OpenOffice.org is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU Lesser General Public License version 3 for more details
' (a copy is included in the LICENSE file that accompanied this code).
'
' You should have received a copy of the GNU Lesser General Public License
' version 3 along with OpenOffice.org.  If not, see
' <http://www.openoffice.org/license.html>
' for a copy of the LGPLv3 License.
'
'/************************************************************************
'*
'* owner : thorsten.bosbach@oracle.com
'*
'* short description : Compress local written status files for submission
'*
'\***********************************************************************

sub main
	'just run, ...
	if (gMahler AND (gMahlerLocal<>"")) then
		' just a dummy call to get gDatabasePath set; DON'T call hStatusOut !!! 
		hStatusIn("writer", "compressstatus.bas")
		call compressStatus
	else
		warnLog "There is nothing to be done - exiting"
	endif
end sub

'-------------------------------------------------------------------------

sub compressStatus
       dim sDestination as string
       dim sList(1000) as string
       dim i as integer
       dim iReturn as integer
       dim sJar as string

       sDestination = convertPath(gDatabasePath+"database/" + "mahlerlocal/")
       ' create directory beside mahlerlocal
'       sJar = convertPath(gDatabasePath+"database/" + convertDateToDatabase(now()))
       sJar = convertPath(gDatabasePath+"database/" + convertDateToDatabase(now()) + "-"+removeCharacter(convertTimeToDatabase(now()),asc(":")))
       mkdir sJar
       ' create jar file with same name as directory, beside mahlerlocal
       try
           iReturn = Shell("jar",0,"cMf " + sJar + ".jar" + " -C " + sDestination + " .",TRUE) ' wait until finished
           printlog "jar cMf " + sJar + ".jar" + " -C " + sDestination + " ."
       catch
           printlog "No program 'jar' available"
           try
                iReturn = Shell("zip",0,"-Djr " + sJar + ".jar" + " " + sDestination,TRUE) ' wait until finished
                printlog "zip -Djr " + sJar + ".jar" + " " + sDestination
           catch
                printlog "No program 'zip' available"
                iReturn = fZip(sDestination, sJar +".jar")
           endcatch
       endcatch
       if (iReturn <> 0) then
           printlog iReturn
       endif
       if (iReturn = 0) then
           printlog "Filename to submit:"
           printlog sJar + ".jar"
           ' copy files from mahlerlocal to backupdirectory with same name as jar file
           getFileList(sDestination, "*.*", sList())
           for i = 1 to listCount(sList())
                try
                    filecopy(sList(i), sJar+gPathSigne)
                catch
                    if (1=i) then warnlog "#ixxxxxx# destination file name needs to get named."
                    filecopy(sList(i), sJar+gPathSigne+DateiExtract(sList(i)))
                endcatch
                ' delete file in mahlerlocal
                kill(sList(i))
                if fileexists(sList(i)) then
                    warnlog "file couldn't get deleted! remove manually:"
                    printlog sList(i)
                endif
           next i
       endif
end sub

'-------------------------------------------------------------------------

function fZip(sDirectory as string, sZipFileName as string) as integer
'/// Zips the files in the first level of a directory into a file
'///+ The zip file hasn't to exists
'///+ Input: absolut directory path to zip
'///+ Absolut path and filename of zip file
	dim oUCB
	dim oUCB2
	dim oID
	dim oRootContent
	dim oInfo
	dim oNewStreamContent
	dim oFile
	dim oArg
    Dim aArgs(1)
    Dim oProps(0) as new com.sun.star.beans.PropertyValue
    Dim oCommand as new com.sun.star.ucb.Command
    dim lsFile(500) as string
    dim i as integer
    dim aArray
    dim sString
	
    fZip = 1
    if fileExists(sZipFileName) then
        warnlog "Can't create zip file, because it already exists: '" + sZipFileName + "'"
        exit function
    endif
    if NOT fileExists(sDirectory) then
        warnlog "Directory to zip doesn't exist: '" + sDirectory + "'"
        exit function
    else
        aArgs(0) = "Local"
        aArgs(1) = "Office"
        oUCB = CreateUnoService( "com.sun.star.ucb.UniversalContentBroker" )
        oUCB.initialize( aArgs() )
        printlog "Zip file name: '" + convertToURL(sZipFileName) + "'"
        aArray = split(convertToURL(sZipFileName), "/")
        sString = join(aArray, "%2F")
        printlog "Zip file name: '" + sString + "'"
        oID = oUCB.createContentIdentifier( "vnd.sun.star.zip://" + sString )
        oRootContent = oUCB.queryContent( oID )
        oInfo = createUnoStruct( "com.sun.star.ucb.ContentInfo" )
        oInfo.Type = "application/vnd.sun.star.zip-stream"
        oInfo.Attributes = 0
        
        ' get all files in a directory
        getFileNameList (sDirectory+"/","*.txt",lsFile())
        printlog "Going to zip Directory: '" + sDirectory + "'"
        for i = 1 to listCount(lsFile())
            printlog "Going to add: " + i + ": '" + lsFile(i) + "'"
            oNewStreamContent = oRootContent.createNewContent( oInfo )
            oProps(0).Name = "Title"
            oProps(0).Handle = -1
            oProps(0).Value = lsFile(i) ' Filename of one content file in zip
            oCommand.Name = "setPropertyValues"
            oCommand.Handle   = -1
            oCommand.Argument = oProps()
            oNewStreamContent.execute( oCommand, 0, Null )
            oUcb2 = createUnoService("com.sun.star.ucb.SimpleFileAccess")   
            oFile = oUcb2.OpenFileRead(ConvertToURL(sDirectory + "/" + lsFile(i)))
            oArg = createUnoStruct( "com.sun.star.ucb.InsertCommandArgument" )
            oArg.Data = oFile
            oArg.ReplaceExisting = false
            oCommand.Name = "insert"
            oCommand.Handle = -1
            oCommand.Argument = oArg
            oNewStreamContent.execute( oCommand, 0, Null )
        next i
    
        REM commit that package file
        oCommand.Name = "flush"
        oCommand.Handle = -1
        oCommand.Argument = 0
        
        oRootContent.execute( oCommand, 0, Null )
        fZip = 0
    endif
end function

'-------------------------------------------------------------------------

sub LoadIncludeFiles
   use "global\system\includes\master.inc"
   use "global\system\includes\gvariabl.inc"
   gApplication = "WRITER"
   call GetUseFiles
end sub

'-------------------------------------------------------------------------