Дублирование Документов

28.02.2013
7
0
#1
Доброе время суток! Уже каждый год мы производим архивацию баз данных. Вроде все ничего, только в архивной базе просто огромное количество дубликатов документов. Их приходиться вручную просматривать и соответственно удалять (к примеру 80 тыс. документов, после архивации в архивной базе становиться 160 тыс. а то и больше документов... и таких баз не один десяток... за голову беремся и бьемся об клаву... очень много времени уходит на налаживание данных баз).

Получилось выяснить что дубликаты от других документов отличаются полем $Revisions (этого поля у дубликатов нет). Но этого мало что бы находить дубликаты (так же как и конфликтные документы($Conflict)). Может есть еще какие нибудь способы решения этой проблемы?

Прошу помочь! ;)
 

ToxaRat

Чёрный маг
Lotus team
06.11.2007
3 233
18
#3
думаю что в архиве тоже работает агент, который и лепит конфликты
 
28.02.2013
7
0
#4
Архивация... тупо документы переходят из одной базы в другую (архивную)... а из старой базы удаляются...
 

Kizarek86

Lotus team
20.07.2007
864
4
#7
Ну тогда ждем отчета как выполняется архивация) самописный скрипт?
 

savl

Lotus team
28.10.2011
2 136
105
#8
Almanah
Копирование через CopyToDatabase?
Проверки на наличие такого документа в архиве полагаю нет.
Документы точно удаляются сразу после переноса?
Агентов в архивной системе нет, которые доступ меняют или что-то еще?
 
28.02.2013
7
0
#9
Вот код...


Sub Initialize
Dim doc, Profile As NotesDocument
Dim db, dbArc As NotesDatabase
Dim session As New NotesSession
Set db = session.CurrentDatabase
Set Profile = db.GetProfileDocument("DatabaseProfile")
Set dbArc = New NotesDatabase("emperor/KRD", Profile.ArchiveDB(0))
Dim RemoveAfterArchiving, answer As Integer
Dim dcChild As NotesDocumentCollection
Dim docChild As NotesDocument

Dim cntDel, cntDelOK, cntArc As Integer
Dim j, k As Integer
cntDel = 0
cntDelOK = 0

If db.CurrentAccessLevel <> 6 Then
Msgbox "Access denied", 0, ca
Exit Sub
End If
'//
'// Запрос на удаление документов
'//
If Messagebox("Delete documents after archiving?", MB_YESNO) = 6 Then
RemoveAfterArchiving = 1
Else
RemoveAfterArchiving = 0
End If

'//
'// Архивирование документов
'//
Set dc = db.UnprocessedDocuments
Set doc = dc.GetFirstDocument
i = 0
cntArc = 0
While Not(doc Is Nothing)
i = i + 1
cntArc = cntArc + 1
doc.CopyToDatabase(dbArc)
If i Mod 100 = 0 Then
Print "Archiving : " & Format(i / dc.Count * 100, "Standard") & "%"
End If
Set doc = dc.GetNextDocument(doc)
Wend
Print "Archiving : 100%"

On Error Goto err_label

' Удаление документов
i = 0
If RemoveAfterArchiving = 1 Then
'Set doc = dc.GetFirstDocument
'While Not(doc Is Nothing)
For k = 1 To dc.Count
i = i + 1
Set doc = dc.GetNthDocument(k)
If (Not doc Is Nothing) And (Not doc.IsDeleted) Then
' Если главный документ
If Not doc.IsResponse Then
' Получаем список всех подчиненных документов
Set dcChild = doc.Responses

' По очереди удаляем подчиненные документы
For j = 1 To dcChild.Count
cntDel = cntDel + 1
Set docChild = dcChild.GetNthDocument(j)
'Print "For delete: " & docChild.UniversalID & " Form=" & docChild.Form(0)
If docChild.Remove(True) Then
cntDelOK = cntDelOK + 1
End If
Next


cntDel = cntDel + 1
If doc.Remove(True) Then
cntDelOK = cntDelOK + 1
End If
End If

End If

If i Mod 100 = 0 Then
Print "Deleting : " & Format(i / dc.Count * 100, "Standard") & "%"
End If

Next
End If
Print "Deleting : 100%"

