#include "hbmxml.ch" 
 #include "ics.ch" 
  
 #command ?C <message> => QOutClr( <message>, .T. ) 
 #command ?! <message> => QOutClr( <message>, .F. ) 
  
 #define DIR_UTILS ( hb_DirBase() + "utils" ) 
  
 REQUEST HB_CODEPAGE_UTF8 
  
 MEMVAR mxml_error 
 MEMVAR mxml_error_msg 
  
 INIT PROCEDURE _OnInit() 
  
    PUBLIC mxml_error 
    PUBLIC mxml_error_msg 
  
    FErase( hb_DirBase() + "_err.log" ) 
    FErase( hb_DirBase() + "_header.log" ) 
    FErase( hb_DirBase() + "_out.xml" ) 
  
    // Проверка доступности cURL 
    IF ! hb_FileExists( hb_DirSepAdd( DIR_UTILS ) + "curl.exe" ) 
       ?! "#white+#Can't find #red+#curl.exe" 
  
       ErrorLevel( 2 ) 
       __Quit() 
    ENDIF 
  
    M->mxml_error := .F. 
    M->mxml_error_msg := "" 
  
    mxmlSetErrorCallback( @cb_error() ) 
  
    RETURN 
  
 /* 
  */ 
 PROCEDURE cb_error( cErrorMsg ) 
  
    M->mxml_error_msg := cErrorMsg 
    M->mxml_error := .T. 
  
    RETURN 
  
 /* 
  */ 
 FUNCTION cb_type( xmlNode ) 
  
    LOCAL cType := mxmlElementGetAttr( xmlNode, "type" ) 
    LOCAL nResult 
  
    IF Empty( cType ) 
       cType := mxmlGetElement( xmlNode ) 
    ENDIF 
  
    SWITCH Lower( cType ) 
    CASE "s:exception" 
    CASE "s:sabredav-version" 
       nResult := MXML_TEXT 
       EXIT 
    CASE "s:message" 
       nResult := MXML_OPAQUE 
       EXIT 
    OTHERWISE 
       nResult := MXML_IGNORE 
       EXIT 
    ENDSWITCH 
  
    RETURN nResult 
  
 /* 
  */ 
 STATIC FUNCTION sf_GetEvent( aSource ) 
  
    LOCAL nStart, nEnd, nLen, e1, e2 
  
    hb_default( @aSource, {} ) 
  
    IF ! Empty( aSource ) 
       nStart := nEnd := 0 
       FOR EACH e1 IN aSource 
          IF e1[ ICS_PARAM ] = "BEGIN" 
             FOR EACH e2 IN e1[ ICS_VALS ] 
                IF hb_LeftEq( e2, "VEVENT" ) 
                   nStart := e1:__enumIndex() 
                   EXIT 
                ENDIF 
             NEXT 
          ELSEIF e1[ ICS_PARAM ] = "END" 
             FOR EACH e2 IN e1[ ICS_VALS ] 
                IF hb_LeftEq( e2, "VEVENT" ) 
                   nEnd := e1:__enumIndex() 
                   EXIT 
                ENDIF 
             NEXT 
          ENDIF 
          IF nEnd > 0 
             EXIT 
          ENDIF 
       NEXT 
  
       IF nStart != 0 .AND. nStart < nEnd 
          nLen := nEnd - nStart + 1 
          RETURN ACopy( aSource, Array( nLen ), nStart, nLen ) 
       ENDIF 
    ENDIF 
  
    RETURN {} 
  
 /* 
  */ 
 STATIC FUNCTION sf_GetEventUID( aSource ) 
  
    LOCAL nPos 
  
    hb_default( @aSource, {} ) 
    IF ! Empty( aSource ) 
       nPos := AScan( aSource, {| e | e[ ICS_PARAM ] = "UID" } ) 
       IF nPos > 0 
          RETURN aSource[ nPos ][ ICS_VALS ][ ICS_PARAM ] 
       ENDIF 
    ENDIF 
  
    RETURN "" 
  
 /* 
  */ 
 STATIC FUNCTION sf_GetError( cArg, cException, cMessage ) 
  
    LOCAL xmlTree, xmlNode, xmlSubNode 
  
    // Check arguments... 
    IF ! HB_ISSTRING( cArg ) .OR. Empty( cArg ) 
       RETURN .F. 
    ENDIF 
  
    xmlTree := iif( hb_LeftEq( cArg, "<" ), ; 
       mxmlLoadString( NIL, cArg, @cb_type() ), mxmlLoadFile( NIL, cArg, @cb_type() ) ) 
  
    IF M->mxml_error .OR. Empty( xmlTree ) 
       RETURN .F. 
    ENDIF 
  
    xmlNode := mxmlFindElement( xmlTree, xmlTree, "d:error",,, MXML_DESCEND ) 
    IF Empty( xmlNode ) 
       mxmlDelete( xmlTree ) 
       RETURN .F. 
    ENDIF 
  
    xmlSubNode := mxmlGetFirstChild( xmlNode ) 
    DO WHILE ! Empty( xmlSubNode ) 
       IF mxmlGetType( xmlSubNode ) == MXML_ELEMENT 
          IF mxmlGetElement( xmlSubNode ) == "s:exception" 
             cException := mxmlGetText( xmlSubNode ) 
          ELSEIF mxmlGetElement( xmlSubNode ) == "s:message" 
             cMessage := mxmlGetOpaque( xmlSubNode ) 
          ENDIF 
       ENDIF 
       xmlSubNode := mxmlGetNextSibling( xmlSubNode ) 
    ENDDO 
  
    mxmlDelete( xmlTree ) 
  
    RETURN .T. 
  
 /* 
  */ 
 STATIC FUNCTION sf_GetHTTPStatusCode( cFile, cCode, cDesc ) 
  
    LOCAL cStr := hb_MemoRead( cFile ) 
    LOCAL aStr := hb_ATokens( cStr, hb_eol() ) 
    LOCAL nAt  := hb_RAScan( aStr, {| s | hb_LeftEq( s, 'HTTP' ) } ) 
  
    IF nAt > 0 
       cStr  := aStr[ nAt ] 
       cCode := hb_tokenGet( cStr, 2, ' ' ) 
       aStr  := hb_ATokens( cStr, cCode ) 
       cDesc := LTrim( aStr[ 2 ] ) 
  
       RETURN .T. 
    ENDIF 
  
    RETURN .F. 
  
 /* 
  */ 
 STATIC PROCEDURE Usage() 
  
    OutStd( "Syntax: fput <file>"  + hb_eol() + hb_eol() ) 
  
    RETURN 
  
 /* 
  */ 
 PROCEDURE Main( cFile ) 
  
    LOCAL cStr 
    LOCAL aEvent, w := 0, cUid 
    LOCAL cOpt 
    LOCAL cCmdLn := '%1$s\curl.exe -u "%2$s:%3$s" %4$s -T "%5$s" -X %6$s %7$s%8$s%9$s' 
    LOCAL cUser := "b329767865754" 
    LOCAL cPwd  := "xk567vjh0t" 
    LOCAL cCalDav := "https://dav.fruux.com/" 
    LOCAL cHRef  := "calendars/a3298166498/ae6b576a-981f-4697-8c00-ac043a96d075/" 
    LOCAL cStdOut, cStdErr 
    LOCAL cException := "", cMessage := "", cCode := "", cDescription := "" 
  
    IF Empty( cFile ) 
       Usage() 
  
       ErrorLevel( 0 ) 
       __Quit() 
    ENDIF 
  
 // Read iCalendar file 
    cStr := hb_MemoRead( cFile ) 
  
 // Get VEVENT 
    aEvent := sf_GetEvent( IcsToArray2( cStr, @w ) ) 
    IF w # 0 
       ?C "Warning:#white+# Missing newline at end of input" 
    ENDIF 
  
 // Get VEVENT UID 
    cUid := sf_GetEventUID( aEvent ) 
    IF Empty( cUid ) 
       ?! "#white+#Do nothing for #red+#" + cFile 
  
       ErrorLevel( 3 ) 
       __Quit() 
    ENDIF 
 /* 
    PUT /calendars/johndoe/home/somerandomstring.ics HTTP/1.1 
    Content-Type: text/calendar; charset=utf-8 
  
    BEGIN:VCALENDAR 
    .... 
    END:VCALENDAR 
 */ 
    cOpt := '--insecure --no-progress-meter ' 
    cOpt += '--http1.1 ' 
    cOpt += '--header "Content-Type: text/calendar; charset=utf-8" ' 
    cOpt += '--dump-header _header.log ' 
    cStr := RTrim( cUid ) + '.ics' 
  
    cCmdLn := hb_StrFormat( cCmdLn, DIR_UTILS, cUser, cPwd, cOpt, cFile, "PUT", cCalDav, cHRef, cStr ) 
  
    hb_processRun( cCmdLn, , @cStdOut, @cStdErr ) 
  
    IF ! Empty( cStdErr ) 
       hb_MemoWrit( hb_DirBase() + "_err.log", cStdErr ) 
  
       ErrorLevel( 4 ) 
       __Quit() 
    ENDIF 
  
    IF ! Empty( cStdOut ) 
       hb_MemoWrit( hb_DirBase() + "_out.xml", cStdOut ) 
  
       IF sf_GetHTTPStatusCode( '_header.log', @cCode, @cDescription ) 
          ?C 'HTTP status code: #white+#' + cCode + '# (' + cDescription + ')' 
       ENDIF 
  
       IF sf_GetError( cStdOut, @cException, @cMessage ) 
          ?! "#red+#" + cException + hb_eol() 
          ?C "#white+#" + cMessage 
  
          ErrorLevel( 5 ) 
          __Quit() 
       ENDIF 
  
       IF M->mxml_error 
          ?! "#red+#An error occured while parsing an XML document." + hb_eol() 
          ?C "#white+#" + M->mxml_error_msg 
  
          ErrorLevel( 6 ) 
          __Quit() 
       ENDIF 
    ENDIF 
  
    OutStd( "Done" + hb_eol() ) 
  
    IF sf_GetHTTPStatusCode( '_header.log', @cCode, @cDescription ) 
       ?C 'HTTP status code: #white+#' + cCode + '# (' + cDescription + ')' 
    ENDIF 
  
    RETURN 
 

 
 # fput.hbp 
  
 -w3  
 #-es2 
 #-mt  
 -I../../include 
  
 -inc 
 -workdir=.hbmk 
 -ofput 
 -strip 
 -instpath=.\ 
  
 #Libs 
 -lhbmxml 
 -lmxml 
 -lics 
 -L../../lib 
 #Link with harbour-32-x64.dll 
 #-shared 
  
 fput.prg 
 colorize.prg