testautomation/global/tools/compressstatus.bas

   1 'encoding UTF-8  Do not remove or change this line!
   2 '**************************************************************************
   3 '* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
   4 '*
   5 '* Copyright 2008 by Sun Microsystems, Inc.
   6 '*
   7 '* OpenOffice.org - a multi-platform office productivity suite
   8 '*
   9 '* $RCSfile: compressstatus.bas,v $
  10 '*
  11 '* $Revision: 1.1 $
  12 '*
  13 '* last change: $Author: jsi $ $Date: 2008-06-13 10:27:06 $
  14 '*
  15 '* This file is part of OpenOffice.org.
  16 '*
  17 '* OpenOffice.org is free software: you can redistribute it and/or modify
  18 '* it under the terms of the GNU Lesser General Public License version 3
  19 '* only, as published by the Free Software Foundation.
  20 '*
  21 '* OpenOffice.org is distributed in the hope that it will be useful,
  22 '* but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 '* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 '* GNU Lesser General Public License version 3 for more details
  25 '* (a copy is included in the LICENSE file that accompanied this code).
  26 '*
  27 '* You should have received a copy of the GNU Lesser General Public License
  28 '* version 3 along with OpenOffice.org.  If not, see
  29 '* <http://www.openoffice.org/license.html>
  30 '* for a copy of the LGPLv3 License.
  31 '*
  32 '/************************************************************************
  33 '*
  34 '* owner : thorsten.bosbach@sun.com
  35 '*
  36 '* short description : Compress local written status files for submission
  37 '*
  38 '\***********************************************************************
  39
  40 sub main
  41         'just run, ...
  42         if (gMahler AND (gMahlerLocal<>"")) then
  43                 ' just a dummy call to get gDatabasePath set; DON'T call hStatusOut !!!
  44                 hStatusIn("writer", "compressstatus.bas")
  45                 call compressStatus
  46         else
  47                 warnLog "There is nothing to be done - exiting"
  48         endif
  49 end sub
  50
  51 '-------------------------------------------------------------------------
  52
  53 sub compressStatus
  54        dim sDestination as string
  55        dim sList(1000) as string
  56        dim i as integer
  57        dim iReturn as integer
  58        dim sJar as string
  59
  60        sDestination = convertPath(gDatabasePath+"database/" + "mahlerlocal/")
  61        ' create directory beside mahlerlocal
  62 '       sJar = convertPath(gDatabasePath+"database/" + convertDateToDatabase(now()))
  63        sJar = convertPath(gDatabasePath+"database/" + convertDateToDatabase(now()) + "-"+removeCharacter(convertTimeToDatabase(now()),asc(":")))
  64        mkdir sJar
  65        ' create jar file with same name as directory, beside mahlerlocal
  66        try
  67            iReturn = Shell("jar",0,"cMf " + sJar + ".jar" + " -C " + sDestination + " .",TRUE) ' wait until finished
  68            printlog "jar cMf " + sJar + ".jar" + " -C " + sDestination + " ."
  69        catch
  70            printlog "No program 'jar' available"
  71            try
  72                 iReturn = Shell("zip",0,"-Djr " + sJar + ".jar" + " " + sDestination,TRUE) ' wait until finished
  73                 printlog "zip -Djr " + sJar + ".jar" + " " + sDestination
  74            catch
  75                 printlog "No program 'zip' available"
  76                 iReturn = fZip(sDestination, sJar +".jar")
  77            endcatch
  78        endcatch
  79        if (iReturn <> 0) then
  80            printlog iReturn
  81        endif
  82        if (iReturn = 0) then
  83            printlog "Filename to submit:"
  84            printlog sJar + ".jar"
  85            ' copy files from mahlerlocal to backupdirectory with same name as jar file
  86            getFileList(sDestination, "*.*", sList())
  87            for i = 1 to listCount(sList())
  88                 try
  89                     filecopy(sList(i), sJar+gPathSigne)
  90                 catch
  91                     if (1=i) then warnlog "#ixxxxxx# destination file name needs to get named."
  92                     filecopy(sList(i), sJar+gPathSigne+DateiExtract(sList(i)))
  93                 endcatch
  94                 ' delete file in mahlerlocal
  95                 kill(sList(i))
  96                 if fileexists(sList(i)) then
  97                     warnlog "file couldn't get deleted! remove manually:"
  98                     printlog sList(i)
  99                 endif
 100            next i
 101        endif
 102 end sub
 103
 104 '-------------------------------------------------------------------------
 105
 106 function fZip(sDirectory as string, sZipFileName as string) as integer
 107 '/// Zips the files in the first level of a directory into a file
 108 '///+ The zip file hasn't to exists
 109 '///+ Input: absolut directory path to zip
 110 '///+ Absolut path and filename of zip file
 111         dim oUCB
 112         dim oUCB2
 113         dim oID
 114         dim oRootContent
 115         dim oInfo
 116         dim oNewStreamContent
 117         dim oFile
 118         dim oArg
 119     Dim aArgs(1)
 120     Dim oProps(0) as new com.sun.star.beans.PropertyValue
 121     Dim oCommand as new com.sun.star.ucb.Command
 122     dim lsFile(500) as string
 123     dim i as integer
 124     dim aArray
 125     dim sString
 126
 127     fZip = 1
 128     if fileExists(sZipFileName) then
 129         warnlog "Can't create zip file, because it already exists: '" + sZipFileName + "'"
 130         exit function
 131     endif
 132     if NOT fileExists(sDirectory) then
 133         warnlog "Directory to zip doesn't exist: '" + sDirectory + "'"
 134         exit function
 135     else
 136         aArgs(0) = "Local"
 137         aArgs(1) = "Office"
 138         oUCB = CreateUnoService( "com.sun.star.ucb.UniversalContentBroker" )
 139         oUCB.initialize( aArgs() )
 140         printlog "Zip file name: '" + convertToURL(sZipFileName) + "'"
 141         aArray = split(convertToURL(sZipFileName), "/")
 142         sString = join(aArray, "%2F")
 143         printlog "Zip file name: '" + sString + "'"
 144         oID = oUCB.createContentIdentifier( "vnd.sun.star.zip://" + sString )
 145         oRootContent = oUCB.queryContent( oID )
 146         oInfo = createUnoStruct( "com.sun.star.ucb.ContentInfo" )
 147         oInfo.Type = "application/vnd.sun.star.zip-stream"
 148         oInfo.Attributes = 0
 149
 150         ' get all files in a directory
 151         getFileNameListLocal (sDirectory+"/","*.txt",lsFile())
 152         printlog "Going to zip Directory: '" + sDirectory + "'"
 153         for i = 1 to listCount(lsFile())
 154             printlog "Going to add: " + i + ": '" + lsFile(i) + "'"
 155             oNewStreamContent = oRootContent.createNewContent( oInfo )
 156             oProps(0).Name = "Title"
 157             oProps(0).Handle = -1
 158             oProps(0).Value = lsFile(i) ' Filename of one content file in zip
 159             oCommand.Name = "setPropertyValues"
 160             oCommand.Handle   = -1
 161             oCommand.Argument = oProps()
 162             oNewStreamContent.execute( oCommand, 0, Null )
 163             oUcb2 = createUnoService("com.sun.star.ucb.SimpleFileAccess")
 164             oFile = oUcb2.OpenFileRead(ConvertToURL(sDirectory + "/" + lsFile(i)))
 165             oArg = createUnoStruct( "com.sun.star.ucb.InsertCommandArgument" )
 166             oArg.Data = oFile
 167             oArg.ReplaceExisting = false
 168             oCommand.Name = "insert"
 169             oCommand.Handle = -1
 170             oCommand.Argument = oArg
 171             oNewStreamContent.execute( oCommand, 0, Null )
 172         next i
 173
 174         REM commit that package file
 175         oCommand.Name = "flush"
 176         oCommand.Handle = -1
 177         oCommand.Argument = 0
 178
 179         oRootContent.execute( oCommand, 0, Null )
 180         fZip = 0
 181     endif
 182 end function
 183
 184 '-------------------------------------------------------------------------
 185
 186 sub LoadIncludeFiles
 187    use "global\system\includes\master.inc"
 188    use "global\system\includes\gvariabl.inc"
 189    gApplication = "WRITER"
 190    call GetUseFiles
 191 end sub
 192
 193 '-------------------------------------------------------------------------
 194