Goto exit_label

err_label:
Dim x As Integer
x% = Erl()
Print "Error at line: " & x%

If (Not doc Is Nothing) And (Not doc.IsDeleted) Then
Print doc.UniversalID & "; InNum=" & doc.InNum(0)
End If
If (Not docChild Is Nothing) And (Not docChild.IsDeleted) Then
Print docChild.UniversalID & "; InNum=" & docChild.InNum(0)
End If

exit_label:
Print "Arc: " & cntArc & "; Del: " & cntDel & "; DelOK: " & cntDelOK

End Sub
 

savl

Lotus team
28.10.2011
2 136
105
#10
1. Подчиненные документы не переносятся в архив.
2. Если ошибка будет на этапе архивирования, то об этом не узнать.
3. Работает до первой ошибки в процессе удаления.
4. Если ошибка была на этапе удаления дочерних документов, то родительский не удалится. (Дубликаты могут быть отсюда)

Агент я так понимаю запускается вручную, значит его могут нажать сразу несколько человек.
 

hosm

* so what *
18.05.2009
2 442
6
#11
к вышесказанному добавлю:
1) И еще такой вариант, что ответили нет - ничего не удалится тогда, но скопируется:
If Messagebox("Delete documents after archiving?", MB_YESNO) = 6 Then
RemoveAfterArchiving = 1
Else
RemoveAfterArchiving = 0
End If
2) не используйте подобное: If (Not doc Is Nothing) And (Not doc.IsDeleted) Then , не умеет лотусскрипт "lazy And"! (пока, по крайней мере), надо делать вложенные if. Подобный код запросто может привести к ошибке.
3) избегайте GetNthDocument, очень неэффективно.
4) подумать и переписать всё
 
28.02.2013
7
0
#12
1. По поводу выполнения данной операции несколькими людьми не проверялось. Т.к. у нас в этом плане все организовано... Один человек занимается одной базой, другой - другой базой...

2. Переписать попробуем... Вот только хочется узнать: есть ли какой нибудь код, проверяющий наличие дубликатов?
 

savl

Lotus team
28.10.2011
2 136
105
#13
Almanah
Кода нет, но есть пара способов:
1. Сделать представление (ByUNID), ключ поиска поле UNID, в нем UniversalID оригинального документ, поле CWC
Данное поле после архивации не менять, искать по нему до переноса. Если нашли документ по такому ключу, то что-то делать (либо все Items копировать, либо не копировать совсем)
2. Метить оригинальные документы флагом (IsArchive), если не удалялись. И потом просто их не переносить, если флаг стоит.
3. Оба способа вместе (сам так делаю)
 

savl

Lotus team
28.10.2011
2 136
105
#14
Что тут думать, сиди да пиши ;)
Не проверял, так что не запускайте сразу на рабочих.
Код:
Sub Initialize

On Error GoTo err_label_archive
Dim session As New NotesSession

Dim Profile As NotesDocument 
Dim db As NotesDatabase 
Dim dbArc As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Dim nxtdoc As NotesDocument
Dim dcChild As NotesDocumentCollection
Dim docChild As NotesDocument
Dim nxtdocChild As NotesDocument

Dim RemoveAfterArchiving As integer 
Dim answer As Integer
Dim cntDel As long 
Dim cntDelOK As long 
Dim cntArc As Integer
Dim i As Long
Dim errStr As String

Set db = session.CurrentDatabase
Set Profile = db.GetProfileDocument("DatabaseProfile")
Set dbArc = New NotesDatabase("emperor/KRD", Profile.ArchiveDB(0))

If dbArc Is Nothing Then
Print " Не найдена база данных " & Profile.ArchiveDB(0) 
Exit sub
End If

If Not dbArc.isopen() Then
Print " Не доступна база данных " & Profile.ArchiveDB(0) 
Exit Sub
End If

cntDel = 0
cntDelOK = 0
cntArc = 0

If db.CurrentAccessLevel <> 6 Then
MsgBox "Access denied", 0, ca
Exit Sub
End If

'//
'// Запрос на удаление документов
'//
RemoveAfterArchiving = 0
If MessageBox("Delete documents after archiving?", MB_YESNO) = 6 Then	RemoveAfterArchiving = 1

