├── .gitignore ├── LICENSE ├── README.md ├── Ugar.dpk ├── Ugar.dproj ├── Ugar.res ├── boss-lock.json ├── boss.json ├── docker-compose.yaml └── src ├── Ugar.pas ├── ugar.connection.Imp.pas ├── ugar.db.Mongo.pas ├── ugar.db.mongo.Enum.pas ├── ugar.db.mongo.Func.pas ├── ugar.db.mongo.Imp.pas ├── ugar.db.mongo.Protocol.pas ├── ugar.db.mongo.Query.pas ├── ugar.db.mongo.internals.pas └── ugar.db.mongo.protocol.Types.pas /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | # Created by https://www.gitignore.io/api/delphi 3 | # Edit at https://www.gitignore.io/?templates=delphi 4 | 5 | ### Delphi ### 6 | # Uncomment these types if you want even more clean repository. But be careful. 7 | # It can make harm to an existing project source. Read explanations below. 8 | # 9 | # Resource files are binaries containing manifest, project icon and version info. 10 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 11 | #*.res 12 | # 13 | # Type library file (binary). In old Delphi versions it should be stored. 14 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 15 | #*.tlb 16 | # 17 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 18 | # Uncomment this if you are not using diagrams or use newer Delphi version. 19 | #*.ddp 20 | # 21 | # Visual LiveBindings file. Added in Delphi XE2. 22 | # Uncomment this if you are not using LiveBindings Designer. 23 | #*.vlb 24 | # 25 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 26 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 27 | #*.deployproj 28 | # 29 | # C++ object files produced when C/C++ Output file generation is configured. 30 | # Uncomment this if you are not using external objects (zlib library for example). 31 | #*.obj 32 | # 33 | 34 | # Delphi compiler-generated binaries (safe to delete) 35 | *.exe 36 | *.dll 37 | *.bpl 38 | *.bpi 39 | *.dcp 40 | *.so 41 | *.apk 42 | *.drc 43 | *.map 44 | *.dres 45 | *.rsm 46 | *.tds 47 | *.dcu 48 | *.lib 49 | *.a 50 | *.o 51 | *.ocx 52 | 53 | # Delphi autogenerated files (duplicated info) 54 | *.cfg 55 | *.hpp 56 | *Resource.rc 57 | 58 | # Delphi local files (user-specific info) 59 | *.local 60 | *.identcache 61 | *.projdata 62 | *.tvsconfig 63 | *.dsk 64 | 65 | # Delphi history and backups 66 | __history/ 67 | __recovery/ 68 | *.~* 69 | 70 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 71 | *.stat 72 | 73 | # Boss dependency manager vendor folder https://github.com/HashLoad/boss 74 | modules/ 75 | 76 | # End of https://www.gitignore.io/api/delphi -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2018 Rodrigo Bernardi 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Ugar 2 | Mongodb delphi connector 3 | -------------------------------------------------------------------------------- /Ugar.dpk: -------------------------------------------------------------------------------- 1 | package Ugar; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS OFF} 17 | {$RANGECHECKS OFF} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$RUNONLY} 29 | {$IMPLICITBUILD ON} 30 | 31 | requires 32 | rtl; 33 | 34 | contains 35 | Ugar in 'src\Ugar.pas', 36 | ugar.db.mongo.Protocol in 'src\ugar.db.mongo.Protocol.pas', 37 | ugar.connection.Imp in 'src\ugar.connection.Imp.pas', 38 | ugar.db.Mongo in 'src\ugar.db.Mongo.pas', 39 | ugar.db.mongo.Imp in 'src\ugar.db.mongo.Imp.pas', 40 | ugar.db.mongo.Enum in 'src\ugar.db.mongo.Enum.pas', 41 | ugar.db.mongo.Func in 'src\ugar.db.mongo.Func.pas', 42 | ugar.db.mongo.internals in 'src\ugar.db.mongo.internals.pas', 43 | ugar.db.mongo.Query in 'src\ugar.db.mongo.Query.pas', 44 | ugar.db.mongo.protocol.Types in 'src\ugar.db.mongo.protocol.Types.pas'; 45 | 46 | end. 47 | -------------------------------------------------------------------------------- /Ugar.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {32B6930D-95E9-4A01-80C9-0E9F138965C0} 4 | Ugar.dpk 5 | 18.8 6 | VCL 7 | True 8 | Debug 9 | Win32 10 | 1 11 | Package 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Base 34 | true 35 | 36 | 37 | true 38 | Cfg_1 39 | true 40 | true 41 | 42 | 43 | true 44 | Base 45 | true 46 | 47 | 48 | .\$(Platform)\$(Config) 49 | .\$(Platform)\$(Config) 50 | false 51 | false 52 | false 53 | false 54 | false 55 | true 56 | true 57 | System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) 58 | All 59 | Ugar 60 | true 61 | modules\TMongoWire\demo\example2;modules\TMongoWire;$(DCC_UnitSearchPath);$(DCC_UnitSearchPath);modules\GrijjyFoundation;modules\GrijjyFoundation\UnitTests\Tests;$(DCC_UnitSearchPath) 62 | 63 | 64 | None 65 | android-support-v4.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services-ads-7.0.0.dex.jar;google-play-services-analytics-7.0.0.dex.jar;google-play-services-base-7.0.0.dex.jar;google-play-services-gcm-7.0.0.dex.jar;google-play-services-identity-7.0.0.dex.jar;google-play-services-maps-7.0.0.dex.jar;google-play-services-panorama-7.0.0.dex.jar;google-play-services-plus-7.0.0.dex.jar;google-play-services-wallet-7.0.0.dex.jar 66 | 67 | 68 | package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= 69 | Debug 70 | true 71 | Base 72 | true 73 | None 74 | android-support-v4.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services-ads-7.0.0.dex.jar;google-play-services-analytics-7.0.0.dex.jar;google-play-services-base-7.0.0.dex.jar;google-play-services-gcm-7.0.0.dex.jar;google-play-services-identity-7.0.0.dex.jar;google-play-services-maps-7.0.0.dex.jar;google-play-services-panorama-7.0.0.dex.jar;google-play-services-plus-7.0.0.dex.jar;google-play-services-wallet-7.0.0.dex.jar 75 | 76 | 77 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 78 | Debug 79 | true 80 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 81 | 1033 82 | 83 | 84 | DEBUG;$(DCC_Define) 85 | true 86 | false 87 | true 88 | true 89 | true 90 | 91 | 92 | false 93 | true 94 | 1033 95 | 96 | 97 | false 98 | RELEASE;$(DCC_Define) 99 | 0 100 | 0 101 | 102 | 103 | 104 | MainSource 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | Cfg_2 119 | Base 120 | 121 | 122 | Base 123 | 124 | 125 | Cfg_1 126 | Base 127 | 128 | 129 | 130 | Delphi.Personality.12 131 | Package 132 | 133 | 134 | 135 | Ugar.dpk 136 | 137 | 138 | Microsoft Office 2000 Sample Automation Server Wrapper Components 139 | Microsoft Office XP Sample Automation Server Wrapper Components 140 | 141 | 142 | 143 | 144 | 145 | Ugar.bpl 146 | true 147 | 148 | 149 | 150 | 151 | true 152 | 153 | 154 | 155 | 156 | true 157 | 158 | 159 | 160 | 161 | true 162 | 163 | 164 | 165 | 166 | true 167 | 168 | 169 | 170 | 171 | true 172 | 173 | 174 | 175 | 176 | true 177 | 178 | 179 | 180 | 181 | bplUgar.so 182 | true 183 | 184 | 185 | 186 | 187 | 1 188 | 189 | 190 | 0 191 | 192 | 193 | 194 | 195 | classes 196 | 1 197 | 198 | 199 | classes 200 | 1 201 | 202 | 203 | 204 | 205 | res\xml 206 | 1 207 | 208 | 209 | res\xml 210 | 1 211 | 212 | 213 | 214 | 215 | library\lib\armeabi-v7a 216 | 1 217 | 218 | 219 | 220 | 221 | library\lib\armeabi 222 | 1 223 | 224 | 225 | library\lib\armeabi 226 | 1 227 | 228 | 229 | 230 | 231 | library\lib\armeabi-v7a 232 | 1 233 | 234 | 235 | 236 | 237 | library\lib\mips 238 | 1 239 | 240 | 241 | library\lib\mips 242 | 1 243 | 244 | 245 | 246 | 247 | library\lib\armeabi-v7a 248 | 1 249 | 250 | 251 | library\lib\arm64-v8a 252 | 1 253 | 254 | 255 | 256 | 257 | library\lib\armeabi-v7a 258 | 1 259 | 260 | 261 | 262 | 263 | res\drawable 264 | 1 265 | 266 | 267 | res\drawable 268 | 1 269 | 270 | 271 | 272 | 273 | res\values 274 | 1 275 | 276 | 277 | res\values 278 | 1 279 | 280 | 281 | 282 | 283 | res\values-v21 284 | 1 285 | 286 | 287 | res\values-v21 288 | 1 289 | 290 | 291 | 292 | 293 | res\values 294 | 1 295 | 296 | 297 | res\values 298 | 1 299 | 300 | 301 | 302 | 303 | res\drawable 304 | 1 305 | 306 | 307 | res\drawable 308 | 1 309 | 310 | 311 | 312 | 313 | res\drawable-xxhdpi 314 | 1 315 | 316 | 317 | res\drawable-xxhdpi 318 | 1 319 | 320 | 321 | 322 | 323 | res\drawable-ldpi 324 | 1 325 | 326 | 327 | res\drawable-ldpi 328 | 1 329 | 330 | 331 | 332 | 333 | res\drawable-mdpi 334 | 1 335 | 336 | 337 | res\drawable-mdpi 338 | 1 339 | 340 | 341 | 342 | 343 | res\drawable-hdpi 344 | 1 345 | 346 | 347 | res\drawable-hdpi 348 | 1 349 | 350 | 351 | 352 | 353 | res\drawable-xhdpi 354 | 1 355 | 356 | 357 | res\drawable-xhdpi 358 | 1 359 | 360 | 361 | 362 | 363 | res\drawable-mdpi 364 | 1 365 | 366 | 367 | res\drawable-mdpi 368 | 1 369 | 370 | 371 | 372 | 373 | res\drawable-hdpi 374 | 1 375 | 376 | 377 | res\drawable-hdpi 378 | 1 379 | 380 | 381 | 382 | 383 | res\drawable-xhdpi 384 | 1 385 | 386 | 387 | res\drawable-xhdpi 388 | 1 389 | 390 | 391 | 392 | 393 | res\drawable-xxhdpi 394 | 1 395 | 396 | 397 | res\drawable-xxhdpi 398 | 1 399 | 400 | 401 | 402 | 403 | res\drawable-xxxhdpi 404 | 1 405 | 406 | 407 | res\drawable-xxxhdpi 408 | 1 409 | 410 | 411 | 412 | 413 | res\drawable-small 414 | 1 415 | 416 | 417 | res\drawable-small 418 | 1 419 | 420 | 421 | 422 | 423 | res\drawable-normal 424 | 1 425 | 426 | 427 | res\drawable-normal 428 | 1 429 | 430 | 431 | 432 | 433 | res\drawable-large 434 | 1 435 | 436 | 437 | res\drawable-large 438 | 1 439 | 440 | 441 | 442 | 443 | res\drawable-xlarge 444 | 1 445 | 446 | 447 | res\drawable-xlarge 448 | 1 449 | 450 | 451 | 452 | 453 | res\values 454 | 1 455 | 456 | 457 | res\values 458 | 1 459 | 460 | 461 | 462 | 463 | 1 464 | 465 | 466 | 1 467 | 468 | 469 | 0 470 | 471 | 472 | 473 | 474 | 1 475 | .framework 476 | 477 | 478 | 1 479 | .framework 480 | 481 | 482 | 0 483 | 484 | 485 | 486 | 487 | 1 488 | .dylib 489 | 490 | 491 | 1 492 | .dylib 493 | 494 | 495 | 0 496 | .dll;.bpl 497 | 498 | 499 | 500 | 501 | 1 502 | .dylib 503 | 504 | 505 | 1 506 | .dylib 507 | 508 | 509 | 1 510 | .dylib 511 | 512 | 513 | 1 514 | .dylib 515 | 516 | 517 | 1 518 | .dylib 519 | 520 | 521 | 0 522 | .bpl 523 | 524 | 525 | 526 | 527 | 0 528 | 529 | 530 | 0 531 | 532 | 533 | 0 534 | 535 | 536 | 0 537 | 538 | 539 | 0 540 | 541 | 542 | 0 543 | 544 | 545 | 0 546 | 547 | 548 | 0 549 | 550 | 551 | 552 | 553 | 1 554 | 555 | 556 | 1 557 | 558 | 559 | 1 560 | 561 | 562 | 563 | 564 | 1 565 | 566 | 567 | 1 568 | 569 | 570 | 1 571 | 572 | 573 | 574 | 575 | 1 576 | 577 | 578 | 1 579 | 580 | 581 | 1 582 | 583 | 584 | 585 | 586 | 1 587 | 588 | 589 | 1 590 | 591 | 592 | 1 593 | 594 | 595 | 596 | 597 | 1 598 | 599 | 600 | 1 601 | 602 | 603 | 1 604 | 605 | 606 | 607 | 608 | 1 609 | 610 | 611 | 1 612 | 613 | 614 | 1 615 | 616 | 617 | 618 | 619 | 1 620 | 621 | 622 | 1 623 | 624 | 625 | 1 626 | 627 | 628 | 629 | 630 | 1 631 | 632 | 633 | 1 634 | 635 | 636 | 1 637 | 638 | 639 | 640 | 641 | 1 642 | 643 | 644 | 1 645 | 646 | 647 | 1 648 | 649 | 650 | 651 | 652 | 1 653 | 654 | 655 | 1 656 | 657 | 658 | 1 659 | 660 | 661 | 662 | 663 | 1 664 | 665 | 666 | 1 667 | 668 | 669 | 1 670 | 671 | 672 | 673 | 674 | 1 675 | 676 | 677 | 1 678 | 679 | 680 | 1 681 | 682 | 683 | 684 | 685 | 1 686 | 687 | 688 | 1 689 | 690 | 691 | 1 692 | 693 | 694 | 695 | 696 | 1 697 | 698 | 699 | 1 700 | 701 | 702 | 1 703 | 704 | 705 | 706 | 707 | 1 708 | 709 | 710 | 1 711 | 712 | 713 | 1 714 | 715 | 716 | 717 | 718 | 1 719 | 720 | 721 | 1 722 | 723 | 724 | 1 725 | 726 | 727 | 728 | 729 | 1 730 | 731 | 732 | 1 733 | 734 | 735 | 1 736 | 737 | 738 | 739 | 740 | 1 741 | 742 | 743 | 1 744 | 745 | 746 | 1 747 | 748 | 749 | 750 | 751 | 1 752 | 753 | 754 | 1 755 | 756 | 757 | 1 758 | 759 | 760 | 761 | 762 | 1 763 | 764 | 765 | 1 766 | 767 | 768 | 1 769 | 770 | 771 | 772 | 773 | 1 774 | 775 | 776 | 1 777 | 778 | 779 | 1 780 | 781 | 782 | 783 | 784 | 1 785 | 786 | 787 | 1 788 | 789 | 790 | 1 791 | 792 | 793 | 794 | 795 | 1 796 | 797 | 798 | 1 799 | 800 | 801 | 1 802 | 803 | 804 | 805 | 806 | 1 807 | 808 | 809 | 1 810 | 811 | 812 | 1 813 | 814 | 815 | 816 | 817 | 1 818 | 819 | 820 | 1 821 | 822 | 823 | 1 824 | 825 | 826 | 827 | 828 | 1 829 | 830 | 831 | 1 832 | 833 | 834 | 1 835 | 836 | 837 | 838 | 839 | 1 840 | 841 | 842 | 1 843 | 844 | 845 | 1 846 | 847 | 848 | 849 | 850 | 1 851 | 852 | 853 | 1 854 | 855 | 856 | 1 857 | 858 | 859 | 860 | 861 | 1 862 | 863 | 864 | 1 865 | 866 | 867 | 868 | 869 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 870 | 1 871 | 872 | 873 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 874 | 1 875 | 876 | 877 | 878 | 879 | 880 | 881 | 882 | 1 883 | 884 | 885 | 1 886 | 887 | 888 | 1 889 | 890 | 891 | 892 | 893 | 894 | 895 | 896 | Contents\Resources 897 | 1 898 | 899 | 900 | Contents\Resources 901 | 1 902 | 903 | 904 | 905 | 906 | library\lib\armeabi-v7a 907 | 1 908 | 909 | 910 | library\lib\arm64-v8a 911 | 1 912 | 913 | 914 | 1 915 | 916 | 917 | 1 918 | 919 | 920 | 1 921 | 922 | 923 | 1 924 | 925 | 926 | 1 927 | 928 | 929 | 1 930 | 931 | 932 | 0 933 | 934 | 935 | 936 | 937 | library\lib\armeabi-v7a 938 | 1 939 | 940 | 941 | 942 | 943 | 1 944 | 945 | 946 | 1 947 | 948 | 949 | 950 | 951 | Assets 952 | 1 953 | 954 | 955 | Assets 956 | 1 957 | 958 | 959 | 960 | 961 | Assets 962 | 1 963 | 964 | 965 | Assets 966 | 1 967 | 968 | 969 | 970 | 971 | 972 | 973 | 974 | 975 | 976 | 977 | 978 | 979 | 980 | 981 | False 982 | False 983 | False 984 | True 985 | False 986 | 987 | 988 | 12 989 | 990 | 991 | 992 | 993 | 994 | -------------------------------------------------------------------------------- /Ugar.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HashLoad/ugar/3c01278f5c5c0b0ae0fffa241e3921c15051d782/Ugar.res -------------------------------------------------------------------------------- /boss-lock.json: -------------------------------------------------------------------------------- 1 | { 2 | "hash": "40fd1d3faef36114a2fc365dc84dd327", 3 | "updated": "2020-04-13T10:52:38.4097451-03:00", 4 | "installedModules": { 5 | "github.com/snakeice/grijjyfoundation": { 6 | "name": "GrijjyFoundation", 7 | "version": "1.2.5", 8 | "hash": "459ddee82133778fdd9ec6290bdbc07e", 9 | "artifacts": {}, 10 | "failed": false, 11 | "changed": false 12 | } 13 | } 14 | } -------------------------------------------------------------------------------- /boss.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "ugar", 3 | "description": "MongoDb connector like mongoose", 4 | "version": "0.0.2", 5 | "homepage": "", 6 | "mainsrc": "src/", 7 | "projects": [], 8 | "dependencies": { 9 | "github.com/snakeice/GrijjyFoundation": "^1.02" 10 | } 11 | } -------------------------------------------------------------------------------- /docker-compose.yaml: -------------------------------------------------------------------------------- 1 | version: '3' 2 | 3 | services: 4 | mongodb: 5 | image: mongo 6 | ports: 7 | - "27017:27017" 8 | volumes: 9 | - mongodata:/data/db 10 | 11 | volumes: 12 | mongodata: -------------------------------------------------------------------------------- /src/Ugar.pas: -------------------------------------------------------------------------------- 1 | unit Ugar; 2 | 3 | interface 4 | 5 | uses 6 | System.Generics.Collections, Ugar.db.mongo.Enum, Ugar.db.mongo.Query, System.JSON, Ugar.db.mongo; 7 | 8 | type 9 | 10 | TUgarBsonValue = Ugar.db.mongo.Enum.TUgarBsonValue; 11 | TUgarBsonDocument = Ugar.db.mongo.Enum.TUgarBsonDocument; 12 | TUgarDatabase = TUgarDatabaseFunction; 13 | UgarQuery = Ugar.db.mongo.Query.TUgarTextSearchOption; 14 | TUgarTextSearchOptions = Ugar.db.mongo.Query.TUgarTextSearchOptions; 15 | UgarFilter = Ugar.db.mongo.Query.TUgarFilter; 16 | Projection = Ugar.db.mongo.Query.TUgarProjection; 17 | TUgarSortDirection = Ugar.db.mongo.Query.TUgarSortDirection; 18 | UgarSort = Ugar.db.mongo.Query.TUgarSort; 19 | TUgarCurrentDateType = Ugar.db.mongo.Query.TUgarCurrentDateType; 20 | UgarUpdate = Ugar.db.mongo.Query.TUgarUpdate; 21 | 22 | TUgar = class 23 | private 24 | FConnection: TDictionary; 25 | class var FInstance: TUgar; 26 | class function GetDefaultInstance: TUgar; 27 | public 28 | constructor Create; 29 | destructor Destroy; override; 30 | class destructor UnInitialize; 31 | class function Init(AHost: string; APort: Integer; ADatabase: String): TUgarDatabase; 32 | end; 33 | 34 | implementation 35 | 36 | uses 37 | System.SysUtils, Ugar.Connection.Imp; 38 | 39 | { TUgar } 40 | 41 | constructor TUgar.Create; 42 | begin 43 | FConnection := TDictionary.Create; 44 | end; 45 | 46 | destructor TUgar.Destroy; 47 | begin 48 | FConnection.DisposeOf; 49 | inherited; 50 | end; 51 | 52 | class function TUgar.GetDefaultInstance: TUgar; 53 | begin 54 | if FInstance = nil then 55 | FInstance := TUgar.Create; 56 | Result := FInstance; 57 | end; 58 | 59 | class function TUgar.Init(AHost: string; APort: Integer; ADatabase: String): TUgarDatabase; 60 | var 61 | LConnection: IUgarConnection; 62 | LKey: string; 63 | begin 64 | LKey := AHost + APort.ToString; 65 | if not GetDefaultInstance.FConnection.TryGetValue(LKey, LConnection) then 66 | begin 67 | LConnection := TUgarConnection.Create(AHost, APort); 68 | GetDefaultInstance.FConnection.Add(LKey, LConnection); 69 | end; 70 | Result := LConnection.Database[ADatabase]; 71 | end; 72 | 73 | class destructor TUgar.UnInitialize; 74 | begin 75 | if FInstance <> nil then 76 | FInstance.Free; 77 | end; 78 | 79 | end. 80 | -------------------------------------------------------------------------------- /src/ugar.connection.Imp.pas: -------------------------------------------------------------------------------- 1 | unit ugar.connection.Imp; 2 | 3 | interface 4 | 5 | uses 6 | ugar.db.Mongo; 7 | 8 | type 9 | TUgarConnection = class(TInterfacedObject, IUgarConnection) 10 | private 11 | FMongo: IUgarClient; 12 | function GetDatabase(ADatabaseName: string): TUgarDatabaseFunction; 13 | public 14 | constructor Create(AHost: string; APort: Integer); 15 | property Database[ADatabaseName: string]: TUgarDatabaseFunction read GetDatabase; 16 | end; 17 | 18 | implementation 19 | 20 | uses 21 | ugar.db.Mongo.Imp; 22 | 23 | { TUgarConnection } 24 | 25 | constructor TUgarConnection.Create(AHost: string; APort: Integer); 26 | begin 27 | FMongo := TUgarClient.Create(AHost, APort); 28 | end; 29 | 30 | function TUgarConnection.GetDatabase(ADatabaseName: string): TUgarDatabaseFunction; 31 | begin 32 | result := function(AName: String): IUgarCollection 33 | begin 34 | result := IUgarCollection(FMongo.GetDatabase(ADatabaseName).GetCollection(AName)) 35 | end; 36 | end; 37 | 38 | end. 39 | -------------------------------------------------------------------------------- /src/ugar.db.Mongo.pas: -------------------------------------------------------------------------------- 1 | unit ugar.db.Mongo; 2 | 3 | interface 4 | 5 | uses 6 | Grijjy.Bson, System.Generics.Collections, System.JSON, System.SysUtils, ugar.db.Mongo.Enum, 7 | ugar.db.Mongo.Query; 8 | 9 | type 10 | 11 | IUgarDatabase = interface; 12 | IUgarCollection = interface; 13 | 14 | IUgarCursor = interface 15 | ['{18813F27-1B41-453C-86FE-E98AFEB3D905}'] 16 | function GetEnumerator: TEnumerator; 17 | function ToArray: TArray; 18 | end; 19 | 20 | IUgarClient = interface 21 | ['{66FF5346-48F6-44E1-A46F-D8B958F06EA0}'] 22 | function ListDatabaseNames: TArray; 23 | function ListDatabases: TArray; 24 | procedure DropDatabase(const AName: String); 25 | function GetDatabase(const AName: String): IUgarDatabase; 26 | end; 27 | 28 | IUgarDatabase = interface 29 | ['{5164D7B1-74F5-45F1-AE22-AB5FFC834590}'] 30 | function _GetClient: IUgarClient; 31 | function _GetName: String; 32 | function ListCollectionNames: TArray; 33 | function ListCollections: TArray; 34 | 35 | procedure DropCollection(const AName: String); 36 | function RunCommand(const ACommand: string): IUgarCursor; overload; 37 | function RunCommand(const ACommand: TUgarBsonDocument): IUgarCursor; overload; 38 | procedure DropDatabase(); 39 | 40 | function GetCollection(const AName: String): IUgarCollection; 41 | 42 | property Client: IUgarClient read _GetClient; 43 | 44 | property Name: String read _GetName; 45 | end; 46 | 47 | IUgarCollection = interface 48 | ['{9822579B-1682-4FAC-81CF-A4B239777812}'] 49 | function _GetDatabase: IUgarDatabase; 50 | function _GetName: String; 51 | function InsertOne(const ADocument: TUgarBsonDocument): Boolean; overload; 52 | function InsertOne(const ADocument: TJsonObject): TJsonObject; overload; 53 | function InsertOne(const ADocument: string): Boolean; overload; 54 | 55 | function InsertMany(const ADocuments: array of TUgarBsonDocument; const AOrdered: Boolean = True): Integer; 56 | overload; 57 | function InsertMany(const ADocuments: array of TJsonObject; const AOrdered: Boolean = True): Integer; overload; 58 | function InsertMany(const ADocuments: array of string; const AOrdered: Boolean = True): Integer; overload; 59 | 60 | function InsertMany(const ADocuments: TArray; const AOrdered: Boolean = True): Integer; overload; 61 | function InsertMany(const ADocuments: TArray; const AOrdered: Boolean = True): Integer; overload; 62 | function InsertMany(const ADocuments: TArray; const AOrdered: Boolean = True): Integer; overload; 63 | 64 | function InsertMany(const ADocuments: TEnumerable; const AOrdered: Boolean = True) 65 | : Integer; overload; 66 | function InsertMany(const ADocuments: TEnumerable; const AOrdered: Boolean = True): Integer; overload; 67 | function InsertMany(const ADocuments: TEnumerable; const AOrdered: Boolean = True): Integer; overload; 68 | 69 | function DeleteOne(const AFilter: TUgarFilter): Boolean; 70 | 71 | function DeleteMany(const AFilter: TUgarFilter; const AOrdered: Boolean = True): Integer; 72 | 73 | function UpdateOne(const AFilter: TUgarFilter; const AUpdate: TUgarUpdate; const AUpsert: Boolean = False): Boolean; 74 | 75 | function UpdateMany(const AFilter: TUgarFilter; const AUpdate: TUgarUpdate; const AUpsert: Boolean = False; 76 | const AOrdered: Boolean = True): Integer; 77 | 78 | function Find(const AFilter: TUgarFilter; const AProjection: TUgarProjection): IUgarCursor; overload; 79 | function Find(const AFilter: TUgarFilter): IUgarCursor; overload; 80 | function Find(const AProjection: TUgarProjection): IUgarCursor; overload; 81 | function Find: TJSONArray; overload; 82 | function Find(const AFilter: TUgarFilter; const ASort: TUgarSort): IUgarCursor; overload; 83 | function Find(const AFilter: TUgarFilter; const AProjection: TUgarProjection; const ASort: TUgarSort) 84 | : IUgarCursor; overload; 85 | 86 | function FindOne(const AFilter: TUgarFilter; const AProjection: TUgarProjection): TUgarBsonDocument; overload; 87 | function FindOne(const AFilter: TUgarFilter): TUgarBsonDocument; overload; 88 | 89 | function Count: Integer; overload; 90 | function Count(const AFilter: TUgarFilter): Integer; overload; 91 | 92 | property Database: IUgarDatabase read _GetDatabase; 93 | 94 | property Name: String read _GetName; 95 | end; 96 | 97 | TUgarDatabaseFunction = reference to function(AName: string = '_'): IUgarCollection; 98 | 99 | IUgarConnection = Interface 100 | function GetDatabase(ADatabaseName: string): TUgarDatabaseFunction; 101 | property Database[ADatabaseName: string]: TUgarDatabaseFunction read GetDatabase; 102 | End; 103 | 104 | implementation 105 | 106 | end. 107 | -------------------------------------------------------------------------------- /src/ugar.db.mongo.Enum.pas: -------------------------------------------------------------------------------- 1 | unit ugar.db.mongo.Enum; 2 | 3 | interface 4 | 5 | uses 6 | Grijjy.Bson, 7 | Grijjy.Bson.IO; 8 | 9 | const 10 | COLLECTION_COMMAND = '$cmd'; 11 | COLLECTION_ADMIN = 'admin'; 12 | COLLECTION_ADMIN_COMMAND = COLLECTION_ADMIN + '.' + COLLECTION_COMMAND; 13 | MAX_BULK_SIZE = 1000; 14 | 15 | type 16 | 17 | TUgarBsonValue = TgoBsonValue; 18 | TUgarJsonWriterSettings = TgoJsonWriterSettings; 19 | TUgarBsonDocument = TgoBsonDocument; 20 | TUgarBsonType = TgoBsonType; 21 | TUgarBsonArray = TgoBsonArray; 22 | TUgarBsonElement = TgoBsonElement; 23 | TUgarBsonRegularExpression = TgoBsonRegularExpression; 24 | TUgarBsonDocumentWriter = TgoBsonDocumentWriter; 25 | TUgarBsonWriter = TgoBsonWriter; 26 | TUgarJsonWriter = TgoJsonWriter; 27 | IUgarBsonWriter = IgoBsonWriter; 28 | IUgarBsonBaseWriter = IgoBsonBaseWriter; 29 | IUgarBsonDocumentWriter = IgoBsonDocumentWriter; 30 | IUgarJsonWriter = IgoJsonWriter; 31 | 32 | TUgarErrorCode = ( 33 | OK = 0, 34 | InternalError = 1, 35 | BadValue = 2, 36 | OBSOLETE_DuplicateKey = 3, 37 | NoSuchKey = 4, 38 | GraphContainsCycle = 5, 39 | HostUnreachable = 6, 40 | HostNotFound = 7, 41 | UnknownError = 8, 42 | FailedToParse = 9, 43 | CannotMutateObject = 10, 44 | UserNotFound = 11, 45 | UnsupportedFormat = 12, 46 | Unauthorized = 13, 47 | TypeMismatch = 14, 48 | Overflow = 15, 49 | InvalidLength = 16, 50 | ProtocolError = 17, 51 | AuthenticationFailed = 18, 52 | CannotReuseObject = 19, 53 | IllegalOperation = 20, 54 | EmptyArrayOperation = 21, 55 | InvalidBSON = 22, 56 | AlreadyInitialized = 23, 57 | LockTimeout = 24, 58 | RemoteValidationError = 25, 59 | NamespaceNotFound = 26, 60 | IndexNotFound = 27, 61 | PathNotViable = 28, 62 | NonExistentPath = 29, 63 | InvalidPath = 30, 64 | RoleNotFound = 31, 65 | RolesNotRelated = 32, 66 | PrivilegeNotFound = 33, 67 | CannotBackfillArray = 34, 68 | UserModificationFailed = 35, 69 | RemoteChangeDetected = 36, 70 | FileRenameFailed = 37, 71 | FileNotOpen = 38, 72 | FileStreamFailed = 39, 73 | ConflictingUpdateOperators = 40, 74 | FileAlreadyOpen = 41, 75 | LogWriteFailed = 42, 76 | CursorNotFound = 43, 77 | UserDataInconsistent = 45, 78 | LockBusy = 46, 79 | NoMatchingDocument = 47, 80 | NamespaceExists = 48, 81 | InvalidRoleModification = 49, 82 | ExceededTimeLimit = 50, 83 | ManualInterventionRequired = 51, 84 | DollarPrefixedFieldName = 52, 85 | InvalidIdField = 53, 86 | NotSingleValueField = 54, 87 | InvalidDBRef = 55, 88 | EmptyFieldName = 56, 89 | DottedFieldName = 57, 90 | RoleModificationFailed = 58, 91 | CommandNotFound = 59, 92 | OBSOLETE_DatabaseNotFound = 60, 93 | ShardKeyNotFound = 61, 94 | OplogOperationUnsupported = 62, 95 | StaleShardVersion = 63, 96 | WriteConcernFailed = 64, 97 | MultipleErrorsOccurred = 65, 98 | ImmutableField = 66, 99 | CannotCreateIndex = 67 , 100 | IndexAlreadyExists = 68 , 101 | AuthSchemaIncompatible = 69, 102 | ShardNotFound = 70, 103 | ReplicaSetNotFound = 71, 104 | InvalidOptions = 72, 105 | InvalidNamespace = 73, 106 | NodeNotFound = 74, 107 | WriteConcernLegacyOK = 75, 108 | NoReplicationEnabled = 76, 109 | OperationIncomplete = 77, 110 | CommandResultSchemaViolation = 78, 111 | UnknownReplWriteConcern = 79, 112 | RoleDataInconsistent = 80, 113 | NoMatchParseContext = 81, 114 | NoProgressMade = 82, 115 | RemoteResultsUnavailable = 83, 116 | DuplicateKeyValue = 84, 117 | IndexOptionsConflict = 85 , 118 | IndexKeySpecsConflict = 86 , 119 | CannotSplit = 87, 120 | SplitFailed_OBSOLETE = 88, 121 | NetworkTimeout = 89, 122 | CallbackCanceled = 90, 123 | ShutdownInProgress = 91, 124 | SecondaryAheadOfPrimary = 92, 125 | InvalidReplicaSetConfig = 93, 126 | NotYetInitialized = 94, 127 | NotSecondary = 95, 128 | OperationFailed = 96, 129 | NoProjectionFound = 97, 130 | DBPathInUse = 98, 131 | CannotSatisfyWriteConcern = 100, 132 | OutdatedClient = 101, 133 | IncompatibleAuditMetadata = 102, 134 | NewReplicaSetConfigurationIncompatible = 103, 135 | NodeNotElectable = 104, 136 | IncompatibleShardingMetadata = 105, 137 | DistributedClockSkewed = 106, 138 | LockFailed = 107, 139 | InconsistentReplicaSetNames = 108, 140 | ConfigurationInProgress = 109, 141 | CannotInitializeNodeWithData = 110, 142 | NotExactValueField = 111, 143 | WriteConflict = 112, 144 | InitialSyncFailure = 113, 145 | InitialSyncOplogSourceMissing = 114, 146 | CommandNotSupported = 115, 147 | DocTooLargeForCapped = 116, 148 | ConflictingOperationInProgress = 117, 149 | NamespaceNotSharded = 118, 150 | InvalidSyncSource = 119, 151 | OplogStartMissing = 120, 152 | DocumentValidationFailure = 121, 153 | OBSOLETE_ReadAfterOptimeTimeout = 122, 154 | NotAReplicaSet = 123, 155 | IncompatibleElectionProtocol = 124, 156 | CommandFailed = 125, 157 | RPCProtocolNegotiationFailed = 126, 158 | UnrecoverableRollbackError = 127, 159 | LockNotFound = 128, 160 | LockStateChangeFailed = 129, 161 | SymbolNotFound = 130, 162 | RLPInitializationFailed = 131, 163 | OBSOLETE_ConfigServersInconsistent = 132, 164 | FailedToSatisfyReadPreference = 133, 165 | ReadConcernMajorityNotAvailableYet = 134, 166 | StaleTerm = 135, 167 | CappedPositionLost = 136, 168 | IncompatibleShardingConfigVersion = 137, 169 | RemoteOplogStale = 138, 170 | JSInterpreterFailure = 139, 171 | InvalidSSLConfiguration = 140, 172 | SSLHandshakeFailed = 141, 173 | JSUncatchableError = 142, 174 | CursorInUse = 143, 175 | IncompatibleCatalogManager = 144, 176 | PooledConnectionsDropped = 145, 177 | ExceededMemoryLimit = 146, 178 | ZLibError = 147, 179 | ReadConcernMajorityNotEnabled = 148, 180 | NoConfigMaster = 149, 181 | StaleEpoch = 150, 182 | OperationCannotBeBatched = 151, 183 | OplogOutOfOrder = 152, 184 | ChunkTooBig = 153, 185 | InconsistentShardIdentity = 154, 186 | CannotApplyOplogWhilePrimary = 155, 187 | NeedsDocumentMove = 156, 188 | CanRepairToDowngrade = 157, 189 | MustUpgrade = 158, 190 | DurationOverflow = 159, 191 | MaxStalenessOutOfRange = 160, 192 | IncompatibleCollationVersion = 161, 193 | CollectionIsEmpty = 162, 194 | ZoneStillInUse = 163, 195 | InitialSyncActive = 164, 196 | ViewDepthLimitExceeded = 165, 197 | CommandNotSupportedOnView = 166, 198 | OptionNotSupportedOnView = 167, 199 | InvalidPipelineOperator = 168, 200 | CommandOnShardedViewNotSupportedOnMongod = 169, 201 | TooManyMatchingDocuments = 170, 202 | CannotIndexParallelArrays = 171, 203 | TransportSessionClosed = 172, 204 | TransportSessionNotFound = 173, 205 | TransportSessionUnknown = 174, 206 | QueryPlanKilled = 175, 207 | FileOpenFailed = 176, 208 | ZoneNotFound = 177, 209 | RangeOverlapConflict = 178, 210 | WindowsPdhError = 179, 211 | BadPerfCounterPath = 180, 212 | AmbiguousIndexKeyPattern = 181, 213 | InvalidViewDefinition = 182, 214 | ClientMetadataMissingField = 183, 215 | ClientMetadataAppNameTooLarge = 184, 216 | ClientMetadataDocumentTooLarge = 185, 217 | ClientMetadataCannotBeMutated = 186, 218 | LinearizableReadConcernError = 187, 219 | IncompatibleServerVersion = 188, 220 | PrimarySteppedDown = 189, 221 | MasterSlaveConnectionFailure = 190, 222 | OBSOLETE_BalancerLostDistributedLock = 191, 223 | FailPointEnabled = 192, 224 | NoShardingEnabled = 193, 225 | BalancerInterrupted = 194, 226 | ViewPipelineMaxSizeExceeded = 195, 227 | InvalidIndexSpecificationOption = 197, 228 | OBSOLETE_ReceivedOpReplyMessage = 198, 229 | ReplicaSetMonitorRemoved = 199, 230 | ChunkRangeCleanupPending = 200, 231 | CannotBuildIndexKeys = 201, 232 | NetworkInterfaceExceededTimeLimit = 202, 233 | ShardingStateNotInitialized = 203, 234 | TimeProofMismatch = 204, 235 | ClusterTimeFailsRateLimiter = 205, 236 | NoSuchSession = 206, 237 | InvalidUUID = 207, 238 | TooManyLocks = 208, 239 | StaleClusterTime = 209, 240 | CannotVerifyAndSignLogicalTime = 210, 241 | KeyNotFound = 211, 242 | IncompatibleRollbackAlgorithm = 212, 243 | DuplicateSession = 213, 244 | AuthenticationRestrictionUnmet = 214, 245 | DatabaseDropPending = 215, 246 | ElectionInProgress = 216, 247 | IncompleteTransactionHistory = 217, 248 | UpdateOperationFailed = 218, 249 | FTDCPathNotSet = 219, 250 | FTDCPathAlreadySet = 220, 251 | IndexModified = 221, 252 | CloseChangeStream = 222, 253 | IllegalOpMsgFlag = 223, 254 | JSONSchemaNotAllowed = 224, 255 | TransactionTooOld = 225, 256 | 257 | SocketException = 9001, 258 | OBSOLETE_RecvStaleConfig = 9996, 259 | NotMaster = 10107, 260 | CannotGrowDocumentInCappedNamespace = 10003, 261 | DuplicateKey = 11000, 262 | InterruptedAtShutdown = 11600, 263 | Interrupted = 11601, 264 | InterruptedDueToReplStateChange = 11602, 265 | OutOfDiskSpace = 14031 , 266 | KeyTooLong = 17280, 267 | BackgroundOperationInProgressForDatabase = 12586, 268 | BackgroundOperationInProgressForNamespace = 12587, 269 | NotMasterOrSecondary = 13436, 270 | NotMasterNoSlaveOk = 13435, 271 | ShardKeyTooBig = 13334, 272 | StaleConfig = 13388, 273 | DatabaseDifferCase = 13297, 274 | OBSOLETE_PrepareConfigsFailed = 13104); 275 | 276 | TUgarMongoQueryFlag = ( 277 | TailableCursor = 1, 278 | SlaveOk = 2, 279 | OplogRelay = 3, 280 | NoCursorTimeout = 4, 281 | AwaitData = 5, 282 | Exhaust = 6, 283 | Partial = 7); 284 | 285 | TUgarMongoQueryFlags = set of TUgarMongoQueryFlag; 286 | 287 | TUgarMongoResponseFlag = ( 288 | rfCursorNotFound = 0, 289 | rfQueryFailure = 1, 290 | rfShardConfigStale = 2, 291 | rfAwaitCapable = 3); 292 | 293 | TUgarMongoResponseFlags = set of TUgarMongoResponseFlag; 294 | 295 | 296 | implementation 297 | 298 | end. 299 | -------------------------------------------------------------------------------- /src/ugar.db.mongo.Func.pas: -------------------------------------------------------------------------------- 1 | unit ugar.db.mongo.Func; 2 | 3 | interface 4 | 5 | uses 6 | ugar.db.mongo.Enum, ugar.db.mongo, System.SysUtils, ugar.db.mongo.protocol.Types; 7 | 8 | type 9 | EUgarDBError = class(Exception); 10 | 11 | EUgarDBConnectionError = class(EUgarDBError); 12 | 13 | EUgarDBWriteError = class(EUgarDBError) 14 | private 15 | FErrorCode: TUgarErrorCode; 16 | public 17 | constructor Create(const AErrorCode: TUgarErrorCode; const AErrorMsg: String); 18 | property ErrorCode: TUgarErrorCode read FErrorCode; 19 | end; 20 | 21 | procedure HandleTimeout(const AReply: IUgarMongoReply); 22 | function HandleCommandReply(const AReply: IUgarMongoReply; 23 | const AErrorToIgnore: TUgarErrorCode = TUgarErrorCode.OK): Integer; 24 | 25 | implementation 26 | 27 | uses 28 | Grijjy.Bson; 29 | 30 | resourcestring 31 | RS_MONGODB_CONNECTION_ERROR = 'Error connecting to the MongoDB database'; 32 | RS_MONGODB_GENERIC_ERROR = 'Unspecified error while performing MongoDB operation'; 33 | 34 | procedure HandleTimeout(const AReply: IUgarMongoReply); 35 | begin 36 | if (AReply = nil) then 37 | raise EUgarDBConnectionError.Create(RS_MONGODB_CONNECTION_ERROR); 38 | end; 39 | 40 | function HandleCommandReply(const AReply: IUgarMongoReply; 41 | const AErrorToIgnore: TUgarErrorCode = TUgarErrorCode.OK): Integer; 42 | var 43 | LDoc, LErrorDoc: TUgarBsonDocument; 44 | LValue: TgoBsonValue; 45 | LValues: TgoBsonArray; 46 | LOK: Boolean; 47 | LErrorCode: TUgarErrorCode; 48 | LErrorMsg: String; 49 | begin 50 | if (AReply = nil) then 51 | raise EUgarDBConnectionError.Create(RS_MONGODB_CONNECTION_ERROR); 52 | 53 | if (AReply.Documents = nil) then 54 | Exit(0); 55 | 56 | LDoc := TUgarBsonDocument.Load(AReply.Documents[0]); 57 | Result := LDoc['n']; 58 | 59 | LOK := LDoc['ok']; 60 | if (not LOK) then 61 | begin 62 | Word(LErrorCode) := LDoc['code']; 63 | 64 | if (AErrorToIgnore <> TUgarErrorCode.OK) and (LErrorCode = AErrorToIgnore) then 65 | Exit; 66 | 67 | if (LErrorCode <> TUgarErrorCode.OK) then 68 | begin 69 | LErrorMsg := LDoc['errmsg']; 70 | raise EUgarDBWriteError.Create(LErrorCode, LErrorMsg); 71 | end; 72 | 73 | if (LDoc.TryGetValue('writeErrors', LValue)) then 74 | begin 75 | LValues := LValue.AsBsonArray; 76 | if (LValues.Count > 0) then 77 | begin 78 | LErrorDoc := LValues.Items[0].AsBsonDocument; 79 | Word(LErrorCode) := LErrorDoc['code']; 80 | LErrorMsg := LErrorDoc['errmsg']; 81 | raise EUgarDBWriteError.Create(LErrorCode, LErrorMsg); 82 | end; 83 | end; 84 | 85 | if (LDoc.TryGetValue('writeConcernError', LValue)) then 86 | begin 87 | LErrorDoc := LValue.AsBsonDocument; 88 | Word(LErrorCode) := LErrorDoc['code']; 89 | LErrorMsg := LErrorDoc['errmsg']; 90 | raise EUgarDBWriteError.Create(LErrorCode, LErrorMsg); 91 | end; 92 | 93 | raise EUgarDBError.Create(RS_MONGODB_GENERIC_ERROR); 94 | end; 95 | end; 96 | 97 | { EUgarDBWriteError } 98 | 99 | constructor EUgarDBWriteError.Create(const AErrorCode: TUgarErrorCode; const AErrorMsg: String); 100 | begin 101 | inherited Create(AErrorMsg + Format(' (error %d)', [Ord(AErrorCode)])); 102 | FErrorCode := AErrorCode; 103 | end; 104 | 105 | end. 106 | -------------------------------------------------------------------------------- /src/ugar.db.mongo.Imp.pas: -------------------------------------------------------------------------------- 1 | unit ugar.db.mongo.Imp; 2 | 3 | interface 4 | 5 | uses 6 | ugar.db.Mongo, 7 | ugar.db.mongo.Enum, ugar.db.mongo.Protocol; 8 | 9 | type 10 | TUgarClientSettings = record 11 | private const 12 | C_DEFAULT_TIMEOUT = 5000; 13 | public 14 | ConnectionTimeout: Integer; 15 | ReplyTimeout: Integer; 16 | public 17 | class function Create: TUgarClientSettings; static; 18 | end; 19 | 20 | type 21 | TUgarClient = class(TInterfacedObject, IUgarClient) 22 | public const 23 | DEFAULT_HOST = 'localhost'; 24 | DEFAULT_PORT = 27017; 25 | private 26 | FProtocol: TUgarMongoProtocol; 27 | protected 28 | function ListDatabaseNames: TArray; 29 | function ListDatabases: TArray; 30 | procedure DropDatabase(const AName: String); 31 | function GetDatabase(const AName: String): IUgarDatabase; 32 | protected 33 | property Protocol: TUgarMongoProtocol read FProtocol; 34 | public 35 | constructor Create(const AHost: String = DEFAULT_HOST; const APort: Integer = DEFAULT_PORT); overload; 36 | constructor Create(const AHost: String; const APort: Integer; const ASettings: TUgarClientSettings); overload; 37 | constructor Create(const ASettings: TUgarClientSettings); overload; 38 | destructor Destroy; override; 39 | end; 40 | 41 | implementation 42 | 43 | uses 44 | System.Math, ugar.db.mongo.Func, ugar.db.mongo.internals; 45 | 46 | constructor TUgarClient.Create(const AHost: String; const APort: Integer); 47 | begin 48 | Create(AHost, APort, TUgarClientSettings.Create); 49 | end; 50 | 51 | constructor TUgarClient.Create(const AHost: String; const APort: Integer; 52 | const ASettings: TUgarClientSettings); 53 | var 54 | LSettings: TUgarMongoProtocolSettings; 55 | begin 56 | inherited Create; 57 | LSettings.ConnectionTimeout := ASettings.ConnectionTimeout; 58 | LSettings.ReplyTimeout := ASettings.ReplyTimeout; 59 | FProtocol := TUgarMongoProtocol.Create(AHost, APort, LSettings); 60 | end; 61 | 62 | constructor TUgarClient.Create(const ASettings: TUgarClientSettings); 63 | begin 64 | Create(DEFAULT_HOST, DEFAULT_PORT, ASettings); 65 | end; 66 | 67 | destructor TUgarClient.Destroy; 68 | begin 69 | FProtocol.Free; 70 | inherited; 71 | end; 72 | 73 | procedure TUgarClient.DropDatabase(const AName: String); 74 | var 75 | Writer: IUgarBsonWriter; 76 | Reply: IUgarMongoReply; 77 | begin 78 | Writer := TUgarBsonWriter.Create; 79 | Writer.WriteStartDocument; 80 | Writer.WriteInt32('dropDatabase', 1); 81 | Writer.WriteEndDocument; 82 | Reply := FProtocol.OpQuery(UTF8String(AName + '.' + COLLECTION_COMMAND), [], 0, -1, Writer.ToBson, nil); 83 | HandleCommandReply(Reply); 84 | end; 85 | 86 | function TUgarClient.GetDatabase(const AName: String): IUgarDatabase; 87 | begin 88 | Result := TUgarDatabase.Create(Self, AName); 89 | end; 90 | 91 | function TUgarClient.ListDatabaseNames: TArray; 92 | begin 93 | 94 | end; 95 | 96 | function TUgarClient.ListDatabases: TArray; 97 | begin 98 | 99 | end; 100 | 101 | { TUgarClientSettings } 102 | 103 | class function TUgarClientSettings.Create: TUgarClientSettings; 104 | begin 105 | Result.ConnectionTimeout := C_DEFAULT_TIMEOUT; 106 | Result.ReplyTimeout := C_DEFAULT_TIMEOUT; 107 | end; 108 | 109 | end. 110 | -------------------------------------------------------------------------------- /src/ugar.db.mongo.Protocol.pas: -------------------------------------------------------------------------------- 1 | unit ugar.db.mongo.Protocol; 2 | 3 | {$INCLUDE 'Grijjy.inc'} 4 | 5 | interface 6 | 7 | uses 8 | System.SyncObjs, 9 | System.SysUtils, 10 | System.Generics.Collections, 11 | {$IF Defined(MSWINDOWS)} 12 | Grijjy.SocketPool.Win, 13 | {$ELSEIF Defined(LINUX)} 14 | Grijjy.SocketPool.Linux, 15 | {$ELSE} 16 | {$MESSAGE Error 'The MongoDB driver is only supported on Windows and Linux'} 17 | {$ENDIF} 18 | Grijjy.Bson, ugar.db.mongo.Enum, ugar.db.mongo.Protocol.Types; 19 | 20 | type 21 | TUgarMongoProtocolSettings = ugar.db.mongo.Protocol.Types.TUgarMongoProtocolSettings; 22 | IUgarMongoReply = ugar.db.mongo.Protocol.Types.IUgarMongoReply; 23 | 24 | TUgarMongoProtocol = class 25 | private const 26 | OP_QUERY = 2004; 27 | OP_GET_MORE = 2005; 28 | RECV_BUFFER_SIZE = 32768; 29 | EMPTY_DOCUMENT: array [0 .. 4] of Byte = (5, 0, 0, 0, 0); 30 | private 31 | FHost: String; 32 | FPort: Integer; 33 | FSettings: TUgarMongoProtocolSettings; 34 | FNextRequestId: Integer; 35 | FConnection: TgoSocketConnection; 36 | FConnectionLock: TCriticalSection; 37 | FCompletedReplies: TDictionary; 38 | FPartialReplies: TDictionary; 39 | FRepliesLock: TCriticalSection; 40 | FRecvBuffer: TBytes; 41 | FRecvSize: Integer; 42 | FRecvBufferLock: TCriticalSection; 43 | private 44 | procedure Send(const AData: TBytes); 45 | function WaitForReply(const ARequestId: Integer): IUgarMongoReply; 46 | function TryGetReply(const ARequestId: Integer; out AReply: IUgarMongoReply): Boolean; inline; 47 | function LastPartialReply(const ARequestId: Integer; out ALastRecv: TDateTime): Boolean; 48 | function OpReplyValid(out AIndex: Integer): Boolean; 49 | function OpReplyMsgHeader(out AMsgHeader): Boolean; 50 | private 51 | { Connection } 52 | function Connect: Boolean; 53 | function IsConnected: Boolean; 54 | function ConnectionState: TgoConnectionState; inline; 55 | private 56 | { Socket events } 57 | procedure SocketConnected; 58 | procedure SocketDisconnected; 59 | procedure SocketRecv(const ABuffer: Pointer; const ASize: Integer); 60 | public 61 | constructor Create(const AHost: String; const APort: Integer; const ASettings: TUgarMongoProtocolSettings); 62 | destructor Destroy; override; 63 | 64 | function OpQuery( 65 | const AFullCollectionName: UTF8String; 66 | const AFlags: TUgarMongoQueryFlags; 67 | const ANumberToSkip, 68 | ANumberToReturn: Integer; 69 | const AQuery: TBytes; 70 | const AReturnFieldsSelector: TBytes = nil): IUgarMongoReply; 71 | 72 | function OpGetMore( 73 | const AFullCollectionName: UTF8String; 74 | const ANumberToReturn: Integer; 75 | const ACursorId: Int64): IUgarMongoReply; 76 | end; 77 | 78 | implementation 79 | 80 | uses 81 | System.DateUtils, 82 | Grijjy.SysUtils; 83 | 84 | var 85 | FClientSocketManager: TgoClientSocketManager; 86 | 87 | function TUgarMongoProtocol.Connect: Boolean; 88 | var 89 | Connection: TgoSocketConnection; 90 | 91 | procedure WaitForConnected; 92 | var 93 | Start: TDateTime; 94 | begin 95 | Start := Now; 96 | while (MillisecondsBetween(Now, Start) < FSettings.ConnectionTimeout) and 97 | (FConnection.State <> TgoConnectionState.Connected) do 98 | Sleep(5); 99 | end; 100 | 101 | begin 102 | FConnectionLock.Acquire; 103 | try 104 | Connection := FConnection; 105 | FConnection := FClientSocketManager.Request(FHost, FPort); 106 | FConnection.OnConnected := SocketConnected; 107 | FConnection.OnDisconnected := SocketDisconnected; 108 | FConnection.OnRecv := SocketRecv; 109 | finally 110 | FConnectionLock.Release; 111 | end; 112 | 113 | if (Connection <> nil) then 114 | FClientSocketManager.Release(Connection); 115 | 116 | Result := (ConnectionState = TgoConnectionState.Connected); 117 | if (not Result) then 118 | begin 119 | FConnectionLock.Acquire; 120 | try 121 | if FConnection.Connect then 122 | WaitForConnected; 123 | finally 124 | FConnectionLock.Release; 125 | end; 126 | Result := (ConnectionState = TgoConnectionState.Connected); 127 | end; 128 | end; 129 | 130 | function TUgarMongoProtocol.ConnectionState: TgoConnectionState; 131 | begin 132 | FConnectionLock.Acquire; 133 | try 134 | if (FConnection <> nil) then 135 | Result := FConnection.State 136 | else 137 | Result := TgoConnectionState.Disconnected; 138 | finally 139 | FConnectionLock.Release; 140 | end; 141 | end; 142 | 143 | constructor TUgarMongoProtocol.Create(const AHost: String; const APort: Integer; 144 | const ASettings: TUgarMongoProtocolSettings); 145 | begin 146 | Assert(AHost <> ''); 147 | Assert(APort <> 0); 148 | inherited Create; 149 | FHost := AHost; 150 | FPort := APort; 151 | FSettings := ASettings; 152 | FConnectionLock := TCriticalSection.Create; 153 | FRepliesLock := TCriticalSection.Create; 154 | FRecvBufferLock := TCriticalSection.Create; 155 | FCompletedReplies := TDictionary.Create; 156 | FPartialReplies := TDictionary.Create; 157 | SetLength(FRecvBuffer, RECV_BUFFER_SIZE); 158 | end; 159 | 160 | destructor TUgarMongoProtocol.Destroy; 161 | var 162 | Connection: TgoSocketConnection; 163 | begin 164 | if (FConnectionLock <> nil) then 165 | begin 166 | FConnectionLock.Acquire; 167 | try 168 | Connection := FConnection; 169 | FConnection := nil; 170 | finally 171 | FConnectionLock.Release; 172 | end; 173 | end 174 | else 175 | begin 176 | Connection := FConnection; 177 | FConnection := nil; 178 | end; 179 | 180 | if (Connection <> nil) and (FClientSocketManager <> nil) then 181 | FClientSocketManager.Release(Connection); 182 | 183 | if (FRepliesLock <> nil) then 184 | begin 185 | FRepliesLock.Acquire; 186 | try 187 | FCompletedReplies.Free; 188 | FPartialReplies.Free; 189 | finally 190 | FRepliesLock.Release; 191 | end; 192 | end; 193 | 194 | FRepliesLock.Free; 195 | FConnectionLock.Free; 196 | FRecvBufferLock.Free; 197 | inherited; 198 | end; 199 | 200 | function TUgarMongoProtocol.IsConnected: Boolean; 201 | begin 202 | Result := (ConnectionState = TgoConnectionState.Connected); 203 | if (not Result) then 204 | Result := Connect; 205 | end; 206 | 207 | function TUgarMongoProtocol.LastPartialReply(const ARequestId: Integer; out ALastRecv: TDateTime): Boolean; 208 | begin 209 | FRepliesLock.Acquire; 210 | try 211 | Result := FPartialReplies.TryGetValue(ARequestId, ALastRecv); 212 | finally 213 | FRepliesLock.Release; 214 | end; 215 | end; 216 | 217 | function TUgarMongoProtocol.OpGetMore(const AFullCollectionName: UTF8String; const ANumberToReturn: Integer; 218 | const ACursorId: Int64): IUgarMongoReply; 219 | { https://docs.mongodb.com/manual/reference/mongodb-wire-protocol/#op-get-more } 220 | var 221 | Header: TMsgHeader; 222 | Data: TgoByteBuffer; 223 | I: Integer; 224 | begin 225 | Header.MessageLength := SizeOf(TMsgHeader) + 16 + Length(AFullCollectionName) + 1; 226 | Header.RequestID := AtomicIncrement(FNextRequestId); 227 | Header.ResponseTo := 0; 228 | Header.OpCode := OP_GET_MORE; 229 | 230 | Data := TgoByteBuffer.Create(Header.MessageLength); 231 | try 232 | Data.AppendBuffer(Header, SizeOf(TMsgHeader)); 233 | I := 0; 234 | Data.AppendBuffer(I, SizeOf(Int32)); // Reserved 235 | Data.AppendBuffer(AFullCollectionName[Low(UTF8String)], Length(AFullCollectionName) + 1); 236 | Data.AppendBuffer(ANumberToReturn, SizeOf(Int32)); 237 | Data.AppendBuffer(ACursorId, SizeOf(Int64)); 238 | Send(Data.ToBytes); 239 | finally 240 | Data.Free; 241 | end; 242 | Result := WaitForReply(Header.RequestID); 243 | end; 244 | 245 | function TUgarMongoProtocol.OpQuery(const AFullCollectionName: UTF8String; const AFlags: TUgarMongoQueryFlags; 246 | const ANumberToSkip, ANumberToReturn: Integer; const AQuery, AReturnFieldsSelector: TBytes): IUgarMongoReply; 247 | { https://docs.mongodb.com/manual/reference/mongodb-wire-protocol/#wire-op-query } 248 | var 249 | Header: TMsgHeader; 250 | Data: TgoByteBuffer; 251 | I: Int32; 252 | begin 253 | Header.MessageLength := SizeOf(TMsgHeader) + 12 + Length(AFullCollectionName) + 1 + Length(AQuery) + 254 | Length(AReturnFieldsSelector); 255 | if (AQuery = nil) then 256 | Inc(Header.MessageLength, Length(EMPTY_DOCUMENT)); 257 | Header.RequestID := AtomicIncrement(FNextRequestId); 258 | Header.ResponseTo := 0; 259 | Header.OpCode := OP_QUERY; 260 | 261 | Data := TgoByteBuffer.Create(Header.MessageLength); 262 | try 263 | Data.AppendBuffer(Header, SizeOf(TMsgHeader)); 264 | I := Byte(AFlags); 265 | Data.AppendBuffer(I, SizeOf(Int32)); 266 | Data.AppendBuffer(AFullCollectionName[Low(UTF8String)], Length(AFullCollectionName) + 1); 267 | Data.AppendBuffer(ANumberToSkip, SizeOf(Int32)); 268 | Data.AppendBuffer(ANumberToReturn, SizeOf(Int32)); 269 | if (AQuery <> nil) then 270 | Data.Append(AQuery) 271 | else 272 | Data.Append(EMPTY_DOCUMENT); 273 | if (AReturnFieldsSelector <> nil) then 274 | Data.Append(AReturnFieldsSelector); 275 | 276 | TMonitor.Enter(Self); 277 | Send(Data.ToBytes); 278 | finally 279 | Data.Free; 280 | end; 281 | Result := WaitForReply(Header.RequestID); 282 | TMonitor.Exit(Self); 283 | end; 284 | 285 | function TUgarMongoProtocol.OpReplyMsgHeader(out AMsgHeader): Boolean; 286 | begin 287 | Result := (FRecvSize >= SizeOf(TMsgHeader)); 288 | if (Result) then 289 | Move(FRecvBuffer[0], AMsgHeader, SizeOf(TMsgHeader)); 290 | end; 291 | 292 | function TUgarMongoProtocol.OpReplyValid(out AIndex: Integer): Boolean; 293 | // https://docs.mongodb.com/manual/reference/mongodb-wire-protocol/#wire-op-reply 294 | var 295 | Header: POpReplyHeader; 296 | Size: Int32; 297 | NumberReturned: Integer; 298 | begin 299 | AIndex := 0; 300 | if (FRecvSize >= SizeOf(TOpReplyHeader)) then { minimum size } 301 | begin 302 | Header := @FRecvBuffer[0]; 303 | if (Header.NumberReturned = 0) then 304 | begin 305 | AIndex := SizeOf(TOpReplyHeader); 306 | Result := True; { no documents, ok } 307 | end 308 | else 309 | begin 310 | { Make sure we have all the documents } 311 | NumberReturned := Header.NumberReturned; 312 | AIndex := SizeOf(TOpReplyHeader); 313 | repeat 314 | if (FRecvSize >= (AIndex + SizeOf(Int32))) then 315 | begin 316 | Move(FRecvBuffer[AIndex], Size, SizeOf(Int32)); 317 | if (FRecvSize >= (AIndex + Size)) then 318 | begin 319 | Dec(NumberReturned); 320 | AIndex := AIndex + Size; { next } 321 | end 322 | else 323 | Break; 324 | end 325 | else 326 | Break; 327 | until (NumberReturned = 0); 328 | Result := (NumberReturned = 0); { all documents, ok } 329 | end; 330 | end 331 | else 332 | Result := False; 333 | end; 334 | 335 | procedure TUgarMongoProtocol.Send(const AData: TBytes); 336 | begin 337 | if IsConnected then 338 | begin 339 | FConnectionLock.Acquire; 340 | try 341 | if (FConnection <> nil) then 342 | FConnection.Send(AData); 343 | finally 344 | FConnectionLock.Release; 345 | end; 346 | end; 347 | end; 348 | 349 | procedure TUgarMongoProtocol.SocketConnected; 350 | begin 351 | { Not interested (yet) } 352 | end; 353 | 354 | procedure TUgarMongoProtocol.SocketDisconnected; 355 | begin 356 | { Not interested (yet) } 357 | end; 358 | 359 | procedure TUgarMongoProtocol.SocketRecv(const ABuffer: Pointer; const ASize: Integer); 360 | var 361 | MongoReply: IUgarMongoReply; 362 | Index: Integer; 363 | MsgHeader: TMsgHeader; 364 | begin 365 | FRecvBufferLock.Enter; 366 | try 367 | { Expand the buffer if we are at capacity } 368 | if (FRecvSize + ASize >= Length(FRecvBuffer)) then 369 | SetLength(FRecvBuffer, (FRecvSize + ASize) * 2); 370 | 371 | { Append the new buffer } 372 | Move(ABuffer^, FRecvBuffer[FRecvSize], ASize); 373 | FRecvSize := FRecvSize + ASize; 374 | 375 | { Is there one or more valid replies pending? } 376 | while True do 377 | begin 378 | if OpReplyValid(Index) then 379 | begin 380 | MongoReply := TUgarMongoReply.Create(FRecvBuffer, FRecvSize); 381 | 382 | FRepliesLock.Acquire; 383 | try 384 | { Remove the partial reply timestamp } 385 | FPartialReplies.Remove(MongoReply.ResponseTo); 386 | 387 | { Add the completed reply to the dictionary } 388 | FCompletedReplies.Add(MongoReply.ResponseTo, MongoReply); 389 | finally 390 | FRepliesLock.Release; 391 | end; 392 | 393 | { Shift the receive buffer, if needed } 394 | if (Index = FRecvSize) then 395 | FRecvSize := 0 396 | else 397 | Move(FRecvBuffer[Index], FRecvBuffer[0], FRecvSize - Index); 398 | end 399 | else 400 | begin 401 | { Update the partial reply timestamp } 402 | if OpReplyMsgHeader(MsgHeader) then 403 | begin 404 | FRepliesLock.Acquire; 405 | try 406 | FPartialReplies.AddOrSetValue(MsgHeader.ResponseTo, Now); 407 | finally 408 | FRepliesLock.Release; 409 | end; 410 | end; 411 | Break; 412 | end; 413 | end; 414 | finally 415 | FRecvBufferLock.Leave; 416 | end; 417 | end; 418 | 419 | function TUgarMongoProtocol.TryGetReply(const ARequestId: Integer; out AReply: IUgarMongoReply): Boolean; 420 | begin 421 | FRepliesLock.Acquire; 422 | try 423 | Result := FCompletedReplies.TryGetValue(ARequestId, AReply); 424 | finally 425 | FRepliesLock.Release; 426 | end; 427 | end; 428 | 429 | function TUgarMongoProtocol.WaitForReply(const ARequestId: Integer): IUgarMongoReply; 430 | var 431 | LastRecv: TDateTime; 432 | begin 433 | Result := nil; 434 | while (ConnectionState = TgoConnectionState.Connected) and (not TryGetReply(ARequestId, Result)) do 435 | begin 436 | if LastPartialReply(ARequestId, LastRecv) and (MillisecondsBetween(Now, LastRecv) > FSettings.ReplyTimeout) then 437 | Break; 438 | Sleep(5); 439 | end; 440 | 441 | if (Result = nil) then 442 | TryGetReply(ARequestId, Result); 443 | end; 444 | 445 | initialization 446 | FClientSocketManager := TgoClientSocketManager.Create(TgoSocketOptimization.Scale, 447 | TgoSocketPoolBehavior.PoolAndReuse, 100); 448 | 449 | finalization 450 | 451 | FreeAndNil(FClientSocketManager); 452 | 453 | end. 454 | -------------------------------------------------------------------------------- /src/ugar.db.mongo.Query.pas: -------------------------------------------------------------------------------- 1 | unit ugar.db.mongo.Query; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, ugar.db.mongo.Enum; 7 | 8 | type 9 | TUgarTextSearchOption = (CaseSensitive, DiacriticSensitive); 10 | TUgarTextSearchOptions = set of TUgarTextSearchOption; 11 | 12 | TUgarFilter = record 13 | private type 14 | IFilter = interface 15 | ['{BAE9502F-7FC3-4AB4-B35F-AEA09F8BC0DB}'] 16 | function Render: TUgarBsonDocument; 17 | function ToBson: TBytes; 18 | function ToJson(const ASettings: TUgarJsonWriterSettings): String; 19 | end; 20 | private 21 | class var FEmpty: TUgarFilter; 22 | private 23 | FImpl: IFilter; 24 | public 25 | class constructor Create; 26 | public 27 | class operator Implicit(const AJson: String): TUgarFilter; static; 28 | class operator Implicit(const ADocument: TUgarBsonDocument): TUgarFilter; static; 29 | function IsNil: Boolean; inline; 30 | procedure SetNil; inline; 31 | function Render: TUgarBsonDocument; inline; 32 | function ToBson: TBytes; inline; 33 | function ToJson: String; overload; inline; 34 | function ToJson(const ASettings: TUgarJsonWriterSettings): String; overload; inline; 35 | class property Empty: TUgarFilter read FEmpty; 36 | public 37 | class function Eq(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; static; 38 | class function Ne(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; static; 39 | class function Lt(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; static; 40 | class function Lte(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; static; 41 | class function Gt(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; static; 42 | class function Gte(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; static; 43 | public 44 | class operator LogicalAnd(const ALeft, ARight: TUgarFilter): TUgarFilter; static; 45 | class operator LogicalOr(const ALeft, ARight: TUgarFilter): TUgarFilter; static; 46 | class operator LogicalNot(const AOperand: TUgarFilter): TUgarFilter; static; 47 | class function &And(const AFilter1, AFilter2: TUgarFilter): TUgarFilter; overload; static; 48 | class function &And(const AFilters: array of TUgarFilter): TUgarFilter; overload; static; 49 | class function &Or(const AFilter1, AFilter2: TUgarFilter): TUgarFilter; overload; static; 50 | class function &Or(const AFilters: array of TUgarFilter): TUgarFilter; overload; static; 51 | class function &Not(const AOperand: TUgarFilter): TUgarFilter; static; 52 | public 53 | class function Exists(const AFieldName: String; const AExists: Boolean = True): TUgarFilter; static; 54 | class function &Type(const AFieldName: String; const AType: TUgarBsonType): TUgarFilter; overload; static; 55 | class function &Type(const AFieldName, AType: String): TUgarFilter; overload; static; 56 | public 57 | class function &Mod(const AFieldName: String; const ADivisor, ARemainder: Int64): TUgarFilter; static; 58 | class function Regex(const AFieldName: String; const ARegex: TUgarBsonRegularExpression): TUgarFilter; static; 59 | class function Text(const AText: String; const AOptions: TUgarTextSearchOptions = []; const ALanguage: String = ''): TUgarFilter; static; 60 | public 61 | class function AnyEq(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; static; 62 | class function AnyNe(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; static; 63 | class function AnyLt(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; static; 64 | class function AnyLte(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; static; 65 | class function AnyGt(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; static; 66 | class function AnyGte(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; static; 67 | class function All(const AFieldName: String; const AValues: TArray): TUgarFilter; overload; static; 68 | class function All(const AFieldName: String; const AValues: array of TUgarBsonValue): TUgarFilter; overload; static; 69 | class function All(const AFieldName: String; const AValues: TUgarBsonArray): TUgarFilter; overload; static; 70 | class function &In(const AFieldName: String; const AValues: TArray): TUgarFilter; overload; static; 71 | class function &In(const AFieldName: String; const AValues: array of TUgarBsonValue): TUgarFilter; overload; static; 72 | class function &In(const AFieldName: String; const AValues: TUgarBsonArray): TUgarFilter; overload; static; 73 | class function Nin(const AFieldName: String; const AValues: TArray): TUgarFilter; overload; static; 74 | class function Nin(const AFieldName: String; const AValues: array of TUgarBsonValue): TUgarFilter; overload; static; 75 | class function Nin(const AFieldName: String; const AValues: TUgarBsonArray): TUgarFilter; overload; static; 76 | class function ElemMatch(const AFieldName: String; const AFilter: TUgarFilter): TUgarFilter; overload; static; 77 | class function Size(const AFieldName: String; const ASize: Integer): TUgarFilter; overload; static; 78 | class function SizeGt(const AFieldName: String; const ASize: Integer): TUgarFilter; overload; static; 79 | class function SizeGte(const AFieldName: String; const ASize: Integer): TUgarFilter; overload; static; 80 | class function SizeLt(const AFieldName: String; const ASize: Integer): TUgarFilter; overload; static; 81 | class function SizeLte(const AFieldName: String; const ASize: Integer): TUgarFilter; overload; static; 82 | public 83 | class function BitsAllClear(const AFieldName: String; const ABitMask: UInt64): TUgarFilter; static; 84 | class function BitsAllSet(const AFieldName: String; const ABitMask: UInt64): TUgarFilter; static; 85 | class function BitsAnyClear(const AFieldName: String; const ABitMask: UInt64): TUgarFilter; static; 86 | class function BitsAnySet(const AFieldName: String; const ABitMask: UInt64): TUgarFilter; static; 87 | end; 88 | 89 | TUgarProjection = record 90 | private type 91 | IProjection = interface 92 | ['{060E413F-6B4E-4FFE-83EF-5A124BC914DB}'] 93 | function Render: TUgarBsonDocument; 94 | function ToBson: TBytes; 95 | function ToJson(const ASettings: TUgarJsonWriterSettings): String; 96 | end; 97 | private 98 | FImpl: IProjection; 99 | class function GetEmpty: TUgarProjection; static; inline; 100 | public 101 | class operator Implicit(const AJson: String): TUgarProjection; static; 102 | class operator Implicit(const ADocument: TUgarBsonDocument): TUgarProjection; static; 103 | class operator Add(const ALeft, ARight: TUgarProjection): TUgarProjection; static; 104 | function IsNil: Boolean; inline; 105 | procedure SetNil; inline; 106 | function Render: TUgarBsonDocument; inline; 107 | function ToBson: TBytes; inline; 108 | function ToJson: String; overload; inline; 109 | function ToJson(const ASettings: TUgarJsonWriterSettings): String; overload; inline; 110 | class property Empty: TUgarProjection read GetEmpty; 111 | public 112 | class function Combine(const AProjection1, AProjection2: TUgarProjection): TUgarProjection; 113 | overload; static; 114 | class function Combine(const AProjections: array of TUgarProjection): TUgarProjection; overload; static; 115 | class function Include(const AFieldName: String): TUgarProjection; overload; static; 116 | class function Include(const AFieldNames: array of String): TUgarProjection; overload; static; 117 | class function Exclude(const AFieldName: String): TUgarProjection; overload; static; 118 | class function Exclude(const AFieldNames: array of String): TUgarProjection; overload; static; 119 | class function ElemMatch(const AFieldName: String; const AFilter: TUgarFilter): TUgarProjection; static; 120 | class function MetaTextScore(const AFieldName: String): TUgarProjection; static; 121 | class function Slice(const AFieldName: String; const ALimit: Integer): TUgarProjection; overload; static; 122 | class function Slice(const AFieldName: String; const ASkip, ALimit: Integer): TUgarProjection; 123 | overload; static; 124 | end; 125 | 126 | TUgarSortDirection = (Ascending, Descending); 127 | 128 | TUgarSort = record 129 | private type 130 | ISort = interface 131 | ['{FB526276-76F3-4F67-90C9-F09010FE8F37}'] 132 | function Render: TUgarBsonDocument; 133 | function ToBson: TBytes; 134 | function ToJson(const ASettings: TUgarJsonWriterSettings): String; 135 | end; 136 | private 137 | FImpl: ISort; 138 | public 139 | class operator Implicit(const AJson: String): TUgarSort; static; 140 | class operator Implicit(const ADocument: TUgarBsonDocument): TUgarSort; static; 141 | class operator Add(const ALeft, ARight: TUgarSort): TUgarSort; static; 142 | function IsNil: Boolean; inline; 143 | procedure SetNil; inline; 144 | function Render: TUgarBsonDocument; inline; 145 | function ToBson: TBytes; inline; 146 | function ToJson: String; overload; inline; 147 | function ToJson(const ASettings: TUgarJsonWriterSettings): String; overload; inline; 148 | public 149 | class function Combine(const ASort1, ASort2: TUgarSort): TUgarSort; overload; static; 150 | class function Combine(const ASorts: array of TUgarSort): TUgarSort; overload; static; 151 | class function Ascending(const AFieldName: String): TUgarSort; static; 152 | class function Descending(const AFieldName: String): TUgarSort; static; 153 | class function MetaTextScore(const AFieldName: String): TUgarSort; static; 154 | end; 155 | 156 | TUgarCurrentDateType = (Default, Date, Timestamp); 157 | 158 | TUgarUpdate = record 159 | public const 160 | NO_SLICE = Integer.MaxValue; 161 | NO_POSITION = Integer.MaxValue; 162 | private type 163 | IUpdate = interface 164 | ['{9FC6C8B5-B4BA-445F-A960-67FBDF8613F4}'] 165 | function Render: TUgarBsonDocument; 166 | function ToBson: TBytes; 167 | function ToJson(const ASettings: TUgarJsonWriterSettings): String; 168 | function IsCombine: Boolean; 169 | end; 170 | private 171 | FImpl: IUpdate; 172 | private 173 | function SetOrCombine(const AUpdate: IUpdate): IUpdate; 174 | public 175 | class function Init: TUgarUpdate; inline; static; 176 | class operator Implicit(const AJson: String): TUgarUpdate; static; 177 | class operator Implicit(const ADocument: TUgarBsonDocument): TUgarUpdate; static; 178 | function IsNil: Boolean; inline; 179 | procedure SetNil; inline; 180 | function Render: TUgarBsonDocument; inline; 181 | function ToBson: TBytes; inline; 182 | function ToJson: String; overload; inline; 183 | function ToJson(const ASettings: TUgarJsonWriterSettings): String; overload; inline; 184 | public 185 | function &Set(const AFieldName: String; const AValue: TUgarBsonValue): TUgarUpdate; 186 | function SetOnInsert(const AFieldName: String; const AValue: TUgarBsonValue): TUgarUpdate; 187 | function Unset(const AFieldName: String): TUgarUpdate; 188 | function Inc(const AFieldName: String; const AAmount: TUgarBsonValue): TUgarUpdate; overload; 189 | function Inc(const AFieldName: String): TUgarUpdate; overload; 190 | function Mul(const AFieldName: String; const AAmount: TUgarBsonValue): TUgarUpdate; 191 | function Max(const AFieldName: String; const AValue: TUgarBsonValue): TUgarUpdate; 192 | function Min(const AFieldName: String; const AValue: TUgarBsonValue): TUgarUpdate; 193 | function CurrentDate(const AFieldName: String; const AType: TUgarCurrentDateType = TUgarCurrentDateType. 194 | Default): TUgarUpdate; 195 | function Rename(const AFieldName, ANewName: String): TUgarUpdate; 196 | public 197 | function AddToSet(const AFieldName: String; const AValue: TUgarBsonValue): TUgarUpdate; 198 | function AddToSetEach(const AFieldName: String; const AValues: array of TUgarBsonValue): TUgarUpdate; 199 | function PopFirst(const AFieldName: String): TUgarUpdate; 200 | function PopLast(const AFieldName: String): TUgarUpdate; 201 | function Pull(const AFieldName: String; const AValue: TUgarBsonValue): TUgarUpdate; 202 | function PullFilter(const AFieldName: String; const AFilter: TUgarFilter): TUgarUpdate; 203 | function PullAll(const AFieldName: String; const AValues: array of TUgarBsonValue): TUgarUpdate; 204 | function Push(const AFieldName: String; const AValue: TUgarBsonValue): TUgarUpdate; 205 | function PushEach(const AFieldName: String; const AValues: array of TUgarBsonValue; 206 | const ASlice: Integer = NO_SLICE; const APosition: Integer = NO_POSITION): TUgarUpdate; overload; 207 | function PushEach(const AFieldName: String; const AValues: array of TUgarBsonValue; const ASort: TUgarSort; 208 | const ASlice: Integer = NO_SLICE; const APosition: Integer = NO_POSITION): TUgarUpdate; overload; 209 | public 210 | function BitwiseAnd(const AFieldName: String; const AValue: TUgarBsonValue): TUgarUpdate; 211 | function BitwiseOr(const AFieldName: String; const AValue: TUgarBsonValue): TUgarUpdate; 212 | function BitwiseXor(const AFieldName: String; const AValue: TUgarBsonValue): TUgarUpdate; 213 | end; 214 | 215 | implementation 216 | 217 | uses 218 | Grijjy.Bson, Grijjy.Bson.IO; 219 | 220 | type 221 | TBuilder = class abstract(TInterfacedObject) 222 | protected 223 | class function SupportsWriter: Boolean; virtual; 224 | procedure Write(const AWriter: IUgarBsonBaseWriter); virtual; 225 | function Build: TUgarBsonDocument; virtual; 226 | protected 227 | function Render: TUgarBsonDocument; 228 | function ToBson: TBytes; 229 | function ToJson(const ASettings: TUgarJsonWriterSettings): String; 230 | end; 231 | 232 | type 233 | TFilter = class abstract(TBuilder, TUgarFilter.IFilter) 234 | end; 235 | 236 | type 237 | TFilterEmpty = class(TFilter) 238 | protected 239 | function Build: TUgarBsonDocument; override; 240 | end; 241 | 242 | type 243 | TFilterJson = class(TFilter) 244 | private 245 | FJson: String; 246 | protected 247 | function Build: TUgarBsonDocument; override; 248 | public 249 | constructor Create(const AJson: String); 250 | end; 251 | 252 | type 253 | TFilterBsonDocument = class(TFilter) 254 | private 255 | FDocument: TUgarBsonDocument; 256 | protected 257 | function Build: TUgarBsonDocument; override; 258 | public 259 | constructor Create(const ADocument: TUgarBsonDocument); 260 | end; 261 | 262 | type 263 | TFilterSimple = class(TFilter) 264 | private 265 | FFieldName: String; 266 | FValue: TUgarBsonValue; 267 | protected 268 | class function SupportsWriter: Boolean; override; 269 | procedure Write(const AWriter: IUgarBsonBaseWriter); override; 270 | public 271 | constructor Create(const AFieldName: String; const AValue: TUgarBsonValue); 272 | end; 273 | 274 | type 275 | TFilterOperator = class(TFilter) 276 | private 277 | FFieldName: String; 278 | FOperator: String; 279 | FValue: TUgarBsonValue; 280 | protected 281 | class function SupportsWriter: Boolean; override; 282 | procedure Write(const AWriter: IUgarBsonBaseWriter); override; 283 | public 284 | constructor Create(const AFieldName, AOperator: String; const AValue: TUgarBsonValue); 285 | end; 286 | 287 | type 288 | TFilterArrayOperator = class(TFilter) 289 | private 290 | FFieldName: String; 291 | FOperator: String; 292 | FValues: TUgarBsonArray; 293 | protected 294 | class function SupportsWriter: Boolean; override; 295 | procedure Write(const AWriter: IUgarBsonBaseWriter); override; 296 | public 297 | constructor Create(const AFieldName, AOperator: String; const AValues: TUgarBsonArray); 298 | end; 299 | 300 | type 301 | TFilterArrayIndexExists = class(TFilter) 302 | private 303 | FFieldName: String; 304 | FIndex: Integer; 305 | FExists: Boolean; 306 | protected 307 | class function SupportsWriter: Boolean; override; 308 | procedure Write(const AWriter: IUgarBsonBaseWriter); override; 309 | public 310 | constructor Create(const AFieldName: String; const AIndex: Integer; const AExists: Boolean); 311 | end; 312 | 313 | type 314 | TFilterAnd = class(TFilter) 315 | private 316 | FFilters: TArray; 317 | private 318 | class procedure AddClause(const ADocument: TUgarBsonDocument; const AClause: TUgarBsonElement); static; 319 | class procedure PromoteFilterToDollarForm(const ADocument: TUgarBsonDocument; 320 | const AClause: TUgarBsonElement); static; 321 | protected 322 | function Build: TUgarBsonDocument; override; 323 | public 324 | constructor Create(const AFilter1, AFilter2: TUgarFilter); overload; 325 | constructor Create(const AFilters: array of TUgarFilter); overload; 326 | end; 327 | 328 | type 329 | TFilterOr = class(TFilter) 330 | private 331 | FFilters: TArray; 332 | private 333 | class procedure AddClause(const AClauses: TUgarBsonArray; const AFilter: TUgarBsonDocument); static; 334 | protected 335 | function Build: TUgarBsonDocument; override; 336 | public 337 | constructor Create(const AFilter1, AFilter2: TUgarFilter); overload; 338 | constructor Create(const AFilters: array of TUgarFilter); overload; 339 | end; 340 | 341 | type 342 | TFilterNot = class(TFilter) 343 | private 344 | FFilter: TUgarFilter.IFilter; 345 | private 346 | class function NegateArbitraryFilter(const AFilter: TUgarBsonDocument): TUgarBsonDocument; static; 347 | class function NegateSingleElementFilter(const AFilter: TUgarBsonDocument; const AElement: TUgarBsonElement) 348 | : TUgarBsonDocument; static; 349 | class function NegateSingleElementTopLevelOperatorFilter(const AFilter: TUgarBsonDocument; 350 | const AElement: TUgarBsonElement): TUgarBsonDocument; static; 351 | class function NegateSingleFieldOperatorFilter(const AFieldName: String; const AElement: TUgarBsonElement) 352 | : TUgarBsonDocument; static; 353 | protected 354 | function Build: TUgarBsonDocument; override; 355 | public 356 | constructor Create(const AOperand: TUgarFilter); 357 | end; 358 | 359 | type 360 | TFilterElementMatch = class(TFilter) 361 | private 362 | FFieldName: String; 363 | FFilter: TUgarFilter.IFilter; 364 | protected 365 | function Build: TUgarBsonDocument; override; 366 | public 367 | constructor Create(const AFieldName: String; const AFilter: TUgarFilter); 368 | end; 369 | 370 | type 371 | TProjection = class abstract(TBuilder, TUgarProjection.IProjection) 372 | end; 373 | 374 | type 375 | TProjectionJson = class(TProjection) 376 | private 377 | FJson: String; 378 | protected 379 | function Build: TUgarBsonDocument; override; 380 | public 381 | constructor Create(const AJson: String); 382 | end; 383 | 384 | type 385 | TProjectionBsonDocument = class(TProjection) 386 | private 387 | FDocument: TUgarBsonDocument; 388 | protected 389 | function Build: TUgarBsonDocument; override; 390 | public 391 | constructor Create(const ADocument: TUgarBsonDocument); 392 | end; 393 | 394 | type 395 | TProjectionSingleField = class(TProjection) 396 | private 397 | FFieldName: String; 398 | FValue: TUgarBsonValue; 399 | protected 400 | class function SupportsWriter: Boolean; override; 401 | procedure Write(const AWriter: IUgarBsonBaseWriter); override; 402 | public 403 | constructor Create(const AFieldName: String; const AValue: TUgarBsonValue); 404 | end; 405 | 406 | type 407 | TProjectionMultipleFields = class(TProjection) 408 | private 409 | FFieldNames: TArray; 410 | FValue: Integer; 411 | protected 412 | class function SupportsWriter: Boolean; override; 413 | procedure Write(const AWriter: IUgarBsonBaseWriter); override; 414 | public 415 | constructor Create(const AFieldNames: array of String; const AValue: Integer); 416 | end; 417 | 418 | type 419 | TProjectionCombine = class(TProjection) 420 | private 421 | FProjections: TArray; 422 | protected 423 | function Build: TUgarBsonDocument; override; 424 | public 425 | constructor Create(const AProjection1, AProjection2: TUgarProjection); overload; 426 | constructor Create(const AProjections: array of TUgarProjection); overload; 427 | end; 428 | 429 | type 430 | TProjectionElementMatch = class(TProjection) 431 | private 432 | FFieldName: String; 433 | FFilter: TUgarFilter.IFilter; 434 | protected 435 | function Build: TUgarBsonDocument; override; 436 | public 437 | constructor Create(const AFieldName: String; const AFilter: TUgarFilter); 438 | end; 439 | 440 | type 441 | TSort = class abstract(TBuilder, TUgarSort.ISort) 442 | end; 443 | 444 | type 445 | TSortJson = class(TSort) 446 | private 447 | FJson: String; 448 | protected 449 | function Build: TUgarBsonDocument; override; 450 | public 451 | constructor Create(const AJson: String); 452 | end; 453 | 454 | type 455 | TSortBsonDocument = class(TSort) 456 | private 457 | FDocument: TUgarBsonDocument; 458 | protected 459 | function Build: TUgarBsonDocument; override; 460 | public 461 | constructor Create(const ADocument: TUgarBsonDocument); 462 | end; 463 | 464 | type 465 | TSortCombine = class(TSort) 466 | private 467 | FSorts: TArray; 468 | protected 469 | function Build: TUgarBsonDocument; override; 470 | public 471 | constructor Create(const ASort1, ASort2: TUgarSort); overload; 472 | constructor Create(const ASorts: array of TUgarSort); overload; 473 | end; 474 | 475 | type 476 | TSortDirectional = class(TSort) 477 | private 478 | FFieldName: String; 479 | FDirection: TUgarSortDirection; 480 | protected 481 | class function SupportsWriter: Boolean; override; 482 | procedure Write(const AWriter: IUgarBsonBaseWriter); override; 483 | public 484 | constructor Create(const AFieldName: String; const ADirection: TUgarSortDirection); 485 | end; 486 | 487 | type 488 | TUpdate = class abstract(TBuilder, TUgarUpdate.IUpdate) 489 | protected 490 | { TUgarUpdate.IUpdate } 491 | function IsCombine: Boolean; virtual; 492 | end; 493 | 494 | type 495 | TUpdateJson = class(TUpdate) 496 | private 497 | FJson: String; 498 | protected 499 | function Build: TUgarBsonDocument; override; 500 | public 501 | constructor Create(const AJson: String); 502 | end; 503 | 504 | type 505 | TUpdateBsonDocument = class(TUpdate) 506 | private 507 | FDocument: TUgarBsonDocument; 508 | protected 509 | function Build: TUgarBsonDocument; override; 510 | public 511 | constructor Create(const ADocument: TUgarBsonDocument); 512 | end; 513 | 514 | type 515 | TUpdateOperator = class(TUpdate) 516 | private 517 | FOperator: String; 518 | FFieldName: String; 519 | FValue: TUgarBsonValue; 520 | protected 521 | class function SupportsWriter: Boolean; override; 522 | procedure Write(const AWriter: IUgarBsonBaseWriter); override; 523 | public 524 | constructor Create(const AOperator, AFieldName: String; const AValue: TUgarBsonValue); 525 | end; 526 | 527 | type 528 | TUpdateBitwiseOperator = class(TUpdate) 529 | private 530 | FOperator: String; 531 | FFieldName: String; 532 | FValue: TUgarBsonValue; 533 | protected 534 | class function SupportsWriter: Boolean; override; 535 | procedure Write(const AWriter: IUgarBsonBaseWriter); override; 536 | public 537 | constructor Create(const AOperator, AFieldName: String; const AValue: TUgarBsonValue); 538 | end; 539 | 540 | type 541 | TUpdateAddToSet = class(TUpdate) 542 | private 543 | FFieldName: String; 544 | FValues: TArray; 545 | protected 546 | class function SupportsWriter: Boolean; override; 547 | procedure Write(const AWriter: IUgarBsonBaseWriter); override; 548 | public 549 | constructor Create(const AFieldName: String; const AValue: TUgarBsonValue); overload; 550 | constructor Create(const AFieldName: String; const AValues: array of TUgarBsonValue); overload; 551 | end; 552 | 553 | type 554 | TUpdatePull = class(TUpdate) 555 | private 556 | FFieldName: String; 557 | FFilter: TUgarFilter; 558 | FValues: TArray; 559 | protected 560 | class function SupportsWriter: Boolean; override; 561 | procedure Write(const AWriter: IUgarBsonBaseWriter); override; 562 | public 563 | constructor Create(const AFieldName: String; const AValue: TUgarBsonValue); overload; 564 | constructor Create(const AFieldName: String; const AValues: array of TUgarBsonValue); overload; 565 | constructor Create(const AFieldName: String; const AFilter: TUgarFilter); overload; 566 | end; 567 | 568 | type 569 | TUpdatePush = class(TUpdate) 570 | private 571 | FFieldName: String; 572 | FValues: TArray; 573 | FSlice: Integer; 574 | FPosition: Integer; 575 | FSort: TUgarSort; 576 | protected 577 | class function SupportsWriter: Boolean; override; 578 | procedure Write(const AWriter: IUgarBsonBaseWriter); override; 579 | public 580 | constructor Create(const AFieldName: String; const AValue: TUgarBsonValue); overload; 581 | constructor Create(const AFieldName: String; const AValues: array of TUgarBsonValue; 582 | const ASlice, APosition: Integer; const ASort: TUgarSort); overload; 583 | end; 584 | 585 | type 586 | TUpdateCombine = class(TUpdate) 587 | private 588 | FUpdates: TArray; 589 | FCount: Integer; 590 | protected 591 | { TUgarUpdate.IUpdate } 592 | function IsCombine: Boolean; override; 593 | protected 594 | function Build: TUgarBsonDocument; override; 595 | public 596 | constructor Create(const AUpdate1, AUpdate2: TUgarUpdate.IUpdate); overload; 597 | constructor Create(const AUpdate1, AUpdate2: TUgarUpdate); overload; 598 | constructor Create(const AUpdates: array of TUgarUpdate); overload; 599 | procedure Add(const AUpdate: TUgarUpdate.IUpdate); 600 | end; 601 | 602 | { TUgarFilter } 603 | 604 | class function TUgarFilter.All(const AFieldName: String; const AValues: TArray): TUgarFilter; 605 | begin 606 | Result.FImpl := TFilterArrayOperator.Create(AFieldName, '$all', TUgarBsonArray.Create(AValues)); 607 | end; 608 | 609 | class function TUgarFilter.All(const AFieldName: String; const AValues: array of TUgarBsonValue): TUgarFilter; 610 | begin 611 | Result.FImpl := TFilterArrayOperator.Create(AFieldName, '$all', TUgarBsonArray.Create(AValues)); 612 | end; 613 | 614 | class function TUgarFilter.&Mod(const AFieldName: String; const ADivisor, ARemainder: Int64): TUgarFilter; 615 | begin 616 | Result.FImpl := TFilterOperator.Create(AFieldName, '$mod', TUgarBsonArray.Create([ADivisor, ARemainder])); 617 | end; 618 | 619 | class function TUgarFilter.Ne(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; 620 | begin 621 | Result.FImpl := TFilterOperator.Create(AFieldName, '$ne', AValue); 622 | end; 623 | 624 | class function TUgarFilter.Nin(const AFieldName: String; const AValues: TArray): TUgarFilter; 625 | begin 626 | Result.FImpl := TFilterArrayOperator.Create(AFieldName, '$nin', TUgarBsonArray.Create(AValues)); 627 | end; 628 | 629 | class function TUgarFilter.Nin(const AFieldName: String; const AValues: array of TUgarBsonValue): TUgarFilter; 630 | begin 631 | Result.FImpl := TFilterArrayOperator.Create(AFieldName, '$nin', TUgarBsonArray.Create(AValues)); 632 | end; 633 | 634 | class function TUgarFilter.Nin(const AFieldName: String; const AValues: TUgarBsonArray): TUgarFilter; 635 | begin 636 | Result.FImpl := TFilterArrayOperator.Create(AFieldName, '$nin', AValues); 637 | end; 638 | 639 | class function TUgarFilter.&Not(const AOperand: TUgarFilter): TUgarFilter; 640 | begin 641 | Result.FImpl := TFilterNot.Create(AOperand); 642 | end; 643 | 644 | class function TUgarFilter.&Or(const AFilter1, AFilter2: TUgarFilter): TUgarFilter; 645 | begin 646 | Result.FImpl := TFilterOr.Create(AFilter1, AFilter2); 647 | end; 648 | 649 | class function TUgarFilter.&Or(const AFilters: array of TUgarFilter): TUgarFilter; 650 | begin 651 | Result.FImpl := TFilterOr.Create(AFilters); 652 | end; 653 | 654 | class function TUgarFilter.&Type(const AFieldName: String; const AType: TUgarBsonType): TUgarFilter; 655 | begin 656 | Result.FImpl := TFilterOperator.Create(AFieldName, '$type', Ord(AType)); 657 | end; 658 | 659 | class function TUgarFilter.&Type(const AFieldName, AType: String): TUgarFilter; 660 | begin 661 | Result.FImpl := TFilterOperator.Create(AFieldName, '$type', AType); 662 | end; 663 | 664 | class function TUgarFilter.All(const AFieldName: String; const AValues: TUgarBsonArray): TUgarFilter; 665 | begin 666 | Result.FImpl := TFilterArrayOperator.Create(AFieldName, '$all', AValues); 667 | end; 668 | 669 | class function TUgarFilter.&And(const AFilter1, AFilter2: TUgarFilter): TUgarFilter; 670 | begin 671 | Result.FImpl := TFilterAnd.Create(AFilter1, AFilter2); 672 | end; 673 | 674 | class function TUgarFilter.&And(const AFilters: array of TUgarFilter): TUgarFilter; 675 | begin 676 | Result.FImpl := TFilterAnd.Create(AFilters); 677 | end; 678 | 679 | class function TUgarFilter.AnyEq(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; 680 | begin 681 | Result.FImpl := TFilterSimple.Create(AFieldName, AValue); 682 | end; 683 | 684 | class function TUgarFilter.AnyGt(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; 685 | begin 686 | Result.FImpl := TFilterOperator.Create(AFieldName, '$gt', AValue); 687 | end; 688 | 689 | class function TUgarFilter.AnyGte(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; 690 | begin 691 | Result.FImpl := TFilterOperator.Create(AFieldName, '$gte', AValue); 692 | end; 693 | 694 | class function TUgarFilter.AnyLt(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; 695 | begin 696 | Result.FImpl := TFilterOperator.Create(AFieldName, '$lt', AValue); 697 | end; 698 | 699 | class function TUgarFilter.AnyLte(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; 700 | begin 701 | Result.FImpl := TFilterOperator.Create(AFieldName, '$lte', AValue); 702 | end; 703 | 704 | class function TUgarFilter.AnyNe(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; 705 | begin 706 | Result.FImpl := TFilterOperator.Create(AFieldName, '$ne', AValue); 707 | end; 708 | 709 | class function TUgarFilter.BitsAllClear(const AFieldName: String; const ABitMask: UInt64): TUgarFilter; 710 | begin 711 | Result.FImpl := TFilterOperator.Create(AFieldName, '$bitsAllClear', ABitMask); 712 | end; 713 | 714 | class function TUgarFilter.BitsAllSet(const AFieldName: String; const ABitMask: UInt64): TUgarFilter; 715 | begin 716 | Result.FImpl := TFilterOperator.Create(AFieldName, '$bitsAllSet', ABitMask); 717 | end; 718 | 719 | class function TUgarFilter.BitsAnyClear(const AFieldName: String; const ABitMask: UInt64): TUgarFilter; 720 | begin 721 | Result.FImpl := TFilterOperator.Create(AFieldName, '$bitsAnyClear', ABitMask); 722 | end; 723 | 724 | class function TUgarFilter.BitsAnySet(const AFieldName: String; const ABitMask: UInt64): TUgarFilter; 725 | begin 726 | Result.FImpl := TFilterOperator.Create(AFieldName, '$bitsAnySet', ABitMask); 727 | end; 728 | 729 | class constructor TUgarFilter.Create; 730 | begin 731 | FEmpty.FImpl := TFilterEmpty.Create; 732 | end; 733 | 734 | class function TUgarFilter.ElemMatch(const AFieldName: String; const AFilter: TUgarFilter): TUgarFilter; 735 | begin 736 | Result.FImpl := TFilterElementMatch.Create(AFieldName, AFilter); 737 | end; 738 | 739 | class function TUgarFilter.Eq(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; 740 | begin 741 | Result.FImpl := TFilterSimple.Create(AFieldName, AValue); 742 | end; 743 | 744 | class function TUgarFilter.Exists(const AFieldName: String; const AExists: Boolean): TUgarFilter; 745 | begin 746 | Result.FImpl := TFilterOperator.Create(AFieldName, '$exists', AExists); 747 | end; 748 | 749 | class function TUgarFilter.Gt(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; 750 | begin 751 | Result.FImpl := TFilterOperator.Create(AFieldName, '$gt', AValue); 752 | end; 753 | 754 | class function TUgarFilter.Gte(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; 755 | begin 756 | Result.FImpl := TFilterOperator.Create(AFieldName, '$gte', AValue); 757 | end; 758 | 759 | class operator TUgarFilter.Implicit(const AJson: String): TUgarFilter; 760 | begin 761 | Result.FImpl := TFilterJson.Create(AJson); 762 | end; 763 | 764 | class operator TUgarFilter.Implicit(const ADocument: TUgarBsonDocument): TUgarFilter; 765 | begin 766 | if (ADocument.IsNil) then 767 | Result.FImpl := nil 768 | else 769 | Result.FImpl := TFilterBsonDocument.Create(ADocument); 770 | end; 771 | 772 | class function TUgarFilter.&In(const AFieldName: String; const AValues: TArray): TUgarFilter; 773 | begin 774 | Result.FImpl := TFilterArrayOperator.Create(AFieldName, '$in', TUgarBsonArray.Create(AValues)); 775 | end; 776 | 777 | class function TUgarFilter.&In(const AFieldName: String; const AValues: array of TUgarBsonValue): TUgarFilter; 778 | begin 779 | Result.FImpl := TFilterArrayOperator.Create(AFieldName, '$in', TUgarBsonArray.Create(AValues)); 780 | end; 781 | 782 | class function TUgarFilter.&In(const AFieldName: String; const AValues: TUgarBsonArray): TUgarFilter; 783 | begin 784 | Result.FImpl := TFilterArrayOperator.Create(AFieldName, '$in', AValues); 785 | end; 786 | 787 | function TUgarFilter.IsNil: Boolean; 788 | begin 789 | Result := (FImpl = nil); 790 | end; 791 | 792 | class operator TUgarFilter.LogicalAnd(const ALeft, ARight: TUgarFilter): TUgarFilter; 793 | begin 794 | Result.FImpl := TFilterAnd.Create(ALeft, ARight); 795 | end; 796 | 797 | class operator TUgarFilter.LogicalNot(const AOperand: TUgarFilter): TUgarFilter; 798 | begin 799 | Result.FImpl := TFilterNot.Create(AOperand); 800 | end; 801 | 802 | class operator TUgarFilter.LogicalOr(const ALeft, ARight: TUgarFilter): TUgarFilter; 803 | begin 804 | Result.FImpl := TFilterOr.Create(ALeft, ARight); 805 | end; 806 | 807 | class function TUgarFilter.Lt(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; 808 | begin 809 | Result.FImpl := TFilterOperator.Create(AFieldName, '$lt', AValue); 810 | end; 811 | 812 | class function TUgarFilter.Lte(const AFieldName: String; const AValue: TUgarBsonValue): TUgarFilter; 813 | begin 814 | Result.FImpl := TFilterOperator.Create(AFieldName, '$lte', AValue); 815 | end; 816 | 817 | class function TUgarFilter.Regex(const AFieldName: String; const ARegex: TUgarBsonRegularExpression) 818 | : TUgarFilter; 819 | begin 820 | Result.FImpl := TFilterSimple.Create(AFieldName, ARegex); 821 | end; 822 | 823 | function TUgarFilter.Render: TUgarBsonDocument; 824 | begin 825 | Assert(Assigned(FImpl)); 826 | Result := FImpl.Render; 827 | end; 828 | 829 | procedure TUgarFilter.SetNil; 830 | begin 831 | FImpl := nil; 832 | end; 833 | 834 | class function TUgarFilter.Size(const AFieldName: String; const ASize: Integer): TUgarFilter; 835 | begin 836 | Result.FImpl := TFilterOperator.Create(AFieldName, '$size', ASize); 837 | end; 838 | 839 | class function TUgarFilter.SizeGt(const AFieldName: String; const ASize: Integer): TUgarFilter; 840 | begin 841 | Result.FImpl := TFilterArrayIndexExists.Create(AFieldName, ASize, True); 842 | end; 843 | 844 | class function TUgarFilter.SizeGte(const AFieldName: String; const ASize: Integer): TUgarFilter; 845 | begin 846 | Result.FImpl := TFilterArrayIndexExists.Create(AFieldName, ASize - 1, True); 847 | end; 848 | 849 | class function TUgarFilter.SizeLt(const AFieldName: String; const ASize: Integer): TUgarFilter; 850 | begin 851 | Result.FImpl := TFilterArrayIndexExists.Create(AFieldName, ASize - 1, False); 852 | end; 853 | 854 | class function TUgarFilter.SizeLte(const AFieldName: String; const ASize: Integer): TUgarFilter; 855 | begin 856 | Result.FImpl := TFilterArrayIndexExists.Create(AFieldName, ASize, False); 857 | end; 858 | 859 | class function TUgarFilter.Text(const AText: String; const AOptions: TUgarTextSearchOptions; 860 | const ALanguage: String): TUgarFilter; 861 | var 862 | Settings: TUgarBsonDocument; 863 | begin 864 | Settings := TUgarBsonDocument.Create; 865 | Settings.Add('$search', AText); 866 | if (ALanguage <> '') then 867 | Settings.Add('$language', ALanguage); 868 | if (TUgarTextSearchOption.CaseSensitive in AOptions) then 869 | Settings.Add('$caseSensitive', True); 870 | if (TUgarTextSearchOption.DiacriticSensitive in AOptions) then 871 | Settings.Add('$diacriticSensitive', True); 872 | 873 | Result.FImpl := TFilterBsonDocument.Create(TUgarBsonDocument.Create('$text', Settings)); 874 | end; 875 | 876 | function TUgarFilter.ToJson: String; 877 | begin 878 | Assert(Assigned(FImpl)); 879 | Result := FImpl.ToJson(TUgarJsonWriterSettings.Default); 880 | end; 881 | 882 | function TUgarFilter.ToBson: TBytes; 883 | begin 884 | Assert(Assigned(FImpl)); 885 | Result := FImpl.ToBson; 886 | end; 887 | 888 | function TUgarFilter.ToJson(const ASettings: TUgarJsonWriterSettings): String; 889 | begin 890 | Assert(Assigned(FImpl)); 891 | Result := FImpl.ToJson(ASettings); 892 | end; 893 | 894 | { TUgarProjection } 895 | 896 | class operator TUgarProjection.Implicit(const AJson: String): TUgarProjection; 897 | begin 898 | Result.FImpl := TProjectionJson.Create(AJson); 899 | end; 900 | 901 | class function TUgarProjection.Combine(const AProjection1, AProjection2: TUgarProjection) 902 | : TUgarProjection; 903 | begin 904 | Result.FImpl := TProjectionCombine.Create(AProjection1, AProjection2); 905 | end; 906 | 907 | class function TUgarProjection.Combine(const AProjections: array of TUgarProjection): TUgarProjection; 908 | begin 909 | Result.FImpl := TProjectionCombine.Create(AProjections); 910 | end; 911 | 912 | class function TUgarProjection.ElemMatch(const AFieldName: String; const AFilter: TUgarFilter) 913 | : TUgarProjection; 914 | begin 915 | Result.FImpl := TProjectionElementMatch.Create(AFieldName, AFilter); 916 | end; 917 | 918 | class function TUgarProjection.Exclude(const AFieldNames: array of String): TUgarProjection; 919 | begin 920 | Result.FImpl := TProjectionMultipleFields.Create(AFieldNames, 0); 921 | end; 922 | 923 | class function TUgarProjection.Exclude(const AFieldName: String): TUgarProjection; 924 | begin 925 | Result.FImpl := TProjectionSingleField.Create(AFieldName, 0); 926 | end; 927 | 928 | class function TUgarProjection.GetEmpty: TUgarProjection; 929 | begin 930 | Result.FImpl := nil; 931 | end; 932 | 933 | class operator TUgarProjection.Implicit(const ADocument: TUgarBsonDocument): TUgarProjection; 934 | begin 935 | if (ADocument.IsNil) then 936 | Result.FImpl := nil 937 | else 938 | Result.FImpl := TProjectionBsonDocument.Create(ADocument); 939 | end; 940 | 941 | class operator TUgarProjection.Add(const ALeft, ARight: TUgarProjection): TUgarProjection; 942 | begin 943 | Result.FImpl := TProjectionCombine.Create(ALeft, ARight); 944 | end; 945 | 946 | class function TUgarProjection.Include(const AFieldName: String): TUgarProjection; 947 | begin 948 | Result.FImpl := TProjectionSingleField.Create(AFieldName, 1); 949 | end; 950 | 951 | class function TUgarProjection.Include(const AFieldNames: array of String): TUgarProjection; 952 | begin 953 | Result.FImpl := TProjectionMultipleFields.Create(AFieldNames, 1); 954 | end; 955 | 956 | function TUgarProjection.IsNil: Boolean; 957 | begin 958 | Result := (FImpl = nil); 959 | end; 960 | 961 | class function TUgarProjection.MetaTextScore(const AFieldName: String): TUgarProjection; 962 | begin 963 | Result.FImpl := TProjectionSingleField.Create(AFieldName, TUgarBsonDocument.Create('$meta', 'textScore')); 964 | end; 965 | 966 | function TUgarProjection.Render: TUgarBsonDocument; 967 | begin 968 | Assert(Assigned(FImpl)); 969 | Result := FImpl.Render; 970 | end; 971 | 972 | class function TUgarProjection.Slice(const AFieldName: String; const ALimit: Integer): TUgarProjection; 973 | begin 974 | Result.FImpl := TProjectionSingleField.Create(AFieldName, TUgarBsonDocument.Create('$slice', ALimit)); 975 | end; 976 | 977 | procedure TUgarProjection.SetNil; 978 | begin 979 | FImpl := nil; 980 | end; 981 | 982 | class function TUgarProjection.Slice(const AFieldName: String; const ASkip, ALimit: Integer): TUgarProjection; 983 | begin 984 | Result.FImpl := TProjectionSingleField.Create(AFieldName, TUgarBsonDocument.Create('$slice', 985 | TUgarBsonArray.Create([ASkip, ALimit]))); 986 | end; 987 | 988 | function TUgarProjection.ToBson: TBytes; 989 | begin 990 | Assert(Assigned(FImpl)); 991 | Result := FImpl.ToBson; 992 | end; 993 | 994 | function TUgarProjection.ToJson: String; 995 | begin 996 | Assert(Assigned(FImpl)); 997 | Result := FImpl.ToJson(TUgarJsonWriterSettings.Default); 998 | end; 999 | 1000 | function TUgarProjection.ToJson(const ASettings: TUgarJsonWriterSettings): String; 1001 | begin 1002 | Assert(Assigned(FImpl)); 1003 | Result := FImpl.ToJson(ASettings); 1004 | end; 1005 | 1006 | { TUgarSort } 1007 | 1008 | class operator TUgarSort.Add(const ALeft, ARight: TUgarSort): TUgarSort; 1009 | begin 1010 | Result.FImpl := TSortCombine.Create(ALeft, ARight); 1011 | end; 1012 | 1013 | class function TUgarSort.Ascending(const AFieldName: String): TUgarSort; 1014 | begin 1015 | Result.FImpl := TSortDirectional.Create(AFieldName, TUgarSortDirection.Ascending); 1016 | end; 1017 | 1018 | class function TUgarSort.Combine(const ASorts: array of TUgarSort): TUgarSort; 1019 | begin 1020 | Result.FImpl := TSortCombine.Create(ASorts); 1021 | end; 1022 | 1023 | class function TUgarSort.Descending(const AFieldName: String): TUgarSort; 1024 | begin 1025 | Result.FImpl := TSortDirectional.Create(AFieldName, TUgarSortDirection.Descending); 1026 | end; 1027 | 1028 | class function TUgarSort.Combine(const ASort1, ASort2: TUgarSort): TUgarSort; 1029 | begin 1030 | Result.FImpl := TSortCombine.Create(ASort1, ASort2); 1031 | end; 1032 | 1033 | class operator TUgarSort.Implicit(const ADocument: TUgarBsonDocument): TUgarSort; 1034 | begin 1035 | if (ADocument.IsNil) then 1036 | Result.FImpl := nil 1037 | else 1038 | Result.FImpl := TSortBsonDocument.Create(ADocument); 1039 | end; 1040 | 1041 | class operator TUgarSort.Implicit(const AJson: String): TUgarSort; 1042 | begin 1043 | Result.FImpl := TSortJson.Create(AJson); 1044 | end; 1045 | 1046 | function TUgarSort.IsNil: Boolean; 1047 | begin 1048 | Result := (FImpl = nil); 1049 | end; 1050 | 1051 | class function TUgarSort.MetaTextScore(const AFieldName: String): TUgarSort; 1052 | begin 1053 | Result.FImpl := TSortBsonDocument.Create(TUgarBsonDocument.Create(AFieldName, TUgarBsonDocument.Create('$meta', 1054 | 'textScore'))); 1055 | end; 1056 | 1057 | function TUgarSort.Render: TUgarBsonDocument; 1058 | begin 1059 | Assert(Assigned(FImpl)); 1060 | Result := FImpl.Render; 1061 | end; 1062 | 1063 | procedure TUgarSort.SetNil; 1064 | begin 1065 | FImpl := nil; 1066 | end; 1067 | 1068 | function TUgarSort.ToBson: TBytes; 1069 | begin 1070 | Assert(Assigned(FImpl)); 1071 | Result := FImpl.ToBson; 1072 | end; 1073 | 1074 | function TUgarSort.ToJson: String; 1075 | begin 1076 | Assert(Assigned(FImpl)); 1077 | Result := FImpl.ToJson(TUgarJsonWriterSettings.Default); 1078 | end; 1079 | 1080 | function TUgarSort.ToJson(const ASettings: TUgarJsonWriterSettings): String; 1081 | begin 1082 | Assert(Assigned(FImpl)); 1083 | Result := FImpl.ToJson(ASettings); 1084 | end; 1085 | 1086 | { TUgarUpdate } 1087 | 1088 | function TUgarUpdate.&Set(const AFieldName: String; const AValue: TUgarBsonValue): TUgarUpdate; 1089 | begin 1090 | Result.FImpl := SetOrCombine(TUpdateOperator.Create('$set', AFieldName, AValue)); 1091 | end; 1092 | 1093 | procedure TUgarUpdate.SetNil; 1094 | begin 1095 | FImpl := nil; 1096 | end; 1097 | 1098 | function TUgarUpdate.SetOnInsert(const AFieldName: String; const AValue: TUgarBsonValue): TUgarUpdate; 1099 | begin 1100 | Result.FImpl := SetOrCombine(TUpdateOperator.Create('$setOnInsert', AFieldName, AValue)); 1101 | end; 1102 | 1103 | function TUgarUpdate.SetOrCombine(const AUpdate: IUpdate): IUpdate; 1104 | begin 1105 | if (FImpl = nil) then 1106 | FImpl := AUpdate 1107 | else if (FImpl.IsCombine) then 1108 | TUpdateCombine(FImpl).Add(AUpdate) 1109 | else 1110 | FImpl := TUpdateCombine.Create(FImpl, AUpdate); 1111 | Result := FImpl; 1112 | end; 1113 | 1114 | function TUgarUpdate.AddToSet(const AFieldName: String; const AValue: TUgarBsonValue): TUgarUpdate; 1115 | begin 1116 | Result.FImpl := SetOrCombine(TUpdateAddToSet.Create(AFieldName, AValue)); 1117 | end; 1118 | 1119 | function TUgarUpdate.AddToSetEach(const AFieldName: String; const AValues: array of TUgarBsonValue) 1120 | : TUgarUpdate; 1121 | begin 1122 | Result.FImpl := SetOrCombine(TUpdateAddToSet.Create(AFieldName, AValues)); 1123 | end; 1124 | 1125 | function TUgarUpdate.BitwiseAnd(const AFieldName: String; const AValue: TUgarBsonValue): TUgarUpdate; 1126 | begin 1127 | Result.FImpl := SetOrCombine(TUpdateBitwiseOperator.Create('and', AFieldName, AValue)); 1128 | end; 1129 | 1130 | function TUgarUpdate.BitwiseOr(const AFieldName: String; const AValue: TUgarBsonValue): TUgarUpdate; 1131 | begin 1132 | Result.FImpl := SetOrCombine(TUpdateBitwiseOperator.Create('or', AFieldName, AValue)); 1133 | end; 1134 | 1135 | function TUgarUpdate.BitwiseXor(const AFieldName: String; const AValue: TUgarBsonValue): TUgarUpdate; 1136 | begin 1137 | Result.FImpl := SetOrCombine(TUpdateBitwiseOperator.Create('xor', AFieldName, AValue)); 1138 | end; 1139 | 1140 | function TUgarUpdate.CurrentDate(const AFieldName: String; const AType: TUgarCurrentDateType) 1141 | : TUgarUpdate; 1142 | var 1143 | Value: TUgarBsonValue; 1144 | begin 1145 | case AType of 1146 | TUgarCurrentDateType.Date: 1147 | Value := TUgarBsonDocument.Create('$type', 'date'); 1148 | 1149 | TUgarCurrentDateType.Timestamp: 1150 | Value := TUgarBsonDocument.Create('$type', 'timestamp'); 1151 | else 1152 | Value := True; 1153 | end; 1154 | 1155 | Result.FImpl := SetOrCombine(TUpdateOperator.Create('$currentDate', AFieldName, Value)); 1156 | end; 1157 | 1158 | class operator TUgarUpdate.Implicit(const ADocument: TUgarBsonDocument): TUgarUpdate; 1159 | begin 1160 | if (ADocument.IsNil) then 1161 | Result.FImpl := nil 1162 | else 1163 | Result.FImpl := TUpdateBsonDocument.Create(ADocument); 1164 | end; 1165 | 1166 | function TUgarUpdate.Inc(const AFieldName: String; const AAmount: TUgarBsonValue): TUgarUpdate; 1167 | begin 1168 | Result.FImpl := SetOrCombine(TUpdateOperator.Create('$inc', AFieldName, AAmount)); 1169 | end; 1170 | 1171 | function TUgarUpdate.Inc(const AFieldName: String): TUgarUpdate; 1172 | begin 1173 | Result.FImpl := SetOrCombine(TUpdateOperator.Create('$inc', AFieldName, 1)); 1174 | end; 1175 | 1176 | class function TUgarUpdate.Init: TUgarUpdate; 1177 | begin 1178 | Result.FImpl := nil; 1179 | end; 1180 | 1181 | class operator TUgarUpdate.Implicit(const AJson: String): TUgarUpdate; 1182 | begin 1183 | Result.FImpl := TUpdateJson.Create(AJson); 1184 | end; 1185 | 1186 | function TUgarUpdate.IsNil: Boolean; 1187 | begin 1188 | Result := (FImpl = nil); 1189 | end; 1190 | 1191 | function TUgarUpdate.Max(const AFieldName: String; const AValue: TUgarBsonValue): TUgarUpdate; 1192 | begin 1193 | Result.FImpl := SetOrCombine(TUpdateOperator.Create('$max', AFieldName, AValue)); 1194 | end; 1195 | 1196 | function TUgarUpdate.Min(const AFieldName: String; const AValue: TUgarBsonValue): TUgarUpdate; 1197 | begin 1198 | Result.FImpl := SetOrCombine(TUpdateOperator.Create('$min', AFieldName, AValue)); 1199 | end; 1200 | 1201 | function TUgarUpdate.Mul(const AFieldName: String; const AAmount: TUgarBsonValue): TUgarUpdate; 1202 | begin 1203 | Result.FImpl := SetOrCombine(TUpdateOperator.Create('$mul', AFieldName, AAmount)); 1204 | end; 1205 | 1206 | function TUgarUpdate.PopFirst(const AFieldName: String): TUgarUpdate; 1207 | begin 1208 | Result.FImpl := SetOrCombine(TUpdateOperator.Create('$pop', AFieldName, -1)); 1209 | end; 1210 | 1211 | function TUgarUpdate.PopLast(const AFieldName: String): TUgarUpdate; 1212 | begin 1213 | Result.FImpl := SetOrCombine(TUpdateOperator.Create('$pop', AFieldName, 1)); 1214 | end; 1215 | 1216 | function TUgarUpdate.Pull(const AFieldName: String; const AValue: TUgarBsonValue): TUgarUpdate; 1217 | begin 1218 | Result.FImpl := SetOrCombine(TUpdatePull.Create(AFieldName, AValue)); 1219 | end; 1220 | 1221 | function TUgarUpdate.PullAll(const AFieldName: String; const AValues: array of TUgarBsonValue): TUgarUpdate; 1222 | begin 1223 | Result.FImpl := SetOrCombine(TUpdatePull.Create(AFieldName, AValues)); 1224 | end; 1225 | 1226 | function TUgarUpdate.PullFilter(const AFieldName: String; const AFilter: TUgarFilter): TUgarUpdate; 1227 | begin 1228 | Result.FImpl := SetOrCombine(TUpdatePull.Create(AFieldName, AFilter)); 1229 | end; 1230 | 1231 | function TUgarUpdate.Push(const AFieldName: String; const AValue: TUgarBsonValue): TUgarUpdate; 1232 | begin 1233 | Result.FImpl := SetOrCombine(TUpdatePush.Create(AFieldName, AValue)); 1234 | end; 1235 | 1236 | function TUgarUpdate.PushEach(const AFieldName: String; const AValues: array of TUgarBsonValue; 1237 | const ASlice, APosition: Integer): TUgarUpdate; 1238 | var 1239 | Sort: TUgarSort; 1240 | begin 1241 | Sort.SetNil; 1242 | Result := PushEach(AFieldName, AValues, Sort, ASlice, APosition); 1243 | end; 1244 | 1245 | function TUgarUpdate.PushEach(const AFieldName: String; const AValues: array of TUgarBsonValue; 1246 | const ASort: TUgarSort; const ASlice, APosition: Integer): TUgarUpdate; 1247 | begin 1248 | Result.FImpl := SetOrCombine(TUpdatePush.Create(AFieldName, AValues, ASlice, APosition, ASort)); 1249 | end; 1250 | 1251 | function TUgarUpdate.Rename(const AFieldName, ANewName: String): TUgarUpdate; 1252 | begin 1253 | Result.FImpl := SetOrCombine(TUpdateOperator.Create('$rename', AFieldName, ANewName)); 1254 | end; 1255 | 1256 | function TUgarUpdate.Render: TUgarBsonDocument; 1257 | begin 1258 | Assert(Assigned(FImpl)); 1259 | Result := FImpl.Render; 1260 | end; 1261 | 1262 | function TUgarUpdate.ToBson: TBytes; 1263 | begin 1264 | Assert(Assigned(FImpl)); 1265 | Result := FImpl.ToBson; 1266 | end; 1267 | 1268 | function TUgarUpdate.ToJson: String; 1269 | begin 1270 | Assert(Assigned(FImpl)); 1271 | Result := FImpl.ToJson(TUgarJsonWriterSettings.Default); 1272 | end; 1273 | 1274 | function TUgarUpdate.ToJson(const ASettings: TUgarJsonWriterSettings): String; 1275 | begin 1276 | Assert(Assigned(FImpl)); 1277 | Result := FImpl.ToJson(ASettings); 1278 | end; 1279 | 1280 | function TUgarUpdate.Unset(const AFieldName: String): TUgarUpdate; 1281 | begin 1282 | Result.FImpl := SetOrCombine(TUpdateOperator.Create('$unset', AFieldName, 1)); 1283 | end; 1284 | 1285 | { TBuilder } 1286 | 1287 | function TBuilder.Build: TUgarBsonDocument; 1288 | begin 1289 | Result := TUgarBsonDocument.Create; 1290 | end; 1291 | 1292 | function TBuilder.Render: TUgarBsonDocument; 1293 | var 1294 | Writer: IUgarBsonDocumentWriter; 1295 | begin 1296 | if (SupportsWriter) then 1297 | begin 1298 | Result := TUgarBsonDocument.Create; 1299 | Writer := TUgarBsonDocumentWriter.Create(Result); 1300 | Write(Writer); 1301 | end 1302 | else 1303 | Result := Build(); 1304 | end; 1305 | 1306 | class function TBuilder.SupportsWriter: Boolean; 1307 | begin 1308 | Result := False; 1309 | end; 1310 | 1311 | function TBuilder.ToBson: TBytes; 1312 | var 1313 | Writer: IUgarBsonWriter; 1314 | begin 1315 | if (SupportsWriter) then 1316 | begin 1317 | Writer := TUgarBsonWriter.Create; 1318 | Write(Writer); 1319 | Result := Writer.ToBson; 1320 | end 1321 | else 1322 | Result := Build().ToBson; 1323 | end; 1324 | 1325 | function TBuilder.ToJson(const ASettings: TUgarJsonWriterSettings): String; 1326 | var 1327 | Writer: IUgarJsonWriter; 1328 | begin 1329 | if (SupportsWriter) then 1330 | begin 1331 | Writer := TUgarJsonWriter.Create(ASettings); 1332 | Write(Writer); 1333 | Result := Writer.ToJson; 1334 | end 1335 | else 1336 | Result := Build().ToJson(ASettings); 1337 | end; 1338 | 1339 | procedure TBuilder.Write(const AWriter: IUgarBsonBaseWriter); 1340 | begin 1341 | { No default implementation } 1342 | end; 1343 | 1344 | { TFilterEmpty } 1345 | 1346 | function TFilterEmpty.Build: TUgarBsonDocument; 1347 | begin 1348 | Result := TUgarBsonDocument.Create; 1349 | end; 1350 | 1351 | { TFilterJson } 1352 | 1353 | function TFilterJson.Build: TUgarBsonDocument; 1354 | begin 1355 | Result := TUgarBsonDocument.Parse(FJson); 1356 | end; 1357 | 1358 | constructor TFilterJson.Create(const AJson: String); 1359 | begin 1360 | inherited Create; 1361 | FJson := AJson; 1362 | end; 1363 | 1364 | { TFilterBsonDocument } 1365 | 1366 | function TFilterBsonDocument.Build: TUgarBsonDocument; 1367 | begin 1368 | Result := FDocument; 1369 | end; 1370 | 1371 | constructor TFilterBsonDocument.Create(const ADocument: TUgarBsonDocument); 1372 | begin 1373 | inherited Create; 1374 | FDocument := ADocument; 1375 | end; 1376 | 1377 | { TFilterSimple } 1378 | 1379 | constructor TFilterSimple.Create(const AFieldName: String; const AValue: TUgarBsonValue); 1380 | begin 1381 | inherited Create; 1382 | FFieldName := AFieldName; 1383 | FValue := AValue; 1384 | end; 1385 | 1386 | class function TFilterSimple.SupportsWriter: Boolean; 1387 | begin 1388 | Result := True; 1389 | end; 1390 | 1391 | procedure TFilterSimple.Write(const AWriter: IUgarBsonBaseWriter); 1392 | begin 1393 | AWriter.WriteStartDocument; 1394 | AWriter.WriteName(FFieldName); 1395 | AWriter.WriteValue(FValue); 1396 | AWriter.WriteEndDocument; 1397 | end; 1398 | 1399 | { TFilterOperator } 1400 | 1401 | constructor TFilterOperator.Create(const AFieldName, AOperator: String; const AValue: TUgarBsonValue); 1402 | begin 1403 | inherited Create; 1404 | FFieldName := AFieldName; 1405 | FOperator := AOperator; 1406 | FValue := AValue; 1407 | end; 1408 | 1409 | class function TFilterOperator.SupportsWriter: Boolean; 1410 | begin 1411 | Result := True; 1412 | end; 1413 | 1414 | procedure TFilterOperator.Write(const AWriter: IUgarBsonBaseWriter); 1415 | begin 1416 | AWriter.WriteStartDocument; 1417 | AWriter.WriteName(FFieldName); 1418 | 1419 | AWriter.WriteStartDocument; 1420 | AWriter.WriteName(FOperator); 1421 | AWriter.WriteValue(FValue); 1422 | AWriter.WriteEndDocument; 1423 | 1424 | AWriter.WriteEndDocument; 1425 | end; 1426 | 1427 | { TFilterArrayOperator } 1428 | 1429 | constructor TFilterArrayOperator.Create(const AFieldName, AOperator: String; const AValues: TUgarBsonArray); 1430 | begin 1431 | inherited Create; 1432 | FFieldName := AFieldName; 1433 | FOperator := AOperator; 1434 | FValues := AValues; 1435 | end; 1436 | 1437 | class function TFilterArrayOperator.SupportsWriter: Boolean; 1438 | begin 1439 | Result := True; 1440 | end; 1441 | 1442 | procedure TFilterArrayOperator.Write(const AWriter: IUgarBsonBaseWriter); 1443 | begin 1444 | AWriter.WriteStartDocument; 1445 | AWriter.WriteName(FFieldName); 1446 | 1447 | AWriter.WriteStartDocument; 1448 | AWriter.WriteName(FOperator); 1449 | AWriter.WriteValue(FValues); 1450 | AWriter.WriteEndDocument; 1451 | 1452 | AWriter.WriteEndDocument; 1453 | end; 1454 | 1455 | { TFilterAnd } 1456 | 1457 | class procedure TFilterAnd.AddClause(const ADocument: TUgarBsonDocument; const AClause: TUgarBsonElement); 1458 | var 1459 | Item, Value: TUgarBsonValue; 1460 | ExistingClauseValue, ClauseValue: TUgarBsonDocument; 1461 | Element: TUgarBsonElement; 1462 | I: Integer; 1463 | begin 1464 | if (AClause.Name = '$and') then 1465 | begin 1466 | for Item in AClause.Value.AsBsonArray do 1467 | begin 1468 | for Element in Item.AsBsonDocument do 1469 | AddClause(ADocument, Element); 1470 | end; 1471 | end 1472 | else if (ADocument.Count = 1) and (ADocument.Elements[0].Name = '$and') then 1473 | ADocument.Values[0].AsBsonArray.Add(TUgarBsonDocument.Create(AClause)) 1474 | else if (ADocument.TryGetValue(AClause.Name, Value)) then 1475 | begin 1476 | if (Value.IsBsonDocument) and (AClause.Value.IsBsonDocument) then 1477 | begin 1478 | ClauseValue := AClause.Value.AsBsonDocument; 1479 | ExistingClauseValue := Value.AsBsonDocument; 1480 | 1481 | for I := 0 to ExistingClauseValue.Count - 1 do 1482 | begin 1483 | if (ClauseValue.Contains(ExistingClauseValue.Elements[I].Name)) then 1484 | begin 1485 | PromoteFilterToDollarForm(ADocument, AClause); 1486 | Exit; 1487 | end; 1488 | end; 1489 | 1490 | for Element in ClauseValue do 1491 | ExistingClauseValue.Add(Element); 1492 | end 1493 | else 1494 | PromoteFilterToDollarForm(ADocument, AClause); 1495 | end 1496 | else 1497 | ADocument.Add(AClause); 1498 | end; 1499 | 1500 | function TFilterAnd.Build: TUgarBsonDocument; 1501 | var 1502 | I, J: Integer; 1503 | RenderedFilter: TUgarBsonDocument; 1504 | begin 1505 | Result := TUgarBsonDocument.Create; 1506 | for I := 0 to Length(FFilters) - 1 do 1507 | begin 1508 | RenderedFilter := FFilters[I].Render; 1509 | for J := 0 to RenderedFilter.Count - 1 do 1510 | AddClause(Result, RenderedFilter.Elements[J]); 1511 | end; 1512 | end; 1513 | 1514 | constructor TFilterAnd.Create(const AFilter1, AFilter2: TUgarFilter); 1515 | begin 1516 | Assert(not AFilter1.IsNil); 1517 | Assert(not AFilter2.IsNil); 1518 | inherited Create; 1519 | SetLength(FFilters, 2); 1520 | FFilters[0] := AFilter1.FImpl; 1521 | FFilters[1] := AFilter2.FImpl; 1522 | end; 1523 | 1524 | constructor TFilterAnd.Create(const AFilters: array of TUgarFilter); 1525 | var 1526 | I: Integer; 1527 | begin 1528 | inherited Create; 1529 | SetLength(FFilters, Length(AFilters)); 1530 | for I := 0 to Length(AFilters) - 1 do 1531 | begin 1532 | Assert(not AFilters[I].IsNil); 1533 | FFilters[I] := AFilters[I].FImpl; 1534 | end; 1535 | end; 1536 | 1537 | class procedure TFilterAnd.PromoteFilterToDollarForm(const ADocument: TUgarBsonDocument; 1538 | const AClause: TUgarBsonElement); 1539 | var 1540 | Clauses: TUgarBsonArray; 1541 | QueryElement: TUgarBsonElement; 1542 | begin 1543 | Clauses := TUgarBsonArray.Create(ADocument.Count); 1544 | for QueryElement in ADocument do 1545 | Clauses.Add(TUgarBsonDocument.Create(QueryElement)); 1546 | Clauses.Add(TUgarBsonDocument.Create(AClause)); 1547 | ADocument.Clear; 1548 | ADocument.Add('$and', Clauses) 1549 | end; 1550 | 1551 | { TFilterOr } 1552 | 1553 | class procedure TFilterOr.AddClause(const AClauses: TUgarBsonArray; const AFilter: TUgarBsonDocument); 1554 | begin 1555 | if (AFilter.Count = 1) and (AFilter.Elements[0].Name = '$or') then 1556 | { Flatten nested $or } 1557 | AClauses.AddRange(AFilter.Values[0].AsBsonArray) 1558 | else 1559 | { We could shortcut the user's query if there are no elements in the filter, 1560 | but I'd rather be literal and let them discover the problem on their own. } 1561 | AClauses.Add(AFilter); 1562 | end; 1563 | 1564 | function TFilterOr.Build: TUgarBsonDocument; 1565 | var 1566 | I: Integer; 1567 | Clauses: TUgarBsonArray; 1568 | RenderedFilter: TUgarBsonDocument; 1569 | begin 1570 | Clauses := TUgarBsonArray.Create; 1571 | for I := 0 to Length(FFilters) - 1 do 1572 | begin 1573 | RenderedFilter := FFilters[I].Render; 1574 | AddClause(Clauses, RenderedFilter); 1575 | end; 1576 | Result := TUgarBsonDocument.Create('$or', Clauses); 1577 | end; 1578 | 1579 | constructor TFilterOr.Create(const AFilter1, AFilter2: TUgarFilter); 1580 | begin 1581 | Assert(not AFilter1.IsNil); 1582 | Assert(not AFilter2.IsNil); 1583 | inherited Create; 1584 | SetLength(FFilters, 2); 1585 | FFilters[0] := AFilter1.FImpl; 1586 | FFilters[1] := AFilter2.FImpl; 1587 | end; 1588 | 1589 | constructor TFilterOr.Create(const AFilters: array of TUgarFilter); 1590 | var 1591 | I: Integer; 1592 | begin 1593 | inherited Create; 1594 | SetLength(FFilters, Length(AFilters)); 1595 | for I := 0 to Length(AFilters) - 1 do 1596 | begin 1597 | Assert(not AFilters[I].IsNil); 1598 | FFilters[I] := AFilters[I].FImpl; 1599 | end; 1600 | end; 1601 | 1602 | { TFilterNot } 1603 | 1604 | function TFilterNot.Build: TUgarBsonDocument; 1605 | var 1606 | RenderedFilter: TUgarBsonDocument; 1607 | begin 1608 | RenderedFilter := FFilter.Render; 1609 | if (RenderedFilter.Count = 1) then 1610 | Result := NegateSingleElementFilter(RenderedFilter, RenderedFilter.Elements[0]) 1611 | else 1612 | Result := NegateArbitraryFilter(RenderedFilter); 1613 | end; 1614 | 1615 | constructor TFilterNot.Create(const AOperand: TUgarFilter); 1616 | begin 1617 | Assert(not AOperand.IsNil); 1618 | inherited Create; 1619 | FFilter := AOperand.FImpl; 1620 | end; 1621 | 1622 | class function TFilterNot.NegateArbitraryFilter(const AFilter: TUgarBsonDocument): TUgarBsonDocument; 1623 | begin 1624 | // $not only works as a meta operator on a single operator so simulate Not using $nor 1625 | Result := TUgarBsonDocument.Create('$nor', TUgarBsonArray.Create([AFilter])); 1626 | end; 1627 | 1628 | class function TFilterNot.NegateSingleElementFilter(const AFilter: TUgarBsonDocument; const AElement: TUgarBsonElement) 1629 | : TUgarBsonDocument; 1630 | var 1631 | Selector: TUgarBsonDocument; 1632 | OperatorName: String; 1633 | begin 1634 | if (AElement.Name.Chars[0] = '$') then 1635 | Exit(NegateSingleElementTopLevelOperatorFilter(AFilter, AElement)); 1636 | 1637 | if (AElement.Value.IsBsonDocument) then 1638 | begin 1639 | Selector := AElement.Value.AsBsonDocument; 1640 | if (Selector.Count > 0) then 1641 | begin 1642 | OperatorName := Selector.Elements[0].Name; 1643 | Assert(OperatorName <> ''); 1644 | if (OperatorName.Chars[0] = '$') and (OperatorName <> '$ref') then 1645 | begin 1646 | if (Selector.Count = 1) then 1647 | Exit(NegateSingleFieldOperatorFilter(AElement.Name, Selector.Elements[0])) 1648 | else 1649 | Exit(NegateArbitraryFilter(AFilter)); 1650 | end; 1651 | end; 1652 | end; 1653 | 1654 | if (AElement.Value.IsBsonRegularExpression) then 1655 | Exit(TUgarBsonDocument.Create(AElement.Name, TUgarBsonDocument.Create('$not', AElement.Value))); 1656 | 1657 | Result := TUgarBsonDocument.Create(AElement.Name, TUgarBsonDocument.Create('$ne', AElement.Value)); 1658 | end; 1659 | 1660 | class function TFilterNot.NegateSingleElementTopLevelOperatorFilter(const AFilter: TUgarBsonDocument; 1661 | const AElement: TUgarBsonElement): TUgarBsonDocument; 1662 | begin 1663 | if (AElement.Name = '$or') then 1664 | Result := TUgarBsonDocument.Create('$nor', AElement.Value) 1665 | else if (AElement.Name = '$nor') then 1666 | Result := TUgarBsonDocument.Create('$or', AElement.Value) 1667 | else 1668 | Result := NegateArbitraryFilter(AFilter); 1669 | end; 1670 | 1671 | class function TFilterNot.NegateSingleFieldOperatorFilter(const AFieldName: String; const AElement: TUgarBsonElement) 1672 | : TUgarBsonDocument; 1673 | var 1674 | S: String; 1675 | begin 1676 | S := AElement.Name; 1677 | if (S = '$exists') then 1678 | Result := TUgarBsonDocument.Create(AFieldName, TUgarBsonDocument.Create('$exists', not AElement.Value.AsBoolean)) 1679 | else if (S = '$in') then 1680 | Result := TUgarBsonDocument.Create(AFieldName, TUgarBsonDocument.Create('$nin', AElement.Value.AsBsonArray)) 1681 | else if (S = '$ne') or (S = '$not') then 1682 | Result := TUgarBsonDocument.Create(AFieldName, AElement.Value) 1683 | else if (S = '$nin') then 1684 | Result := TUgarBsonDocument.Create(AFieldName, TUgarBsonDocument.Create('$in', AElement.Value.AsBsonArray)) 1685 | else 1686 | Result := TUgarBsonDocument.Create(AFieldName, TUgarBsonDocument.Create('$not', 1687 | TUgarBsonDocument.Create(AElement))); 1688 | end; 1689 | 1690 | { TFilterElementMatch } 1691 | 1692 | function TFilterElementMatch.Build: TUgarBsonDocument; 1693 | begin 1694 | Result := TUgarBsonDocument.Create(FFieldName, TUgarBsonDocument.Create('$elemMatch', FFilter.Render)); 1695 | end; 1696 | 1697 | constructor TFilterElementMatch.Create(const AFieldName: String; const AFilter: TUgarFilter); 1698 | begin 1699 | Assert(not AFilter.IsNil); 1700 | inherited Create; 1701 | FFieldName := AFieldName; 1702 | FFilter := AFilter.FImpl; 1703 | end; 1704 | 1705 | { TFilterArrayIndexExists } 1706 | 1707 | constructor TFilterArrayIndexExists.Create(const AFieldName: String; const AIndex: Integer; const AExists: Boolean); 1708 | begin 1709 | inherited Create; 1710 | FFieldName := AFieldName; 1711 | FIndex := AIndex; 1712 | FExists := AExists; 1713 | end; 1714 | 1715 | class function TFilterArrayIndexExists.SupportsWriter: Boolean; 1716 | begin 1717 | Result := True; 1718 | end; 1719 | 1720 | procedure TFilterArrayIndexExists.Write(const AWriter: IUgarBsonBaseWriter); 1721 | begin 1722 | AWriter.WriteStartDocument; 1723 | AWriter.WriteName(FFieldName + '.' + FIndex.ToString); 1724 | AWriter.WriteStartDocument; 1725 | AWriter.WriteName('$exists'); 1726 | AWriter.WriteBoolean(FExists); 1727 | AWriter.WriteEndDocument; 1728 | AWriter.WriteEndDocument; 1729 | end; 1730 | 1731 | { TProjectionJson } 1732 | 1733 | function TProjectionJson.Build: TUgarBsonDocument; 1734 | begin 1735 | Result := TUgarBsonDocument.Parse(FJson); 1736 | end; 1737 | 1738 | constructor TProjectionJson.Create(const AJson: String); 1739 | begin 1740 | inherited Create; 1741 | FJson := AJson; 1742 | end; 1743 | 1744 | { TProjectionBsonDocument } 1745 | 1746 | function TProjectionBsonDocument.Build: TUgarBsonDocument; 1747 | begin 1748 | Result := FDocument; 1749 | end; 1750 | 1751 | constructor TProjectionBsonDocument.Create(const ADocument: TUgarBsonDocument); 1752 | begin 1753 | inherited Create; 1754 | FDocument := ADocument; 1755 | end; 1756 | 1757 | { TProjectionCombine } 1758 | 1759 | function TProjectionCombine.Build: TUgarBsonDocument; 1760 | var 1761 | Projection: TUgarProjection.IProjection; 1762 | RenderedProjection: TUgarBsonDocument; 1763 | Element: TUgarBsonElement; 1764 | begin 1765 | Result := TUgarBsonDocument.Create; 1766 | for Projection in FProjections do 1767 | begin 1768 | RenderedProjection := Projection.Render; 1769 | for Element in RenderedProjection do 1770 | begin 1771 | Result.Remove(Element.Name); 1772 | Result.Add(Element) 1773 | end; 1774 | end; 1775 | end; 1776 | 1777 | constructor TProjectionCombine.Create(const AProjection1, AProjection2: TUgarProjection); 1778 | begin 1779 | Assert(not AProjection1.IsNil); 1780 | Assert(not AProjection2.IsNil); 1781 | inherited Create; 1782 | SetLength(FProjections, 2); 1783 | FProjections[0] := AProjection1.FImpl; 1784 | FProjections[1] := AProjection2.FImpl; 1785 | end; 1786 | 1787 | constructor TProjectionCombine.Create(const AProjections: array of TUgarProjection); 1788 | var 1789 | I: Integer; 1790 | begin 1791 | inherited Create; 1792 | SetLength(FProjections, Length(AProjections)); 1793 | for I := 0 to Length(AProjections) - 1 do 1794 | begin 1795 | Assert(not AProjections[I].IsNil); 1796 | FProjections[I] := AProjections[I].FImpl; 1797 | end; 1798 | end; 1799 | 1800 | { TProjectionSingleField } 1801 | 1802 | constructor TProjectionSingleField.Create(const AFieldName: String; const AValue: TUgarBsonValue); 1803 | begin 1804 | inherited Create; 1805 | FFieldName := AFieldName; 1806 | FValue := AValue; 1807 | end; 1808 | 1809 | class function TProjectionSingleField.SupportsWriter: Boolean; 1810 | begin 1811 | Result := True; 1812 | end; 1813 | 1814 | procedure TProjectionSingleField.Write(const AWriter: IUgarBsonBaseWriter); 1815 | begin 1816 | AWriter.WriteStartDocument; 1817 | AWriter.WriteName(FFieldName); 1818 | AWriter.WriteValue(FValue); 1819 | AWriter.WriteEndDocument; 1820 | end; 1821 | 1822 | { TProjectionMultipleFields } 1823 | 1824 | constructor TProjectionMultipleFields.Create(const AFieldNames: array of String; const AValue: Integer); 1825 | var 1826 | I: Integer; 1827 | begin 1828 | inherited Create; 1829 | FValue := AValue; 1830 | SetLength(FFieldNames, Length(AFieldNames)); 1831 | for I := 0 to Length(AFieldNames) - 1 do 1832 | FFieldNames[I] := AFieldNames[I]; 1833 | end; 1834 | 1835 | class function TProjectionMultipleFields.SupportsWriter: Boolean; 1836 | begin 1837 | Result := True; 1838 | end; 1839 | 1840 | procedure TProjectionMultipleFields.Write(const AWriter: IUgarBsonBaseWriter); 1841 | var 1842 | I: Integer; 1843 | begin 1844 | AWriter.WriteStartDocument; 1845 | for I := 0 to Length(FFieldNames) - 1 do 1846 | begin 1847 | AWriter.WriteName(FFieldNames[I]); 1848 | AWriter.WriteInt32(FValue); 1849 | end; 1850 | AWriter.WriteEndDocument; 1851 | end; 1852 | 1853 | { TProjectionElementMatch } 1854 | 1855 | function TProjectionElementMatch.Build: TUgarBsonDocument; 1856 | begin 1857 | Result := TUgarBsonDocument.Create(FFieldName, TUgarBsonDocument.Create('$elemMatch', FFilter.Render)); 1858 | end; 1859 | 1860 | constructor TProjectionElementMatch.Create(const AFieldName: String; const AFilter: TUgarFilter); 1861 | begin 1862 | Assert(not AFilter.IsNil); 1863 | inherited Create; 1864 | FFieldName := AFieldName; 1865 | FFilter := AFilter.FImpl; 1866 | end; 1867 | 1868 | { TSortJson } 1869 | 1870 | function TSortJson.Build: TUgarBsonDocument; 1871 | begin 1872 | Result := TUgarBsonDocument.Parse(FJson); 1873 | end; 1874 | 1875 | constructor TSortJson.Create(const AJson: String); 1876 | begin 1877 | inherited Create; 1878 | FJson := AJson; 1879 | end; 1880 | 1881 | { TSortBsonDocument } 1882 | 1883 | function TSortBsonDocument.Build: TUgarBsonDocument; 1884 | begin 1885 | Result := FDocument; 1886 | end; 1887 | 1888 | constructor TSortBsonDocument.Create(const ADocument: TUgarBsonDocument); 1889 | begin 1890 | inherited Create; 1891 | FDocument := ADocument; 1892 | end; 1893 | 1894 | { TSortCombine } 1895 | 1896 | function TSortCombine.Build: TUgarBsonDocument; 1897 | var 1898 | Sort: TUgarSort.ISort; 1899 | RenderedSort: TUgarBsonDocument; 1900 | Element: TUgarBsonElement; 1901 | begin 1902 | Result := TUgarBsonDocument.Create; 1903 | for Sort in FSorts do 1904 | begin 1905 | RenderedSort := Sort.Render; 1906 | for Element in RenderedSort do 1907 | begin 1908 | Result.Remove(Element.Name); 1909 | Result.Add(Element) 1910 | end; 1911 | end; 1912 | end; 1913 | 1914 | constructor TSortCombine.Create(const ASort1, ASort2: TUgarSort); 1915 | begin 1916 | Assert(not ASort1.IsNil); 1917 | Assert(not ASort2.IsNil); 1918 | inherited Create; 1919 | SetLength(FSorts, 2); 1920 | FSorts[0] := ASort1.FImpl; 1921 | FSorts[1] := ASort2.FImpl; 1922 | end; 1923 | 1924 | constructor TSortCombine.Create(const ASorts: array of TUgarSort); 1925 | var 1926 | I: Integer; 1927 | begin 1928 | inherited Create; 1929 | SetLength(FSorts, Length(ASorts)); 1930 | for I := 0 to Length(ASorts) - 1 do 1931 | begin 1932 | Assert(not ASorts[I].IsNil); 1933 | FSorts[I] := ASorts[I].FImpl; 1934 | end; 1935 | end; 1936 | 1937 | { TSortDirectional } 1938 | 1939 | constructor TSortDirectional.Create(const AFieldName: String; const ADirection: TUgarSortDirection); 1940 | begin 1941 | inherited Create; 1942 | FFieldName := AFieldName; 1943 | FDirection := ADirection; 1944 | end; 1945 | 1946 | class function TSortDirectional.SupportsWriter: Boolean; 1947 | begin 1948 | Result := True; 1949 | end; 1950 | 1951 | procedure TSortDirectional.Write(const AWriter: IUgarBsonBaseWriter); 1952 | begin 1953 | AWriter.WriteStartDocument; 1954 | AWriter.WriteName(FFieldName); 1955 | case FDirection of 1956 | TUgarSortDirection.Ascending: 1957 | AWriter.WriteInt32(1); 1958 | 1959 | TUgarSortDirection.Descending: 1960 | AWriter.WriteInt32(-1); 1961 | else 1962 | Assert(False); 1963 | end; 1964 | AWriter.WriteEndDocument; 1965 | end; 1966 | 1967 | { TUpdate } 1968 | 1969 | function TUpdate.IsCombine: Boolean; 1970 | begin 1971 | Result := False; 1972 | end; 1973 | 1974 | { TUpdateJson } 1975 | 1976 | function TUpdateJson.Build: TUgarBsonDocument; 1977 | begin 1978 | Result := TUgarBsonDocument.Parse(FJson); 1979 | end; 1980 | 1981 | constructor TUpdateJson.Create(const AJson: String); 1982 | begin 1983 | inherited Create; 1984 | FJson := AJson; 1985 | end; 1986 | 1987 | { TUpdateBsonDocument } 1988 | 1989 | function TUpdateBsonDocument.Build: TUgarBsonDocument; 1990 | begin 1991 | Result := FDocument; 1992 | end; 1993 | 1994 | constructor TUpdateBsonDocument.Create(const ADocument: TUgarBsonDocument); 1995 | begin 1996 | inherited Create; 1997 | FDocument := ADocument; 1998 | end; 1999 | 2000 | { TUpdateOperator } 2001 | 2002 | constructor TUpdateOperator.Create(const AOperator, AFieldName: String; const AValue: TUgarBsonValue); 2003 | begin 2004 | inherited Create; 2005 | FOperator := AOperator; 2006 | FFieldName := AFieldName; 2007 | FValue := AValue; 2008 | end; 2009 | 2010 | class function TUpdateOperator.SupportsWriter: Boolean; 2011 | begin 2012 | Result := True; 2013 | end; 2014 | 2015 | procedure TUpdateOperator.Write(const AWriter: IUgarBsonBaseWriter); 2016 | begin 2017 | AWriter.WriteStartDocument; 2018 | AWriter.WriteName(FOperator); 2019 | 2020 | AWriter.WriteStartDocument; 2021 | AWriter.WriteName(FFieldName); 2022 | AWriter.WriteValue(FValue); 2023 | AWriter.WriteEndDocument; 2024 | 2025 | AWriter.WriteEndDocument; 2026 | end; 2027 | 2028 | { TUpdateBitwiseOperator } 2029 | 2030 | constructor TUpdateBitwiseOperator.Create(const AOperator, AFieldName: String; const AValue: TUgarBsonValue); 2031 | begin 2032 | inherited Create; 2033 | FOperator := AOperator; 2034 | FFieldName := AFieldName; 2035 | FValue := AValue; 2036 | end; 2037 | 2038 | class function TUpdateBitwiseOperator.SupportsWriter: Boolean; 2039 | begin 2040 | Result := True; 2041 | end; 2042 | 2043 | procedure TUpdateBitwiseOperator.Write(const AWriter: IUgarBsonBaseWriter); 2044 | begin 2045 | AWriter.WriteStartDocument; 2046 | AWriter.WriteName('$bit'); 2047 | 2048 | AWriter.WriteStartDocument; 2049 | AWriter.WriteName(FFieldName); 2050 | 2051 | AWriter.WriteStartDocument; 2052 | AWriter.WriteName(FOperator); 2053 | AWriter.WriteValue(FValue); 2054 | AWriter.WriteEndDocument; 2055 | 2056 | AWriter.WriteEndDocument; 2057 | 2058 | AWriter.WriteEndDocument; 2059 | end; 2060 | 2061 | { TUpdateAddToSet } 2062 | 2063 | constructor TUpdateAddToSet.Create(const AFieldName: String; const AValue: TUgarBsonValue); 2064 | begin 2065 | inherited Create; 2066 | FFieldName := AFieldName; 2067 | SetLength(FValues, 1); 2068 | FValues[0] := AValue; 2069 | end; 2070 | 2071 | constructor TUpdateAddToSet.Create(const AFieldName: String; const AValues: array of TUgarBsonValue); 2072 | var 2073 | I: Integer; 2074 | begin 2075 | inherited Create; 2076 | FFieldName := AFieldName; 2077 | SetLength(FValues, Length(AValues)); 2078 | for I := 0 to Length(AValues) - 1 do 2079 | FValues[I] := AValues[I]; 2080 | end; 2081 | 2082 | class function TUpdateAddToSet.SupportsWriter: Boolean; 2083 | begin 2084 | Result := True; 2085 | end; 2086 | 2087 | procedure TUpdateAddToSet.Write(const AWriter: IUgarBsonBaseWriter); 2088 | var 2089 | I: Integer; 2090 | begin 2091 | AWriter.WriteStartDocument; 2092 | 2093 | AWriter.WriteName('$addToSet'); 2094 | AWriter.WriteStartDocument; 2095 | 2096 | AWriter.WriteName(FFieldName); 2097 | 2098 | if (Length(FValues) = 1) then 2099 | AWriter.WriteValue(FValues[0]) 2100 | else 2101 | begin 2102 | AWriter.WriteStartDocument; 2103 | AWriter.WriteName('$each'); 2104 | AWriter.WriteStartArray; 2105 | 2106 | for I := 0 to Length(FValues) - 1 do 2107 | AWriter.WriteValue(FValues[I]); 2108 | 2109 | AWriter.WriteEndArray; 2110 | AWriter.WriteEndDocument; 2111 | end; 2112 | 2113 | AWriter.WriteEndDocument; 2114 | 2115 | AWriter.WriteEndDocument; 2116 | end; 2117 | 2118 | { TUpdatePull } 2119 | 2120 | constructor TUpdatePull.Create(const AFieldName: String; const AValue: TUgarBsonValue); 2121 | begin 2122 | inherited Create; 2123 | FFieldName := AFieldName; 2124 | SetLength(FValues, 1); 2125 | FValues[0] := AValue; 2126 | end; 2127 | 2128 | constructor TUpdatePull.Create(const AFieldName: String; const AValues: array of TUgarBsonValue); 2129 | var 2130 | I: Integer; 2131 | begin 2132 | inherited Create; 2133 | FFieldName := AFieldName; 2134 | SetLength(FValues, Length(AValues)); 2135 | for I := 0 to Length(AValues) - 1 do 2136 | FValues[I] := AValues[I]; 2137 | end; 2138 | 2139 | constructor TUpdatePull.Create(const AFieldName: String; const AFilter: TUgarFilter); 2140 | begin 2141 | inherited Create; 2142 | FFieldName := AFieldName; 2143 | FFilter := AFilter; 2144 | end; 2145 | 2146 | class function TUpdatePull.SupportsWriter: Boolean; 2147 | begin 2148 | Result := True; 2149 | end; 2150 | 2151 | procedure TUpdatePull.Write(const AWriter: IUgarBsonBaseWriter); 2152 | var 2153 | RenderedFilter: TUgarBsonDocument; 2154 | I: Integer; 2155 | begin 2156 | AWriter.WriteStartDocument; 2157 | if (FFilter.IsNil) then 2158 | begin 2159 | if (Length(FValues) = 1) then 2160 | AWriter.WriteName('$pull') 2161 | else 2162 | AWriter.WriteName('$pullAll'); 2163 | AWriter.WriteStartDocument; 2164 | 2165 | AWriter.WriteName(FFieldName); 2166 | if (Length(FValues) = 1) then 2167 | AWriter.WriteValue(FValues[0]) 2168 | else 2169 | begin 2170 | AWriter.WriteStartArray; 2171 | for I := 0 to Length(FValues) - 1 do 2172 | AWriter.WriteValue(FValues[I]); 2173 | AWriter.WriteEndArray; 2174 | end; 2175 | 2176 | AWriter.WriteEndDocument; 2177 | end 2178 | else 2179 | begin 2180 | RenderedFilter := FFilter.Render; 2181 | 2182 | AWriter.WriteStartDocument('$pull'); 2183 | 2184 | AWriter.WriteName(FFieldName); 2185 | AWriter.WriteValue(RenderedFilter); 2186 | 2187 | AWriter.WriteEndDocument; 2188 | end; 2189 | AWriter.WriteEndDocument; 2190 | end; 2191 | 2192 | { TUpdatePush } 2193 | 2194 | constructor TUpdatePush.Create(const AFieldName: String; const AValue: TUgarBsonValue); 2195 | begin 2196 | inherited Create; 2197 | FFieldName := AFieldName; 2198 | SetLength(FValues, 1); 2199 | FValues[0] := AValue; 2200 | FSlice := TUgarUpdate.NO_SLICE; 2201 | FPosition := TUgarUpdate.NO_POSITION; 2202 | end; 2203 | 2204 | constructor TUpdatePush.Create(const AFieldName: String; const AValues: array of TUgarBsonValue; 2205 | const ASlice, APosition: Integer; const ASort: TUgarSort); 2206 | var 2207 | I: Integer; 2208 | begin 2209 | inherited Create; 2210 | FFieldName := AFieldName; 2211 | SetLength(FValues, Length(AValues)); 2212 | for I := 0 to Length(AValues) - 1 do 2213 | FValues[I] := AValues[I]; 2214 | FSlice := ASlice; 2215 | FPosition := APosition; 2216 | FSort := ASort; 2217 | end; 2218 | 2219 | class function TUpdatePush.SupportsWriter: Boolean; 2220 | begin 2221 | Result := True; 2222 | end; 2223 | 2224 | procedure TUpdatePush.Write(const AWriter: IUgarBsonBaseWriter); 2225 | var 2226 | I: Integer; 2227 | RenderedSort: TUgarBsonDocument; 2228 | begin 2229 | AWriter.WriteStartDocument; 2230 | AWriter.WriteStartDocument('$push'); 2231 | 2232 | AWriter.WriteName(FFieldName); 2233 | if (FSlice = TUgarUpdate.NO_SLICE) and (FPosition = TUgarUpdate.NO_POSITION) and (FSort.IsNil) and 2234 | (Length(FValues) = 1) then 2235 | AWriter.WriteValue(FValues[0]) 2236 | else 2237 | begin 2238 | AWriter.WriteStartDocument; 2239 | 2240 | AWriter.WriteStartArray('$each'); 2241 | for I := 0 to Length(FValues) - 1 do 2242 | AWriter.WriteValue(FValues[I]); 2243 | AWriter.WriteEndArray; 2244 | 2245 | if (FSlice <> TUgarUpdate.NO_SLICE) then 2246 | AWriter.WriteInt32('$slice', FSlice); 2247 | 2248 | if (FPosition <> TUgarUpdate.NO_POSITION) then 2249 | AWriter.WriteInt32('$position', FPosition); 2250 | 2251 | if (not FSort.IsNil) then 2252 | begin 2253 | RenderedSort := FSort.Render; 2254 | AWriter.WriteName('$sort'); 2255 | AWriter.WriteValue(RenderedSort); 2256 | end; 2257 | AWriter.WriteEndDocument; 2258 | end; 2259 | 2260 | AWriter.WriteEndDocument; 2261 | AWriter.WriteEndDocument; 2262 | end; 2263 | 2264 | { TUpdateCombine } 2265 | 2266 | procedure TUpdateCombine.Add(const AUpdate: TUgarUpdate.IUpdate); 2267 | var 2268 | NewCapacity: Integer; 2269 | begin 2270 | if (FCount >= Length(FUpdates)) then 2271 | begin 2272 | if (FCount = 0) then 2273 | NewCapacity := 2 2274 | else 2275 | NewCapacity := FCount * 2; 2276 | SetLength(FUpdates, NewCapacity); 2277 | end; 2278 | FUpdates[FCount] := AUpdate; 2279 | Inc(FCount); 2280 | end; 2281 | 2282 | function TUpdateCombine.Build: TUgarBsonDocument; 2283 | var 2284 | I: Integer; 2285 | Update: TUgarUpdate.IUpdate; 2286 | RenderedUpdate: TUgarBsonDocument; 2287 | Element: TUgarBsonElement; 2288 | CurrentOperatorValue: TUgarBsonValue; 2289 | begin 2290 | Result := TUgarBsonDocument.Create; 2291 | for I := 0 to FCount - 1 do 2292 | begin 2293 | Update := FUpdates[I]; 2294 | RenderedUpdate := Update.Render; 2295 | for Element in RenderedUpdate do 2296 | begin 2297 | if (Result.TryGetValue(Element.Name, CurrentOperatorValue)) then 2298 | Result[Element.Name] := CurrentOperatorValue.AsBsonDocument.Merge(Element.Value.AsBsonDocument, True) 2299 | else 2300 | Result.Add(Element); 2301 | end; 2302 | end; 2303 | end; 2304 | 2305 | constructor TUpdateCombine.Create(const AUpdate1, AUpdate2: TUgarUpdate.IUpdate); 2306 | begin 2307 | Assert(Assigned(AUpdate1)); 2308 | Assert(Assigned(AUpdate2)); 2309 | inherited Create; 2310 | FCount := 2; 2311 | SetLength(FUpdates, 2); 2312 | FUpdates[0] := AUpdate1; 2313 | FUpdates[1] := AUpdate2; 2314 | end; 2315 | 2316 | constructor TUpdateCombine.Create(const AUpdate1, AUpdate2: TUgarUpdate); 2317 | begin 2318 | Assert(not AUpdate1.IsNil); 2319 | Assert(not AUpdate2.IsNil); 2320 | inherited Create; 2321 | FCount := 2; 2322 | SetLength(FUpdates, 2); 2323 | FUpdates[0] := AUpdate1.FImpl; 2324 | FUpdates[1] := AUpdate2.FImpl; 2325 | end; 2326 | 2327 | constructor TUpdateCombine.Create(const AUpdates: array of TUgarUpdate); 2328 | var 2329 | I: Integer; 2330 | begin 2331 | inherited Create; 2332 | FCount := Length(AUpdates); 2333 | SetLength(FUpdates, FCount); 2334 | for I := 0 to FCount - 1 do 2335 | begin 2336 | Assert(not AUpdates[I].IsNil); 2337 | FUpdates[I] := AUpdates[I].FImpl; 2338 | end; 2339 | end; 2340 | 2341 | function TUpdateCombine.IsCombine: Boolean; 2342 | begin 2343 | Result := True; 2344 | end; 2345 | 2346 | end. 2347 | -------------------------------------------------------------------------------- /src/ugar.db.mongo.internals.pas: -------------------------------------------------------------------------------- 1 | unit ugar.db.mongo.internals; 2 | 3 | interface 4 | 5 | {$POINTERMATH ON} 6 | 7 | uses 8 | ugar.db.mongo, ugar.db.mongo.Imp, 9 | ugar.db.mongo.Enum, ugar.db.mongo.Query, System.SysUtils, System.JSON, 10 | System.Generics.Collections, ugar.db.mongo.Protocol; 11 | 12 | type 13 | TUgarClientHack = class(TUgarClient) 14 | property Protocol; 15 | end; 16 | 17 | TUgarDatabase = class(TInterfacedObject, IUgarDatabase) 18 | private 19 | FClient: IUgarClient; 20 | FProtocol: TUgarMongoProtocol; // Reference 21 | FName: String; 22 | FFullCommandCollectionName: UTF8String; 23 | protected 24 | function _GetClient: IUgarClient; 25 | function _GetName: String; 26 | 27 | function ListCollectionNames: TArray; 28 | function ListCollections: TArray; 29 | procedure DropCollection(const AName: String); 30 | procedure DropDatabase; 31 | function GetCollection(const AName: String): IUgarCollection; 32 | 33 | function RunCommand(const ACommand: string): IUgarCursor; overload; 34 | function RunCommand(const ACommand: TUgarBsonDocument): IUgarCursor; overload; 35 | protected 36 | property Protocol: TUgarMongoProtocol read FProtocol; 37 | property Name: String read FName; 38 | property FullCommandCollectionName: UTF8String read FFullCommandCollectionName; 39 | public 40 | constructor Create(const AClient: TUgarClient; const AName: String); 41 | end; 42 | 43 | TUgarCursor = class(TInterfacedObject, IUgarCursor) 44 | private type 45 | TEnumerator = class(TEnumerator) 46 | private 47 | FProtocol: TUgarMongoProtocol; // Reference 48 | FFullCollectionName: UTF8String; 49 | FPage: TArray; 50 | FCursorId: Int64; 51 | FIndex: Integer; 52 | private 53 | procedure GetMore; 54 | protected 55 | function DoGetCurrent: TUgarBsonDocument; override; 56 | function DoMoveNext: Boolean; override; 57 | public 58 | constructor Create(const AProtocol: TUgarMongoProtocol; const AFullCollectionName: UTF8String; 59 | const APage: TArray; const ACursorId: Int64); 60 | end; 61 | private 62 | FProtocol: TUgarMongoProtocol; // Reference 63 | FFullCollectionName: UTF8String; 64 | FInitialPage: TArray; 65 | FInitialCursorId: Int64; 66 | public 67 | function GetEnumerator: TEnumerator; 68 | function ToArray: TArray; 69 | public 70 | constructor Create(const AProtocol: TUgarMongoProtocol; const AFullCollectionName: UTF8String; 71 | const AInitialPage: TArray; const AInitialCursorId: Int64); 72 | end; 73 | 74 | TUgarCollection = class(TInterfacedObject, IUgarCollection) 75 | private type 76 | PUgarBsonDocument = ^TUgarBsonDocument; 77 | private 78 | FDatabase: IUgarDatabase; 79 | FProtocol: TUgarMongoProtocol; // Reference 80 | FName: String; 81 | FFullName: UTF8String; 82 | FFullCommandCollectionName: UTF8String; 83 | private 84 | procedure AddWriteConcern(const AWriter: IUgarBsonWriter); 85 | function InsertMany(const ADocuments: PUgarBsonDocument; const ACount: Integer; const AOrdered: Boolean) 86 | : Integer; overload; 87 | function Delete(const AFilter: TUgarFilter; const AOrdered: Boolean; const ALimit: Integer): Integer; 88 | function Update(const AFilter: TUgarFilter; const AUpdate: TUgarUpdate; 89 | const AUpsert, AOrdered, AMulti: Boolean): Integer; 90 | 91 | function Find(const AFilter, AProjection: TBytes): IUgarCursor; overload; 92 | function FindOne(const AFilter, AProjection: TBytes): TUgarBsonDocument; overload; 93 | private 94 | class function AddModifier(const AFilter: TUgarFilter; const ASort: TUgarSort): TBytes; static; 95 | protected 96 | function _GetDatabase: IUgarDatabase; 97 | function _GetName: String; 98 | 99 | function InsertOne(const ADocument: TUgarBsonDocument): Boolean; overload; 100 | function InsertOne(const ADocument: TJsonObject): TJSONObject; overload; 101 | function InsertOne(const ADocument: string): Boolean; overload; 102 | 103 | function InsertMany(const ADocuments: array of TUgarBsonDocument; const AOrdered: Boolean = True): Integer; overload; 104 | function InsertMany(const ADocuments: array of TJsonObject; const AOrdered: Boolean = True): Integer; overload; 105 | function InsertMany(const ADocuments: array of string; const AOrdered: Boolean = True): Integer; overload; 106 | 107 | function InsertMany(const ADocuments: TArray; const AOrdered: Boolean = True): Integer; overload; 108 | function InsertMany(const ADocuments: TArray; const AOrdered: Boolean = True): Integer; overload; 109 | function InsertMany(const ADocuments: TArray; const AOrdered: Boolean = True): Integer; overload; 110 | 111 | function InsertMany(const ADocuments: TEnumerable; const AOrdered: Boolean = True) 112 | : Integer; overload; 113 | function InsertMany(const ADocuments: TEnumerable; const AOrdered: Boolean = True): Integer; overload; 114 | function InsertMany(const ADocuments: TEnumerable; const AOrdered: Boolean = True): Integer; overload; 115 | 116 | function DeleteOne(const AFilter: TUgarFilter): Boolean; 117 | function DeleteMany(const AFilter: TUgarFilter; const AOrdered: Boolean = True): Integer; 118 | 119 | function UpdateOne(const AFilter: TUgarFilter; const AUpdate: TUgarUpdate; const AUpsert: Boolean = False): Boolean; 120 | function UpdateMany(const AFilter: TUgarFilter; const AUpdate: TUgarUpdate; const AUpsert: Boolean = False; 121 | const AOrdered: Boolean = True): Integer; 122 | 123 | function Find(const AFilter: TUgarFilter; const AProjection: TUgarProjection): IUgarCursor; overload; 124 | function Find(const AFilter: TUgarFilter): IUgarCursor; overload; 125 | function Find(const AProjection: TUgarProjection): IUgarCursor; overload; 126 | function Find: TJSONArray; overload; 127 | function Find(const AFilter: TUgarFilter; const ASort: TUgarSort): IUgarCursor; overload; 128 | function Find(const AFilter: TUgarFilter; const AProjection: TUgarProjection; const ASort: TUgarSort) 129 | : IUgarCursor; overload; 130 | function FindOne(const AFilter: TUgarFilter; const AProjection: TUgarProjection): TUgarBsonDocument; overload; 131 | function FindOne(const AFilter: TUgarFilter): TUgarBsonDocument; overload; 132 | 133 | function Count: Integer; overload; 134 | function Count(const AFilter: TUgarFilter): Integer; overload; 135 | public 136 | constructor Create(const ADatabase: TUgarDatabase; const AName: String); 137 | end; 138 | 139 | implementation 140 | 141 | uses 142 | ugar.db.mongo.Func, System.Math, Grijjy.Bson, Grijjy.Bson.IO; 143 | 144 | { TUgarDatabase } 145 | 146 | constructor TUgarDatabase.Create(const AClient: TUgarClient; const AName: String); 147 | begin 148 | Assert(AClient <> nil); 149 | Assert(AName <> ''); 150 | inherited Create; 151 | FClient := AClient; 152 | FName := AName; 153 | FFullCommandCollectionName := UTF8String(AName + '.' + COLLECTION_COMMAND); 154 | FProtocol := TUgarClientHack(AClient).Protocol; 155 | Assert(FProtocol <> nil); 156 | end; 157 | 158 | procedure TUgarDatabase.DropCollection(const AName: String); 159 | var 160 | Writer: IUgarBsonWriter; 161 | Reply: IUgarMongoReply; 162 | begin 163 | Writer := TUgarBsonWriter.Create; 164 | Writer.WriteStartDocument; 165 | Writer.WriteString('drop', AName); 166 | Writer.WriteEndDocument; 167 | Reply := FProtocol.OpQuery(FFullCommandCollectionName, [], 0, -1, Writer.ToBson, nil); 168 | HandleCommandReply(Reply, TUgarErrorCode.NamespaceNotFound); 169 | end; 170 | 171 | procedure TUgarDatabase.DropDatabase; 172 | begin 173 | _GetClient.DropDatabase(Name); 174 | end; 175 | 176 | function TUgarDatabase.GetCollection(const AName: String): IUgarCollection; 177 | begin 178 | Result := TUgarCollection.Create(Self, AName); 179 | end; 180 | 181 | function TUgarDatabase.ListCollectionNames: TArray; 182 | var 183 | LDocs: TArray; 184 | LIndex: Integer; 185 | begin 186 | LDocs := ListCollections; 187 | SetLength(Result, Length(LDocs)); 188 | for LIndex := 0 to Length(LDocs) - 1 do 189 | Result[LIndex] := LDocs[LIndex]['name']; 190 | end; 191 | 192 | function TUgarDatabase.ListCollections: TArray; 193 | var 194 | LWriter: IUgarBsonWriter; 195 | LReply: IUgarMongoReply; 196 | LDoc, LCursor: TUgarBsonDocument; 197 | LValue: TUgarBsonValue; 198 | LDocs: TUgarBsonArray; 199 | LIndex: Integer; 200 | begin 201 | LWriter := TUgarBsonWriter.Create; 202 | LWriter.WriteStartDocument; 203 | LWriter.WriteInt32('listCollections', 1); 204 | LWriter.WriteEndDocument; 205 | LReply := FProtocol.OpQuery(FFullCommandCollectionName, [], 0, -1, LWriter.ToBson, nil); 206 | HandleCommandReply(LReply); 207 | if (LReply.Documents = nil) then 208 | Exit(nil); 209 | 210 | LDoc := TUgarBsonDocument.Load(LReply.Documents[0]); 211 | if (not LDoc.TryGetValue('cursor', LValue)) then 212 | Exit(nil); 213 | LCursor := LValue.AsBsonDocument; 214 | 215 | if (not LCursor.TryGetValue('firstBatch', LValue)) then 216 | Exit(nil); 217 | 218 | LDocs := LValue.AsBsonArray; 219 | SetLength(Result, LDocs.Count); 220 | for LIndex := 0 to LDocs.Count - 1 do 221 | Result[LIndex] := LDocs[LIndex].AsBsonDocument; 222 | end; 223 | 224 | function TUgarDatabase.RunCommand(const ACommand: TUgarBsonDocument): IUgarCursor; 225 | var 226 | Reply: IUgarMongoReply; 227 | begin 228 | Reply := FProtocol.OpQuery(FFullCommandCollectionName, [], 0, -1, ACommand.ToBson, nil); 229 | HandleCommandReply(Reply); 230 | Result := TUgarCursor.Create(FProtocol, UTF8String(FName), Reply.Documents, Reply.CursorId); 231 | end; 232 | 233 | function TUgarDatabase.RunCommand(const ACommand: string): IUgarCursor; 234 | begin 235 | Result := RunCommand(TgoBsonDocument.Parse(ACommand)); 236 | end; 237 | 238 | function TUgarDatabase._GetClient: IUgarClient; 239 | begin 240 | Result := FClient; 241 | end; 242 | 243 | function TUgarDatabase._GetName: String; 244 | begin 245 | Result := FName; 246 | end; 247 | 248 | { TUgarCollection } 249 | 250 | class function TUgarCollection.AddModifier(const AFilter: TUgarFilter; const ASort: TUgarSort): TBytes; 251 | var 252 | Writer: IUgarBsonWriter; 253 | begin 254 | Writer := TUgarBsonWriter.Create; 255 | Writer.WriteStartDocument; 256 | Writer.WriteName('$query'); 257 | Writer.WriteRawBsonDocument(AFilter.ToBson); 258 | Writer.WriteName('$orderby'); 259 | Writer.WriteRawBsonDocument(ASort.ToBson); 260 | Writer.WriteEndDocument; 261 | Result := Writer.ToBson; 262 | end; 263 | 264 | procedure TUgarCollection.AddWriteConcern(const AWriter: IUgarBsonWriter); 265 | begin 266 | { TODO -oROB -cFeature : Write concerns are currently not supported } 267 | end; 268 | 269 | function TUgarCollection.Count(const AFilter: TUgarFilter): Integer; 270 | var 271 | Writer: IUgarBsonWriter; 272 | Reply: IUgarMongoReply; 273 | begin 274 | Writer := TUgarBsonWriter.Create; 275 | 276 | Writer.WriteStartDocument; 277 | Writer.WriteString('count', FName); 278 | Writer.WriteName('query'); 279 | Writer.WriteRawBsonDocument(AFilter.ToBson); 280 | Writer.WriteEndDocument; 281 | 282 | Reply := FProtocol.OpQuery(FFullCommandCollectionName, [], 0, -1, Writer.ToBson, nil); 283 | Result := HandleCommandReply(Reply); 284 | end; 285 | 286 | function TUgarCollection.Count: Integer; 287 | begin 288 | Result := Count(TUgarFilter.Empty); 289 | end; 290 | 291 | constructor TUgarCollection.Create(const ADatabase: TUgarDatabase; const AName: String); 292 | begin 293 | Assert(Assigned(ADatabase)); 294 | Assert(AName <> ''); 295 | inherited Create; 296 | FDatabase := ADatabase; 297 | FName := AName; 298 | FFullName := UTF8String(ADatabase.Name + '.' + AName); 299 | FFullCommandCollectionName := ADatabase.FullCommandCollectionName; 300 | FProtocol := ADatabase.Protocol; 301 | Assert(FProtocol <> nil); 302 | end; 303 | 304 | function TUgarCollection.Delete(const AFilter: TUgarFilter; const AOrdered: Boolean; const ALimit: Integer): Integer; 305 | var 306 | Writer: IUgarBsonWriter; 307 | Reply: IUgarMongoReply; 308 | begin 309 | Writer := TUgarBsonWriter.Create; 310 | Writer.WriteStartDocument; 311 | 312 | Writer.WriteString('delete', FName); 313 | 314 | Writer.WriteStartArray('deletes'); 315 | Writer.WriteStartDocument; 316 | Writer.WriteName('q'); 317 | Writer.WriteRawBsonDocument(AFilter.ToBson); 318 | Writer.WriteInt32('limit', ALimit); 319 | Writer.WriteEndDocument; 320 | Writer.WriteEndArray; 321 | 322 | AddWriteConcern(Writer); 323 | Writer.WriteEndDocument; 324 | 325 | Reply := FProtocol.OpQuery(FFullCommandCollectionName, [], 0, -1, Writer.ToBson, nil); 326 | Result := HandleCommandReply(Reply); 327 | end; 328 | 329 | function TUgarCollection.DeleteMany(const AFilter: TUgarFilter; const AOrdered: Boolean): Integer; 330 | begin 331 | Result := Delete(AFilter, AOrdered, 0); 332 | end; 333 | 334 | function TUgarCollection.DeleteOne(const AFilter: TUgarFilter): Boolean; 335 | begin 336 | Result := (Delete(AFilter, True, 1) = 1); 337 | end; 338 | 339 | function TUgarCollection.Find(const AFilter: TUgarFilter; const ASort: TUgarSort): IUgarCursor; 340 | begin 341 | Result := Find(AddModifier(AFilter, ASort), nil); 342 | end; 343 | 344 | function TUgarCollection.Find(const AFilter: TUgarFilter; const AProjection: TUgarProjection; const ASort: TUgarSort) 345 | : IUgarCursor; 346 | begin 347 | Result := Find(AddModifier(AFilter, ASort), AProjection.ToBson); 348 | end; 349 | 350 | function TUgarCollection.Find(const AFilter: TUgarFilter; const AProjection: TUgarProjection): IUgarCursor; 351 | begin 352 | Result := Find(AFilter.ToBson, AProjection.ToBson); 353 | end; 354 | 355 | function TUgarCollection.Find(const AFilter: TUgarFilter): IUgarCursor; 356 | begin 357 | Result := Find(AFilter.ToBson, nil); 358 | end; 359 | 360 | function TUgarCollection.Find(const AProjection: TUgarProjection): IUgarCursor; 361 | begin 362 | Result := Find(nil, AProjection.ToBson); 363 | end; 364 | 365 | function TUgarCollection.Find(const AFilter, AProjection: TBytes): IUgarCursor; 366 | var 367 | Reply: IUgarMongoReply; 368 | begin 369 | Reply := FProtocol.OpQuery(FFullName, [], 0, 0, AFilter, AProjection); 370 | HandleTimeout(Reply); 371 | Result := TUgarCursor.Create(FProtocol, FFullName, Reply.Documents, Reply.CursorId); 372 | end; 373 | 374 | function TUgarCollection.Find: TJSONArray; 375 | var 376 | LBSON: TEnumerator; 377 | begin 378 | Result := TJSONArray.Create; 379 | 380 | LBSON := Find(nil, nil).GetEnumerator; 381 | 382 | while LBSON.MoveNext do 383 | begin 384 | Result.AddElement(TJSONObject.ParseJSONValue(LBSON.Current.ToJson)); 385 | end; 386 | 387 | end; 388 | 389 | function TUgarCollection.FindOne(const AFilter, AProjection: TBytes): TUgarBsonDocument; 390 | var 391 | LReply: IUgarMongoReply; 392 | begin 393 | LReply := FProtocol.OpQuery(FFullName, [], 0, 1, AFilter, AProjection); 394 | HandleTimeout(LReply); 395 | if (LReply.Documents = nil) then 396 | Result.SetNil 397 | else 398 | Result := TUgarBsonDocument.Load(LReply.Documents[0]); 399 | end; 400 | 401 | function TUgarCollection.FindOne(const AFilter: TUgarFilter): TUgarBsonDocument; 402 | begin 403 | Result := FindOne(AFilter.ToBson, nil); 404 | end; 405 | 406 | function TUgarCollection.FindOne(const AFilter: TUgarFilter; const AProjection: TUgarProjection): TUgarBsonDocument; 407 | begin 408 | Result := FindOne(AFilter.ToBson, AProjection.ToBson); 409 | end; 410 | 411 | function TUgarCollection.InsertMany(const ADocuments: TArray; const AOrdered: Boolean): Integer; 412 | begin 413 | if (Length(ADocuments) > 0) then 414 | Result := InsertMany(@ADocuments[0], Length(ADocuments), AOrdered) 415 | else 416 | Result := 0; 417 | end; 418 | 419 | function TUgarCollection.InsertMany(const ADocuments: TEnumerable; const AOrdered: Boolean): Integer; 420 | begin 421 | Result := InsertMany(ADocuments.ToArray, AOrdered); 422 | end; 423 | 424 | function TUgarCollection.InsertMany(const ADocuments: PUgarBsonDocument; const ACount: Integer; 425 | const AOrdered: Boolean): Integer; 426 | var 427 | LWriter: IUgarBsonWriter; 428 | LReply: IUgarMongoReply; 429 | LI, LRemaining, LItemsInBatch, LIndex: Integer; 430 | begin 431 | LRemaining := ACount; 432 | LIndex := 0; 433 | Result := 0; 434 | while (LRemaining > 0) do 435 | begin 436 | LWriter := TUgarBsonWriter.Create; 437 | 438 | LWriter.WriteStartDocument; 439 | 440 | LWriter.WriteString('insert', FName); 441 | 442 | LWriter.WriteStartArray('documents'); 443 | 444 | LItemsInBatch := Min(LRemaining, MAX_BULK_SIZE); 445 | 446 | for LI := 0 to LItemsInBatch - 1 do 447 | begin 448 | LWriter.WriteValue(ADocuments[LIndex]); 449 | Inc(LIndex); 450 | end; 451 | 452 | Dec(LRemaining, LItemsInBatch); 453 | LWriter.WriteEndArray; 454 | 455 | LWriter.WriteBoolean('ordered', AOrdered); 456 | 457 | AddWriteConcern(LWriter); 458 | 459 | LWriter.WriteEndDocument; 460 | 461 | LReply := FProtocol.OpQuery(FFullCommandCollectionName, [], 0, -1, LWriter.ToBson, nil); 462 | Inc(Result, HandleCommandReply(LReply)); 463 | end; 464 | Assert(LIndex = ACount); 465 | end; 466 | 467 | function TUgarCollection.InsertMany(const ADocuments: array of TUgarBsonDocument; const AOrdered: Boolean): Integer; 468 | begin 469 | if (Length(ADocuments) > 0) then 470 | Result := InsertMany(@ADocuments[0], Length(ADocuments), AOrdered) 471 | else 472 | Result := 0; 473 | end; 474 | 475 | function TUgarCollection.InsertOne(const ADocument: TUgarBsonDocument): Boolean; 476 | var 477 | Writer: IUgarBsonWriter; 478 | Reply: IUgarMongoReply; 479 | begin 480 | Writer := TUgarBsonWriter.Create; 481 | Writer.WriteStartDocument; 482 | Writer.WriteString('insert', FName); 483 | 484 | Writer.WriteStartArray('documents'); 485 | Writer.WriteValue(ADocument); 486 | Writer.WriteEndArray; 487 | 488 | AddWriteConcern(Writer); 489 | 490 | Writer.WriteEndDocument; 491 | 492 | Reply := FProtocol.OpQuery(FFullCommandCollectionName, [], 0, -1, Writer.ToBson, nil); 493 | Result := (HandleCommandReply(Reply) = 1); 494 | end; 495 | 496 | function TUgarCollection.InsertOne(const ADocument: TJsonObject): TJSONObject; 497 | begin 498 | InsertOne(TUgarBsonDocument.Parse(ADocument.ToJSON)); 499 | Result := ADocument; 500 | end; 501 | 502 | function TUgarCollection.InsertMany(const ADocuments: TArray; const AOrdered: Boolean): Integer; 503 | var 504 | LDocuments: TArray; 505 | LIndex: Integer; 506 | begin 507 | SetLength(LDocuments, Length(ADocuments)); 508 | 509 | for LIndex := 0 to Length(ADocuments) - 1 do 510 | LDocuments[LIndex] := ADocuments[LIndex].ToJSON; 511 | 512 | Result := InsertMany(LDocuments, AOrdered); 513 | end; 514 | 515 | function TUgarCollection.InsertMany(const ADocuments: array of string; const AOrdered: Boolean): Integer; 516 | var 517 | LDocuments: TArray; 518 | LIndex: Integer; 519 | begin 520 | SetLength(LDocuments, Length(ADocuments)); 521 | 522 | for LIndex := 0 to Length(ADocuments) - 1 do 523 | LDocuments[LIndex] := TUgarBsonDocument.Parse(ADocuments[LIndex]); 524 | 525 | Result := InsertMany(LDocuments, AOrdered); 526 | end; 527 | 528 | function TUgarCollection.InsertMany(const ADocuments: array of TJsonObject; const AOrdered: Boolean): Integer; 529 | var 530 | LDocuments: TArray; 531 | LIndex: Integer; 532 | begin 533 | SetLength(LDocuments, Length(ADocuments)); 534 | 535 | for LIndex := 0 to Length(ADocuments) - 1 do 536 | LDocuments[LIndex] := ADocuments[LIndex].ToJSON; 537 | 538 | Result := InsertMany(LDocuments, AOrdered); 539 | end; 540 | 541 | function TUgarCollection.InsertMany(const ADocuments: TEnumerable; const AOrdered: Boolean): Integer; 542 | begin 543 | Result := InsertMany(ADocuments.ToArray, AOrdered); 544 | end; 545 | 546 | function TUgarCollection.InsertMany(const ADocuments: TEnumerable; const AOrdered: Boolean): Integer; 547 | begin 548 | Result := InsertMany(ADocuments.ToArray, AOrdered); 549 | end; 550 | 551 | function TUgarCollection.InsertMany(const ADocuments: TArray; const AOrdered: Boolean): Integer; 552 | var 553 | LDocuments: TArray; 554 | LIndex: Integer; 555 | begin 556 | SetLength(LDocuments, Length(ADocuments)); 557 | 558 | for LIndex := 0 to Length(ADocuments) - 1 do 559 | LDocuments[LIndex] := TUgarBsonDocument.Parse(ADocuments[LIndex]); 560 | 561 | Result := InsertMany(LDocuments, AOrdered); 562 | end; 563 | 564 | function TUgarCollection.InsertOne(const ADocument: string): Boolean; 565 | begin 566 | Result := InsertOne(TUgarBsonDocument.Parse(ADocument)); 567 | end; 568 | 569 | function TUgarCollection.Update(const AFilter: TUgarFilter; const AUpdate: TUgarUpdate; 570 | const AUpsert, AOrdered, AMulti: Boolean): Integer; 571 | var 572 | Writer: IUgarBsonWriter; 573 | Reply: IUgarMongoReply; 574 | begin 575 | Writer := TUgarBsonWriter.Create; 576 | Writer.WriteStartDocument; 577 | Writer.WriteString('update', FName); 578 | 579 | Writer.WriteStartArray('updates'); 580 | 581 | Writer.WriteStartDocument; 582 | Writer.WriteName('q'); 583 | Writer.WriteRawBsonDocument(AFilter.ToBson); 584 | Writer.WriteName('u'); 585 | Writer.WriteRawBsonDocument(AUpdate.ToBson); 586 | Writer.WriteBoolean('upsert', AUpsert); 587 | Writer.WriteBoolean('multi', AMulti); 588 | Writer.WriteEndDocument; 589 | 590 | Writer.WriteEndArray; 591 | 592 | Writer.WriteBoolean('ordered', AOrdered); 593 | 594 | AddWriteConcern(Writer); 595 | 596 | Writer.WriteEndDocument; 597 | 598 | Reply := FProtocol.OpQuery(FFullCommandCollectionName, [], 0, -1, Writer.ToBson, nil); 599 | Result := HandleCommandReply(Reply); 600 | end; 601 | 602 | function TUgarCollection.UpdateMany(const AFilter: TUgarFilter; const AUpdate: TUgarUpdate; 603 | const AUpsert, AOrdered: Boolean): Integer; 604 | begin 605 | Result := Update(AFilter, AUpdate, AUpsert, AOrdered, True); 606 | end; 607 | 608 | function TUgarCollection.UpdateOne(const AFilter: TUgarFilter; const AUpdate: TUgarUpdate; 609 | const AUpsert: Boolean): Boolean; 610 | begin 611 | Result := (Update(AFilter, AUpdate, AUpsert, False, False) = 1); 612 | end; 613 | 614 | function TUgarCollection._GetDatabase: IUgarDatabase; 615 | begin 616 | Result := FDatabase; 617 | end; 618 | 619 | function TUgarCollection._GetName: String; 620 | begin 621 | Result := FName; 622 | end; 623 | 624 | { TUgarCursor } 625 | 626 | constructor TUgarCursor.Create(const AProtocol: TUgarMongoProtocol; const AFullCollectionName: UTF8String; 627 | const AInitialPage: TArray; const AInitialCursorId: Int64); 628 | begin 629 | inherited Create; 630 | FProtocol := AProtocol; 631 | FFullCollectionName := AFullCollectionName; 632 | FInitialPage := AInitialPage; 633 | FInitialCursorId := AInitialCursorId; 634 | end; 635 | 636 | function TUgarCursor.GetEnumerator: TEnumerator; 637 | begin 638 | Result := TEnumerator.Create(FProtocol, FFullCollectionName, FInitialPage, FInitialCursorId); 639 | end; 640 | 641 | function TUgarCursor.ToArray: TArray; 642 | var 643 | LCount, LCapacity: Integer; 644 | LDoc: TUgarBsonDocument; 645 | begin 646 | LCount := 0; 647 | LCapacity := 16; 648 | SetLength(Result, LCapacity); 649 | 650 | for LDoc in Self do 651 | begin 652 | if (LCount >= LCapacity) then 653 | begin 654 | LCapacity := LCapacity * 2; 655 | SetLength(Result, LCapacity); 656 | end; 657 | Result[LCount] := LDoc; 658 | Inc(LCount); 659 | end; 660 | SetLength(Result, LCount); 661 | end; 662 | 663 | { TUgarCursor.TEnumerator } 664 | 665 | constructor TUgarCursor.TEnumerator.Create(const AProtocol: TUgarMongoProtocol; const AFullCollectionName: UTF8String; 666 | const APage: TArray; const ACursorId: Int64); 667 | begin 668 | inherited Create; 669 | FProtocol := AProtocol; 670 | FFullCollectionName := AFullCollectionName; 671 | FPage := APage; 672 | FCursorId := ACursorId; 673 | FIndex := -1; 674 | end; 675 | 676 | function TUgarCursor.TEnumerator.DoGetCurrent: TUgarBsonDocument; 677 | begin 678 | Result := TUgarBsonDocument.Load(FPage[FIndex]); 679 | end; 680 | 681 | function TUgarCursor.TEnumerator.DoMoveNext: Boolean; 682 | begin 683 | Result := (FIndex < (Length(FPage) - 1)); 684 | if Result then 685 | Inc(FIndex) 686 | else if (FCursorId <> 0) then 687 | begin 688 | GetMore; 689 | Result := (FPage <> nil); 690 | end; 691 | end; 692 | 693 | procedure TUgarCursor.TEnumerator.GetMore; 694 | var 695 | LReply: IUgarMongoReply; 696 | begin 697 | LReply := FProtocol.OpGetMore(FFullCollectionName, Length(FPage), FCursorId); 698 | HandleTimeout(LReply); 699 | FPage := LReply.Documents; 700 | FCursorId := LReply.CursorId; 701 | FIndex := 0; 702 | end; 703 | 704 | end. 705 | -------------------------------------------------------------------------------- /src/ugar.db.mongo.protocol.Types.pas: -------------------------------------------------------------------------------- 1 | unit ugar.db.mongo.protocol.Types; 2 | 3 | interface 4 | 5 | uses 6 | ugar.db.mongo.Enum, System.SysUtils; 7 | 8 | type 9 | IUgarMongoReply = interface 10 | ['{25CEF8E1-B023-4232-BE9A-1FBE9E51CE57}'] 11 | function _GetResponseFlags: TUgarMongoResponseFlags; 12 | function _GetCursorId: Int64; 13 | function _GetStartingFrom: Integer; 14 | function _GetResponseTo: Integer; 15 | function _GetDocuments: TArray; 16 | property ReponseFlags: TUgarMongoResponseFlags read _GetResponseFlags; 17 | property CursorId: Int64 read _GetCursorId; 18 | property StartingFrom: Integer read _GetStartingFrom; 19 | property ResponseTo: Integer read _GetResponseTo; 20 | property Documents: TArray read _GetDocuments; 21 | end; 22 | 23 | TUgarMongoProtocolSettings = record 24 | ConnectionTimeout: Integer; 25 | ReplyTimeout: Integer; 26 | PoolSize: Integer; 27 | end; 28 | 29 | type 30 | TMsgHeader = packed record 31 | MessageLength: Int32; 32 | RequestID: Int32; 33 | ResponseTo: Int32; 34 | OpCode: Int32; 35 | end; 36 | 37 | PMsgHeader = ^TMsgHeader; 38 | 39 | type 40 | TOpReplyHeader = packed record 41 | Header: TMsgHeader; 42 | ResponseFlags: Int32; 43 | CursorId: Int64; 44 | StartingFrom: Int32; 45 | NumberReturned: Int32; 46 | { Documents: Documents } 47 | end; 48 | 49 | POpReplyHeader = ^TOpReplyHeader; 50 | 51 | TUgarMongoReply = class(TInterfacedObject, IUgarMongoReply) 52 | private 53 | FHeader: TOpReplyHeader; 54 | FDocuments: TArray; 55 | protected 56 | function _GetResponseFlags: TUgarMongoResponseFlags; 57 | function _GetCursorId: Int64; 58 | function _GetStartingFrom: Integer; 59 | function _GetResponseTo: Integer; 60 | function _GetDocuments: TArray; 61 | public 62 | constructor Create(const ABuffer: TBytes; const ASize: Integer); 63 | end; 64 | 65 | implementation 66 | 67 | constructor TUgarMongoReply.Create(const ABuffer: TBytes; const ASize: Integer); 68 | var 69 | I, Index, Count: Integer; 70 | Size: Int32; 71 | Document: TBytes; 72 | begin 73 | inherited Create; 74 | if (ASize >= SizeOf(TOpReplyHeader)) then 75 | begin 76 | FHeader := POpReplyHeader(@ABuffer[0])^; 77 | if (FHeader.NumberReturned > 0) then 78 | begin 79 | Index := SizeOf(TOpReplyHeader); 80 | Count := 0; 81 | SetLength(FDocuments, FHeader.NumberReturned); 82 | 83 | for I := 0 to FHeader.NumberReturned - 1 do 84 | begin 85 | Move(ABuffer[Index], Size, SizeOf(Int32)); 86 | if (ASize < (Index + Size)) then 87 | Break; 88 | 89 | SetLength(Document, Size); 90 | Move(ABuffer[Index], Document[0], Size); 91 | FDocuments[Count] := Document; 92 | Inc(Index, Size); 93 | Inc(Count); 94 | end; 95 | 96 | SetLength(FDocuments, Count); 97 | end; 98 | end 99 | else 100 | FHeader.CursorId := -1; 101 | end; 102 | 103 | function TUgarMongoReply._GetCursorId: Int64; 104 | begin 105 | Result := FHeader.CursorId; 106 | end; 107 | 108 | function TUgarMongoReply._GetDocuments: TArray; 109 | begin 110 | Result := FDocuments; 111 | end; 112 | 113 | function TUgarMongoReply._GetResponseFlags: TUgarMongoResponseFlags; 114 | begin 115 | Byte(Result) := FHeader.ResponseFlags; 116 | end; 117 | 118 | function TUgarMongoReply._GetResponseTo: Integer; 119 | begin 120 | Result := FHeader.Header.ResponseTo; 121 | end; 122 | 123 | function TUgarMongoReply._GetStartingFrom: Integer; 124 | begin 125 | Result := FHeader.StartingFrom; 126 | end; 127 | 128 | end. 129 | --------------------------------------------------------------------------------