download.R

library(utils)

b3_download_handler <- function(obj, data_ref, dest_dir) {
  function () {
    mapply(function(url_fname, fname) {
      b3_file_downloader(url_fname, fname, dest_dir, data_ref)
    }, obj$url_file, obj$filename)
  }
}

b3_file_downloader <- function(url_fname, fname, dest_dir, ref_date) {
  data <- as.Date(ref_date)
  if (fname == "DO") { # arquivo DO é gerado como d+1 para d0
    data <- data + days(1)
    data <- adjust.next(data)
    if (substr(as.character(data), 6, nchar(as.character(data))) %in% c("01-25", "07-09", "11-20")) { # ajustar feriados municipais
      data <- data + days(1)
      data <- adjust.next(data)
    }
  }
  data <- format(x=data, format="%y%m%d")
  url <- 'http://www.bmfbovespa.com.br/pesquisapregao/download?filelist='
  url <- paste(url, url_fname, data, '.ex_', sep="")
  dest_file <- paste(dest_dir, '/', fname, '.zip', sep="")
  final_file <- paste(dest_dir, '/', fname, sep="")
  download.file(url, dest_file, "auto", mode="wb")
  if(file.exists(dest_file)) {
    sec_zip <- unzip(zipfile=dest_file, exdir=dest_dir)
    txt_files <- unzip(zipfile=sec_zip, exdir=dest_dir)
    file.remove(dest_file)
    file.remove(sec_zip)
    file.copy(txt_files[length(txt_files)], final_file)
    file.remove(txt_files)
    final_file
  } else {
    logging_error(paste("Erro no download do arquivo ", obj$filename))
    return(NULL)
  }
}

b3_stock_opts_insert_handler <- function(con, obj, data_ref, dest_dir) {
  function() {
    fname <- paste(dest_dir, "/", obj$filename, sep="")
    if (file.exists(fname)) {
      contents <- read.csv(fname, header=FALSE, sep=";", skip=1, stringsAsFactors = FALSE)
      names(contents) <- c('cod_opcao', 'tipo_opc', 'tipo_instr', 'data_vcto',
                           'strike', 'preco_ref', 'vol')

      contents$data_vcto <- as.Date(as.character(contents$data_vcto), format='%Y%m%d')
      contents$tipo_opc <- ifelse(contents$tipo_opc == "C", "call", "put")
      contents$tipo_instr <- ifelse(contents$tipo_instr == "A", "american", "european")

      lista_opcoes <- dbGetQuery(con, "SELECT id_opcao, cod_opcao, data_vcto, tipo_opc, tipo_instr from opcoes_cad")

      contents <- merge(contents, lista_opcoes)

      orig_query <- paste0("INSERT INTO bdin_opcoes_hist (id_opcao, data_ref, strike, preco_ref, vol)",
                           " VALUES ({id_opcao}, '{data_ref}', {strike}, {pref}, {vol})",
                           " ON DUPLICATE KEY UPDATE preco_ref = {pref}, vol = {vol};")
      dbBegin(con)
      ins <- lapply(1:nrow(contents), function(rw) {
        entry <- contents[rw, ]
        pref <- entry$preco_ref
        vol <- entry$vol
        strike <- entry$strike
        id_opcao <- entry$id_opcao
        qry <- glue(orig_query)
        dbSendQuery(con, qry)
      })
      dbCommit(con)

    } else {
      logging_error("Arquivo PE (prêmio de opções de ações) não encontrado")
      return(NULL)
    }
  }
}