'//
'// Архивирование документов
'//
Set dc = db.UnprocessedDocuments
Set doc = dc.GetFirstDocument
i = 0
While Not(doc Is Nothing)
If Not doc.hasitem("Archived") then
Call doc.CopyToDatabase(dbArc)
Call doc.replaceitemvaue("Archived", "1")
Call doc.save(True,doc.Isresponse)
If i Mod 100 = 0 Then
Print "Archiving : " & Format(i / dc.Count * 100, "Standard") & "%"
End If
i = i + 1
cntArc = cntArc + 1
End if
Set doc = dc.GetNextDocument(doc)
Wend
Print "Archiving : 100%"

On Error GoTo err_label_delete
' Удаление документов
i = 0
cntDelOK = 0
cntDel = 0
If RemoveAfterArchiving = 1 Then
Set doc = dc.GetFirstDocument
While Not(doc Is Nothing)

Set nxtdoc = dc.Getnextdocument(doc)

' Если главный документ
If Not doc.IsResponse Then
' Получаем список всех подчиненных документов
Set dcChild = doc.Responses
If Not dcChild.Count < 1 Then
Set docChild = dcChild.Getfirstdocument()
While Not docChild Is nothing
Set nxtdocChild = dcChild.Getnextdocument(docChild)
' По очереди удаляем подчиненные документы 
Call docChild.Remove(true)
cntDelOK = cntDelOK + 1
i = i + 1
nxtChild:
Set docChild = nxtdocChild
Wend
End if 
End if	

Call doc.Remove(True)
cntDel = cntDel + 1
i=i+1
If i Mod 100 = 0 Then Print "Deleting : " & Format(i / dc.Count * 100, "Standard") & "%"
nxtMainDoc:
Set doc = nxtdoc
wend
End If

Print "Deleting : 100%"

GoTo exit_label

err_label_archive:
errStr = "Error at line: " & Erl & " Error: " & Error$
if Not doc Is nothing Then errStr = errStr & doc.UniversalID & "; InNum=" & doc.InNum(0)
Print errStr 
Resume exit_label

err_label_delete:
errStr = "Error at line: " & Erl & " Error: " & Error$
If Not docChild Is Nothing Then errStr = errStr & doc.UniversalID & "; InNum=" & doc.InNum(0) & "; "
If Not doc Is Nothing Then errStr = errStr & doc.UniversalID & "; InNum=" & doc.InNum(0)
Print errStr 
If Not nxtdocChild Is Nothing Then Resume nxtChild ' продолжаем удалять дочерние
If Not nxtdoc Is Nothing Then Resume nxtMainDoc ' продолжаем удалять основные
Resume exit_label

exit_label:
Print "Arciving: " & cntArc & "; DelMainDoc: " & cntDel & "; DelRespDoc: " & cntDelOK

End Sub
 

hosm

* so what *
18.05.2009
2 442
6
#15
>Вот только хочется узнать: есть ли какой нибудь код, проверяющий наличие дубликатов?
Вариант, как продумать архивирование в дальнейшем, написал savl выше.
Возможен вариант, как справится с тем, "что сейчас есть":
А вы можете однозначно идентифицировать на данный момент ваши документы по какому-либо ключу?
(UniversalId документа тут не катит, он обычно меняется при копировании в другую БД. Если в каком-то поле уже сохранен UniversalId исходного документа (до архивации) и оно не пересчитывается в архиве, то используйте его).
Если уникальный ключ есть, то при архивации проверяете совпадение ключевых полей (например, поиском документа в архивной БД в некотором представлении). Это может быть также какой-нибудь уникальный ключевой признак именно ваших данных - например, табельный номер сотрудника, налоговый код, регистрационный номер документа (если он уникален)...
Если уникальных ключей нет, можно использовать какое-то неуникальное поле в документе, например, хранящее точную дату-время создания (или другого действия над документами), если оно может помочь сделать проверку уникальности - отобрать небольшое кол-во "потенциальных дубликатов", которые можно потом как-то пометить (варианты: положить в папку, добавить какое-то поле, отобрать в представление) и дальше сравнить по полям, чтобы уточнить, дубликат это или нет.