b3_opts_insert_handler <- function(con, obj, data_ref, dest_dir) {
  function() {

    fname <- paste(dest_dir, "/", obj$filename[1], sep="")
    if (file.exists(fname)) {
      fields_DO <- c(data_ref = 8, cod_merc = 3, tip_merc = 1,
                     serie = 4, vencimento = 8, cod_gts = 20,
                     tip_opc = 1, modelo_opc = 1, ajuste = 1,
                     cod_moeda = 2, strike = 15, vol = 19,
                     delta_sign = 1, delta = 19)
      names_DO <- c('data_ref', 'cod_merc', 'tip_merc', 'serie', 'vencimento',
                    'cod_gts', 'tip_opc', 'modelo_opc', 'ajuste', 'cod_moeda', 'strike',
                    'vol', 'delta_sign', 'delta')

      decimais_vol <- 7
      decimais_strike <- 3
      decimais_delta <- 7
      contents_do <- read.fwf(fname, fields_DO)
      names(contents_do) <- names_DO
      contents_do$vol <- as.numeric(contents_do$vol)
      contents_do$strike <- as.numeric(contents_do$strike)
      contents_do$delta <- as.numeric(contents_do$delta)
      contents_do <- contents_do[!is.na(contents_do$vol), ]
      contents_do <- contents_do[!is.na(contents_do$strike), ]
      contents_do <- contents_do[!is.na(contents_do$delta), ]
      contents_do$vol <- contents_do$vol/(10^decimais_vol)
      contents_do$strike <- contents_do$strike/(10^decimais_strike)
      contents_do$delta <- (contents_do$delta/(10^decimais_delta))*ifelse(contents_do$delta_sign == "+", 1, -1)
      contents_do$data_ref <- rep(as.character(data_ref), nrow(contents_do))
      contents_do$vencimento <- as.Date(as.character(contents_do$vencimento), format='%Y%m%d')
      contents_do$cod_gts <- trimws(contents_do$cod_gts)
      contents_do <- subset(contents_do, select=-c(delta_sign, ajuste, cod_moeda))
    } else {
      logging_error("Arquivo DO (delta de opções) não encontrado")
      return(NULL)
    }

    fname <- paste(dest_dir, "/", obj$filename[2], sep="")
    if (file.exists(fname)) {

      fields_RE <- c(id_trans = 6, compl_trans = 3, tipo_reg = 2, data_ref = 8,
                     cod_merc = 3, tip_merc = 1, serie = 4, tip_opc = 1,
                     modelo_opc = 1, vencimento = 8, strike = 15, preco_ref = 15,
                     n_dec = 1)

      names_RE <- c('id_trans', 'compl_trans', 'tipo_reg', 'data_ref', 'cod_merc',
                    'tip_merc', 'serie', 'tip_opc', 'modelo_opc', 'vencimento',
                    'strike', 'preco_ref', 'n_dec')

      contents_re <- read.fwf(fname, fields_RE)
      names(contents_re) <- names_RE
      contents_re <- contents_re[!is.na(contents_re$preco_ref), ]
      contents_re <- contents_re[!is.na(contents_re$strike), ]
      contents_re$preco_ref <- as.numeric(contents_re$preco_ref)
      contents_re$strike <- as.numeric(contents_re$strike)
      contents_re$preco_ref <- contents_re$preco_ref/(10^contents_re$n_dec)
      contents_re$strike <- contents_re$strike/(10^contents_re$n_dec)
      contents_re$data_ref <- as.Date(as.character(contents_re$data_ref), format='%Y%m%d')
      contents_re$vencimento <- as.Date(as.character(contents_re$vencimento), format='%Y%m%d')

      contents_re <- subset(contents_re, select=-c(id_trans, compl_trans, tipo_reg, n_dec))

    } else {
      logging_error("Arquivo RE (prêmio de opções) não encontrado")
      return(NULL)
    }

    contents <- merge(contents_re, contents_do)
    contents <- subset(contents, select=c(cod_gts, preco_ref, vol, delta))

    lista_opcoes <- dbGetQuery(con, "SELECT id_contr, cod_gts FROM contr_cad;")

    contents <- merge(contents, lista_opcoes)

    orig_query <- paste0("INSERT INTO futuros_opc_hist (id_contr, data_ref, preco_ref, vol, delta)",
                         " VALUES ({id_contr}, '{data_ref}', {pref}, {vol}, {delta})",
                         " ON DUPLICATE KEY UPDATE preco_ref = {pref}, vol = {vol}, delta = {delta};")

    dbBegin(con)
    ins <- lapply(1:nrow(contents), function(rw) {
      entry <- contents[rw, ]
      pref <- entry$preco_ref
      vol <- entry$vol
      delta <- entry$delta
      id_contr <- entry$id_contr
      qry <- glue(orig_query)
      dbSendQuery(con, qry)
    })
    dbCommit(con)

  }
}