Attean-0.034/000755 000765 000024 00000000000 14636711140 013026 5ustar00gregstaff000000 000000 Attean-0.034/inc/000755 000765 000024 00000000000 14636711137 013605 5ustar00gregstaff000000 000000 Attean-0.034/SIGNATURE000644 000765 000024 00000047156 14636711140 014327 0ustar00gregstaff000000 000000 This file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.88. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: RIPEMD160 SHA256 487035f339ab736e78a76a560f4e8ad820c24bd025feeab9c494d2bd6d9445b1 CONTRIBUTING SHA256 6c28c91ad03dd02bc314213cdc5289369c0d48dc84a9087e717f8b0f8c451239 Changes SHA256 e8d538bc7bfdb00f243ba45c94a03bc10a0720477ab473868679c4ba3c65906e MANIFEST SHA256 f69798ed9edaefcd6ca13002c92739cb3404011c4d30329a854b8594bc25c0a0 META.yml SHA256 8bd6be673f8d9f3be118bd8e152dbd02152f270951da9fae12462140ae8a3b96 Makefile.PL SHA256 949d49d547f195f95b54383c8f2baff39fe4e035c3a1847416f3351f34d52de6 README.md SHA256 0989c0007d1742b3c91f59ff267f7a8ec62543c2dba09bf447f7d44fc316a3c4 bin/attean_parse SHA256 bb5f36b5b9a46d93d167fac3770172f95fb1fb888aefc282cbbeb0dd1f1bc67a bin/attean_query SHA256 7a079f36ccbe5ca289fa7591875ff392fc35e4cb946b773d98c4efad7eba17c4 bin/canonicalize_bgp.pl SHA256 cd5397bbe618f5bbd4e12a33b0cf5d21114e771c2dbd0ce28e2135beb52c35a8 inc/Module/Install.pm SHA256 1b5430a46a35142ef8914d8c745196fca825defc9dfa7e389299bf294613825e inc/Module/Install/AuthorTests.pm SHA256 798836f9ccb8d204b1be31fc3835631f57e9d818b21a8f0d14bfcfb82ff4a72a inc/Module/Install/Base.pm SHA256 d64cd4c16f83c5baf11f64a44bea3a0abc060a49da5aba040f0eb01394bf75ab inc/Module/Install/Can.pm SHA256 668306ae2fad17b3049f885251b8679497c4eb8d5c4b0d13f5c95bda331d1f00 inc/Module/Install/DOAPChangeSets.pm SHA256 65d7a6098bf3f829e8c1c2865476d3537aa6f0ad0ffc9149e10812c856529043 inc/Module/Install/Fetch.pm SHA256 70c4b77acab3ff51dfb318110369607cb109e1c319459249623b787cf3859750 inc/Module/Install/Makefile.pm SHA256 14556386168007ce913e669fc08a332ccdb6140246fd55a90c879b5190c1b57a inc/Module/Install/Metadata.pm SHA256 63ec8405523ae67c33823dcf4b136a46f0711fb17a8b58b49ddd922ed6b69611 inc/Module/Install/Scripts.pm SHA256 4c746c02c5cc19bed4c352e76205b4adff4c45ce8310d71294e1b83c059659c2 inc/Module/Install/Win32.pm SHA256 d3d9b4583243c470ae895defa4c44564485b53693cba1c50ab0320768f443e97 inc/Module/Install/WriteAll.pm SHA256 2b309fbcdd748897f83ea10e0cf81d4ef2cbd237a49d3eade3e35b11b90d29f9 lib/Attean.pm SHA256 ebbfe8da89505c8de2c1a188460a2e7400265959e5806a52221f25e333e93ac7 lib/Attean/API.pm SHA256 690e7aa796009beab9d91c418d6723b7979b935e96176e035f10326a974af300 lib/Attean/API/AbbreviatingParser.pod SHA256 33a7532c75d09d3a428db38df3aa5e8cc21af7dc9ae109851a13dbb4d8e8349d lib/Attean/API/AbbreviatingSerializer.pod SHA256 df392e2f8f9503664cebbe9ffb3cbc0cd0c087853f26b9484c156c2f1d36a15e lib/Attean/API/AggregateExpression.pod SHA256 3557b16a800205e7b6e79c086994dab7f0e15f9ad08e1e89b704e1d5f678ae9b lib/Attean/API/AppendableSerializer.pod SHA256 4346abe29a62972633e90fee4ffcc8c523da430c33db9762a6536ab76599581e lib/Attean/API/AtOnceParser.pod SHA256 1368cd08a39f0c3285531589857263abf1ea565ce4d10af29eaa9fba8b054d89 lib/Attean/API/Binding.pm SHA256 8052361d85748b06353f55ad3f091a5e594b4d418469ebf5a90d6b89c6660c8a lib/Attean/API/Blank.pod SHA256 3bd03853fa902867e8802316aea0f7e6c11383a28dbb7be062d933de7a9c8140 lib/Attean/API/BlankOrIRI.pod SHA256 6d9cc3b1162f29a7b738cf45816fe86810750ffde7485a19ee87cf6ce866dd0c lib/Attean/API/BulkUpdatableModel.pod SHA256 a8a09292a7e2da4f2f8b55bdbd06a15c9cfa2940fdce39f39c8f5ac0e667b405 lib/Attean/API/Expression.pm SHA256 6f9aa0c7c77edca42e89f06a5077ed48607ac139fa065b449f7bfbb5b1050f6a lib/Attean/API/IRI.pod SHA256 a946558b79c485cd9bea551944c34691cd076b2afabdc50d0d93183d0801708e lib/Attean/API/Iterator.pm SHA256 59d7ca8c2f709241f03e3f8ce84b5d2143f0e13f2401fe67fe6aa889bc9659c5 lib/Attean/API/Literal.pod SHA256 bf537a44bf883ecbb241ec44dc86f3161fb89989c6b3ef3c9d1e0049563edd9d lib/Attean/API/MixedStatementParser.pod SHA256 cea0cc652511a1fdc84a87a4f16c61374e5a03dae5c009d438b4a6c2dc199daa lib/Attean/API/MixedStatementSerializer.pod SHA256 f1069d249a5647a96915b4ce4aaf59328d98ef0caa040fc665eb6b15df97befa lib/Attean/API/Model.pm SHA256 e16c1e24bbf2d81b6733bd1e3df6155add0d7a1369054a50aebc6185e2ec0c3e lib/Attean/API/MutableModel.pod SHA256 7a62b0e20aa93d07abae6d2cc3d8d4374e73643212287f1b550a3eaaf3ff53b5 lib/Attean/API/MutableTripleStore.pod SHA256 e8d5a17ee18bfa01bbdb58a5e5cea98ee1e41bfebdc8c4c4b1d2e439490d4352 lib/Attean/API/Parser.pm SHA256 81856794b6eb84e6359543cd91bcddfb15d2a7809d1be29975cbb7870ff24c6b lib/Attean/API/Plan.pm SHA256 fb7cb4e0aba9638e7eede27ea39012a89857d5ead00e5050a98d0194537e1de9 lib/Attean/API/PullParser.pod SHA256 16a778f0cf13255643a52c4b61789b85ada745c82473f47bb5b96dbfd454687b lib/Attean/API/PushParser.pod SHA256 2b774feabffe21c74f25d22187c5abe79116ed26c45065bd857a74007f94630f lib/Attean/API/Quad.pod SHA256 45625551709585fbe2557cdd7494995fdedab0fd0f67658b53831d3cd9fdda28 lib/Attean/API/QuadParser.pod SHA256 7b48ed0d9e4becfb7179748b9f72c7734b3a6720d3aaa246dfe524ce63b2c374 lib/Attean/API/QuadPattern.pod SHA256 52792079800f0496b7bf34e4b7d90dfc7d508bfd366b97524db68cc20d6e8532 lib/Attean/API/QuadSerializer.pod SHA256 d90a9d9d2936c416a3847b224db5a50b684e39454d1a085cc4d3ee6a18d838b1 lib/Attean/API/Query.pm SHA256 c3343bf4ad611be1c3f3c7b2680d8ae7c816f07378ed3a8a10439f2afa2b08f1 lib/Attean/API/QueryPlanner.pm SHA256 2259ef5b0a240704b396c7dce8184aa437d6e8249a29b8671cc8ff6a3ef4d40e lib/Attean/API/RepeatableIterator.pod SHA256 007aa6736186bd1370fb6b79c20cc3d15660fb2321eca1d99186ef38cafd6a79 lib/Attean/API/Result.pod SHA256 02b3b16ac897b5a096de1b49b4165fda5ddc0dd27547876a6855c5e32d210b0e lib/Attean/API/ResultParser.pod SHA256 2303d8a0e608c1a13656acbb2a2387830d23c8c3e12f6f0e6310fbec6cf9f31f lib/Attean/API/ResultSerializer.pod SHA256 2a5a7558d25d71f89edad27907f5a4d7d651fbe9fb17f8318cecd11a9692e3d6 lib/Attean/API/Serializer.pm SHA256 243202bfc9d3b88a97640c3e8d4c7c3e8d58dcd2950632ec40a94a19ce0def10 lib/Attean/API/Store.pm SHA256 19eb418592fa17dffeea861e268aa352687074134b33f3749079f8d018813c6d lib/Attean/API/Term.pm SHA256 29ceb246500a7f14ec8363f3f1faa247bb676977a0c12beaefb6e08286bfa6de lib/Attean/API/TermOrVariable.pod SHA256 ba32c6ab36ea8d87483aa6aef7af940238fcf1036d15080faf28cb3c74d53625 lib/Attean/API/TermParser.pod SHA256 e6e455d0745e02db98930d604aacaea6ab71bafec6e239a5b9e77f9376c24c8a lib/Attean/API/TermSerializer.pod SHA256 3e278707693964a221a01cf57e3844649d122d7e06c065d80da2a729dec646c2 lib/Attean/API/Triple.pod SHA256 6b89cfad1d7d7a9bafe634cf80bda98032f5b4d83f9057ea61b026b5413cb1fd lib/Attean/API/TripleOrQuad.pod SHA256 48abdde7486cee171387154650da46bff19e31d0c7114b27432fa9d4aa8f40ea lib/Attean/API/TripleParser.pod SHA256 952a9e6d5bb129426dc2842a8199d5de2cf404877cb5053bee02d07a9c1447db lib/Attean/API/TriplePattern.pod SHA256 08072bc3798394ffd1706dc51b4ac15bc43ac6f7755f4606cd479cd83b3a0de9 lib/Attean/API/TripleSerializer.pod SHA256 55d29f53817ba5abc553f817e663827e1c879701485d7c1b3d302a406f328a65 lib/Attean/API/Variable.pod SHA256 4952a7ee8d6da39fca9abd74a6352041e6a7fae98b95fbdf6411f716105de861 lib/Attean/AggregateExpression.pod SHA256 cdbe1066ed9f6f3ba062dc39c5e193b8f520b2b9b14abc6be9e1e1d2ddd91d1d lib/Attean/Algebra.pm SHA256 55eb51248c10aaca05c9c7a493d7e389f4e68a60faba82dc08be13987418530b lib/Attean/BindingEqualityTest.pm SHA256 e6934053b2b4b67ce99f5b3810327cbe9b8e4c29f668fc175ac6bf47105dbf14 lib/Attean/Blank.pm SHA256 ca193d60d75c441de64aa68396f3f144387d83477593eeee046e0a2ee8f7e846 lib/Attean/CodeIterator.pm SHA256 e1d889b203f89efcd276070ab69a33ecc3f47c9f75600f1db8ce71142c6ce9b4 lib/Attean/Expression.pm SHA256 cfc0c3987020b3f1c942d38cf9a59dd5041507d960ee2c941eb2fef34bcfce6e lib/Attean/IDPQueryPlanner.pm SHA256 621bafe3f7231e7ed622440efbe4f56902af5b69294daa327ad784b7ed6ba470 lib/Attean/IRI.pm SHA256 d315c14bf6a9494854df106e61a4d52e345486626872aca48e4908ec3d989759 lib/Attean/IteratorSequence.pm SHA256 6ac140fd6114e9d7482d6b9aba6cdbb36be6d5a27b213861c08609ff7df0239c lib/Attean/ListIterator.pm SHA256 38bc4f68a1dea147cd3856c045b6178e4e2b5181789d3c12d016e25c8303e850 lib/Attean/Literal.pm SHA256 6c59db2ef0fd86a5bdee7e6df861e373f4d80cbd66e318a410ca462331e38679 lib/Attean/Plan.pm SHA256 1a7f964981ebe9cc1fad8c38f8a06dbd93543af49932b1d037d38212415331d6 lib/Attean/Quad.pm SHA256 2b73d0fc72bdf86c8534648914bc0071292f7e945101e52df764cb7b9ceccee1 lib/Attean/QuadModel.pm SHA256 0d7fce1c43655e4ce2b8374c9d7851d25755f2df68712bb2a447b26106485850 lib/Attean/QueryPlanner.pm SHA256 92c0aecdaa3c32aa2ae86c86bb3e90cccd74616caf2de321d210b94af1389ad2 lib/Attean/RDF.pm SHA256 60f22ed9f380e3d18f38a25a0340be2a9b4a616e4d8654dd42b796f8f31062ff lib/Attean/Result.pm SHA256 39bf29916743e07431c1a2f3c26c7c25ddf3d9f6f6680ed50e27d59c00157764 lib/Attean/SPARQLClient.pm SHA256 f21407c83123f1fabca5fa3933d4d62bec2abd3168f7a40780e35ae4caa63d41 lib/Attean/SimpleQueryEvaluator.pm SHA256 e3ba4a977fcc62e3825ac781c2e62ae8f614f738b5b0e57c9bb7e04adb98cdcd lib/Attean/TermMap.pm SHA256 76555f03d579082d4e7e9fbd3e145578a2c4c843025a4616c39434aa7c445bea lib/Attean/TreeRewriter.pm SHA256 bfaaa7776da39617d5e9bf8ae54885a3039d731f4e5e9c6232c73686750c704d lib/Attean/Triple.pm SHA256 9724aa4edc26608992249128141f59f71e2c9171979c59264499df155770f44c lib/Attean/TripleModel.pm SHA256 bcfd2da01b1ad16b150717a109607ac901efdbe47e78fc1976c44e98ebc4a3fc lib/Attean/Variable.pm SHA256 98ff2e10922b046b4c98e55d1a77b57ca203cc4fbc4191fbf4222872ee88b3d2 lib/AtteanX/API/JoinRotatingPlanner.pm SHA256 2c7c4940bb5903b1821256a6021852572743cc5710befa4f90051673baf6c622 lib/AtteanX/API/Lexer.pm SHA256 f126dcbd4cef6c736c6bf29fb2dfc68c78711230c8febe15fdaa1add3f5c6393 lib/AtteanX/Functions/CompositeLists.pm SHA256 4354757e70ca77881ffae3b0c4267c0ef454eb0041247879e06572d585c34054 lib/AtteanX/Functions/CompositeMaps.pm SHA256 aa214b1b342daaeb696322a35366e598af423127963d1c211a3b905eabc9e8bf lib/AtteanX/Parser/NQuads.pm SHA256 0590407b459d9933ae747059e9b1cb2bc98414bb851941e7923817055b37d9db lib/AtteanX/Parser/NTriples.pm SHA256 26c2160ec9d475294f0df7e2e523b4662700d922206ceffb2e6d5692d4eefc0b lib/AtteanX/Parser/NTuples.pm SHA256 4ecea129a6bcdbf8fba168ef2cca0134277dd7c0c08eb06905e0a5865d0caaca lib/AtteanX/Parser/RDFXML.pm SHA256 0a155ef35a2be1cb04dce299f183d06d0e744c929db0f50ce3824b737c7ed8eb lib/AtteanX/Parser/SPARQL.pm SHA256 dd362f93d630768f57b8ffd7beab33a0a28ddd13bc3aa4f214d5f04b262de115 lib/AtteanX/Parser/SPARQLJSON.pm SHA256 edef8be880f8baa91af57a64e4ebc5c8f9177273ff10cf514783e6728bcfe8c4 lib/AtteanX/Parser/SPARQLLex.pm SHA256 10fd44ee15ee300d7b95b80184fdeaa7fada79a30c438d5197dc827aa2940120 lib/AtteanX/Parser/SPARQLTSV.pm SHA256 647a5ae01e407e1a2879ac2a765d640df3ea4a9fdc54b55960055e5ec8af3d0b lib/AtteanX/Parser/SPARQLXML.pm SHA256 f8e46fdd9799a1f8a53987ca9f0667bd3f5e32de35b8a46a81b9a5c021e67214 lib/AtteanX/Parser/SPARQLXML/SAXHandler.pm SHA256 30ed17bc3639531a4d616b446de2f5a2e89651bd8b612529cdee17b012af5d97 lib/AtteanX/Parser/Trig.pm SHA256 012809296b9569b65152c77d3437f192394c9cdc9530caab1877fbd32dd9c293 lib/AtteanX/Parser/Turtle.pm SHA256 45abbb87b1b081703ef611f957c74ab631a22f4b6b3925f443a490a0bff184d7 lib/AtteanX/Parser/Turtle/Constants.pm SHA256 c7ef874390279c827d90124bff0113597694e65db56ab06a9ea55c047d599e6e lib/AtteanX/Parser/Turtle/Lexer.pm SHA256 e28f34b01175da7c345426e2799e8032f1031f694fca4637fd58f517cde70ec5 lib/AtteanX/Parser/Turtle/Token.pm SHA256 80577ce636e039df4ac98f362dc1e584c4f9673aa0b6d2ec0de9c81accf1a2d4 lib/AtteanX/SPARQL/Constants.pm SHA256 06ed8ffe9c59427d3a8ac46df6c3bdae1df6b1c5c1c112ff78aab5038fb736f0 lib/AtteanX/SPARQL/Token.pm SHA256 a02b65f4082306a7d63143aed6b5828394ab702497ce60f1731196ee7a42b158 lib/AtteanX/Serializer/CanonicalNTriples.pm SHA256 741d4b74bc65c39b5c85afa89db4ac08cac2c238d5ada0f455f8c64ecac92dd7 lib/AtteanX/Serializer/NQuads.pm SHA256 e4db8655c0efed6bc67ef505f9d7126418c0c61874fb2b5fa44d246a741c2fcc lib/AtteanX/Serializer/NTriples.pm SHA256 f0d6829c5c1fb53fd88b5d36ab738699723d5585bd655cd3359a7db40e4737ea lib/AtteanX/Serializer/NTuples.pm SHA256 984395e5c108263d397635f4e4e2a35d5c95bf56d4fcead617ed7ad1e73dbf00 lib/AtteanX/Serializer/RDFXML.pm SHA256 140d905edf8a703013f36ad0c4487368637c123a01450b0b5562468de00bf2fd lib/AtteanX/Serializer/SPARQL.pm SHA256 6a89f86d6803ac67c5d296e13865c337b6a3c2c6db801e5f00bb846a361fc0e9 lib/AtteanX/Serializer/SPARQLCSV.pm SHA256 12e69db4d7a7e2460eec03391022db25634c1473118d1f1d4542fd6ed3d803a5 lib/AtteanX/Serializer/SPARQLHTML.pm SHA256 31b39f7121d78ae04afc7a3a184dae09ccec9d9a5b344cd3a2b9635978e72fc2 lib/AtteanX/Serializer/SPARQLJSON.pm SHA256 85395925980d3c772541850288f0b23c4001a3c661a6838383f5e95688aabeee lib/AtteanX/Serializer/SPARQLTSV.pm SHA256 8d6c0651d36ea3766ae74ebe198229b11988683893e3cec5347bbebb452b0240 lib/AtteanX/Serializer/SPARQLXML.pm SHA256 3fbc0e87ade2071ac1584fd58a96f38e5de4a6ec234ae15bb4f61c75aab5d897 lib/AtteanX/Serializer/TextTable.pm SHA256 ba9cf74cb6112f184315cf039428febb34dfd4fc76f166b6c56ac0674428e93b lib/AtteanX/Serializer/Turtle.pm SHA256 0674cfc913174f49f605a3eccdb371beaad5aff7a12cc07f1ada1df5aa7dc6b7 lib/AtteanX/Serializer/TurtleTokens.pm SHA256 e765a66bb35281308273f70b80c967cca3b3378708632b6dc93b50a11ce7cf23 lib/AtteanX/Store/Memory.pm SHA256 cc1ba2abb8f06ea4391f94ec9fa1ac54b7882828c5232004358c70ec4c7b0c7a lib/AtteanX/Store/Simple.pm SHA256 fe3d82ddfafd58cc501e9f3d0183292fc0c702c57b1b75b19e1a6a913408244d lib/AtteanX/Store/SimpleTripleStore.pm SHA256 b9f77d0fb0a9aaad104bc869f3aeec1064ffa1d813c8aba1e7aef44e59da0519 lib/Test/Attean/ETagCacheableQuadStore.pm SHA256 c0fac9b24dea93536f0a236140ae63d4107f068f7b8071068150460f4276f4d1 lib/Test/Attean/MutableETagCacheableQuadStore.pm SHA256 b0e086a72b39626e27b07b84668d8a9c54d1798a419679cf1634cf98c22a6837 lib/Test/Attean/MutableQuadStore.pm SHA256 3599fe030b21f71cbcc4f8a3f2d5f5dc55cdf5412753bfbb22f6b419da90c14f lib/Test/Attean/MutableTimeCacheableQuadStore.pm SHA256 6aabbccaa730533bccc360db4eb61db357541e40f33eef03ef2557134aaf023d lib/Test/Attean/MutableTripleStore.pm SHA256 6034d9d2921c11ba6f93807e01cce1fff6c2aeb02cd59a83600ebeef6ee6ad19 lib/Test/Attean/QuadStore.pm SHA256 f42635dfbfe26d09fcadc8e6b42b5ae7509c207cc8133ed413f26601b6c08e68 lib/Test/Attean/SPARQLStarSuite.pm SHA256 4390bc29a9dd66b5480cbe234b69ef6f8bcc0922bfca15d994808d8b24388361 lib/Test/Attean/SPARQLSuite.pm SHA256 460142176b6e3b84c3e3adf5b354ac095729aaddaced60bf631b6a1519fc4ca5 lib/Test/Attean/StoreCleanup.pm SHA256 512a054baea037a14c67a0a2d8294ca458764f49da13868f94737073c58e8698 lib/Test/Attean/TimeCacheableQuadStore.pm SHA256 0bea5aeeb41c69ac6b36b1737b918bae744268cdbd165dc7b2223746bbc2e3ba lib/Test/Attean/TripleStore.pm SHA256 d76d6e956801d3ab4370a527b2ab44909bc37feada1f2d018b447b2d1c52804b lib/Test/Attean/W3CManifestTestSuite.pm SHA256 b918c81b3ad707940a5c3448b56449b322e2fa002d2a72419a77f30cbb5b5464 lib/Types/Attean.pm SHA256 8af0524608505de31f40cbf051101e0a66bfebe6a5cac4ec03e3b1b787e764c8 meta/changes.ttl SHA256 1dc79bb2b9cdf890004c1760ece495500ae624a3759fa24cd5fe888bec58db52 t/00.load.t SHA256 b9478f6e0d48e753304792448c6440a7974d13ceac602b5b634ac62ce3f7d9ec t/algebra.t SHA256 e247d21a6674074ba2620a7a804deb98893ba72b84ef0e2e6d20f356d1194430 t/binding-equality.t SHA256 4ca870ddb09a1ff622da1e36c4ee6dc19f47cf62a7d36db8ea2f4fd006f74b76 t/binding.t SHA256 b9fb362268d464199e9966a871fc8a43fc0e97af1dc1b7ea57851a5cf333d6ec t/convenience.t SHA256 1a1d1ef2a8fa1836d221e47a5a6501396c5f8aa34e6442c71d0113bfd5e83e46 t/cost_planner.t SHA256 ce9233f9d79f3c6d247850d3563093898b301fe094d4ac10528f2a38d8c40e33 t/export-functions.t SHA256 560cc1589d84209231b9bf72ff2c1d7dcb181801da060ef3ed0d1e27d89f8ec6 t/expression.t SHA256 50f5e2e35383ef9e6e5dfc85065bcfc8cd8820c44d209938029f6cba5b2959cf t/http-negotiation.t SHA256 32e8eef05c67002cb124105540f18c01825e743c1fb8e3c3be5575fb5a78cc41 t/idp_planner.t SHA256 c91d27d6a4adcf3a15a7f6deff359c0f19b7613c53a909af27ed3b646948793f t/iter.t SHA256 5d562c2b9445f744947ecd6e0e0a5bd067b5c593ecb61307e8f7c85437c7843b t/join_rotating_planner.t SHA256 88ff05bc7a3b3bdaeb3bb97b631ae3029dcdf320fd057471752291a4edeae425 t/model-quad.t SHA256 78e95af88a2280528015d6dfb51c0a52e28d0ccf6b878feb74a75275e4aeac11 t/model-triple.t SHA256 16917197261d7fee09be08b8a35b8fa29e12454aea025fa65d8b8850b8a34e71 t/naive_planner.t SHA256 defb6bed4c81808342ff65257e9a5f5d0ef3fea2ba5d6dcc0d3d056bcf0b2df2 t/parser-nquads.t SHA256 ac0738aa575954860f2bb7e80e28fd5f7ded05dfeadb40dc35ed2e4f936b832e t/parser-ntriples.t SHA256 3054f885baa580cb480a89de3960de3bd7d81a7f146b0bd17657ae017d6c7dda t/parser-rdfxml.t SHA256 6d7faba1079d1365d3c4d70c87ed935e6b77696f65678088de96c82bb3c16ed3 t/parser-sparql-star.t SHA256 bd8c72a77f58984fc117d9a9840ab4d4e6b71d1b07ca5cec77ece90cca5ae92e t/parser-sparql.t SHA256 cebcc5c75cf316d48df99abbc0df6c2d2a978320cb7aae0aa217a1018e1f3d8f t/parser-sparqljson.t SHA256 884b39ca9083ef1f3fea577dc2cd57b8de60836e82dcff1bff6d21452a7303ec t/parser-sparqltsv.t SHA256 11e5be8b14c5cb0aeb7e3256688aaa8bd27b8e241ea6ed5d104d91e4957abbd5 t/parser-sparqlxml.t SHA256 3b3773a53599d84845383dee130c773c2b50a73ebd1309b4089ffb879cc279a6 t/parser-turtle-star.t SHA256 2e0db8b74089fe5212a8bcacb91e2a16342ddb6370d491686e50e62930989138 t/parser-turtle.t SHA256 49d3adff4d64a797ce302f7307d4e126690f74b3faf67911ac840ff89c746f0f t/parser.t SHA256 972045f0d6db1e95e3ba5af360d6897257df7a0b07320a99bcdd82b393936f22 t/parser_serializer_api.t SHA256 5ac6fefb729bca37648c388a20c9e49a436e64ccc58062ae8bff4ad49fc50f11 t/plan.t SHA256 b3c643f68881fc5e7ee89dc26d50846a99f1eb7d4d238853561dfbf55b060e1e t/plans.t SHA256 85c1e0994d2e1a7c83e16e51cc5d9f267176a7f137b525ee8cf64a508236200e t/serializer-canonicalntriples.t SHA256 32be8d68a6ca07edbf4cd80cc2f3cda6520459885fbc2740be770e049161711c t/serializer-nquads.t SHA256 d497b0324e6b634636fbcc1b6c306a0e4b085aa3ab953a28aed9c7fed57a4d23 t/serializer-ntriples.t SHA256 ebf0041a9028693861ab3050cbcce8f4399211f08a53f5291db5225d2d8c8f90 t/serializer-rdfxml.t SHA256 0a6f28944cecbc09e8adb74e3e8c79b9867d30c676e4b803b13947e17dde9375 t/serializer-sparql.t SHA256 776f7fcece5befff17c6bb4f3b62222d773e393a6ef35ba7be52a782a109c03d t/serializer-sparqlcsv.t SHA256 87e3e51c20d9b2fd89c571ec4ff10ed0879cd3310c670dfcedfcc31cb41dd9c2 t/serializer-sparqlhtml.t SHA256 4c63b97ce6b45dbc1decabc6bed0f8220a91c2855c2965fed8c0c14fe75d8504 t/serializer-sparqljson.t SHA256 fd557f136413c2aa9fd4fb37ad98cc675b00bc9198c4c847fbaabc1c5cb5019a t/serializer-sparqltsv.t SHA256 7c67054f8972ed39121b00232d5ec56d6c2a3aa6cb6783b111b0749455aa6754 t/serializer-sparqlxml.t SHA256 17beabdc87423cc5f48fab93bf1e76ed86ae0c080960331f3f807583224cad67 t/serializer-turtle.t SHA256 c612288c1607ce563d87b7e30201ae5187be830beb7a01c72aa6b7925c9b601b t/serializer.t SHA256 15b9787049ce24c70a8184d9986c0cc8d0603cd678c193333724579e552e1bf2 t/simple-eval.t SHA256 4c7e65106d909f992a8acd478cafa012bb96c44985e4d425a9a60b327d130e57 t/simple.t SHA256 80c9444f53b85b70a7ca6c34c5483610dcfd8c078f3f8c13542a0fbd362217db t/store-memory.t SHA256 b5ef5fc3e12c7f2338185d600ed70a441bdb4757877651e72a929007fe6b8f14 t/store-simple.t SHA256 f6567e7f55c4031d6987ce33e06ecf9d08adc6ed11b8631d711a3635fddc7663 t/store-simpletriple.t SHA256 410ab17e0316f548675ee815e00d0801eb9d7a0ca0714847ce432578c0618c72 t/term-map.t SHA256 8d54ad4dc5f5bb60ba29fea8b1ab0a7334dfe7c624b07ba440d6259ea3fa3960 t/term.t SHA256 09757d8fcc25b8f3c92179c2439fb7e60c61d75988fa69c1e35c6dc14f786433 t/treerewrite.t SHA256 e1020bec7b7fbff97e0e9ec8b7fe91fc02ecdd9a2452cd6654fb484212a387ac t/types-general.t SHA256 5cfcacd72b4d27998c3e6b0167d00c630a7f4815362c0ec346daf205a5bf228a t/types-iri.t SHA256 73f708492cbd60615994f32861d017c67f96224ba6a5fe0b1e6f9231e7cbd2c0 xt/dawg11-memory.t SHA256 738067ae3b8cb02b23ad4e29dc30034bc9d8f7ba32b1b75b8694549e07ff5fe3 xt/eval-sparql-star-memory-simpleeval.t SHA256 c7d5660216beaca18bc60da47b897ceed2645c8e8106794ccde0e08d53da4b52 xt/eval-sparql-star-memory.t SHA256 81dae5e652e694c2acc7d105e32ba5f69edc343b22b2e1d47f95fdef8b441cd3 xt/pod-coverage.t SHA256 2b04b20ff767801fde2fb6435361dc8ca0a9b60dda6cb0bbd18dd52962e1c1a3 xt/pod.t Attean-0.034/bin/000755 000765 000024 00000000000 14636711137 013604 5ustar00gregstaff000000 000000 Attean-0.034/CONTRIBUTING000644 000765 000024 00000001501 13235706150 014654 0ustar00gregstaff000000 000000 # How to contribute ## Reporting Issues * [Create an issue](https://github.com/kasei/attean/issues), assuming one does not already exist. * Add relevant labels ## Submitting Changes * Try to follow the existing whitespace and brace style * [1TBS](https://en.wikipedia.org/wiki/Indent_style#Variant:_1TBS) * Tabs used for indentation and aligning of comments (with a tabstop width of 4-characters) * Ensure the test suite passes (`perl Makefile.PL && make && prove -l t xt`) * Consider using the [pre-push hook](https://gist.github.com/kasei/0819f25cee79b3597576) to prevent pushing if the test suite is failing * Submit a Pull Request ## Getting Help * [IRC in the #perlrdf channel on irc.perl.org](irc://irc.perl.org/perlrdf) * [@kasei](http://twitter.com/kasei/) or [@perlrdf](http://twitter.com/perlrdf/) on Twitter Attean-0.034/PaxHeader/Changes000644 000765 000024 00000000460 14636711132 016273 xustar00gregstaff000000 000000 30 mtime=1719374426.343038508 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 85 LIBARCHIVE.xattr.com.apple.FinderInfo=VEVYVAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 70 SCHILY.xattr.com.apple.FinderInfo=TEXT Attean-0.034/Changes000644 000765 000024 00000063627 14636711132 014340 0ustar00gregstaff000000 000000 Attean ====== Created: 2014-09-27 Home page: Bug tracker: Maintainer: Gregory Todd Williams 0.034 2024-06-25 - (Addition) Add registry to allow extension literal datatypes to map to Moo roles. - (Addition) Add support for composite types (CDTs). - (Addition) Allow extension functions to register as functional forms. - (Update) Add Attean::API::NumericLiteral->equals. - (Update) Add GitHub workflow using perlrdf/devops actions (#163 from @zmughal). - (Update) Add HTTP::Headers to test requirements. - (Update) Add types for RDF triple/quad and their terms (#166 from @zmughal). - (Update) Change in `import()` behaviour for Perl > 5.39.1 (#168 from @zmughal). - (Update) Fix bit-rotten code in W3C test suite harnesses. - (Update) Fix bugs discovered based on run of updated W3C test suite harnesses. - (Update) Fix casing for AtteanIRI type (#165 from @zmughal). - (Update) Fix handling of BOUND and error-causing INVOKE expressions in Attean::Plan. - (Update) Impove error reporting in Attean::API::MutableModel->load_urls_into_graph. - (Update) Improve Attean::API::CanonicalizingLiteral to have strict and non-strict c14n variants. 0.033 2022-10-02 - (Addition) Add new Attean::SPARQLClient protocol implementation. - (Update) Fixed handling of endpoint URLs containing query parameters. - (Update) Protocol HTTP requests can now be signed by specifying a 'request_signer'. - (Update) Update SERVICE evaluation classes to use Attean::SPARQLClient. 0.032 2022-08-14 - (Update) Fix for bug caused by newly added TermOrVariableOrTriplePattern role. 0.031 2022-08-04 - (Addition) Add initial implementation for TriG-star parser. - (Addition) Add support for parsing and evaluating SPARQL-star queries. - (Update) Improve implementation, docs, and tests for accessing parsers and serializers by file extension. - (Update) Update Turtle, SPARQL-XML, and SPARQL-JSON parsers to support RDF-star. - (Update) Update docs and add tests for handling of base URIs in parsers (#158). 0.030 2021-02-06 - (Update) Fix bug in attean_parse for parsers that are not either pull or push parsers. 0.029 2021-02-01 - (Addition) Add Attean::API::MutableModel->load_triples_from_io (#157). - (Addition) Added -n CLI argument to attean_parse to allow numbering of results. - (Update) Fix bug in Attean::API::ResultSerializer->serialize_list_to_io. - (Update) Update Attean get_parser and get_serializer to allow searching file extensions and media types for 1-arg calls. - (Update) Updated Attean::API::Serializer to require file_extensions. - (Update) Updated AtteanX::Serializer::TextTable to print table borders and rules. 0.027 2020-11-06 - (Addition) Add canonicalization support for xsd:negativeInteger. - (Addition) Added TextTable SPARQL results serializer. - (Update) Fix SPARQL lexer to accept variables using the $ sigil. - (Update) Fix evaluation of aggregates over empty groups. - (Update) Fix handling of utf-8 encoding in AtteanX::Parser::SPARQLXML. - (Update) Improve Attean::API::Result->apply_map handling of unbound variables. - (Update) Improve Test::Attean::SPARQLSuite. - (Update) Improve handling of XPath Constructor (casting) functions. - (Update) Update module metadata URLs (#155 from @szabgab). 0.028 2020-11-02 - (Addition) Add uniq method on iterators over objects with an as_string method. - (Update) Added Attean::API::RepeatableIterator->size method (#89). - (Update) Fix Attean::QuadModel->get_quads when called with an empty term set in some position. - (Update) Fix utf8 handling of syntax tests in dawg test harness. - (Update) Improve documentation about statement projection accessors (e.g. subjects) not being unique (#152). - (Update) Remove AtteanX::Store::DBI which was not a real DBI store and was accidentally checked-in (#134). - (Update) Switch UUID dependency from Data::UUID to UUID::Tiny (#145). 0.026 2020-02-20 - (Addition) Added Attean::API::Model->evaluate convenience method (#149, #150). - (Update) Fix typo in Attean::Plan::Service POD (#146). - (Update) Improve type coercions (#148 from @kjetilk). 0.025 2019-10-25 - (Update) Fix Moo::Role/Role::Tiny imports (#141, #142 from @haarg). 0.024 2019-09-22 - (Addition) Add attribute in AbbreviatingSerializer to omit base declaration to have all relative URIs (#135 from @kjetilk). - (Update) Added ground_blanks attribute to Attean::SimpleQueryEvaluator. - (Update) Fixed bug in AtteanX::API::Lexer that caused infinite recursion when finding EOF in the middle of an escape sequence. - (Update) Updates to use namespace types, available in Types::Attean (#129, #137 from @kjetilk). 0.024 2019-04-30 - (Addition) Add a simple factory for temporary models (#132 from @kjetilk). - (Update) Document how to check whether a term looks like the head of an rdf:List (#133 from @kjetilk). - (Update) Removed the deprecated parse_term_from_string method from NTuples and Turtle parsers (#131). 0.022 2019-03-21 - (Addition) Add Attean::API::TermOrVariable->is_bound method (#129 from @kjetilk). - (Addition) Added statement matching functionality for iterators. 0.021 2019-02-12 - (Addition) Added Attean::API::Model->algebra_holds method. 0.020 2019-01-09 - (Addition) Add holds handle to Model (from @kjetilk). - (Addition) Added bgp export function in Attean::RDF with associated tests (#125 from @kjetilk). - (Update) Export using Exporter::Tiny instead of Exporter.pm (#122 from @tobyink). - (Update) Expose count_quads_estimate method at the model level. - (Update) Make count_quad_estimate accessible from TripleModel (#124 from @kjetilk). 0.019 2018-02-04 - (Update) Documentation updates (#120, #121 from @kjetilk). - (Update) Fix incorrect URI for langString (#119 from @kjetilk). 0.018 2018-01-06 - (Update) Added tests for turtle parser escape handling (#55). - (Update) Allow UUIDs to have lowercase hex digits (#102). - (Update) Documentation fixes (#105 from @Varadinsky). - (Update) Fixed as_string serialization of CONSTRUCT algebras (#97). - (Update) Improve code coverage for Attean::TermMap (#107 from @Varadinsky). - (Update) Improvements to HashJoin query planning (#103 from @KjetilK). - (Update) Removed LICENSE file and updated licensing statement in individual modules (#116). - (Update) Updated Makefile.PL for perl 5.26. - (Update) Updated required version of IRI (#118). - (Update) Use Moo::Role instead of namespace::clean to cleanup namespaces (#112 from @baby-gnu). 0.017 2016-06-09 - (Addition) Port SPARQL-JSON serializer to Attean (#20, #101 from @cakirke). - (Update) Add a .gitignore file (#99 from @cakirke). - (Update) Changed use of binmode to `use open` in attean_parse and attean_query. - (Update) Fix Construct plan string serialization. - (Update) Fix declared arity of various algebra classes. - (Update) Fixed bug in handling of restricted available named graphs during query planning. - (Update) Fixed documentation in Attean::QueryPlanner. - (Update) Improved handling of unexpected EOF in AtteanX::Parser::SPARQL. - (Update) Improved test coverage. - (Update) Improved use of Travis CI (#100 from @cakirke). - (Update) Make parse_term_from_string deprecations noisy. - (Update) Removed default implementation of Attean::API::Plan->plan_as_string. - (Update) Updated SPARQL parser to produce Attean::Algebra::Reduced algebra objects for REDUCED queries. - (Update) Updated required versions of Moo and Test::Modern. 0.016 2016-05-04 - (Addition) Ported RDF::Trine::Serializer::RDFXML to AtteanX::Serializer::RDFXML (#22). - (Update) Add serialization of SPARQL PREFIX declarations and prefixnames when namespaces are set (#53). - (Update) Added Test::Attean::QuadStore->cleanup_store method. - (Update) Added Test::Attean::StoreCleanup role and added store cleanup to store tests. - (Update) Changed Attean::TriplePattern->as_quadpattern to delegate to Attean::API::TriplePattern->as_quad_pattern. - (Update) Fix overly aggressive code that attempted to turn IRIs into prefix names during Turtle serialization. - (Update) Fixed bug in SPARQL parsing of NIL tokens. - (Update) Fixes to POD, test, and metadata issues reported by jonassmedegaard (#93, #94, #95, #96). - (Update) Improve Attean::SimpleQueryEvaluator to handle updated algebra classes and iterator API. - (Update) Improved test suite (includes #92 from KjetilK, #53). - (Update) Removed AtteanX::RDFQueryTranslator (split into a new package) and all other references to RDF::Query. - (Update) Removed default implementation of Attean::API::Term->ebv (now required of consumers). - (Update) Serialize SPARQL and Turtle namespace declarations in a stable order. - (Update) Updated Attean::API::AbbreviatingParser->base definition to be a consumer of Attean::API::IRI. - (Update) Updated Attean::API::SPARQLSerializable->as_sparql to return a unicode string, not bytes. 0.015 2016-04-09 - (Update) Fixed metadata used to generate README files. 0.014 2016-04-09 - (Addition) Add a size estimate attribute to Attean::Plan::Iterator (#90 from KjetilK). - (Addition) Added Attean::Plan::Iterator for cases where there is too much data for Attean::Plan::Table (#88). - (Update) Add ability for parsers to construct lazy IRIs. - (Update) Add type checking to serialize_iter_* methods. - (Update) Added Attean::ListIterator->size method (#89). - (Update) Fix cases where result iterators were constructed without a variables list. - (Update) Improve error message generated for some SPARQL syntax errors. - (Update) Update Attean::FunctionExpression to canonicalize ISURI to ISIRI. 0.013 2016-03-19 - (Addition) Added Attean::API::BulkUpdatableStore role. - (Addition) Added Attean::API::MutableModel->load_urls_into_graph method. - (Addition) Added Attean::API::QuadPattern->as_triple_pattern method. - (Addition) Added Attean::API::TripleOrQuadPattern->parse and AtteanX::Parser::SPARQL->parse_nodes methods (#82). - (Addition) Added Attean::Algebra::Query to indicate a full query trees and aid in serialization (#67). - (Addition) Added AtteanX::SPARQL::Token->integer constructor. - (Addition) Added parsing, algebra, planning, and test support for SPARQL 1.1 Updates. - (Update) Add and use Attean::Algebra::Query->subquery flag when appropriate and stop generating needless unary join algebras. - (Update) Add child accessor to Attean::API::UnaryQueryTree. - (Update) Added CONTRIBUTING file. - (Update) Allow producing short blank node labels in attean_query results. - (Update) Check types of invocant and model objects in calls to cost_for_plan planning method (#77). - (Update) Fix Attean::API::IDPJoinPlanner->cost_for_plan to pass the planner object in calls to the model. - (Update) Fix Attean::Algebra::Update->blank_nodes (#70). - (Update) Fix Attean::QueryPlanner active_graphs argument during recursive call to plans_for_algebra. - (Update) Fix lost in-scope variables in aggregation algebra and plans (#78). - (Update) Fix result iterator generation for quad patterns to keep associated variable names. - (Update) Fix serialization of SILENT flag on Service queries. - (Update) Fix sparql_tokens generation for quad patterns to use SPARQL GRAPH syntax, not N-Quads syntax. - (Update) Fixed bug in Attean::Literal that was returning rdf:string instead of rdf:langString for language literals. - (Update) Improve error messages in Attean::CodeIterator and Attean::API::Binding. - (Update) Improve errors and logging in SPARQL parser (#84 from KjetilK). - (Update) Improve handling of utf8 encoding in SPARQL/XML, algebra, and plan serializations. - (Update) Improve temporary variable names in aggregates generated during parsing. - (Update) Improved Attean::Plan::Union to handle plans with zero children. - (Update) Improved error message in query planners (#76 from KjetilK). - (Update) Pass tree depth as argument to algebra_as_string. - (Update) Refactored SPARQL 1.1 test harness into a testing role (#80). - (Update) Update bin/attean_query to allow dryruns to avoid generating query plans when appropriate. - (Update) Updated attean_query to allow updates. 0.012 2016-02-04 - (Addition) Added Attean::API::TermOrVariable->apply_binding method. - (Addition) Added AtteanX::Store::SimpleTripleStore. - (Update) Die on attempts to add non-ground triples/quads to stores (#66). - (Update) Fixed Attean::Algebra::Table to consume Attean::API::NullaryQueryTree instead of Attean::API::UnaryQueryTree. - (Update) Fixed type checks performed when ATTEAN_TYPECHECK is set. - (Update) Improve error reporting for unexpected EOF in AtteanX::Parser::SPARQL. - (Update) Throwing an error when Triple or Quad objects gets passed a variable (#65 from KjetilK). - (Update) Add planning support for DESCRIBE queries (#45). - (Update) Add type checking to store get_triples and get_quads methods (#61). - (Update) Added logging in QueryPlanner and TreeRewriter (#64 from KjetilK). - (Update) Avoid attempting to parse empty XML documents when passed in as a scalar (#60). - (Update) Fix Attean::CodeIterator type checking to handle non-blessed items properly. - (Update) Fix AtteanX::Parser::RDFXML to properly use caller-supplied base IRI. - (Update) Fix algebra generation for describe queries in SPARQL parser. - (Update) Fix bug in Attean::Plan::Aggregate handling of COUNT(*) queries. - (Update) Fix bugs in SPARQL CSV and TSV serializers. - (Update) Fix sparql_tokens generation for integer and datatyped literals. - (Update) Fixed AtteanX::Parser::SPARQL to maintain its URI::NamespaceMap on prefix declarations. - (Update) Improve POD and test coverage (#55; #61 from KjetilK). - (Update) Improve attean_parse and attean_parse including preservation of prefix declarations where possible. - (Update) Improve regex escaping in t/algebra.t to silence warnings in perl 5.22. - (Update) Improve use of SPARQL and Turtle token objects. - (Update) Improved triple model classes to allow adding and droping triple store graphs. - (Update) Merge code paths for canonical NTriples serializer. - (Update) Preserve in-scope variables in result iterators. - (Update) Serialize SPARQL/XML bindings in a stable order. - (Update) Simplify cost estimation code for hash joins in Attean::API::QueryPlanner (#59 from KjetilK). - (Update) Update SPARQL parser to die on unimplemented Update syntax. - (Update) Update SPARQL/HTML serializer to implement AbbreviatingSerializer (#54, #63 from Zoran Varadinsky). - (Update) Update turtle serializer to consume Attean::API::AppendableSerializer. - (Update) Updated prerequisites in Makefile.PL and .travis.yml. - (Update) Use Test::Modern. 0.011 2016-01-16 - (Addition) Add initial implementation for Attean::MutableTripleModel. - (Addition) Add logging of costs to query planner (#56 from KjetilK). - (Addition) Add use of MooX::Log::Any (from KjetilK). - (Addition) Added Attean::API::Plan->subplans_of_type_are_variable_connected method. - (Addition) Added Attean::API::Plan->children_are_variable_connected. - (Addition) Added AtteanX::Parser::SPARQL->parse convenience method. - (Addition) Added RDF/XML parser tests. - (Addition) Added Turtle serializer. - (Addition) Added exportable quadpattern constructor. - (Addition) Added tests for get_sequence model accessor method (#3). - (Update) Change API for Attean::API::CostPlanner->cost_for_plan to pass in the query planner. - (Update) Fix bug in handling unbound join variables in hash join evaluation. - (Update) Fix use of blank and variable shortcut constructors (#57 from KjetilK). - (Update) Fixed bug in AtteanX::Serializer::SPARQLHTML->serialize_iter_to_bytes. - (Update) Implementation of canonicalize method for triple and quad patterns (#43 from KjetilK). - (Update) Improve Attean::ExistsExpression->as_string. - (Update) Improve cost estimation for cartesian joins in Attean::API::QueryPlanner. - (Update) Improved SPARQL serialization of algebra and expression trees (including #51). - (Update) Improved error handling in Attean::ListIterator->BUILD. - (Update) Improved recognition of invalid aggregation queries. - (Update) Make regexes used for prefixname parsing publicly accessibly. - (Update) Merged shared constants for Turtle and SPARQL tokens. - (Update) Moved subpatterns_of_type from Attean::API::Algebra to Attean::API::DirectedAcyclicGraph. - (Update) Renamed parse_term_from_string methods to parse_term_from_bytes (adding delegating methods that should be decprecated in the future). - (Update) Silence XML::Parser warnings on empty input documents. - (Update) Update AtteanX::Parser::RDFXML to populate a namespace map during parsing. - (Update) Updated Attean::API::CanonicalizingBindingSet to produce the same type of object as are input. - (Update) Updated copyright years. 0.010 2015-12-22 - (Addition) Add INVOKE function expression to allow representing IRI-defined functions. - (Addition) Added Attean::API::Algebra methods blank_nodes and subpatterns_of_type. - (Addition) Added Attean::API::SimpleCostPlanner. - (Addition) Added Attean::API::UnionScopeVariablesPlan role to handle common computation of in-scope variables (Github issue #38). - (Addition) Added Attean::Algebra::Sequence class. - (Addition) Added AtteanX::API::JoinRotatingPlanner role. - (Addition) Added SPARQL parsing support for RANK operator (Github issue #35). - (Addition) Added initial algebra and plan support for group ranking (Github issue #34). - (Addition) Added simple SPARQL HTML serializer (ported from RDF::Endpoint; Github issue #27). - (Addition) Added simple SPARQL serializer implementation (Github issue #36). - (Update) Added ability to turn some query algebras into SPARQL token interators. - (Update) Compute in-scope variables in Attean::Plan::Quad instead of relying on calling code (Github issue #39). - (Update) Ensure query plan costs are integers, fixing a bug when running on perl with long doubles (#42). - (Update) Fixed attean_query to support custom output serializers. - (Update) Fixed bug in Attean::Algebra::Project->in_scope_variables. - (Update) Fixed bug in t/http-negotiation.t that caused false failures when negotiation led to the Canonical NTriples serializer. - (Update) Fixed mis-named method call in AtteanX::Store::Memory. - (Update) Improve error messages in query planning code (manual patch from #41). - (Update) Improve serializer negotiation to support multiple classes that handle the same media type. - (Update) Ported RDF::Query SPARQL parser to Attean. - (Update) Refactored query planner to separate IDP code from the core planning code. - (Update) Renamed Attean::API::Planner to Attean::API::QueryPlanner and re-organized planning code. - (Update) Update Changes metadata handling to use Module::Instal::DOAPChangeSets (Github issue #25). - (Update) Updated Attean::Algebra::Join to be n-ary, not binary. - (Update) Updated attean_query to use the native SPARQL parser. 0.009 2015-11-04 - (Addition) Added Attean::API::Result->shared_domain method. - (Update) Improve handling on unicode data in SPARQL TSV parser. - (Update) Improve query planner and plan implementations to support SPARQL 1.1 test suite. - (Update) Removed HeapSort plan implementation and use of Array::Heap due to packaging concerns (issue #32). 0.008 2015-08-18 - (Addition) Added Attean::API::Plan::Join role. - (Addition) Added apply_triple and apply_quad methods to triple and quad pattern classes to produce Result objects. - (Addition) Added heap sort plan implementation. - (Update) Attean::API::TripleOrQuadPattern constructors accept non-existent parameters (#13). - (Update) Consolidated BUILDARGS handling in Attean::API::TripleOrQuadPattern. - (Update) Moved computation of in_scope_variables from calling code to to Plan class BUILDARGS. 0.007 2015-07-16 - (Addition) Added Attean::API::Binding->apply_bindings to bind additional variables. - (Addition) Added Attean::API::Binding->is_ground. - (Addition) Added Attean::API::TriplePattern->as_triple, Attean::API::QuadPattern->as_quad. - (Update) Added evaluation support for REGEX functions. - (Update) Fix Attean plugin loading to allow non-plugins nested below the plugin namespace. - (Update) Improve SPARQL serialization for IRIs and triple patterns. - (Update) Improve SPARQL serialization of OPTIONAL and boolean literals. - (Update) POD improvements (PR #15 from Kjetil Kjernsmo). 0.006 2015-06-30 - (Addition) Added Attean::API::DirectedAcyclicGraph->has_only_subtree_types method. - (Addition) Added Attean->acceptable_parsers method (GH issue #11). - (Addition) Added methods to test terms and variables for common term role consumption. - (Update) Added HSP heuristics to Attean::IDPQueryPlanner (patch from Kjetil Kjernsmo). - (Update) Added documentation (patches from Kjetil Kjernsmo). - (Update) Disable stable sortint in Attean::IDPQueryPlanner where it is unnecessary (patch from Kjetil Kjernsmo). - (Update) Fixed handling of blank nodes in BGPs in Attean::IDPQueryPlanner. - (Update) Updated Attean::IDPQueryPlanner->join_plans API to allow easier extensibility. - (Update) Updated attean_query to use the IDPQueryPlanner. 0.005 2015-05-27 - (Update) Add initial code to support interesting orders in Attean::IDPQueryPlanner. - (Update) Added Attean::Plan::Unique class. - (Update) Added POD description of each Attean::Plan class. - (Update) Added evaluation support for type checking functions (ISIRI, ISLITERAL, etc.). - (Update) Added planning support for Extend and Ask algebra operations. - (Update) Added planning support for Unique plans for DISTINCT queries which are already ordered. - (Update) Added query planning tests. - (Update) Added use Set::Scalar in lib/Attean/Algebra.pm. - (Update) Allow store-planning of more than just BGPs in Attean::TripleModel. - (Update) Change use of ListIterator to CodeIterator in plan classes that can be pipelined. - (Update) Changed Attean::Plan::Filter to check the EBV of a single, named variable binding. - (Update) Fixed bug in IDPQueryPlanner->cost_for_plan to reflect recently changed Attean::Plan::Quad API. - (Update) Improve propagation of distinct and ordered attributes during query planning. - (Update) Improved query planning. - (Update) Removed references to Attean::QueryEvaluator (obviated by $plan->evaluate). - (Update) Removed unused/unnecessary code and comments. - (Update) Rename Attean::Plan::Distinct to Attean::Plan::HashDistinct (making room for different implementation strategies). - (Update) Renamed Attean::Plan::Filter to Attean::Plan::EBVFilter. - (Update) Simplified implementation of Attean::Plan::Unique. - (Update) Split handling of BGP and GGP join planning in Attean::IDPQueryPlanner for easier subclass overriding. - (Update) Updated Attean::Plan::Quad to consume Attean::API::QuadPattern. - (Update) Updated IDP query planner to produce correct plans for empty BGPs. 0.004 2015-05-18 - (Addition) Add Attean::ValueExpression->in_scope_variables method. - (Addition) Add initial implementation of Attean::TripleModel. - (Addition) Added Attean::API::Binding->values_consuming_role method. - (Addition) Added Attean::TriplePattern->as_quadpattern method. - (Addition) Added SPARQL CSV and XML serializers. - (Addition) Added Test::Attean roles for caching quadstores. - (Addition) Added Test::Attean::MutableTripleStore. - (Addition) Added an IDP-based query planner and associated classes and roles. - (Addition) Added initial support for representing, translating, and evaluating SERVICE patterns. - (Update) Add SPARQL serialization support for Expression classes. - (Update) Add algebra_as_string methods for some algebra classes missing an implementation. - (Update) Add variables to result iterators. - (Update) Added Math::Cartesian::Product to prerequisite list. - (Update) Added Test::Roo-based store tests. - (Update) Added comments about handling of graphs in Test::Attean::MutableQuadStore. - (Update) Added missing use statements. - (Update) Fix documentation of serialize_iter_to_io method. - (Update) Fixed Attean->get_parser to accept media types with parameters. - (Update) Fixed required version of perl in store test roles to be v5.14. - (Update) Fixed serialization bug in Attean::FunctionExpression->as_sparql. - (Update) Improve SPARQL serialization for projection, slicing, ordering, and distinct/reduced modifiers. - (Update) Improve SPARQL serialization of algebra trees. - (Update) Update Attean::API::Expression to consume Attean::API::UnionScopeVariables. - (Update) Updated AtteanX::Store::Memory to conform to both etag and time caching roles. - (Update) Updated Memory store matching methods to accept node arrays for any quad pattern position. 0.003 2015-02-19 - (Addition) Added Attean::TreeRewriter class. - (Addition) Added count estimate methods to TripleStore QuadStore roles (in lieu of github pull request #6). - (Addition) Added missing algebra_as_string impelementations in Attean::API::Query and Attean::Algebra. - (Addition) Added tree_attributes methods to tree classes. - (Update) Fixed method name typo in Attean::API::TimeCacheableTripleStore. - (Update) Split Cacheable roles into ETagCacheable and TimeCacheable variants. 0.002 2014-10-15 - (Addition) Added Attean->negotiate_serializer method. - (Addition) Added POD for many classes and roles. - (Update) Changed media_type attributes to class methods in Serializer classes. - (Update) Moved RDF::Query algebra translator to AtteanX::RDFQueryTranslator. - (Update) Switched from Sub::Name to Sub::Util (github issue #5). - (Update) Updated Attean->get_serializer to support media_type argument. - (Update) Wrap mutating methods in a single bulk-update. 0.001 2014-09-27 - (Addition) Initial release. Attean-0.034/MANIFEST000644 000765 000024 00000012413 14636711137 014166 0ustar00gregstaff000000 000000 bin/attean_parse bin/attean_query bin/canonicalize_bgp.pl Changes CONTRIBUTING inc/Module/Install.pm inc/Module/Install/AuthorTests.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/DOAPChangeSets.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Scripts.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/Attean.pm lib/Attean/AggregateExpression.pod lib/Attean/Algebra.pm lib/Attean/API.pm lib/Attean/API/AbbreviatingParser.pod lib/Attean/API/AbbreviatingSerializer.pod lib/Attean/API/AggregateExpression.pod lib/Attean/API/AppendableSerializer.pod lib/Attean/API/AtOnceParser.pod lib/Attean/API/Binding.pm lib/Attean/API/Blank.pod lib/Attean/API/BlankOrIRI.pod lib/Attean/API/BulkUpdatableModel.pod lib/Attean/API/Expression.pm lib/Attean/API/IRI.pod lib/Attean/API/Iterator.pm lib/Attean/API/Literal.pod lib/Attean/API/MixedStatementParser.pod lib/Attean/API/MixedStatementSerializer.pod lib/Attean/API/Model.pm lib/Attean/API/MutableModel.pod lib/Attean/API/MutableTripleStore.pod lib/Attean/API/Parser.pm lib/Attean/API/Plan.pm lib/Attean/API/PullParser.pod lib/Attean/API/PushParser.pod lib/Attean/API/Quad.pod lib/Attean/API/QuadParser.pod lib/Attean/API/QuadPattern.pod lib/Attean/API/QuadSerializer.pod lib/Attean/API/Query.pm lib/Attean/API/QueryPlanner.pm lib/Attean/API/RepeatableIterator.pod lib/Attean/API/Result.pod lib/Attean/API/ResultParser.pod lib/Attean/API/ResultSerializer.pod lib/Attean/API/Serializer.pm lib/Attean/API/Store.pm lib/Attean/API/Term.pm lib/Attean/API/TermOrVariable.pod lib/Attean/API/TermParser.pod lib/Attean/API/TermSerializer.pod lib/Attean/API/Triple.pod lib/Attean/API/TripleOrQuad.pod lib/Attean/API/TripleParser.pod lib/Attean/API/TriplePattern.pod lib/Attean/API/TripleSerializer.pod lib/Attean/API/Variable.pod lib/Attean/BindingEqualityTest.pm lib/Attean/Blank.pm lib/Attean/CodeIterator.pm lib/Attean/Expression.pm lib/Attean/IDPQueryPlanner.pm lib/Attean/IRI.pm lib/Attean/IteratorSequence.pm lib/Attean/ListIterator.pm lib/Attean/Literal.pm lib/Attean/Plan.pm lib/Attean/Quad.pm lib/Attean/QuadModel.pm lib/Attean/QueryPlanner.pm lib/Attean/RDF.pm lib/Attean/Result.pm lib/Attean/SimpleQueryEvaluator.pm lib/Attean/SPARQLClient.pm lib/Attean/TermMap.pm lib/Attean/TreeRewriter.pm lib/Attean/Triple.pm lib/Attean/TripleModel.pm lib/Attean/Variable.pm lib/AtteanX/API/JoinRotatingPlanner.pm lib/AtteanX/API/Lexer.pm lib/AtteanX/Functions/CompositeMaps.pm lib/AtteanX/Functions/CompositeLists.pm lib/AtteanX/Parser/NQuads.pm lib/AtteanX/Parser/NTriples.pm lib/AtteanX/Parser/NTuples.pm lib/AtteanX/Parser/RDFXML.pm lib/AtteanX/Parser/SPARQL.pm lib/AtteanX/Parser/SPARQLJSON.pm lib/AtteanX/Parser/SPARQLLex.pm lib/AtteanX/Parser/SPARQLTSV.pm lib/AtteanX/Parser/SPARQLXML.pm lib/AtteanX/Parser/SPARQLXML/SAXHandler.pm lib/AtteanX/Parser/Trig.pm lib/AtteanX/Parser/Turtle.pm lib/AtteanX/Parser/Turtle/Constants.pm lib/AtteanX/Parser/Turtle/Lexer.pm lib/AtteanX/Parser/Turtle/Token.pm lib/AtteanX/Serializer/CanonicalNTriples.pm lib/AtteanX/Serializer/NQuads.pm lib/AtteanX/Serializer/NTriples.pm lib/AtteanX/Serializer/NTuples.pm lib/AtteanX/Serializer/RDFXML.pm lib/AtteanX/Serializer/SPARQL.pm lib/AtteanX/Serializer/SPARQLCSV.pm lib/AtteanX/Serializer/SPARQLHTML.pm lib/AtteanX/Serializer/SPARQLJSON.pm lib/AtteanX/Serializer/SPARQLTSV.pm lib/AtteanX/Serializer/SPARQLXML.pm lib/AtteanX/Serializer/TextTable.pm lib/AtteanX/Serializer/Turtle.pm lib/AtteanX/Serializer/TurtleTokens.pm lib/AtteanX/SPARQL/Constants.pm lib/AtteanX/SPARQL/Token.pm lib/AtteanX/Store/Memory.pm lib/AtteanX/Store/Simple.pm lib/AtteanX/Store/SimpleTripleStore.pm lib/Test/Attean/ETagCacheableQuadStore.pm lib/Test/Attean/MutableETagCacheableQuadStore.pm lib/Test/Attean/MutableQuadStore.pm lib/Test/Attean/MutableTimeCacheableQuadStore.pm lib/Test/Attean/MutableTripleStore.pm lib/Test/Attean/QuadStore.pm lib/Test/Attean/SPARQLStarSuite.pm lib/Test/Attean/SPARQLSuite.pm lib/Test/Attean/StoreCleanup.pm lib/Test/Attean/TimeCacheableQuadStore.pm lib/Test/Attean/TripleStore.pm lib/Test/Attean/W3CManifestTestSuite.pm lib/Types/Attean.pm Makefile.PL MANIFEST This list of files META.yml meta/changes.ttl README.md t/00.load.t t/algebra.t t/binding-equality.t t/binding.t t/convenience.t t/cost_planner.t t/export-functions.t t/expression.t t/http-negotiation.t t/idp_planner.t t/iter.t t/join_rotating_planner.t t/model-quad.t t/model-triple.t t/naive_planner.t t/parser_serializer_api.t t/parser-nquads.t t/parser-ntriples.t t/parser-rdfxml.t t/parser-sparql-star.t t/parser-sparql.t t/parser-sparqljson.t t/parser-sparqltsv.t t/parser-sparqlxml.t t/parser-turtle-star.t t/parser-turtle.t t/parser.t t/plan.t t/plans.t t/serializer-canonicalntriples.t t/serializer-nquads.t t/serializer-ntriples.t t/serializer-rdfxml.t t/serializer-sparql.t t/serializer-sparqlcsv.t t/serializer-sparqlhtml.t t/serializer-sparqljson.t t/serializer-sparqltsv.t t/serializer-sparqlxml.t t/serializer-turtle.t t/serializer.t t/simple-eval.t t/simple.t t/store-memory.t t/store-simple.t t/store-simpletriple.t t/term-map.t t/term.t t/treerewrite.t t/types-general.t t/types-iri.t xt/dawg11-memory.t xt/eval-sparql-star-memory-simpleeval.t xt/eval-sparql-star-memory.t xt/pod-coverage.t xt/pod.t SIGNATURE Public-key signature (added by MakeMaker) Attean-0.034/meta/000755 000765 000024 00000000000 14636711137 013762 5ustar00gregstaff000000 000000 Attean-0.034/t/000755 000765 000024 00000000000 14636711137 013277 5ustar00gregstaff000000 000000 Attean-0.034/xt/000755 000765 000024 00000000000 14636711137 013467 5ustar00gregstaff000000 000000 Attean-0.034/README.md000644 000765 000024 00000002253 14273070744 014314 0ustar00gregstaff000000 000000 Attean Semantic Web Framework ============================= Attean is a Perl framework for working with RDF data and SPARQL queries. It features parsers and serializers for many different RDF formats including RDF/XML, Turtle, N-Triples and N-Quads, as well as SPARQL formats like SPARQL-XML, SPARQL-JSON, SPARQL-CSV and SPARQL-TSV. Attean features support for SPARQL 1.1 queries, and a set of APIs and command line tools to parse, transform, query, and serialize RDF data. Getting Attean -------------- Attean is available from: * [GitHub](https://github.com/kasei/attean/) * [CPAN](https://metacpan.org/release/Attean) And is also available as [Debian packages](https://packages.qa.debian.org/liba/libattean-perl.html). Getting Help ------------ A group of perl-rdf developers are usually available in the [perlrdf IRC channel](irc://irc.perl.org/perlrdf) where we're happy to answer questions. You can also: * Create a new [GitHub Issue](https://github.com/kasei/attean/issues) or submit a pull request Licensing --------- Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Attean-0.034/META.yml000644 000765 000024 00000003017 14636711132 014301 0ustar00gregstaff000000 000000 --- abstract: 'A Semantic Web Framework' author: - 'Gregory Todd Williams C<< >>' - 'Gregory Todd Williams ' build_requires: ExtUtils::MakeMaker: 6.59 HTTP::Headers: 0 HTTP::Message::PSGI: 0 Regexp::Common: 0 Test::Exception: 0 Test::LWP::UserAgent: 0 Test::More: 0.88 Test::Requires: 0 XML::Simple: 0 configure_requires: ExtUtils::MakeMaker: 6.59 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.21' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Attean no_index: directory: - inc - t - xt requires: Algorithm::Combinatorics: 0 DateTime::Format::W3CDTF: 0 Exporter::Tiny: 1 File::Slurp: 0 HTTP::Negotiate: 0 IRI: 0.005 JSON: 0 LWP::UserAgent: 0 List::MoreUtils: 0 Math::Cartesian::Product: 1.008 Module::Pluggable: 0 Moo: 2.000002 MooX::Log::Any: 0 PerlIO::Layers: 0 Role::Tiny: 2.000003 Set::Scalar: 0 Sub::Install: 0 Sub::Util: 1.4 Test::Modern: 0.012 Test::Moose: 0 Test::Roo: 0 Test::TypeTiny: 0 Text::CSV: 0 Text::Table: 0 Try::Tiny: 0 Type::Tiny: 0 URI::Escape: 1.36 URI::NamespaceMap: 0.12 UUID::Tiny: 0 XML::SAX: 0 namespace::clean: 0 perl: 5.14.0 resources: IRC: irc://irc.perl.org/#perlrdf bugtracker: https://github.com/kasei/attean/issues homepage: https://metacpan.org/release/Attean license: http://dev.perl.org/licenses/ repository: https://github.com/kasei/attean/ version: '0.034' Attean-0.034/lib/000755 000765 000024 00000000000 14636711137 013602 5ustar00gregstaff000000 000000 Attean-0.034/Makefile.PL000644 000765 000024 00000003735 14632645502 015014 0ustar00gregstaff000000 000000 use strict; use warnings; use lib '.'; use inc::Module::Install; name 'Attean'; all_from 'lib/Attean.pm'; author 'Gregory Todd Williams '; license 'perl'; test_requires 'HTTP::Message::PSGI' => 0; test_requires 'Regexp::Common' => 0; test_requires 'Test::Exception' => 0; test_requires 'Test::Requires' => 0; test_requires 'Test::LWP::UserAgent' => 0; test_requires 'Test::More' => 0.88; test_requires 'XML::Simple' => 0; test_requires 'HTTP::Headers' => 0; perl_version '5.014'; requires 'Algorithm::Combinatorics' => 0; requires 'UUID::Tiny' => 0; requires 'DateTime::Format::W3CDTF' => 0; requires 'Exporter::Tiny' => 1.000000; requires 'File::Slurp' => 0; requires 'HTTP::Negotiate' => 0; requires 'IRI' => 0.005; requires 'JSON' => 0; requires 'List::MoreUtils' => 0; requires 'LWP::UserAgent' => 0; requires 'Math::Cartesian::Product' => 1.008; requires 'Module::Pluggable' => 0; requires 'Moo' => 2.000002; requires 'MooX::Log::Any' => 0; requires 'namespace::clean' => 0; requires 'PerlIO::Layers' => 0; requires 'Role::Tiny' => 2.000003; requires 'Set::Scalar' => 0; requires 'Sub::Install' => 0; requires 'Sub::Util' => 1.40; requires 'Test::Modern' => 0.012; requires 'Test::Moose' => 0; requires 'Test::Roo' => 0; requires 'Test::TypeTiny' => 0; requires 'Text::CSV' => 0; requires 'Text::Table' => 0; requires 'Try::Tiny' => 0; requires 'Type::Tiny' => 0; requires 'URI::Escape' => 1.36; requires 'URI::NamespaceMap' => 0.12; requires 'XML::SAX' => 0; resources( 'homepage' => "https://metacpan.org/release/Attean", 'repository' => "https://github.com/kasei/attean/", 'bugtracker' => "https://github.com/kasei/attean/issues", 'IRC' => "irc://irc.perl.org/#perlrdf", ); author_tests('xt'); install_script glob('bin/attean_*'); write_doap_changes "meta/changes.ttl", "Changes", "turtle"; sign if ! exists $ENV{CI}; WriteAll; Attean-0.034/lib/Types/000755 000765 000024 00000000000 14636711137 014706 5ustar00gregstaff000000 000000 Attean-0.034/lib/Test/000755 000765 000024 00000000000 14636711137 014521 5ustar00gregstaff000000 000000 Attean-0.034/lib/PaxHeader/Attean.pm000644 000765 000024 00000000225 14636707632 017331 xustar00gregstaff000000 000000 30 mtime=1719373722.497833324 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean.pm000644 000765 000024 00000035321 14636707632 015365 0ustar00gregstaff000000 000000 =head1 NAME Attean - A Semantic Web Framework =head1 VERSION This document describes Attean version 0.034 =head1 SYNOPSIS use Attean; use Attean::RDF qw(iri); my $store = Attean->get_store('Memory')->new(); my $parser = Attean->get_parser('NTriples')->new(); # iterator of triples and quads my $iter = $parser->parse_iter_from_io(\*STDIN); # add a graph name to all triples my $graph = iri('http://graph-name/'); my $quads = $iter->as_quads($graph); $store->add_iter($quads); my $model = Attean::QuadModel->new( store => $store ); my $iter = $model->get_quads(); while (my $quad = $iter->next) { say $quad->object->ntriples_string; } # run a SPARQL query and iterate over the results my $sparql = 'SELECT * WHERE { ?s ?p ?o }'; my $s = Attean->get_parser('SPARQL')->new(); my ($algebra) = $s->parse($sparql); my $results = $model->evaluate($algebra, $graph); while (my $r = $results->next) { say $r->as_string; } =head1 DESCRIPTION Attean provides APIs for parsing, storing, querying, and serializing Semantic Web (RDF and SPARQL) data. =head1 METHODS =over 4 =cut package Attean { use v5.14; use warnings; our $VERSION = '0.034'; use Attean::API; use Attean::Blank; use Attean::Literal; use Attean::Variable; use Attean::IRI; use Attean::Triple; use Attean::Quad; use Attean::Result; use Attean::QuadModel; use Attean::TripleModel; use Attean::BindingEqualityTest; use Attean::CodeIterator; use Attean::ListIterator; use Attean::IteratorSequence; use Attean::IDPQueryPlanner; use Attean::TermMap; use HTTP::Negotiate qw(choose); use List::MoreUtils qw(any all); use Module::Load::Conditional qw(can_load); use Role::Tiny (); use Sub::Util qw(set_subname); use namespace::clean; use Module::Pluggable search_path => 'AtteanX::Parser', sub_name => 'parsers', max_depth => 3; use Module::Pluggable search_path => 'AtteanX::Serializer', sub_name => 'serializers', max_depth => 3; use Module::Pluggable search_path => 'AtteanX::Store', sub_name => 'stores', max_depth => 3; sub import { my $class = shift; if (scalar(@_)) { my %args = @_; foreach my $p (@{ $args{parsers} || [] }) { # warn "Loading $p parser..."; $class->get_parser($p) || die "Failed to load parser: $p"; } foreach my $s (@{ $args{serializers} || [] }) { # warn "Loading $s serializer..."; $class->get_serializer($s) || die "Failed to load serializer: $s"; } foreach my $s (@{ $args{stores} || [] }) { # warn "Loading $s store..."; $class->get_store($s) || die "Failed to load store: $s"; } } } =item C<< get_store( $NAME ) >> Attempts to find a L implementation with the given C<< $NAME >>. This is done using L and will generally be searching for class names C<< AtteanX::Store::$NAME >>. Returns the full class name if a matching implementation is found, otherwise returns undef. =cut sub get_store { my $self = shift; return $self->_get_plugin('stores', shift); } =item C<< temporary_model >> Returns a temporary, mutable quad model based on a L store. =cut sub temporary_model { my $self = shift; return Attean::MutableQuadModel->new( store => $self->get_store('Memory')->new() ) } =item C<< get_serializer( $NAME ) >> =item C<< get_serializer( filename => $FILENAME ) >> =item C<< get_serializer( media_type => $MEDIA_TYPE ) >> Attempts to find a L serializer class with the given C<< $NAME >>, or that can serialize files with the C<< $MEDIA_TYPE >> media type. Returns the full class name if a matching implementation is found, otherwise returns undef. =cut sub get_serializer { my $self = shift; my $role = 'Attean::API::Serializer'; if (scalar(@_) == 1) { my $name = shift; my $p = $self->_get_plugin('serializers', $name, $role); return $p if $p; foreach my $type (qw'filename media_type') { my $p = $self->get_serializer($type => $name); return $p if $p; } return; } my $type = shift; my %method = (filename => 'file_extensions', media_type => 'media_types'); if (my $method = $method{ $type }) { my $value = shift; $value =~ s/^.*[.]// if ($type eq 'filename'); $value =~ s/;.*$// if ($type eq 'media_type'); foreach my $p ($self->serializers()) { if (can_load( modules => { $p => 0 })) { next unless ($p->does($role)); my @exts = @{ $p->$method() }; return $p if (any { $value eq $_ } @exts); } } return; } else { die "Not a valid constraint in get_serializer call: $type"; } } =item C<< get_parser( $NAME ) >> =item C<< get_parser( filename => $FILENAME ) >> =item C<< get_parser( media_type => $MEDIA_TYPE ) >> Attempts to find a L parser class with the given C<< $NAME >>, or that can parse files with the same extension as C<< $FILENAME >>, or that can parse files with the C<< $MEDIA_TYPE >> media type. Returns the full class name if a matching implementation is found, otherwise returns undef. =cut sub get_parser { my $self = shift; my $role = 'Attean::API::Parser'; if (scalar(@_) == 1) { my $name = shift; my $p = $self->_get_plugin('parsers', $name, $role); return $p if $p; foreach my $type (qw'filename media_type') { my $p = $self->get_parser($type => $name); return $p if $p; } return; } while (my $type = shift) { my %method = (filename => 'file_extensions', media_type => 'media_types'); if (my $method = $method{ $type }) { my $value = shift; $value =~ s/^.*[.]// if ($type eq 'filename'); $value =~ s/;.*$// if ($type eq 'media_type'); foreach my $p ($self->parsers()) { if (can_load( modules => { $p => 0 })) { next unless ($p->can('does') and $p->does($role)); my @exts = @{ $p->$method() }; return $p if (any { $value eq $_ } @exts); } } } else { die "Not a valid constraint in get_parser call: $type"; } } return; } { my %roles = ( serializers => 'Attean::API::Serializer', parsers => 'Attean::API::Parser', stores => 'Attean::API::Store', ); for my $method (keys %roles) { my $role = $roles{$method}; my $code = sub { my $self = shift; my @classes; foreach my $class ($self->$method()) { next unless (can_load( modules => { $class => 0 })); push(@classes, $class) if ($class->can('does') and $class->does($role)); } return @classes; }; Sub::Install::install_sub({ code => set_subname("list_${method}", $code), as => "list_${method}" }); } } sub _get_plugin { my $self = shift; my $type = shift; my $name = shift; my @roles = @_; foreach my $p ($self->$type()) { if (lc(substr($p, -(length($name)+2))) eq lc("::$name")) { unless (can_load( modules => { $p => 0 })) { warn $Module::Load::Conditional::ERROR; return; } foreach (@roles) { unless ($p->does($_)) { die ucfirst($type) . " class $p failed validation for role $_"; } } return $p; } } } =item C<< negotiate_serializer ( request_headers => $request_headers, restrict => \@serializer_names, extend => \%media_types ) >> Returns a two-element list containing an appropriate media type and L class as decided by L. If the C<< 'request_headers' >> key-value is supplied, the C<< $request_headers >> is passed to C<< HTTP::Negotiate::choose >>. The option C<< 'restrict' >>, set to a list of serializer names, can be used to limit the serializers to choose from. Finally, an C<<'extend'>> option can be set to a hashref that contains MIME-types as keys and a custom variant as value. This will enable the user to use this negotiator to return a type that isn't supported by any serializers. The subsequent code will have to find out how to return a representation. =cut sub negotiate_serializer { my $class = shift; my %options = @_; my $headers = delete $options{ 'request_headers' }; my $restrict = delete $options{ 'restrict' }; my $extend = delete $options{ 'extend' } || {}; my %serializer_names; my %media_types; foreach my $sclass ($class->list_serializers) { my $name = $sclass =~ s/^.*://r; $serializer_names{lc($name)} = $sclass; for (@{ $sclass->media_types }) { push(@{ $media_types{$_} }, $sclass); } } my %sclasses; if (ref($restrict) && ref($restrict) eq 'ARRAY') { foreach (@$restrict) { if (my $sclass = $serializer_names{lc($_)}) { $sclasses{ $sclass } = 1; } } } else { %sclasses = reverse %serializer_names; } my @default_variants; while (my($type, $sclasses) = each(%media_types)) { foreach my $sclass (@$sclasses) { next unless $sclasses{$sclass}; my $qv; # slightly prefer turtle as a readable format to others # try hard to avoid using ntriples as 'text/plain' isn't very useful for conneg if ($type eq 'application/n-triples') { $qv = 1.0; } elsif ($type eq 'text/plain') { $qv = 0.2; } else { $qv = 0.99; $qv -= 0.01 if ($type =~ m#/x-#); # prefer non experimental media types $qv -= 0.01 if ($type =~ m#^application/(?!rdf[+]xml)#); # prefer standard rdf/xml to other application/* formats } push(@default_variants, [$type, $qv, $type]); } } my %custom_thunks; my @custom_variants; while (my($type,$thunk) = each(%$extend)) { push(@custom_variants, [$thunk, 1.0, $type]); $custom_thunks{ $thunk } = [$type, $thunk]; } # remove variants with media types that are in custom_variants from @variants my @variants = grep { not exists $extend->{ $_->[2] } } @default_variants; push(@variants, @custom_variants); my $stype = choose( \@variants, $headers ); if (defined($stype) and $custom_thunks{ $stype }) { my $thunk = $stype; my $type = $custom_thunks{ $stype }[0]; return ($type, $thunk); } if (defined($stype) and my $sclasses = $media_types{ $stype }) { return ($stype, $sclasses->[0]); } else { die "No appropriate serializer found for content-negotiation: " . Data::Dumper->Dump([$headers, $restrict, $extend], [qw(headers restrict extend)]); } } =item C<< acceptable_parsers ( handles => $item_role, prefer => $parser_role ) >> Returns a string value expressing the media types that are acceptable to the parsers available to the system. This string may be used as an 'Accept' HTTP header value. If a C<< handles >> role is supplied, only parsers that produce objects that conform to C<< $item_role >> will be included. If a C<< prefer >> role is supplied, only parsers that conform to C<< $parser_role >> will be included. Parsers are given a quality-value (expressing a preferred order or use) based on the roles each parser consumes. Parsers consuming L are preferred, while those consuming L are not preferred. An exact ordering between parsers consuming similar roles is currently undefined. =cut sub acceptable_parsers { my $class = shift; my %options = @_; my $handles = delete $options{ 'handles' }; my $prefer = delete $options{ 'prefer' }; if (defined($handles) and $handles !~ /::/) { $handles = ucfirst(lc($handles)); $handles = "Attean::API::$handles"; } if (defined($prefer) and $prefer !~ /::/) { $prefer = "Attean::API::" . ucfirst($prefer); $prefer = "${prefer}Parser" unless ($prefer =~ /Parser$/); } my %media_types; foreach my $pclass ($class->list_parsers) { if (defined($handles)) { my $type = $pclass->handled_type; next unless ($type->can('role')); my $role = $type->role; next unless Role::Tiny::does_role($handles, $role); } if (defined($prefer)) { next unless ($pclass->does($prefer)); } my $q = 0.5; if ($pclass->does('Attean::API::PullParser')) { $q += 0.25; } elsif ($pclass->does('Attean::API::AtOnceParser')) { $q -= 0.25; } for (@{ $pclass->media_types }) { my $mt = "$_;q=$q"; $media_types{$mt} = $q; } } my @sorted = sort { $media_types{$b} <=> $media_types{$a} } keys %media_types; return join(',', @sorted); } # Global registry for extension functions that can be invoked via BIND, FILTER, etc. { our %global_functions; =item C<< register_global_function( %uri_to_func ) >> =cut sub register_global_function { my $class = shift; my %args = @_; foreach my $uri (keys %args) { my $func = $args{ $uri }; $global_functions{ $uri } = $func; } } =item C<< get_global_function( $uri ) >> =cut sub get_global_function { my $class = shift; my $uri = shift; return $global_functions{ $uri }; } } # Global registry for extension "functional forms" that can be invoked via BIND, FILTER, etc. # These differ from extension "functions" in that they can be passed undef values as arguments # for expressions whose evaluation resulted in an error. { our %global_functional_forms; =item C<< register_global_functional_form( %uri_to_func ) >> =cut sub register_global_functional_form { my $class = shift; my %args = @_; foreach my $uri (keys %args) { my $func = $args{ $uri }; $global_functional_forms{ $uri } = $func; } } =item C<< get_global_functional_form( $uri ) >> =cut sub get_global_functional_form { my $class = shift; my $uri = shift; return $global_functional_forms{ $uri }; } } # Global registry for extension aggregates { our %global_aggregates; =item C<< register_global_aggregate( %uri_to_hash ) >> =cut sub register_global_aggregate { my $class = shift; my %args = @_; foreach my $uri (keys %args) { my $funcs = $args{ $uri }; $global_aggregates{ $uri } = $funcs; } } =item C<< get_global_aggregate( $uri ) >> =cut sub get_global_aggregate { my $class = shift; my $uri = shift; return $global_aggregates{ $uri }; } } # Global registry for extension datatypes. # When literals of this datatype are constructed, they will have the registered Moo role applied to them. { our %datatype_roles; =item C<< register_datatype_role( %uri_to_role ) >> =cut sub register_datatype_role { my $class = shift; my %args = @_; foreach my $uri (keys %args) { my $func = $args{ $uri }; $datatype_roles{ $uri } = $func; } } =item C<< get_datatype_role( $uri ) >> =cut sub get_datatype_role { my $class = shift; my $uri = shift; return $datatype_roles{ $uri }; } } } use AtteanX::Functions::CompositeLists; 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/000755 000765 000024 00000000000 14636711137 015146 5ustar00gregstaff000000 000000 Attean-0.034/lib/Attean/000755 000765 000024 00000000000 14636711137 015016 5ustar00gregstaff000000 000000 Attean-0.034/lib/Attean/PaxHeader/IRI.pm000644 000765 000024 00000000225 14636707547 017761 xustar00gregstaff000000 000000 30 mtime=1719373671.877313917 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/IRI.pm000644 000765 000024 00000004233 14636707547 016013 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::IRI - RDF Internationalized Resource Identifiers (IRIs) =head1 VERSION This document describes Attean::IRI version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my $term = Attean::IRI->new('http://example.org/'); $term->ntriples_string; # =head1 DESCRIPTION The Attean::IRI class represents RDF IRIs. It conforms to the L role and extends the L class. =head1 METHODS =over 4 =cut package Attean::IRI 0.034 { use Moo; use Types::Standard qw(Str); use IRI 0.005; use namespace::clean; extends 'IRI'; has 'ntriples_string' => (is => 'ro', isa => Str, lazy => 1, builder => '_ntriples_string'); =item C<< equals ( $iri ) >> Returns true if C<< $iri >> is equal to the invocant, false otherwise. =cut sub equals { # This overrides the Attean::API::TermOrVariable::equals implementation # to allow lazy IRIs to remain unparsed for the case where neither has # a base IRI. my ($a, $b) = @_; if ($b->isa('Attean::IRI')) { unless ($a->has_base or $b->has_base) { return ($a->value eq $b->value); } } return ($a->as_string eq $b->as_string); } with 'Attean::API::IRI'; with 'Attean::API::BlankOrIRI'; around BUILDARGS => sub { my $orig = shift; my $class = shift; my $args; if (scalar(@_) == 1) { $args = $class->$orig(value => shift); } else { $args = $class->$orig(@_); } if (exists $args->{base}) { # fully qualify IRIs my $iri = IRI->new( %$args ); $args = { value => $iri->as_string }; } return $args; }; =item C<< as_string >> Returns the IRI value. =cut sub as_string { my $self = shift; return $self->abs; } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO L L =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/Quad.pm000644 000765 000024 00000000225 14636707547 020230 xustar00gregstaff000000 000000 30 mtime=1719373671.970277383 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/Quad.pm000644 000765 000024 00000003627 14636707547 016270 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::Quad - RDF Quads =head1 VERSION This document describes Attean::Quad version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my $quad = Attean::Quad->new( $s, $p, $o, $g ); =head1 DESCRIPTION The Attean::Quad class represents an RDF quad. It conforms to the L role. =head1 ROLES This class consumes L. =head1 METHODS =over 4 =item C<< subject >> =item C<< predicate >> =item C<< object >> =item C<< graph >> =back =cut package Attean::QuadPattern 0.034 { use Moo; use Scalar::Util qw(blessed); use Attean::RDF; use Attean::API::Binding; has 'subject' => (is => 'ro', required => 1); has 'predicate' => (is => 'ro', required => 1); has 'object' => (is => 'ro', required => 1); has 'graph' => (is => 'ro', required => 1); with 'Attean::API::QuadPattern'; } package Attean::Quad 0.034 { use Moo; use Attean::API::Binding; has 'subject' => (is => 'ro', does => 'Attean::API::BlankOrIRI', required => 1); has 'predicate' => (is => 'ro', does => 'Attean::API::IRI', required => 1); has 'object' => (is => 'ro', does => 'Attean::API::Term', required => 1); has 'graph' => (is => 'ro', does => 'Attean::API::BlankOrIRI', required => 1); with 'Attean::API::Quad'; around BUILDARGS => sub { my $orig = shift; my $class = shift; if (scalar(@_) == 4) { my %args; @args{ $class->variables } = @_; return $class->$orig(%args); } return $class->$orig(@_); }; } 1; __END__ =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/Plan.pm000644 000765 000024 00000000224 14636707547 020227 xustar00gregstaff000000 000000 29 mtime=1719373671.95193081 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/Plan.pm000644 000765 000024 00000256723 14636707547 016277 0ustar00gregstaff000000 000000 use v5.14; use warnings; use utf8; =head1 NAME Attean::Plan - Representation of SPARQL query plan operators =head1 VERSION This document describes Attean::Plan version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a utility package that defines all the Attean query plan classes in the Attean::Plan namespace: =over 4 =cut use Attean::API::Query; =item * L Evaluates a quad pattern against the model. =cut package Attean::Plan::Quad 0.034 { use Moo; use Scalar::Util qw(blessed reftype); use Types::Standard qw(ConsumerOf ArrayRef); use AtteanX::Functions::CompositeLists; use AtteanX::Functions::CompositeMaps; use namespace::clean; has 'subject' => (is => 'ro', required => 1); has 'predicate' => (is => 'ro', required => 1); has 'object' => (is => 'ro', required => 1); has 'graph' => (is => 'ro', required => 1); with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::NullaryQueryTree'; with 'Attean::API::QuadPattern'; around 'BUILDARGS' => sub { my $orig = shift; my $class = shift; my $args = $orig->( $class, @_ ); if (exists $args->{in_scope_variables}) { Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor"; } my %vars; foreach my $pos (qw(subject predicate object graph)) { my $term = $args->{$pos}; if (blessed($term) and $term->does('Attean::API::Variable')) { $vars{$term->value} = $term; } } my @vars = keys %vars; $args->{in_scope_variables} = [@vars]; return $args; }; sub plan_as_string { my $self = shift; my @nodes = $self->values; my @strings; foreach my $t (@nodes) { if (ref($t) eq 'ARRAY') { my @tstrings = map { $_->ntriples_string } @$t; if (scalar(@tstrings) == 1) { push(@strings, @tstrings); } else { push(@strings, '[' . join(', ', @tstrings) . ']'); } } elsif ($t->does('Attean::API::TermOrVariable')) { push(@strings, $t->ntriples_string); } else { use Data::Dumper; die "Unrecognized node in quad pattern: " . Dumper($t); } } return sprintf('Quad { %s }', join(', ', @strings)); } sub substitute_impl { my $self = shift; my $model = shift; my $b = shift; my @values = $self->values; foreach my $i (0 .. $#values) { my $value = $values[$i]; if (reftype($value) eq 'ARRAY') { my @values; foreach my $value (@{ $value }) { my $name = $value->value; if (my $node = $b->value($name)) { push(@values, $node); } else { push(@values, $value); } $values[$i] = \@values; } } elsif ($value->does('Attean::API::Variable')) { my $name = $value->value; if (my $node = $b->value($name)) { $values[$i] = $node; } } } return sub { return $model->get_bindings( @values ); } } sub impl { my $self = shift; my $model = shift; my @values = $self->values; return sub { return $model->get_bindings( @values ); } } } =item * L Evaluates a join (natural-, anti-, or left-) using a nested loop. =cut package Attean::Plan::NestedLoopJoin 0.034 { use Moo; use List::MoreUtils qw(all); use namespace::clean; with 'Attean::API::BindingSubstitutionPlan'; with 'Attean::API::Plan::Join'; sub plan_as_string { my $self = shift; if ($self->left) { return 'NestedLoop Left Join'; } elsif ($self->anti) { return 'NestedLoop Anti Join'; } else { return 'NestedLoop Join'; } } sub impl { my $self = shift; my $model = shift; my @children = map { $_->impl($model) } @{ $self->children }; return $self->_impl($model, @children); } sub substitute_impl { my $self = shift; my $model = shift; my $b = shift; unless (all { $_->does('Attean::API::BindingSubstitutionPlan') } @{ $self->children }) { die "Plan children do not all consume BindingSubstitutionPlan role:\n" . $self->as_string; } my @children = map { $_->substitute_impl($model, $b) } @{ $self->children }; return $self->_impl($model, @children); } sub _impl { my $self = shift; my $model = shift; my @children = @_; my $left = $self->left; my $anti = $self->anti; my $iter_variables = $self->in_scope_variables; return sub { my ($lhs, $rhs) = map { $_->() } @children; my @right = $rhs->elements; my @results; while (my $l = $lhs->next) { my $seen = 0; foreach my $r (@right) { my @shared = $l->shared_domain($r); if ($anti and scalar(@shared) == 0) { # in a MINUS, two results that have disjoint domains are considered not to be joinable next; } if (my $j = $l->join($r)) { $seen++; if ($left) { # TODO: filter with expression push(@results, $j); } elsif ($anti) { } else { push(@results, $j); } } } if ($left and not($seen)) { push(@results, $l); } elsif ($anti and not($seen)) { push(@results, $l); } } return Attean::ListIterator->new( item_type => 'Attean::API::Result', variables => $iter_variables, values => \@results, ); } } } =item * L Evaluates a join (natural-, anti-, or left-) using a hash join. =cut package Attean::Plan::HashJoin 0.034 { use Moo; use List::MoreUtils qw(all); use namespace::clean; sub BUILD { my $self = shift; if ($self->anti) { die "Cannot use a HashJoin for anti-joins"; } } with 'Attean::API::BindingSubstitutionPlan'; with 'Attean::API::Plan::Join'; sub plan_as_string { my $self = shift; my $name; if ($self->left) { $name = "Hash Left Join"; } else { $name = "Hash Join"; } return sprintf('%s { %s }', $name, join(', ', @{$self->join_variables})); } sub impl { my $self = shift; my $model = shift; my @children = map { $_->impl($model) } @{ $self->children }; return $self->_impl($model, @children); } sub substitute_impl { my $self = shift; my $model = shift; my $b = shift; unless (all { $_->does('Attean::API::BindingSubstitutionPlan') } @{ $self->children }) { die "Plan children do not all consume BindingSubstitutionPlan role:\n" . $self->as_string; } my @children = map { $_->substitute_impl($model, $b) } @{ $self->children }; return $self->_impl($model, @children); } sub _impl { my $self = shift; my $model = shift; my @children = @_; my $left = $self->left; my $iter_variables = $self->in_scope_variables; return sub { my %hash; my @vars = @{ $self->join_variables }; my $rhs = $children[1]->(); while (my $r = $rhs->next()) { my $has_unbound_right_join_var = 0; my @values; foreach my $var (@vars) { my $value = $r->value($var); unless (defined($value)) { $has_unbound_right_join_var++; } push(@values, $value); } if ($has_unbound_right_join_var) { # this is a RHS row that doesn't have a term bound to one of the join variables. # this will make it impossible to compute the proper hash key to access the row bucket, # so we add this row to the null bucket (hash key '') which we try to join all LHS rows # against. push(@{ $hash{''} }, $r); } else { my $key = join(',', map { ref($_) ? $_->as_string : '' } @values); push(@{ $hash{$key} }, $r); } } my @results; my $lhs = $children[0]->(); while (my $l = $lhs->next()) { my $seen = 0; my @values; my $has_unbound_left_join_var = 0; foreach my $var (@vars) { my $value = $l->value($var); unless (defined($value)) { $has_unbound_left_join_var++; } push(@values, $value); } my @buckets; if (my $b = $hash{''}) { push(@buckets, $b); } if ($has_unbound_left_join_var) { my $pattern = join(',', map { ref($_) ? quotemeta($_->as_string) : '.*' } @values); foreach my $key (keys %hash) { if ($key =~ /^${pattern}$/) { push(@buckets, $hash{$key}); } } } else { my $key = join(',', map { ref($_) ? $_->as_string : '' } @values); if (my $rows = $hash{$key}) { push(@buckets, $rows); } } foreach my $rows (@buckets) { foreach my $r (@$rows) { if (my $j = $l->join($r)) { $seen++; if ($left) { # TODO: filter with expression push(@results, $j); } else { push(@results, $j); } } } } if ($left and not($seen)) { push(@results, $l); } } return Attean::ListIterator->new( item_type => 'Attean::API::Result', variables => $iter_variables, values => \@results ); } } } =item * L =cut package Attean::Plan::Construct 0.034 { use Moo; use List::MoreUtils qw(all); use Types::Standard qw(Str ArrayRef ConsumerOf InstanceOf); use namespace::clean; has 'triples' => (is => 'ro', 'isa' => ArrayRef[ConsumerOf['Attean::API::TripleOrQuadPattern']], required => 1); with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::UnaryQueryTree'; sub plan_as_string { my $self = shift; my $triples = $self->triples; return sprintf('Construct { %s }', join(' . ', map { $_->as_string } @$triples)); } sub BUILDARGS { # TODO: this code is repeated in several plan classes; figure out a way to share it. my $class = shift; my %args = @_; my %vars = map { $_ => 1 } map { @{ $_->in_scope_variables } } @{ $args{ children } }; my @vars = keys %vars; if (exists $args{in_scope_variables}) { Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor"; } $args{in_scope_variables} = \@vars; return $class->SUPER::BUILDARGS(%args); } sub impl { my $self = shift; my $model = shift; my @children = map { $_->impl($model) } @{ $self->children }; return $self->_impl($model, @children); } sub substitute_impl { my $self = shift; my $model = shift; my $b = shift; unless (all { $_->does('Attean::API::BindingSubstitutionPlan') } @{ $self->children }) { die "Plan children do not all consume BindingSubstitutionPlan role:\n" . $self->as_string; } warn "TODO: fix substitute_impl to substitute construct triples"; my @children = map { $_->substitute_impl($model, $b) } @{ $self->children }; return $self->_impl($model, @children); } # replace blank nodes in all the triple patterns with fresh ones sub refresh_triples { my $self = shift; my @t; my %mapping; foreach my $t (@_) { foreach my $term ($t->values) { if ($term->does('Attean::API::Blank')) { $mapping{$term->as_string} = Attean::Blank->new(); } } } my $mapper = Attean::TermMap->rewrite_map(\%mapping); foreach my $t (@_) { push(@t, $t->apply_map($mapper)); } return @t; } sub _impl { my $self = shift; my $model = shift; my $child = shift; my @triples = @{ $self->triples }; return sub { my $iter = $child->(); my @buffer; my %seen; return Attean::CodeIterator->new( item_type => 'Attean::API::Triple', generator => sub { if (scalar(@buffer)) { return shift(@buffer); } while (my $row = $iter->next) { foreach my $tp ($self->refresh_triples(@triples)) { my $tp = $tp->apply_bindings($row); my $t = eval { $tp->as_triple }; if ($t) { push(@buffer, $t); } } if (scalar(@buffer)) { my $t = shift(@buffer); return $t; } } } )->grep(sub { return not $seen{$_->as_string}++; }); } } } =item * L =cut package Attean::Plan::Describe 0.034 { use Moo; use Attean::RDF; use List::MoreUtils qw(all); use Types::Standard qw(Str ArrayRef ConsumerOf InstanceOf); use namespace::clean; has 'graph' => (is => 'ro'); has 'terms' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::TermOrVariable']]); with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::UnaryQueryTree'; with 'Attean::API::UnionScopeVariablesPlan'; sub plan_as_string { my $self = shift; my $terms = $self->terms; return sprintf('Describe { %s }', join(' . ', map { $_->as_string } @$terms)); } sub impl { my $self = shift; my $model = shift; my @children = map { $_->impl($model) } @{ $self->children }; return $self->_impl($model, @children); } sub substitute_impl { my $self = shift; my $model = shift; my $b = shift; unless (all { $_->does('Attean::API::BindingSubstitutionPlan') } @{ $self->children }) { die "Plan children do not all consume BindingSubstitutionPlan role:\n" . $self->as_string; } warn "TODO: fix substitute_impl to substitute describe terms"; my @children = map { $_->substitute_impl($model, $b) } @{ $self->children }; return $self->_impl($model, @children); } sub _impl { my $self = shift; my $model = shift; my $child = shift; my $graph = $self->graph; my @terms = @{ $self->terms }; # TODO: Split @terms into ground terms and variables. # Only call get_quads once for ground terms. # For variable terms, call get_quads for each variable-result combination. return sub { my $iter = $child->(); my @buffer; my %seen; return Attean::CodeIterator->new( item_type => 'Attean::API::Triple', generator => sub { if (scalar(@buffer)) { return shift(@buffer); } while (my $row = $iter->next) { foreach my $term (@terms) { my $value = $term->apply_binding($row); if ($value->does('Attean::API::Term')) { my $iter = $model->get_quads( $value, variable('predicate'), variable('object'), $graph ); push(@buffer, $iter->elements); } if (scalar(@buffer)) { return shift(@buffer); } } } } )->grep(sub { return not $seen{$_->as_string}++; }); } } } =item * L Filters results from a sub-plan based on the effective boolean value of a named variable binding. =cut package Attean::Plan::EBVFilter 0.034 { use Moo; use Scalar::Util qw(blessed); use Types::Standard qw(Str ConsumerOf); use namespace::clean; with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::UnaryQueryTree'; with 'Attean::API::UnionScopeVariablesPlan'; has 'variable' => (is => 'ro', isa => Str, required => 1); sub plan_as_string { my $self = shift; return sprintf('EBVFilter { ?%s }', $self->variable); } sub tree_attributes { return qw(expression) }; sub substitute_impl { my $self = shift; my $model = shift; my $bind = shift; my ($impl) = map { $_->substitute_impl($model, $bind) } @{ $self->children }; my $var = $self->variable; return sub { my $iter = $impl->(); return $iter->grep(sub { my $r = shift; my $term = $r->value($var); return 0 unless (blessed($term) and $term->does('Attean::API::Term')); return $term->ebv; }); }; } sub impl { my $self = shift; my $model = shift; my ($impl) = map { $_->impl($model) } @{ $self->children }; my $var = $self->variable; return sub { my $iter = $impl->(); return $iter->grep(sub { my $r = shift; my $term = $r->value($var); return 0 unless (blessed($term) and $term->does('Attean::API::Term')); return $term->ebv; }); }; } } =item * L Evaluates a set of sub-plans, returning the merged union of results, preserving ordering. =cut package Attean::Plan::Merge 0.034 { use Moo; use Scalar::Util qw(blessed); use Types::Standard qw(Str ArrayRef ConsumerOf); use namespace::clean; with 'Attean::API::Plan', 'Attean::API::BinaryQueryTree'; with 'Attean::API::UnionScopeVariablesPlan'; has 'variables' => (is => 'ro', isa => ArrayRef[Str], required => 1); sub plan_as_string { return 'Merge' } sub impl { my $self = shift; my $model = shift; my @children = map { $_->impl($model) } @{ $self->children }; return sub { die "Unimplemented"; }; } } =item * L Evaluates a set of sub-plans, returning the union of results. =cut package Attean::Plan::Union 0.034 { use Moo; use Scalar::Util qw(blessed); use namespace::clean; with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::BinaryQueryTree'; with 'Attean::API::UnionScopeVariablesPlan'; sub plan_as_string { return 'Union' } sub impl { my $self = shift; my $model = shift; my @children = map { $_->impl($model) } @{ $self->children }; return $self->_impl($model, @children); } sub substitute_impl { my $self = shift; my $model = shift; my $b = shift; unless (all { $_->does('Attean::API::BindingSubstitutionPlan') } @{ $self->children }) { die "Plan children do not all consume BindingSubstitutionPlan role:\n" . $self->as_string; } my @children = map { $_->substitute_impl($model, $b) } @{ $self->children }; return $self->_impl($model, @children); } sub _impl { my $self = shift; my $model = shift; my @children = @_; my $iter_variables = $self->in_scope_variables; return sub { if (my $current = shift(@children)) { my $iter = $current->(); return Attean::CodeIterator->new( item_type => 'Attean::API::Result', variables => $iter_variables, generator => sub { while (blessed($iter)) { my $row = $iter->next(); if ($row) { return $row; } else { $current = shift(@children); if ($current) { $iter = $current->(); } else { undef $iter; } } } }, ); } else { return Attean::ListIterator->new( item_type => 'Attean::API::Result', variables => [], values => [], ); } }; } } =item * L Evaluates a sub-plan, and extends each result by evaluating a set of expressions, binding the produced values to new variables. =cut package Attean::Plan::Extend 0.034 { use Moo; use Encode; use UUID::Tiny ':std'; use URI::Escape; use Data::Dumper; use I18N::LangTags; use POSIX qw(ceil floor); use Digest::SHA; use Digest::MD5 qw(md5_hex); use Scalar::Util qw(blessed looks_like_number); use List::MoreUtils qw(uniq all); use Types::Standard qw(ConsumerOf ArrayRef InstanceOf HashRef); use namespace::clean; with 'MooX::Log::Any'; with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::UnaryQueryTree'; has 'expressions' => (is => 'ro', isa => HashRef[ConsumerOf['Attean::API::Expression']], required => 1); has 'active_graphs' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::IRI']], required => 1); sub plan_as_string { my $self = shift; my @strings = map { sprintf('?%s ↠%s', $_, $self->expressions->{$_}->as_string) } keys %{ $self->expressions }; return sprintf('Extend { %s }', join(', ', @strings)); } sub tree_attributes { return qw(variable expression) }; sub BUILDARGS { my $class = shift; my %args = @_; my $exprs = $args{ expressions }; my @vars = map { @{ $_->in_scope_variables } } @{ $args{ children } }; my @evars = (@vars, keys %$exprs); if (exists $args{in_scope_variables}) { Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor"; } $args{in_scope_variables} = [@evars]; return $class->SUPER::BUILDARGS(%args); } sub evaluate_expression { my $self = shift; my $model = shift; my $expr = shift; my $r = shift; Carp::confess unless ($expr->can('operator')); my $op = $expr->operator; state $true = Attean::Literal->true; state $false = Attean::Literal->false; state $type_roles = { qw(URI IRI IRI IRI BLANK Blank LITERAL Literal NUMERIC NumericLiteral TRIPLE Triple) }; state $type_classes = { qw(URI Attean::IRI IRI Attean::IRI STR Attean::Literal) }; if ($expr->isa('Attean::CastExpression')) { my $datatype = $expr->datatype->value; my ($child) = @{ $expr->children }; my $term = $self->evaluate_expression($model, $child, $r); if ($datatype =~ m<^http://www.w3.org/2001/XMLSchema#string$>) { my $value = $term->value; if ($term->does('Attean::API::IRI')) { return Attean::Literal->new(value => $term->value); } elsif ($term->datatype->value eq 'http://www.w3.org/2001/XMLSchema#boolean') { my $v = ($value eq 'true' or $value eq '1') ? 'true' : 'false'; return Attean::Literal->new(value => $v); } elsif ($term->does('Attean::API::NumericLiteral')) { my $v = $term->numeric_value(); if ($v == int($v)) { return Attean::Literal->new(value => int($v)); } } return Attean::Literal->new(value => $value); } die "TypeError $op" unless (blessed($term) and $term->does('Attean::API::Literal')); if ($datatype =~ m<^http://www.w3.org/2001/XMLSchema#(integer|float|double|decimal)>) { my $value = $term->value; my $num; if ($datatype eq 'http://www.w3.org/2001/XMLSchema#integer') { if ($term->datatype->value eq 'http://www.w3.org/2001/XMLSchema#boolean') { $value = ($value eq 'true' or $value eq '1') ? '1' : '0'; } elsif ($term->does('Attean::API::NumericLiteral')) { my $v = $term->numeric_value(); $v =~ s/[.].*$//; $value = int($v); } elsif ($value =~ /^[-+]\d+$/) { my ($v) = "$value"; $v =~ s/[.].*$//; $value = int($v); } $num = $value; } elsif ($datatype eq 'http://www.w3.org/2001/XMLSchema#decimal') { if ($term->datatype->value eq 'http://www.w3.org/2001/XMLSchema#boolean') { $value = ($value eq 'true') ? '1' : '0'; } elsif ($term->does('Attean::API::NumericLiteral')) { $value = $term->numeric_value; } elsif (looks_like_number($value)) { if ($value =~ /[eE]/) { # double die "cannot cast to xsd:decimal as precision would be lost"; } $value = +$value; } $num = "$value"; $num =~ s/[.]0+$/.0/; $num =~ s/[.](\d+)0*$/.$1/; } elsif ($datatype =~ m<^http://www.w3.org/2001/XMLSchema#(float|double)$>) { my $typename = $1; if ($term->datatype->value eq 'http://www.w3.org/2001/XMLSchema#boolean') { $value = ($value eq 'true') ? '1.0' : '0.0'; } elsif ($term->does('Attean::API::NumericLiteral')) { # no-op } elsif (looks_like_number($value)) { $value = +$value; } else { die "cannot cast unrecognized value '$value' to xsd:$typename"; } $num = sprintf("%e", $value); } my $c = Attean::Literal->new(value => $num, datatype => $expr->datatype); if (my $term = $c->canonicalized_term_strict()) { return $term; } else { die "Term value is not a valid lexical form for $datatype"; } } elsif ($datatype =~ m<^http://www.w3.org/2001/XMLSchema#boolean$>) { if ($term->does('Attean::API::NumericLiteral')) { my $value = $term->numeric_value; return ($value == 0) ? Attean::Literal->false : Attean::Literal->true; } else { my $value = $term->value; if ($value =~ m/^(true|false|0|1)$/) { return ($value eq 'true' or $value eq '1') ? Attean::Literal->true : Attean::Literal->false; } else { die "Bad lexical form for xsd:boolean: '$value'"; } } } elsif ($datatype =~ m<^http://www.w3.org/2001/XMLSchema#dateTime$>) { my $value = $term->value; my $c = Attean::Literal->new(value => $value, datatype => $expr->datatype); if ($c->does('Attean::API::DateTimeLiteral') and $c->datetime) { return $c; } else { die "Bad lexical form for xsd:dateTime: '$value'"; } } $self->log->warn("Cast expression unimplemented for $datatype: " . Dumper($expr)); } elsif ($expr->isa('Attean::ValueExpression')) { my $node = $expr->value; if ($node->does('Attean::API::Variable')) { my $value = $r->value($node->value); unless (blessed($value)) { die "Variable " . $node->as_string . " is unbound in expression " . $expr->as_string; } return $value; } else { return $node; } } elsif ($expr->isa('Attean::UnaryExpression')) { my ($child) = @{ $expr->children }; my $term = $self->evaluate_expression($model, $child, $r); if ($op eq '!') { return ($term->ebv) ? $false : $true; } elsif ($op eq '-' or $op eq '+') { die "TypeError $op" unless (blessed($term) and $term->does('Attean::API::NumericLiteral')); my $v = $term->numeric_value; return Attean::Literal->new( value => eval "$op$v", datatype => $term->datatype ); } die "Unimplemented UnaryExpression evaluation: " . $expr->operator; } elsif ($expr->isa('Attean::BinaryExpression')) { my $op = $expr->operator; if ($op eq '&&') { foreach my $child (@{ $expr->children }) { my $term = $self->evaluate_expression($model, $child, $r); unless ($term->ebv) { return $false; } } return $true; } elsif ($op eq '||') { foreach my $child (@{ $expr->children }) { my $term = $self->evaluate_expression($model, $child, $r); if (blessed($term) and $term->ebv) { return $true; } } return $false; } elsif ($op eq '=') { my ($lhs, $rhs) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; my $eq = $lhs->equals($rhs); return $eq ? $true : $false; # TODO: this may not be using value-space comparision for numerics... } elsif ($op eq '!=') { my ($lhs, $rhs) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; return not($lhs->equals($rhs)) ? $true : $false; # TODO: this may not be using value-space comparision for numerics... } elsif ($op =~ m#[<>]=?#) { my ($lhs, $rhs) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; my $cmp = $lhs->compare($rhs); if ($cmp < 0) { return ($op =~ /^<=?/) ? $true : $false; } elsif ($cmp > 0) { return ($op =~ /^>=?/) ? $true : $false; } else { return ($op =~ /=/) ? $true : $false; } } elsif ($op =~ m<^[-+*/]$>) { my ($lhs, $rhs) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; die "TypeError $op" unless all { blessed($_) and $_->does('Attean::API::NumericLiteral') } ($lhs, $rhs); my ($lv, $rv) = map { $_->numeric_value } ($lhs, $rhs); my $type = $lhs->binary_promotion_type($rhs, $op); if ($op eq '+') { return Attean::Literal->new(value => ($lv + $rv), datatype => $type); } elsif ($op eq '-') { return Attean::Literal->new(value => ($lv - $rv), datatype => $type); } elsif ($op eq '*') { return Attean::Literal->new(value => ($lv * $rv), datatype => $type); } elsif ($op eq '/') { return Attean::Literal->new(value => ($lv / $rv), datatype => $type); } } $self->log->warn("Binary operator $op expression evaluation unimplemented: " . Dumper($expr)); die "Expression evaluation unimplemented: " . $expr->as_string; } elsif ($expr->isa('Attean::FunctionExpression')) { my $func = $expr->operator; if ($func eq 'IF') { my ($check, @children) = @{ $expr->children }; my ($term) = $self->evaluate_expression($model, $check, $r); $self->log->warn($@) if ($@); my $expr = $children[ (blessed($term) and $term->ebv) ? 0 : 1 ]; my $value = $self->evaluate_expression($model, $expr, $r); # warn '############# ' . $value->as_string; return $value; } elsif ($func eq 'COALESCE') { # warn "COALESCE: . " . $r->as_string . "\n"; foreach my $child (@{ $expr->children }) { # warn '- ' . $child->as_string . "\n"; my $term = eval { $self->evaluate_expression($model, $child, $r) }; # warn $@ if $@; if (blessed($term)) { # warn ' returning ' . $term->as_string . "\n"; return $term; } } # warn " no value\n"; return; } elsif ($func eq 'BOUND') { my ($child) = @{ $expr->children }; my ($term) = eval { $self->evaluate_expression($model, $child, $r) }; return blessed($term) ? $true : $false; } if ($func eq 'INVOKE') { my @children = @{ $expr->children }; my $furi = $self->evaluate_expression($model, shift(@children), $r)->value; if (my $func = Attean->get_global_function($furi)) { my @operands = map { $self->evaluate_expression($model, $_, $r) } @children; my $rr = eval { $func->($model, $self->active_graphs, @operands) }; if ($@) { warn "INVOKE error: $@" if $@; return; } return $rr; } elsif (my $fform = Attean->get_global_functional_form($furi)) { my @operands = map { eval { $self->evaluate_expression($model, $_, $r) } || undef } @children; my $rr = eval { $fform->($model, $self->active_graphs, @operands) }; if ($@) { warn "INVOKE error: $@" if $@; return $r; } return $rr; } else { die "No extension registered for <$furi>"; } } else { my @terms = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; if ($func =~ /^IS([UI]RI|BLANK|LITERAL|NUMERIC|TRIPLE)$/) { my $role = "Attean::API::$type_roles->{$1}"; my $t = shift(@terms); my $ok = (blessed($t) and $t->does($role)); return $ok ? $true : $false; } elsif ($func eq 'REGEX') { my ($string, $pattern, $flags) = @terms; # my ($string, $pattern, $flags) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; # TODO: ensure that $string is a literal ($string, $pattern, $flags) = map { blessed($_) ? $_->value : '' } ($string, $pattern, $flags); my $re; if ($flags =~ /i/) { $re = qr/$pattern/i; } else { $re = qr/$pattern/; } return ($string =~ $re) ? $true : $false; } elsif ($func =~ /^(NOT)?IN$/) { my $ok = ($func eq 'IN') ? $true : $false; my $notok = ($func eq 'IN') ? $false : $true; # my @children = @{ $expr->children }; my ($term, @children) = @terms; # my ($term) = $self->evaluate_expression($model, shift(@children), $r); # foreach my $child (@{ $expr->children }) { foreach my $value (@children) { # my $value = $self->evaluate_expression($model, $child, $r); if ($term->equals($value)) { return $ok; } } return $notok; } elsif ($func eq 'NOW') { my $dt = DateTime->now; my $value = DateTime::Format::W3CDTF->new->format_datetime( $dt ); return Attean::Literal->new(value => $value, datatype => 'http://www.w3.org/2001/XMLSchema#dateTime'); } elsif ($func eq 'STR') { my ($term) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; return Attean::Literal->new(value => $term->value); } elsif ($func =~ /^[UI]RI$/) { # IRI URI my ($term) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; return Attean::IRI->new(value => $term->value, base => $expr->base); } elsif ($func eq 'ABS') { my ($string) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; my $value = abs($string->numeric_value); return Attean::Literal->new(value => $value, datatype => $string->datatype); } elsif ($func eq 'ROUND') { my ($string) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; my $value = $string->numeric_value; my $mult = 1; if ($value < 0) { $mult = -1; $value = -$value; } my $round = $mult * POSIX::floor($value + 0.50000000000008); return Attean::Literal->new(value => $round, datatype => $string->datatype); } elsif ($func eq 'CEIL') { my ($string) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; my $value = ceil($string->numeric_value); return Attean::Literal->new(value => $value, datatype => $string->datatype); } elsif ($func eq 'FLOOR') { my ($string) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; my $value = floor($string->numeric_value); return Attean::Literal->new(value => $value, datatype => $string->datatype); } elsif ($func eq 'CONCAT') { my @strings = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; if (scalar(@strings) == 0) { return Attean::Literal->new(value => ''); } # die "CONCAT called with terms that are not argument compatible" unless ($strings[0]->argument_compatible(@strings)); my %args; if (my $l = $strings[0]->language) { $args{language} = $l; } else { my $dt = $strings[0]->datatype; if ($dt->value eq '') { $args{datatype} = 'http://www.w3.org/2001/XMLSchema#string'; } } foreach my $s (@strings) { die unless ($s->does('Attean::API::Literal')); die if ($s->datatype and not($s->datatype->value =~ m)); if (my $l2 = $s->language) { if (my $l1 = $args{language}) { if ($l1 ne $l2) { delete $args{language}; } } } else { delete $args{language}; } } my $c = Attean::Literal->new(value => join('', map { $_->value } @strings), %args); return $c; } elsif ($func eq 'DATATYPE') { my ($string) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; die unless ($string->does('Attean::API::Literal')); return $string->datatype; } elsif ($func eq 'LANG') { my ($string) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; die unless ($string->does('Attean::API::Literal')); my $value = $string->language // ''; return Attean::Literal->new(value => $value); } elsif ($func eq 'LANGMATCHES') { my ($term, $pat) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; my $lang = $term->value; my $match = $pat->value; if ($match eq '*') { # """A language-range of "*" matches any non-empty language-tag string.""" return $lang ? $true : $false; } else { return (I18N::LangTags::is_dialect_of( $lang, $match )) ? $true : $false; } } elsif ($func eq 'ENCODE_FOR_URI') { my ($string) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; return Attean::Literal->new(value => uri_escape_utf8($string->value)); } elsif ($func =~ /^[LU]CASE$/) { my $term = shift(@terms); my $value = ($func eq 'LCASE') ? lc($term->value) : uc($term->value); return Attean::Literal->new(value => $value, $term->construct_args); } elsif ($func eq 'STRLANG') { my ($term, $lang) = @terms; die unless ($term->does('Attean::API::Literal')); die unless ($term->datatype->value =~ m); die if ($term->language); return Attean::Literal->new(value => $term->value, language => $lang->value); } elsif ($func eq 'STRDT') { my ($term, $dt) = @terms; die unless ($term->does('Attean::API::Literal')); die unless ($term->datatype->value =~ m); die if ($term->language); # my ($term, $dt) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; return Attean::Literal->new(value => $term->value, datatype => $dt->value); } elsif ($func eq 'REPLACE') { my ($term, $pat, $rep) = @terms; die unless ($term->does('Attean::API::Literal')); die unless ($term->language or $term->datatype->value =~ m); # my ($term, $pat, $rep) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; my $value = $term->value; my $pattern = $pat->value; my $replace = $rep->value; die 'REPLACE() called with unsafe ?{} match pattern' if (index($pattern, '(?{') != -1 or index($pattern, '(??{') != -1); die 'REPLACE() called with unsafe ?{} replace pattern' if (index($replace, '(?{') != -1 or index($replace, '(??{') != -1); $replace =~ s/\\/\\\\/g; $replace =~ s/\$(\d+)/\$$1/g; $replace =~ s/"/\\"/g; $replace = qq["$replace"]; no warnings 'uninitialized'; $value =~ s/$pattern/"$replace"/eeg; # warn "==> " . Dumper($value); return Attean::Literal->new(value => $value, $term->construct_args); } elsif ($func eq 'SUBSTR') { my ($term, @args) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; my $value = $term->value; my @nums; foreach my $i (0 .. $#args) { my $argnum = $i + 2; my $arg = $args[ $i ]; push(@nums, $arg->numeric_value); } $nums[0]--; my $substring = (scalar(@nums) > 1) ? substr($value, $nums[0], $nums[1]) : substr($value, $nums[0]); return Attean::Literal->new(value => $substring, $term->construct_args); } elsif ($func eq 'CONTAINS') { my ($term, $pattern) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; if ($term->has_language and $pattern->has_language) { if ($term->literal_value_language ne $pattern->literal_value_language) { die "CONTAINS called with literals of different languages"; } } my ($string, $pat) = map { $_->value } ($term, $pattern); my $pos = index($string, $pat); return ($pos >= 0) ? $true : $false; } elsif ($func eq 'STRSTARTS') { my (@terms) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; my ($string, $pat) = map { $_->value } @terms; return (substr($string, 0, length($pat)) eq $pat) ? $true : $false; } elsif ($func eq 'STRENDS') { my (@terms) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; my ($string, $pat) = map { $_->value } @terms; return (substr($string, length($string) - length($pat)) eq $pat) ? $true : $false; } elsif ($func eq 'STRAFTER') { my ($term, $pat) = @terms; die "STRAFTER called without a literal" unless ($term->does('Attean::API::Literal')); die "STRAFTER called without a plain literal" unless ($term->language or $term->datatype->value eq 'http://www.w3.org/2001/XMLSchema#string'); die "$func arguments are not term compatible: " . join(', ', map { $_->as_string } @terms) unless ($term->argument_compatible($pat)); # TODO: check that the terms are argument compatible my $value = $term->value; my $match = $pat->value; my $i = index($value, $match, 0); if ($i < 0) { return Attean::Literal->new(value => ''); } else { return Attean::Literal->new(value => substr($value, $i+length($match)), $term->construct_args); } } elsif ($func eq 'STRBEFORE') { my ($term, $pat) = @terms; die "STRBEFORE called without a literal" unless ($term->does('Attean::API::Literal')); die "STRBEFORE called without a plain literal" unless ($term->language or $term->datatype->value eq 'http://www.w3.org/2001/XMLSchema#string'); die "$func arguments are not term compatible: " . join(', ', map { $_->as_string } @terms) unless ($term->argument_compatible($pat)); # TODO: check that the terms are argument compatible my $value = $term->value; my $match = $pat->value; my $i = index($value, $match, 0); if ($i < 0) { return Attean::Literal->new(value => ''); } else { return Attean::Literal->new(value => substr($value, 0, $i), $term->construct_args); } } elsif ($func eq 'STRLEN') { my ($string) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; return Attean::Literal->new(value => length($string->value), datatype => 'http://www.w3.org/2001/XMLSchema#integer'); } elsif ($func eq 'MD5') { my ($string) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; my $bytes = encode('UTF-8', $string->value, Encode::FB_CROAK); return Attean::Literal->new(value => md5_hex($bytes)); } elsif ($func =~ /^SHA(\d+)$/) { my $sha = Digest::SHA->new($1); my ($string) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; my $bytes = encode('UTF-8', $string->value, Encode::FB_CROAK); $sha->add($bytes); return Attean::Literal->new(value => $sha->hexdigest); } elsif ($func eq 'RAND') { return Attean::Literal->new(value => rand(), datatype => 'http://www.w3.org/2001/XMLSchema#double'); } elsif ($func =~ /^(YEAR|MONTH|DAY|HOUR|MINUTE)S?$/) { my $method = lc($1); my ($term) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; my $dt = $term->datetime; return Attean::Literal->new(value => $dt->$method(), datatype => 'http://www.w3.org/2001/XMLSchema#integer'); } elsif ($func eq 'SECONDS') { my ($term) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; my $dt = $term->datetime; return Attean::Literal->new(value => $dt->second, datatype => 'http://www.w3.org/2001/XMLSchema#decimal'); } elsif ($func eq 'TIMEZONE') { my ($term) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; my $dt = $term->datetime; my $tz = $dt->time_zone; die "TIMEZONE called with a dateTime without a timezone" if ($tz->is_floating); my $offset = $tz->offset_for_datetime( $dt ); my $minus = ''; if ($offset < 0) { $minus = '-'; $offset = -$offset; } my $duration = "${minus}PT"; if ($offset >= 60*60) { my $h = int($offset / (60*60)); $duration .= "${h}H" if ($h > 0); $offset = $offset % (60*60); } if ($offset >= 60) { my $m = int($offset / 60); $duration .= "${m}M" if ($m > 0); $offset = $offset % 60; } my $s = int($offset); $duration .= "${s}S" if ($s > 0 or $duration eq 'PT'); return Attean::Literal->new(value => $duration, datatype => 'http://www.w3.org/2001/XMLSchema#dayTimeDuration'); } elsif ($func eq 'TZ') { my ($term) = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; my $dt = $term->datetime; my $tz = $dt->time_zone; return Attean::Literal->new(value =>'') if ($tz->is_floating); return Attean::Literal->new('Z') if ($tz->is_utc); my $offset = $tz->offset_for_datetime( $dt ); my $hours = 0; my $minutes = 0; my $minus = '+'; if ($offset < 0) { $minus = '-'; $offset = -$offset; } if ($offset >= 60*60) { $hours = int($offset / (60*60)); $offset = $offset % (60*60); } if ($offset >= 60) { $minutes = int($offset / 60); $offset = $offset % 60; } my $seconds = int($offset); return Attean::Literal->new(value => sprintf('%s%02d:%02d', $minus, $hours, $minutes)); } elsif ($func eq 'UUID') { my $uuid = 'urn:uuid:' . uc(uuid_to_string(create_uuid())); return Attean::IRI->new(value => $uuid); } elsif ($func eq 'STRUUID') { return Attean::Literal->new(value => uc(uuid_to_string(create_uuid()))); } elsif ($func eq 'BNODE') { if (scalar(@{ $expr->children })) { my $string = $self->evaluate_expression($model, $expr->children->[0], $r); my $value = $string->value; my $b = (exists $r->eval_stash->{'sparql:bnode'}{$value}) ? $r->eval_stash->{'sparql:bnode'}{$value} : Attean::Blank->new(); $r->eval_stash->{'sparql:bnode'}{$value} = $b; return $b; } else { return Attean::Blank->new(); } } elsif ($func eq 'SAMETERM') { my @operands = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; my ($a, $b) = @operands; die "TypeError: SAMETERM" unless (blessed($operands[0]) and blessed($operands[1])); if ($a->does('Attean::API::Binding')) { my $ok = ($a->sameTerms($b)); return $ok ? $true : $false; } else { my $ok = ($a->value eq $b->value); return $ok ? $true : $false; } } elsif ($func =~ /^(SUBJECT|PREDICATE|OBJECT)$/) { my @operands = map { $self->evaluate_expression($model, $_, $r) } @{ $expr->children }; my $pos = lc($func); my $term = $operands[0]->$pos(); return $term; } else { warn "Expression evaluation unimplemented: " . $expr->as_string; $self->log->warn("Expression evaluation unimplemented: " . $expr->as_string); die "Expression evaluation unimplemented: " . $expr->as_string; } } } elsif ($expr->isa('Attean::ExistsPlanExpression')) { my $plan = $expr->plan; my $impl = $plan->substitute_impl($model, $r); my $iter = $impl->(); my $found = 0; if (my $row = $iter->next) { # warn "EXISTS found row: " . $row->as_string; $found++; } return $found ? Attean::Literal->true : Attean::Literal->false; } else { $self->log->warn("Expression evaluation unimplemented: " . $expr->as_string); die "Expression evaluation unimplemented: " . $expr->as_string; } } sub substitute_impl { my $self = shift; my $model = shift; my $bind = shift; my %exprs = %{ $self->expressions }; my ($impl) = map { $_->substitute_impl($model, $bind) } @{ $self->children }; # TODO: substitute variables in the expression return $self->_impl($model, $impl, %exprs); } sub impl { my $self = shift; my $model = shift; my %exprs = %{ $self->expressions }; my ($impl) = map { $_->impl($model) } @{ $self->children }; return $self->_impl($model, $impl, %exprs); } sub _impl { my $self = shift; my $model = shift; my $impl = shift; my %exprs = @_; my $iter_variables = $self->in_scope_variables; return sub { my $iter = $impl->(); return Attean::CodeIterator->new( item_type => 'Attean::API::Result', variables => $iter_variables, generator => sub { ROW: while (my $r = $iter->next) { # warn 'Extend Row -------------------------------> ' . $r->as_string . "\n"; my %row = map { $_ => $r->value($_) } $r->variables; foreach my $var (keys %exprs) { my $expr = $exprs{$var}; # warn "-> $var => " . $expr->as_string . "\n"; my $term = eval { $self->evaluate_expression($model, $expr, $r) }; # if ($@) { # warn "EXTEND expression evaluation error: $@"; # warn '- expression: ' . $expr->as_string; # } if (blessed($term)) { # warn "===> " . $term->as_string . "\n"; if ($row{ $var } and $term->as_string ne $row{ $var }->as_string) { next ROW; } if ($term->does('Attean::API::Binding')) { # patterns need to be made ground to be bound as values (e.g. TriplePattern -> Triple) $term = $term->ground($r); } $row{ $var } = $term; } } return Attean::Result->new( bindings => \%row, eval_stash => $r->eval_stash ); } return; } ); }; } } =item * L Evaluates a sub-plan, and returns distinct results by checking a persistent hash of already-seen results. =cut package Attean::Plan::HashDistinct 0.034 { use Moo; use namespace::clean; with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree'; with 'Attean::API::UnionScopeVariablesPlan'; sub plan_as_string { return 'HashDistinct' } sub impl { my $self = shift; my $model = shift; my ($impl) = map { $_->impl($model) } @{ $self->children }; my %seen; return sub { my $iter = $impl->(); return $iter->grep(sub { return not($seen{ shift->as_string }++); }); }; } } =item * L Evaluates an already-ordered sub-plan, and returns distinct results by filtering out sequential duplicates. =cut package Attean::Plan::Unique 0.034 { use Moo; use namespace::clean; with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree'; with 'Attean::API::UnionScopeVariablesPlan'; sub plan_as_string { return 'Unique' } sub impl { my $self = shift; my $model = shift; my ($impl) = map { $_->impl($model) } @{ $self->children }; return sub { my $iter = $impl->(); my $last = ''; return $iter->grep(sub { my $r = shift; my $s = $r->as_string; my $ok = $s ne $last; $last = $s; return $ok; }); }; } } =item * L Evaluates a sub-plan, and returns the results after optionally skipping some number of results ("offset") and limiting the total number of returned results ("limit"). =cut package Attean::Plan::Slice 0.034 { use Moo; use Types::Standard qw(Int); use namespace::clean; with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree'; with 'Attean::API::UnionScopeVariablesPlan'; has 'limit' => (is => 'ro', isa => Int, default => -1); has 'offset' => (is => 'ro', isa => Int, default => 0); sub plan_as_string { my $self = shift; my @str; push(@str, "Limit=" . $self->limit) if ($self->limit >= 0); push(@str, "Offset=" . $self->offset) if ($self->offset > 0); return sprintf('Slice { %s }', join(' ', @str)); } sub impl { my $self = shift; my $model = shift; my ($impl) = map { $_->impl($model) } @{ $self->children }; my $offset = $self->offset; my $limit = $self->limit; return sub { my $iter = $impl->(); $iter = $iter->offset($offset) if ($offset > 0); $iter = $iter->limit($limit) if ($limit >= 0); return $iter; }; } } =item * L Evaluates a sub-plan and returns projected results by only keeping a fixed-set of variable bindings in each result. =cut package Attean::Plan::Project 0.034 { use Moo; with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::UnaryQueryTree'; use Types::Standard qw(ArrayRef ConsumerOf); has 'variables' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Variable']], required => 1); sub BUILDARGS { my $class = shift; my %args = @_; my @vars = map { $_->value } @{ $args{variables} }; if (exists $args{in_scope_variables}) { Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor"; } $args{in_scope_variables} = \@vars; return $class->SUPER::BUILDARGS(%args); } # sub BUILD { # my $self = shift; # my @vars = map { $_->value } @{ $self->variables }; # unless (scalar(@vars)) { # Carp::confess "No vars in project?"; # } # } sub plan_as_string { my $self = shift; return sprintf('Project { %s }', join(' ', map { '?' . $_->value } @{ $self->variables })); } sub tree_attributes { return qw(variables) }; sub substitute_impl { my $self = shift; my $model = shift; my $bind = shift; my ($impl) = map { $_->substitute_impl($model, $bind) } @{ $self->children }; my @vars = map { $_->value } @{ $self->variables }; my $iter_variables = $self->in_scope_variables; # TODO: substitute variables in the projection where appropriate return sub { my $iter = $impl->(); return $iter->map(sub { my $r = shift; my $b = { map { my $t = $r->value($_); $t ? ($_ => $t) : () } @vars }; return Attean::Result->new( bindings => $b ); }, $iter->item_type, variables => $iter_variables); }; } sub impl { my $self = shift; my $model = shift; my ($impl) = map { $_->impl($model) } @{ $self->children }; my @vars = map { $_->value } @{ $self->variables }; my $iter_variables = $self->in_scope_variables; return sub { my $iter = $impl->(); return $iter->map(sub { my $r = shift; my $b = { map { my $t = $r->value($_); $t ? ($_ => $t) : () } @vars }; return Attean::Result->new( bindings => $b ); }, $iter->item_type, variables => $iter_variables); }; } } =item * L Evaluates a sub-plan and returns the results after fully materializing and sorting is applied. =cut package Attean::Plan::OrderBy 0.034 { use Moo; use Types::Standard qw(HashRef ArrayRef InstanceOf Bool Str); use Scalar::Util qw(blessed); use namespace::clean; with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree'; with 'Attean::API::UnionScopeVariablesPlan'; has 'variables' => (is => 'ro', isa => ArrayRef[Str], required => 1); has 'ascending' => (is => 'ro', isa => HashRef[Bool], required => 1); sub plan_as_string { my $self = shift; my @vars = @{ $self->variables }; my $ascending = $self->ascending; my @strings = map { sprintf('%s(?%s)', ($ascending->{$_} ? 'ASC' : 'DESC'), $_) } @vars; return sprintf('Order { %s }', join(', ', @strings)); } sub sort_rows { my $self = shift; my $vars = shift; my $ascending = shift; my $rows = shift; local($Attean::API::Binding::ALLOW_IRI_COMPARISON) = 1; my @sorted = map { $_->[0] } sort { my ($ar, $avalues) = @$a; my ($br, $bvalues) = @$b; my $c = 0; foreach my $i (0 .. $#{ $vars }) { my $ascending = $ascending->{ $vars->[$i] }; my ($av, $bv) = map { $_->[$i] } ($avalues, $bvalues); # Mirrors code in Attean::SimpleQueryEvaluator->evaluate if (blessed($av) and $av->does('Attean::API::Binding') and (not(defined($bv)) or not($bv->does('Attean::API::Binding')))) { $c = 1; } elsif (blessed($bv) and $bv->does('Attean::API::Binding') and (not(defined($av)) or not($av->does('Attean::API::Binding')))) { $c = -1; } else { $c = eval { $av ? $av->compare($bv) : 1 }; if ($@) { $c = 1; } } $c *= -1 unless ($ascending); last unless ($c == 0); } $c } map { my $r = $_; [$r, [map { $r->value($_) } @$vars]] } @$rows; return @sorted; } sub impl { my $self = shift; my $model = shift; my $vars = $self->variables; my $ascending = $self->ascending; my ($impl) = map { $_->impl($model) } @{ $self->children }; my $iter_variables = $self->in_scope_variables; return sub { my $iter = $impl->(); my @rows = $iter->elements; my @sorted = $self->sort_rows($vars, $ascending, \@rows); return Attean::ListIterator->new( values => \@sorted, variables => $iter_variables, item_type => $iter->item_type ); } } } =item * L Evaluates a SPARQL query against a remote endpoint. =cut package Attean::Plan::Service 0.034 { use Moo; use Types::Standard qw(ConsumerOf Bool Str InstanceOf); use Encode qw(encode); use Scalar::Util qw(blessed); use URI::Escape; use Attean::SPARQLClient; use namespace::clean; with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree'; has 'endpoint' => (is => 'ro', isa => ConsumerOf['Attean::API::TermOrVariable'], required => 1); has 'silent' => (is => 'ro', isa => Bool, default => 0); has 'sparql' => (is => 'ro', isa => Str, required => 1); has 'user_agent' => (is => 'rw', isa => InstanceOf['LWP::UserAgent']); has 'request_signer' => (is => 'rw'); sub plan_as_string { my $self = shift; my $sparql = $self->sparql; $sparql =~ s/\s+/ /g; return sprintf('Service <%s> %s', $self->endpoint->as_string, $sparql); } sub tree_attributes { return qw(endpoint) }; sub impl { my $self = shift; my $model = shift; my $endpoint = $self->endpoint->value; my $sparql = $self->sparql; my $silent = $self->silent; my %args = ( endpoint => $endpoint, silent => $silent, request_signer => $self->request_signer, ); $args{user_agent} = $self->user_agent if ($self->user_agent); my $client = Attean::SPARQLClient->new(%args); return sub { return $client->query($sparql); }; } } =item * L Returns a constant set of results. =cut package Attean::Plan::Table 0.034 { use Moo; use Types::Standard qw(ArrayRef ConsumerOf); use namespace::clean; with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree'; has variables => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Variable']]); has rows => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Result']]); sub tree_attributes { return qw(variables rows) }; sub plan_as_string { my $self = shift; my $level = shift; my $indent = ' ' x ($level + 1); my $vars = join(', ', map { "?$_" } @{ $self->in_scope_variables }); my $s = "Table (" . $vars . ")"; foreach my $row (@{ $self->rows }) { $s .= "\n-${indent} " . $row->as_string; } return $s; } sub BUILDARGS { my $class = shift; my %args = @_; my @vars = map { $_->value } @{ $args{variables} }; if (exists $args{in_scope_variables}) { Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor"; } $args{in_scope_variables} = \@vars; return $class->SUPER::BUILDARGS(%args); } sub impl { my $self = shift; my $model = shift; my $rows = $self->rows; my $iter_variables = $self->in_scope_variables; return sub { return Attean::ListIterator->new( item_type => 'Attean::API::Result', variables => $iter_variables, values => $rows ); }; } } =item * L Returns a constant set of results. Be aware that if the iterator being wrapped is not repeatable (consuming the L role), then this plan may only be evaluated once. A size estimate may be given if it is available. If the iterator is an L, the size of that iterator will be used. =cut package Attean::Plan::Iterator 0.034 { use Moo; use Types::Standard qw(ArrayRef ConsumerOf Int); use namespace::clean; with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree'; has iterator => (is => 'ro', isa => ConsumerOf['Attean::API::ResultIterator']); has size_estimate => (is => 'lazy', isa => Int, predicate => 1); sub _build_size_estimate { my $self = shift; my $iter = $self->iterator; if ($iter->isa('Attean::ListIterator')) { return $iter->size; } } sub tree_attributes { return qw(iterator) }; sub plan_as_string { my $self = shift; my $level = shift; my $indent = ' ' x ($level + 1); my $string = 'Iterator ('; $string .= join(', ', map { "?$_" } @{ $self->in_scope_variables }); if ($self->has_size_estimate) { $string .= ' with ' . $self->size_estimate . ' elements'; } $string .= ')'; return $string; } sub BUILDARGS { my $class = shift; my %args = @_; my $vars = $args{iterator}->variables; if (exists $args{in_scope_variables}) { Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor"; } $args{in_scope_variables} = $vars; return $class->SUPER::BUILDARGS(%args); } sub impl { my $self = shift; my $model = shift; my $iter = $self->iterator; return sub { if ($iter->does('Attean::API::RepeatableIterator')) { $iter->reset; } return $iter; }; } } =item * L =cut package Attean::Plan::ALPPath 0.034 { use Moo; use Attean::TreeRewriter; use Types::Standard qw(ArrayRef ConsumerOf); use namespace::clean; has 'subject' => (is => 'ro', required => 1); has 'object' => (is => 'ro', required => 1); has 'graph' => (is => 'ro', required => 1); has 'step_begin' => (is => 'ro', required => 1); has 'step_end' => (is => 'ro', required => 1); has 'skip' => (is => 'ro', required => 1, default => 0); # has 'children' => (is => 'ro', isa => ConsumerOf['Attean::API::BindingSubstitutionPlan'], required => 1); with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::NullaryQueryTree'; sub tree_attributes { return qw(subject object graph) }; with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree'; sub plan_as_string { my $self = shift; my @strings; push(@strings, sprintf('%s ↠%s', map { $_->ntriples_string } ($self->subject, $self->step_begin))); push(@strings, sprintf('%s ↠%s', map { $_->ntriples_string } ($self->object, $self->step_end))); return sprintf('ALPPath %s', join(', ', @strings)); } sub BUILDARGS { my $class = shift; my %args = @_; my @vars = map { $_->value } grep { $_->does('Attean::API::Variable') } (@args{qw(subject object)}); if (exists $args{in_scope_variables}) { Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor"; } $args{in_scope_variables} = \@vars; return $class->SUPER::BUILDARGS(%args); } sub alp { my $model = shift; my $graph = shift; my $skip = shift; my $x = shift; my $path = shift; my $v = shift; my $start = shift; my $end = shift; my $bind = shift; if (exists $v->{$x->as_string}) { return; } my $binding = Attean::Result->new( bindings => { $start => $x } )->join($bind); unless ($binding) { return; } if ($skip) { $skip--; } else { $v->{$x->as_string} = $x; } my $impl = $path->substitute_impl($model, $binding); my $iter = $impl->(); while (my $row = $iter->next()) { my $n = $row->value($end); alp($model, $graph, $skip, $n, $path, $v, $start, $end, $bind); } } sub substitute_impl { my $self = shift; my $model = shift; my $bind = shift; my $path = $self->children->[0]; my $subject = $self->subject; my $object = $self->object; my $graph = $self->graph; my $start = $self->step_begin->value; my $end = $self->step_end->value; my $skip = $self->skip; my $iter_variables = $self->in_scope_variables; for ($subject, $object) { if ($_->does('Attean::API::Variable')) { my $name = $_->value; if (my $node = $bind->value($name)) { $_ = $node; } } } my $s_var = $subject->does('Attean::API::Variable'); my $o_var = $object->does('Attean::API::Variable'); if ($s_var and $o_var) { return sub { my $nodes = $model->graph_nodes($graph); my @rows; while (my $n = $nodes->next) { my %seen; alp($model, $graph, $skip, $n, $path, \%seen, $start, $end, $bind); foreach my $term (values %seen) { my $b = Attean::Result->new( bindings => { $subject->value => $n, $object->value => $term, } ); push(@rows, $b); } } return Attean::ListIterator->new( item_type => 'Attean::API::Result', variables => $iter_variables, values => \@rows, ); }; } elsif ($o_var) { return sub { my %seen; alp($model, $graph, $skip, $subject, $path, \%seen, $start, $end, $bind); my @rows = map { Attean::Result->new( bindings => { $object->value => $_ } ) } (values %seen); return Attean::ListIterator->new( item_type => 'Attean::API::Result', variables => $iter_variables, values => \@rows, ); }; } elsif ($s_var) { die "ALP for FB should never occur in a plan (should be inversed during planning)"; } else { return sub { my %seen; alp($model, $graph, $skip, $subject, $path, \%seen, $start, $end, $bind); if (exists $seen{ $object->as_string }) { return Attean::ListIterator->new( item_type => 'Attean::API::Result', variables => $iter_variables, values => [Attean::Result->new()] ); } else { return Attean::ListIterator->new( item_type => 'Attean::API::Result', variables => $iter_variables, values => [] ); } }; } } } package Attean::Plan::ZeroOrOnePath 0.034 { use Moo; use Attean::TreeRewriter; use Types::Standard qw(ArrayRef ConsumerOf); use namespace::clean; has 'subject' => (is => 'ro', required => 1); has 'object' => (is => 'ro', required => 1); has 'graph' => (is => 'ro', required => 1); with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::NullaryQueryTree'; sub BUILDARGS { my $class = shift; my %args = @_; my @vars = map { $_->value } grep { $_->does('Attean::API::Variable') } (@args{qw(subject object)}); if (exists $args{in_scope_variables}) { Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor"; } $args{in_scope_variables} = \@vars; return $class->SUPER::BUILDARGS(%args); } sub tree_attributes { return qw(subject object) }; with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree'; sub plan_as_string { return 'ZeroOrOnePath' } sub substitute_impl { my $self = shift; my $model = shift; my $bind = shift; my ($impl) = map { $_->substitute_impl($model, $bind) } @{ $self->children }; my $iter_variables = $self->in_scope_variables; my $subject = $self->subject; my $object = $self->object; my $graph = $self->graph; for ($subject, $object) { if ($_->does('Attean::API::Variable')) { my $name = $_->value; if (my $node = $bind->value($name)) { $_ = $node; } } } my $s_var = $subject->does('Attean::API::Variable'); my $o_var = $object->does('Attean::API::Variable'); return sub { my @extra; if ($s_var and $o_var) { my $nodes = $model->graph_nodes($graph); while (my $n = $nodes->next) { push(@extra, Attean::Result->new( bindings => { map { $_->value => $n } ($subject, $object) } )); } } elsif ($s_var) { push(@extra, Attean::Result->new( bindings => { $subject->value => $object } )); } elsif ($o_var) { push(@extra, Attean::Result->new( bindings => { $object->value => $subject } )); } else { if (0 == $subject->compare($object)) { push(@extra, Attean::Result->new( bindings => {} )); } } my $iter = $impl->(); my %seen; return Attean::CodeIterator->new( item_type => 'Attean::API::Result', variables => $iter_variables, generator => sub { while (scalar(@extra)) { my $r = shift(@extra); unless ($seen{$r->as_string}++) { return $r; } } while (my $r = $iter->next()) { return unless ($r); if ($seen{$r->as_string}++) { next; } return $r; } } ); }; } } =item * L Returns an iterator containing a single boolean term indicating whether any results were produced by evaluating the sub-plan. =cut package Attean::Plan::Exists 0.034 { use Moo; use Types::Standard qw(ArrayRef ConsumerOf); use namespace::clean; with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree'; with 'Attean::API::UnionScopeVariablesPlan'; has variables => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Variable']]); has rows => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Result']]); sub tree_attributes { return qw(variables rows) }; sub plan_as_string { return 'Exists' } sub impl { my $self = shift; my $model = shift; my ($impl) = map { $_->impl($model) } @{ $self->children }; return sub { my $iter = $impl->(); my $result = $iter->next; # if ($result) { # warn "EXISTS: " . $result->as_string; # } my $term = $result ? Attean::Literal->true : Attean::Literal->false; return Attean::ListIterator->new(values => [$term], item_type => 'Attean::API::Term'); } } } =item * L =cut package Attean::Plan::Aggregate 0.034 { use Moo; use Encode; use UUID::Tiny ':std'; use URI::Escape; use I18N::LangTags; use POSIX qw(ceil floor); use Digest::SHA; use Digest::MD5 qw(md5_hex); use Scalar::Util qw(blessed); use List::MoreUtils qw(uniq); use Types::Standard qw(ConsumerOf InstanceOf HashRef ArrayRef); use namespace::clean; with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree'; has 'aggregates' => (is => 'ro', isa => HashRef[ConsumerOf['Attean::API::Expression']], required => 1); has 'groups' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Expression']], required => 1); has 'active_graphs' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::IRI']], required => 1); sub plan_as_string { my $self = shift; my @astrings = map { sprintf('?%s ↠%s', $_, $self->aggregates->{$_}->as_string) } keys %{ $self->aggregates }; my @gstrings = map { sprintf('%s', $_->as_string) } @{ $self->groups }; return sprintf('Aggregate { %s } Groups { %s }', join(', ', @astrings), join(', ', @gstrings)); } sub tree_attributes { return qw(aggregates groups) }; sub BUILD { # Ensure that the CT extensions are registered AtteanX::Functions::CompositeLists->register(); AtteanX::Functions::CompositeMaps->register(); } sub BUILDARGS { my $class = shift; my %args = @_; my $aggs = $args{ aggregates }; my @vars = map { $_->value } grep { $_->does('Attean::API::Variable') } map { $_->value } @{ $args{groups} // [] }; my @evars = (@vars, keys %$aggs); if (exists $args{in_scope_variables}) { Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor"; } $args{in_scope_variables} = [@evars]; return $class->SUPER::BUILDARGS(%args); } sub evaluate_aggregate { my $self = shift; my $model = shift; my $expr = shift; my $rows = shift; my $op = $expr->operator; my ($e) = @{ $expr->children }; # my @children = map { Attean::Plan::Extend->evaluate_expression($model, $_, $r) } @{ $expr->children }; # warn "$op — " . join(' ', map { $_->as_string } @children); if ($op eq 'COUNT') { my $count = 0; foreach my $r (@$rows) { if ($e) { my $term = Attean::Plan::Extend->evaluate_expression($model, $e, $r); if ($term) { $count++; } } else { # This is the special-case branch for COUNT(*) $count++; } } return Attean::Literal->new(value => $count, datatype => 'http://www.w3.org/2001/XMLSchema#integer'); } elsif ($op eq 'SUM') { my @cmp; my @terms; foreach my $r (@$rows) { my $term = Attean::Plan::Extend->evaluate_expression($model, $e, $r); if ($term->does('Attean::API::NumericLiteral')) { push(@terms, $term); } } my $lhs = shift(@terms); while (my $rhs = shift(@terms)) { my $type = $lhs->binary_promotion_type($rhs, '+'); my ($lv, $rv) = map { $_->numeric_value } ($lhs, $rhs); $lhs = Attean::Literal->new(value => ($lv + $rv), datatype => $type); } return $lhs; } elsif ($op eq 'AVG') { my @cmp; my $count = 0; my $all_ints = 1; my @terms; if (scalar(@$rows) == 0) { return Attean::Literal->integer(0); } foreach my $r (@$rows) { my $term = Attean::Plan::Extend->evaluate_expression($model, $e, $r); die unless ($term->does('Attean::API::NumericLiteral')); push(@terms, $term); $count++; } my $lhs = shift(@terms); while (my $rhs = shift(@terms)) { my $type = $lhs->binary_promotion_type($rhs, '+'); my ($lv, $rv) = map { $_->numeric_value } ($lhs, $rhs); $lhs = Attean::Literal->new(value => ($lv + $rv), datatype => $type); } my $rhs = Attean::Literal->new(value => $count, datatype => 'http://www.w3.org/2001/XMLSchema#integer'); my ($lv, $rv) = map { $_->numeric_value } ($lhs, $rhs); my $type = $lhs->binary_promotion_type($rhs, '/'); return Attean::Literal->new(value => ($lv / $rv), datatype => $type); } elsif ($op eq 'SAMPLE') { foreach my $r (@$rows) { my $term = Attean::Plan::Extend->evaluate_expression($model, $e, $r); return $term if (blessed($term)); } } elsif ($op =~ /^(MIN|MAX)$/) { my @cmp; foreach my $r (@$rows) { my $term = Attean::Plan::Extend->evaluate_expression($model, $e, $r); push(@cmp, $term); } @cmp = sort { $a->compare($b) } @cmp; return ($op eq 'MIN') ? shift(@cmp) : pop(@cmp); } elsif ($op eq 'GROUP_CONCAT') { my $sep = $expr->scalar_vars->{seperator} // ' '; my @values; my $all_lang = 1; my $all_str = 1; my $lang; foreach my $r (@$rows) { my $term = Attean::Plan::Extend->evaluate_expression($model, $e, $r); die "GROUP_CONCAT called with a non-literal argument" unless ($term->does('Attean::API::Literal')); if ($term->language) { $all_str = 0; if (defined($lang) and $lang ne $term->language) { $all_lang = 0; } else { $lang = $term->language; } } else { $all_lang = 0; $all_str = 0; } push(@values, $term->value); } my %strtype; if ($all_lang and $lang) { $strtype{language} = $lang; } elsif ($all_str) { $strtype{datatype} = 'http://www.w3.org/2001/XMLSchema#string' } my $string = join($sep, @values); return Attean::Literal->new(value => $string, %strtype); } elsif ($op eq 'FOLD') { my @arg_exprs = @{ $expr->children }; my $order = $expr->order || []; my @cmps = @$order; my @exprs = map { $_->[1] } @cmps; my @dirs = map { $_->[0] eq 'ASC' } @cmps; my $l = eval { if (scalar(@$order)) { # sort $rows by the order condition my $fold_cmp = sub { my ($ar, $avalues) = @$a; my ($br, $bvalues) = @$b; my $c = 0; foreach my $i (0 .. $#cmps) { my ($av, $bv) = map { $_->[$i] } ($avalues, $bvalues); # Mirrors code in Attean::Plan::OrderBy->sort_rows if (not(blessed($av))) { $c = -1; } elsif (not(blessed($av))) { $c = 1; } elsif (blessed($av) and $av->does('Attean::API::Binding') and (not(defined($bv)) or not($bv->does('Attean::API::Binding')))) { $c = 1; } elsif (blessed($bv) and $bv->does('Attean::API::Binding') and (not(defined($av)) or not($av->does('Attean::API::Binding')))) { $c = -1; } else { $c = eval { $av ? $av->compare($bv) : 1 }; if ($@) { $c = 1; } } $c *= -1 if ($dirs[$i] == 0); last unless ($c == 0); } $c }; my @sorted = map { $_->[0] } sort { $fold_cmp->() } map { my $r = $_; [$r, [map { eval { Attean::Plan::Extend->evaluate_expression( $model, $_, $r ) } } @exprs]] } @$rows; $rows = \@sorted; } my %seen; if (scalar(@arg_exprs) > 1) { # map my @values; foreach my $r (@$rows) { my ($key, $value) = map { eval { Attean::Plan::Extend->evaluate_expression($model, $_, $r) } || undef } @arg_exprs; if (defined($key)) { push(@values, $key, $value); } } my $func = Attean->get_global_functional_form($AtteanX::Functions::CompositeMaps::MAP_TYPE_IRI); $func->(undef, undef, @values); } else { my @values; foreach my $r (@$rows) { my $term = eval { Attean::Plan::Extend->evaluate_expression($model, $e, $r) }; if ($expr->distinct and blessed($term)) { next if ($seen{ $term->as_string }++); } push(@values, $term); } my $func = Attean->get_global_functional_form($AtteanX::Functions::CompositeLists::LIST_TYPE_IRI); $func->(undef, undef, @values); } }; warn $@ if $@; return $l; } elsif ($op eq 'CUSTOM') { my $iri = $expr->custom_iri; my $data = Attean->get_global_aggregate($iri); unless ($data) { die "No extension aggregate registered for <$iri>"; } my $start = $data->{'start'}; my $process = $data->{'process'}; my $finalize = $data->{'finalize'}; my $thunk = $start->($model, $self->active_graphs); foreach my $r (@$rows) { my $t = Attean::Plan::Extend->evaluate_expression($model, $e, $r); $process->($thunk, $t); } return $finalize->($thunk); } else { warn "Unexpected aggregate expression: $op"; } die "$op not implemented"; } sub impl { my $self = shift; my $model = shift; my %aggs = %{ $self->aggregates }; my @groups = @{ $self->groups }; my $iter_variables = $self->in_scope_variables; my $group_template_generator = sub { my $r = shift; my %components; foreach my $g (@groups) { if ($g->isa('Attean::ValueExpression')) { my $value = $g->value; if ($value->isa('Attean::Variable')) { my $var = $value->value; my $value = eval { Attean::Plan::Extend->evaluate_expression($model, $g, $r) }; if (blessed($value)) { $components{$var} = $value; } } } } return %components; }; my $group_key_generator = sub { my $r = shift; my @components; foreach my $g (@groups) { my $value = eval { Attean::Plan::Extend->evaluate_expression($model, $g, $r) }; my $key = blessed($value) ? $value->as_string : ''; push(@components, $key); } my $group = join('|', @components); return $group; }; my $rank; while (my($var, $agg) = each(%aggs)) { if ($agg->operator eq 'RANK') { $rank = $var; } } my ($impl) = map { $_->impl($model) } @{ $self->children }; my %row_groups; my %group_templates; return sub { my $iter = $impl->(); while (my $r = $iter->next) { my $group_key = $group_key_generator->($r); push(@{ $row_groups{ $group_key } }, $r); unless (exists $group_templates{ $group_key }) { $group_templates{ $group_key } = { $group_template_generator->($r) }; } } my @group_keys = keys %row_groups; # SPARQL evaluation of aggregates over an empty input sequence should # result in an empty result my @results; if (scalar(@group_keys) == 0 and scalar(@groups) == 0) { push(@group_keys, ''); $row_groups{''} = []; $group_templates{''} = {}; } foreach my $group (@group_keys) { my %row = %{ $group_templates{ $group } }; my $rows = $row_groups{$group}; if (defined $rank) { my $agg = $aggs{$rank}; my $ascending = $agg->scalar_vars->{ascending} // {}; my $vars = [map { $_->value->value } @{ $agg->children }]; # TODO: support ordering by complex expressions in $vars, not just ValueExpressions with variables my @sorted = Attean::Plan::OrderBy->sort_rows($vars, $ascending, $rows); my $ord = 0; foreach my $row (@sorted) { my %b = %{ $row->bindings }; $b{ $rank } = Attean::Literal->integer($ord++); my $r = Attean::Result->new( bindings => \%b ); push(@results, $r); } } else { foreach my $var (keys %aggs) { my $expr = $aggs{$var}; my $value = eval { $self->evaluate_aggregate($model, $expr, $rows) }; if ($value) { $row{$var} = $value; } } my $result = Attean::Result->new( bindings => \%row ); push(@results, $result); } } return Attean::ListIterator->new( values => \@results, variables => $iter_variables, item_type => 'Attean::API::Result' ); }; } } package Attean::Plan::Sequence 0.034 { use Moo; use Scalar::Util qw(blessed); use Types::Standard qw(ConsumerOf ArrayRef); use namespace::clean; with 'Attean::API::Plan', 'Attean::API::QueryTree'; with 'Attean::API::UnionScopeVariablesPlan'; sub plan_as_string { return 'Sequence'; } sub impl { my $self = shift; my $model = shift; my @children = map { $_->impl($model) } @{ $self->children }; return sub { foreach my $child (@children) { my $iter = $child->(); $iter->elements; } return Attean::ListIterator->new(values => [Attean::Literal->true], item_type => 'Attean::API::Term'); }; } } package Attean::Plan::Clear 0.034 { use Moo; use Scalar::Util qw(blessed); use Types::Standard qw(ConsumerOf ArrayRef); use namespace::clean; with 'Attean::API::Plan', 'Attean::API::NullaryQueryTree'; with 'Attean::API::UnionScopeVariablesPlan'; has 'graphs' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Term']]); sub plan_as_string { my $self = shift; my $level = shift; my $indent = ' ' x (1+$level); my $s = sprintf("Clear { %d graphs }", scalar(@{ $self->graphs })); foreach my $g (@{ $self->graphs }) { my $name = $g->as_sparql; chomp($name); $s .= "\n-${indent} $name"; } return $s; } sub impl { my $self = shift; my $model = shift; my $graphs = $self->graphs; return sub { foreach my $g (@$graphs) { $model->clear_graph($g); } return Attean::ListIterator->new(values => [Attean::Literal->true], item_type => 'Attean::API::Term'); }; } } package Attean::Plan::Drop 0.034 { use Moo; use Scalar::Util qw(blessed); use Types::Standard qw(ConsumerOf ArrayRef); use namespace::clean; with 'Attean::API::Plan', 'Attean::API::NullaryQueryTree'; with 'Attean::API::UnionScopeVariablesPlan'; has 'graphs' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Term']]); sub plan_as_string { my $self = shift; my $level = shift; my $indent = ' ' x (1+$level); my $s = sprintf("Drop { %d graphs }", scalar(@{ $self->graphs })); foreach my $g (@{ $self->graphs }) { $s .= "\n-${indent} " . $g->as_sparql; } return $s; } sub impl { my $self = shift; my $model = shift; my $graphs = $self->graphs; return sub { foreach my $g (@$graphs) { $model->drop_graph($g); } return Attean::ListIterator->new(values => [Attean::Literal->true], item_type => 'Attean::API::Term'); }; } } package Attean::Plan::TripleTemplateToModelQuadMethod 0.034 { use Moo; use Scalar::Util qw(blessed); use Types::Standard qw(ConsumerOf Str ArrayRef HashRef); use namespace::clean; with 'Attean::API::Plan', 'Attean::API::UnaryQueryTree'; with 'Attean::API::UnionScopeVariablesPlan'; has 'order' => (is => 'ro', isa => ArrayRef[Str], required => 1); has 'patterns' => (is => 'ro', isa => HashRef[ArrayRef[ConsumerOf['Attean::API::TripleOrQuadPattern']]], required => 1); has 'graph' => (is => 'ro', isa => ConsumerOf['Attean::API::Term']); sub plan_as_string { my $self = shift; my $level = shift; my $indent = ' ' x (1+$level); my $s = sprintf("Template-to-Model { Default graph: %s }", $self->graph->as_string); foreach my $method (@{ $self->order }) { my $pattern = $self->patterns->{ $method }; $s .= "\n-${indent} Method: ${method}"; foreach my $p (@$pattern) { $s .= "\n-${indent} " . $p->as_string; } } return $s; } sub impl { my $self = shift; my $model = shift; my $child = $self->children->[0]->impl($model); my $graph = $self->graph; my @order = @{ $self->order }; my $method = shift(@order); my $pattern = $self->patterns->{ $method }; return sub { my $iter = $child->(); my @results; while (my $t = $iter->next) { if (scalar(@order)) { push(@results, $t); } foreach my $p (@$pattern) { my $q = $p->apply_bindings($t); my $quad = $q->does('Attean::API::QuadPattern') ? $q : $q->as_quad_pattern($graph); if ($quad->is_ground) { # warn "# $method: " . $quad->as_string . "\n"; $model->$method($quad->as_quad); } else { # warn "not ground: " . $quad->as_string; } } } foreach my $method (@order) { my $pattern = $self->patterns->{ $method }; foreach my $t (@results) { foreach my $p (@$pattern) { my $q = $p->apply_bindings($t); my $quad = $q->does('Attean::API::QuadPattern') ? $q : $q->as_quad_pattern($graph); if ($quad->is_ground) { # warn "# $method: " . $quad->as_string . "\n"; $model->$method($quad->as_quad); } else { # warn "not ground: " . $quad->as_string; } } } } return Attean::ListIterator->new(values => [Attean::Literal->integer($model->size)], item_type => 'Attean::API::Term'); }; } } package Attean::Plan::Load 0.034 { use Moo; use Encode; use LWP::UserAgent; use Scalar::Util qw(blessed); use Types::Standard qw(Bool Str); use namespace::clean; with 'Attean::API::Plan', 'Attean::API::NullaryQueryTree'; with 'Attean::API::UnionScopeVariablesPlan'; has 'silent' => (is => 'ro', isa => Bool, default => 0); has 'url' => (is => 'ro', isa => Str); sub plan_as_string { my $self = shift; return sprintf("Load { %s }", $self->url); } sub impl { my $self = shift; my $url = $self->url; my $ua = LWP::UserAgent->new(); my $silent = $self->silent; my $accept = Attean->acceptable_parsers( handles => 'Attean::API::Triple' ); $ua->default_headers->push_header( 'Accept' => $accept ); return sub { my $resp = $ua->get( $url ); if ($resp->is_success) { my $ct = $resp->header('Content-Type'); if (my $pclass = Attean->get_parser( media_type => $ct )) { my $p = $pclass->new(); my $str = $resp->decoded_content; my $bytes = encode('UTF-8', $str, Encode::FB_CROAK); my $iter = $p->parse_iter_from_bytes( $bytes ); return $iter; } } if ($silent) { return Attean::ListIterator->new(values => [], item_type => 'Attean::API::Triple'); } else { die "Failed to load url: " . $resp->status_line; } }; } } =item * L =cut package Attean::Plan::Unfold 0.032 { use Moo; use Encode; use UUID::Tiny ':std'; use URI::Escape; use Data::Dumper; use I18N::LangTags; use POSIX qw(ceil floor); use Digest::SHA; use Digest::MD5 qw(md5_hex); use Scalar::Util qw(blessed looks_like_number); use List::MoreUtils qw(uniq all); use Types::Standard qw(ConsumerOf ArrayRef InstanceOf HashRef); use namespace::clean; with 'MooX::Log::Any'; with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::UnaryQueryTree'; has 'variables' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Variable']], required => 1); has 'expression' => (is => 'ro', isa => ConsumerOf['Attean::API::Expression'], required => 1); has 'active_graphs' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::IRI']], required => 1); sub plan_as_string { my $self = shift; my @vars = map { $_->as_string } @{ $self->variables }; my $vars = '(' . join(', ', @vars) . ')'; return sprintf('Unfold { %s ↠%s }', $vars, $self->expression->as_string); } sub tree_attributes { return qw(variable expression) }; sub BUILDARGS { my $class = shift; my %args = @_; my $exprs = $args{ expressions }; my @vars = map { @{ $_->in_scope_variables } } @{ $args{ children } }; my @evars = (@vars, keys %$exprs); if (exists $args{in_scope_variables}) { Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor"; } $args{in_scope_variables} = [@evars]; return $class->SUPER::BUILDARGS(%args); } sub substitute_impl { my $self = shift; my $model = shift; my $bind = shift; my $expr = $self->expression; my $vars = $self->variables; my ($impl) = map { $_->substitute_impl($model, $bind) } @{ $self->children }; # TODO: substitute variables in the expression return $self->_impl($model, $impl, $expr, @$vars); } sub impl { my $self = shift; my $model = shift; my $expr = $self->expression; my $vars = $self->variables; my ($impl) = map { $_->impl($model) } @{ $self->children }; return $self->_impl($model, $impl, $expr, @$vars); } sub _impl { my $self = shift; my $model = shift; my $impl = shift; Carp::confess unless (defined($impl)); my $expr = shift; my @vars = @_; my $iter_variables = $self->in_scope_variables; my $var = $vars[0]; my $index_var = $vars[1]; return sub { my $iter = $impl->(); my @buffer; return Attean::CodeIterator->new( item_type => 'Attean::API::Result', variables => $iter_variables, generator => sub { if (scalar(@buffer)) { return shift(@buffer); } ROW: while (my $r = $iter->next) { my %base = map { $_ => $r->value($_) } $r->variables; my $cdt = eval { Attean::Plan::Extend->evaluate_expression($model, $expr, $r) }; warn "UNFOLD expression evaluation error: $@" if ($@); unless ($cdt) { return $r; } if ($cdt->does('Attean::API::Literal') and $cdt->datatype->value eq $AtteanX::Functions::CompositeLists::LIST_TYPE_IRI) { my @values = AtteanX::Functions::CompositeLists::lex_to_list($cdt); foreach my $index (0 .. $#values) { my %row = %base; my $term = $values[$index]; if (blessed($term)) { if ($row{ $var } and $term->as_string ne $row{ $var }->as_string) { next ROW; } if ($term->does('Attean::API::Binding')) { # patterns need to be made ground to be bound as values (e.g. TriplePattern -> Triple) $term = $term->ground($r); } $row{ $var->value } = $term; if (defined $index_var) { $row{ $index_var->value } = Attean::Literal->integer(1+$index); } } push(@buffer, Attean::Result->new( bindings => \%row, eval_stash => $r->eval_stash )); } } elsif ($cdt->does('Attean::API::Literal') and $cdt->datatype->value eq $AtteanX::Functions::CompositeMaps::MAP_TYPE_IRI) { my @values = AtteanX::Functions::CompositeMaps::lex_to_maplist($cdt); while (my @pair = splice(@values, 0, 2)) { my ($index, $term) = @pair; my %row = %base; if (blessed($term)) { if ($row{ $var } and $term->as_string ne $row{ $var }->as_string) { next ROW; } if ($term->does('Attean::API::Binding')) { # patterns need to be made ground to be bound as values (e.g. TriplePattern -> Triple) $term = $term->ground($r); } if (defined $index_var) { # 2-var $row{ $index_var->value } = $term; $row{ $var->value } = $index; } else { # 1-var $row{ $var->value } = $term; } } push(@buffer, Attean::Result->new( bindings => \%row, eval_stash => $r->eval_stash )); } } return shift(@buffer); } return; } ); }; } } # Create(iri) 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/IDPQueryPlanner.pm000644 000765 000024 00000000225 14636707547 022320 xustar00gregstaff000000 000000 30 mtime=1719373671.858723731 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/IDPQueryPlanner.pm000644 000765 000024 00000002373 14636707547 020355 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::IDPQueryPlanner - Iterative dynamic programming query planner =head1 VERSION This document describes Attean::IDPQueryPlanner version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my $planner = Attean::IDPQueryPlanner->new(); my $default_graphs = [ Attean::IRI->new('http://example.org/') ]; my $plan = $planner->plan_for_algebra( $algebra, $model, $default_graphs ); my $iter = $plan->evaluate($model); my $iter = $e->evaluate( $model ); =head1 DESCRIPTION The Attean::IDPQueryPlanner class implements a query planner using the iterative dynamic programming approach. =head1 ATTRIBUTES =over 4 =back =head1 METHODS =over 4 =cut package Attean::IDPQueryPlanner 0.034 { use Moo; use namespace::clean; extends 'Attean::QueryPlanner'; with 'Attean::API::IDPJoinPlanner'; } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/QuadModel.pm000644 000765 000024 00000000223 14636707547 021207 xustar00gregstaff000000 000000 28 mtime=1719373671.9864777 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/QuadModel.pm000644 000765 000024 00000007061 14636707547 017245 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::QuadModel - RDF model backed by a quad-store =head1 VERSION This document describes Attean::QuadModel version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my $model = Attean::QuadModel->new( store => $store ); =head1 DESCRIPTION The Attean::QuadModel class represents a model that is backed by a single L object. It conforms to the L role. The Attean::QuadModel constructor requires one named argument: =over 4 =item store A L object representing the backing quad-store. =back =head1 METHODS =over 4 =cut package Attean::QuadModel 0.034 { use Moo; use Scalar::Util qw(reftype); use namespace::clean; has 'store' => ( is => 'ro', does => 'Attean::API::QuadStore', required => 1, handles => [qw(size count_quads count_quads_estimate get_graphs holds)], ); =item C<< get_quads ( $subject, $predicate, $object, $graph ) >> Returns an L for quads in the model that match the supplied C<< $subject >>, C<< $predicate >>, C<< $object >>, and C<< $graph >>. Any of these terms may be undefined or a L object, in which case that term will be considered as a wildcard for the purposes of matching. The returned iterator conforms to both L and L. =cut sub get_quads { my $self = shift; my @nodes = @_[0..3]; foreach my $i (0..3) { my $t = $nodes[$i]; if (not(ref($t)) or reftype($t) ne 'ARRAY') { $nodes[$i] = [$t]; } } my @iters; foreach my $s (@{ $nodes[0] }) { foreach my $p (@{ $nodes[1] }) { foreach my $o (@{ $nodes[2] }) { foreach my $g (@{ $nodes[3] }) { push(@iters, $self->store->get_quads($s, $p, $o, $g)); } } } } if (scalar(@iters) == 0) { return Attean::ListIterator->new(values => [], item_type => 'Attean::API::Quad'); } elsif (scalar(@iters) == 1) { return shift(@iters); } else { return Attean::IteratorSequence->new( iterators => \@iters, item_type => $iters[0]->item_type ); } } =item C<< plans_for_algebra( $algebra, $model, $active_graphs, $default_graphs ) >> Delegates to the underlying store if the store consumes Attean::API::CostPlanner. =cut sub plans_for_algebra { my $self = shift; if ($self->store->does('Attean::API::CostPlanner')) { return $self->store->plans_for_algebra(@_); } return; } =item C<< cost_for_plan( $plan ) >> Delegates to the underlying store if the store consumes Attean::API::CostPlanner. =cut sub cost_for_plan { my $self = shift; if ($self->store->does('Attean::API::CostPlanner')) { return $self->store->cost_for_plan(@_); } return; } with 'Attean::API::Model'; with 'Attean::API::CostPlanner'; } package Attean::MutableQuadModel 0.034 { use Moo; extends 'Attean::QuadModel'; has 'store' => ( is => 'ro', does => 'Attean::API::MutableQuadStore', required => 1, handles => [qw(size count_quads count_quads_estimate add_quad remove_quad get_graphs create_graph drop_graph clear_graph add_iter)], ); with 'Attean::API::MutableModel'; } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/SimpleQueryEvaluator.pm000644 000765 000024 00000000223 14636707550 023470 xustar00gregstaff000000 000000 28 mtime=1719373672.0573448 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/SimpleQueryEvaluator.pm000644 000765 000024 00000144630 14636707550 021532 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::SimpleQueryEvaluator - Simple query evaluator =head1 VERSION This document describes Attean::SimpleQueryEvaluator version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my $algebra = Attean->get_parser('SPARQL')->parse('SELECT * WHERE { ... }'); my $active_graph = Attean::IRI->new('http://example.org/'); my $e = Attean::SimpleQueryEvaluator->new( model => $model ); my $iter = $e->evaluate( $algebra, $active_graph ); =head1 DESCRIPTION The Attean::SimpleQueryEvaluator class implements a simple query evaluator that, given an L and a L object, evaluates the query represented by the algebra using data from the model, and returns a query result. =head1 ATTRIBUTES =over 4 =cut use Attean::Algebra; use Attean::Expression; package Attean::SimpleQueryEvaluator 0.034 { use Moo; use Encode qw(encode); use Attean::RDF; use AtteanX::Functions::CompositeLists; use AtteanX::Functions::CompositeMaps; use LWP::UserAgent; use Scalar::Util qw(blessed); use List::Util qw(all any reduce); use Types::Standard qw(ConsumerOf InstanceOf Bool Object); use URI::Escape; use Attean::SPARQLClient; use namespace::clean; =item C<< model >> The L object used for query evaluation. =cut has 'model' => (is => 'ro', isa => ConsumerOf['Attean::API::Model'], required => 1); =item C<< default_graph >> The L object representing the default graph in the C<< model >>. The default graph will be excluded from enumeration of graph names for query features such as C<< GRAPH ?g {} >>. =cut has 'default_graph' => (is => 'ro', isa => ConsumerOf['Attean::API::IRI'], required => 1); has 'user_agent' => (is => 'rw', isa => InstanceOf['LWP::UserAgent'], default => sub { my $ua = LWP::UserAgent->new(); $ua->agent("Attean/$Attean::VERSION " . $ua->_agent); $ua }); =item C<< request_signer >> If set, used to modify HTTP::Request objects used in evaluating SERVICE calls before the request is made. This may be used to, for example, add cryptographic signature headers to the request. The modification is performed by calling C<< $request_signer->sign( $request ) >>. =cut has 'request_signer' => (is => 'rw', isa => Object); has 'ground_blanks' => (is => 'rw', isa => Bool, default => 0); sub BUILD { # Ensure that the CT extensions are registered AtteanX::Functions::CompositeLists->register(); AtteanX::Functions::CompositeMaps->register(); } =back =head1 METHODS =over 4 =item C<< evaluate( $algebra, $active_graph ) >> Returns an L object with results produced by evaluating the query C<< $algebra >> against the evaluator's C<< model >>, using the supplied C<< $active_graph >>. =cut sub evaluate { my $self = shift; my $algebra = shift; my $active_graph = shift || Carp::confess "No active-graph passed to Attean::SimpleQueryEvaluator->evaluate"; Carp::confess "No algebra passed for evaluation" unless ($algebra); my $expr_eval = Attean::SimpleQueryEvaluator::ExpressionEvaluator->new( evaluator => $self ); my @children = @{ $algebra->children }; my ($child) = $children[0]; if ($algebra->isa('Attean::Algebra::Query') or $algebra->isa('Attean::Algebra::Update')) { return $self->evaluate($algebra->child, $active_graph, @_); } elsif ($algebra->isa('Attean::Algebra::BGP')) { my @triples = @{ $algebra->triples }; if (scalar(@triples) == 0) { my $b = Attean::Result->new( bindings => {} ); return Attean::ListIterator->new(variables => [], values => [$b], item_type => 'Attean::API::Result'); } else { my @iters; my @new_vars; my %blanks; foreach my $t (@triples) { push(@iters, $self->evaluate_pattern($t, $active_graph, \@new_vars, \%blanks)); } while (scalar(@iters) > 1) { my ($lhs, $rhs) = splice(@iters, 0, 2); unshift(@iters, $lhs->join($rhs)); } return shift(@iters)->map(sub { shift->project_complement(@new_vars) }); } } elsif ($algebra->isa('Attean::Algebra::Distinct') or $algebra->isa('Attean::Algebra::Reduced')) { my %seen; my $iter = $self->evaluate( $child, $active_graph ); return $iter->grep(sub { my $r = shift; my $str = $r->as_string; my $ok = not($seen{ $str }) ? 1 : 0; $seen{ $str }++; return $ok; }); } elsif ($algebra->isa('Attean::Algebra::Extend')) { my $child = $algebra; my @extends; my %extends; while ($child->isa('Attean::Algebra::Extend')) { my $expr = $child->expression; my $var = $child->variable->value; $extends{ $var } = $expr; unshift(@extends, $var); ($child) = @{ $child->children }; } return $self->evaluate( $child, $active_graph )->map(sub { my $r = shift; my %extension; my %row_cache; foreach my $var (@extends) { my $expr = $extends{ $var }; my $val = $expr_eval->evaluate_expression( $expr, $r, $active_graph, \%row_cache ); if (blessed($val) and $val->does('Attean::API::Binding')) { # patterns need to be made ground to be bound as values (e.g. TriplePattern -> Triple) $val = $val->ground($r); } # warn "Extend error: $@" if ($@); $r = Attean::Result->new( bindings => { $var => $val } )->join($r) if ($val); } return $r; }); } elsif ($algebra->isa('Attean::Algebra::Unfold')) { my $expr = $algebra->expression; my @vars = map { $_->value } @{ $algebra->variables }; my ($first, $second); $first = $vars[0]; if (scalar(@vars) == 2) { $second = $vars[1]; } my ($child) = @{ $algebra->children }; my $iter = $self->evaluate( $child, $active_graph ); my @results; while (my $r = $iter->next) { my %extension; my %row_cache; my $val = $expr_eval->evaluate_expression( $expr, $r, $active_graph, \%row_cache ); my $dt = $val->datatype; if ($dt->value eq $AtteanX::Functions::CompositeLists::LIST_TYPE_IRI) { my @nodes = AtteanX::Functions::CompositeLists::lex_to_list($val); foreach my $i (0 .. $#nodes) { my $val = $nodes[$i]; my %bindings; if (defined($val)) { if ($val->does('Attean::API::Binding')) { # patterns need to be made ground to be bound as values (e.g. TriplePattern -> Triple) $val = $val->ground($r); } # warn "Unfold error: $@" if ($@); $bindings{$first} = $val if ($val); } if (defined($second)) { $bindings{$second} = Attean::Literal->integer(1+$i); } my $new = Attean::Result->new( bindings => \%bindings )->join($r); push(@results, $new); } } elsif ($dt->value eq $AtteanX::Functions::CompositeMaps::MAP_TYPE_IRI) { my @nodes = AtteanX::Functions::CompositeMaps::lex_to_map($val); # The namespace map here is used to correctly parse maps with boolean keys like `{true:1}` my $p = AtteanX::Parser::Turtle->new(); while (my ($key_string, $val) = splice(@nodes, 0, 2)) { my $key = $p->parse_node($key_string); # TODO: this mistakes "true:4" as an attempted prefixname, not a key-value pair my %bindings; if (defined($first)) { if ($key->does('Attean::API::Binding')) { # patterns need to be made ground to be bound as values (e.g. TriplePattern -> Triple) $key = $key->ground($r); } # warn "Unfold error: $@" if ($@); $bindings{$first} = $key if ($key); } if (defined($second)) { if (blessed($val) and $val->does('Attean::API::Binding')) { # patterns need to be made ground to be bound as values (e.g. TriplePattern -> Triple) $val = $val->ground($r); } # warn "Unfold error: $@" if ($@); $bindings{$second} = $val if ($val); } my $new = Attean::Result->new( bindings => \%bindings )->join($r); push(@results, $new); } } } my %vars = map { $_ => 1 } $iter->variables; $vars{$first}++; $vars{$second}++ if defined($second); return Attean::ListIterator->new(variables => [keys %vars], values => \@results, item_type => 'Attean::API::Result'); } elsif ($algebra->isa('Attean::Algebra::Filter')) { # TODO: Merge adjacent filter evaluation so that they can share a row_cache hash (as is done for Extend above) my $expr = $algebra->expression; my $iter = $self->evaluate( $child, $active_graph ); return $iter->grep(sub { my $t = $expr_eval->evaluate_expression( $expr, shift, $active_graph, {} ); # if ($@) { warn "Filter evaluation: $@\n" }; return ($t ? $t->ebv : 0); }); } elsif ($algebra->isa('Attean::Algebra::OrderBy')) { local($Attean::API::Binding::ALLOW_IRI_COMPARISON) = 1; my $iter = $self->evaluate( $child, $active_graph ); my @rows = $iter->elements; my @cmps = @{ $algebra->comparators }; my @exprs = map { $_->expression } @cmps; my @dirs = map { $_->ascending } @cmps; my @sorted = map { $_->[0] } sort { my ($ar, $avalues) = @$a; my ($br, $bvalues) = @$b; my $c = 0; foreach my $i (0 .. $#cmps) { my ($av, $bv) = map { $_->[$i] } ($avalues, $bvalues); # Mirrors code in Attean::Plan::OrderBy->sort_rows if (blessed($av) and $av->does('Attean::API::Binding') and (not(defined($bv)) or not($bv->does('Attean::API::Binding')))) { $c = 1; } elsif (blessed($bv) and $bv->does('Attean::API::Binding') and (not(defined($av)) or not($av->does('Attean::API::Binding')))) { $c = -1; } else { $c = eval { $av ? $av->order($bv) : 1 }; if ($@) { $c = 1; } } $c *= -1 if ($dirs[$i] == 0); last unless ($c == 0); } $c } map { my $r = $_; [$r, [map { $expr_eval->evaluate_expression( $_, $r, $active_graph, {} ) } @exprs]] } @rows; return Attean::ListIterator->new( values => \@sorted, item_type => $iter->item_type, variables => $iter->variables); } elsif ($algebra->isa('Attean::Algebra::Service')) { my $endpoint = $algebra->endpoint->value; my ($pattern) = @{ $algebra->children }; my $sparql = Attean::Algebra::Project->new( variables => [ map { variable($_) } $pattern->in_scope_variables ], children => [ $pattern ] )->as_sparql; my $silent = $algebra->silent; my $client = Attean::SPARQLClient->new( endpoint => $endpoint, silent => $silent, user_agent => $self->user_agent, request_signer => $self->request_signer, ); return $client->query($sparql); } elsif ($algebra->isa('Attean::Algebra::Graph')) { my $graph = $algebra->graph; return $self->evaluate($child, $graph) if ($graph->does('Attean::API::Term')); my @iters; my $graphs = $self->model->get_graphs(); my %vars; while (my $g = $graphs->next) { next if ($g->value eq $self->default_graph->value); my $gr = Attean::Result->new( bindings => { $graph->value => $g } ); my $iter = $self->evaluate($child, $g)->map(sub { if (my $result = shift->join($gr)) { return $result } else { return } }); foreach my $v (@{ $iter->variables }) { $vars{$v}++; } push(@iters, $iter); } return Attean::IteratorSequence->new( variables => [keys %vars], iterators => \@iters, item_type => 'Attean::API::Result' ); } elsif ($algebra->isa('Attean::Algebra::Group')) { my @groupby = @{ $algebra->groupby }; my $iter = $self->evaluate($child, $active_graph); my %groups; while (my $r = $iter->next) { my %vars; my %row_cache; my @group_terms = map { $expr_eval->evaluate_expression( $_, $r, $active_graph, \%row_cache ) } @groupby; my $key = join(' ', map { blessed($_) ? $_->as_string : '' } @group_terms); my %group_bindings; foreach my $i (0 .. $#group_terms) { my $v = $groupby[$i]; if (blessed($v) and $v->isa('Attean::ValueExpression') and $v->value->does('Attean::API::Variable') and $group_terms[$i]) { $group_bindings{$v->value->value} = $group_terms[$i]; } } $groups{$key} = [Attean::Result->new( bindings => \%group_bindings ), []] unless (exists($groups{$key})); push(@{ $groups{$key}[1] }, $r); } my @keys = keys %groups; $groups{''} = [Attean::Result->new( bindings => {} ), []] if (scalar(@keys) == 0); my $aggs = $algebra->aggregates; my @results; my %vars; foreach my $key (keys %groups) { my %row_cache; my ($binding, $rows) = @{ $groups{$key} }; my $count = scalar(@$rows); my %bindings; foreach my $i (0 .. $#{ $aggs }) { my $name = $aggs->[$i]->variable->value; my $term = $expr_eval->evaluate_expression( $aggs->[$i], $rows, $active_graph, {} ); # warn "AGGREGATE error: $@" if ($@); $vars{$name}++; $bindings{ $name } = $term if ($term); } push(@results, Attean::Result->new( bindings => \%bindings )->join($binding)); } return Attean::ListIterator->new(variables => [keys %vars], values => \@results, item_type => 'Attean::API::Result'); } elsif ($algebra->isa('Attean::Algebra::Join')) { my ($lhs, $rhs) = map { $self->evaluate($_, $active_graph) } @children; return $lhs->join($rhs); } elsif ($algebra->isa('Attean::Algebra::LeftJoin')) { my $expr = $algebra->expression; my ($lhs_iter, $rhs_iter) = map { $self->evaluate($_, $active_graph) } @children; my @rhs = $rhs_iter->elements; my @results; my %vars = map { $_ => 1 } (@{ $lhs_iter->variables }, @{ $rhs_iter->variables }); while (my $lhs = $lhs_iter->next) { my $joined = 0; foreach my $rhs (@rhs) { if (my $j = $lhs->join($rhs)) { if ($expr_eval->evaluate_expression( $expr, $j, $active_graph, {} )->ebv) { $joined++; push(@results, $j); } } } push(@results, $lhs) unless ($joined); } return Attean::ListIterator->new( variables => [keys %vars], values => \@results, item_type => 'Attean::API::Result'); } elsif ($algebra->isa('Attean::Algebra::Minus')) { my ($lhsi, $rhs) = map { $self->evaluate($_, $active_graph) } @children; my @rhs = $rhs->elements; my @results; while (my $lhs = $lhsi->next) { my @compatible; my @disjoint; RHS: foreach my $rhs (@rhs) { if (my $j = $lhs->join($rhs)) { push(@compatible, 1); } else { push(@compatible, 0); } my $intersects = 0; my %lhs_dom = map { $_ => 1 } $lhs->variables; foreach my $rvar ($rhs->variables) { if (exists $lhs_dom{$rvar}) { $intersects = 1; } } push(@disjoint, not($intersects)); } my $count = scalar(@rhs); my $keep = 1; foreach my $i (0 .. $#rhs) { $keep = 0 unless ($compatible[$i] == 0 or $disjoint[$i] == 1); } push(@results, $lhs) if ($keep); } return Attean::ListIterator->new( variables => $lhsi->variables, values => \@results, item_type => 'Attean::API::Result'); } elsif ($algebra->isa('Attean::Algebra::Path')) { my $s = $algebra->subject; my $path = $algebra->path; my $o = $algebra->object; my @children = @{ $path->children }; my ($child) = $children[0]; return $self->model->get_bindings( $s, $path->predicate, $o, $active_graph ) if ($path->isa('Attean::Algebra::PredicatePath')); if ($path->isa('Attean::Algebra::InversePath')) { my $path = Attean::Algebra::Path->new( subject => $o, path => $child, object => $s ); return $self->evaluate( $path, $active_graph ); } elsif ($path->isa('Attean::Algebra::AlternativePath')) { my @children = @{ $path->children }; my @algebras = map { Attean::Algebra::Path->new( subject => $s, path => $_, object => $o ) } @children; my @iters = map { $self->evaluate($_, $active_graph) } @algebras; return Attean::IteratorSequence->new( iterators => \@iters, item_type => $iters[0]->item_type, variables => [$algebra->in_scope_variables] ); } elsif ($path->isa('Attean::Algebra::NegatedPropertySet')) { my $preds = $path->predicates; my %preds = map { $_->value => 1 } @$preds; my $filter = $self->model->get_quads($s, undef, $o, $active_graph)->grep(sub { my $q = shift; my $p = $q->predicate; return not exists $preds{ $p->value }; }); my %vars; $vars{subject} = $s->value if ($s->does('Attean::API::Variable')); $vars{object} = $o->value if ($o->does('Attean::API::Variable')); return $filter->map(sub { my $q = shift; return unless $q; my %bindings = map { $vars{$_} => $q->$_() } (keys %vars); return Attean::Result->new( bindings => \%bindings ); }, 'Attean::API::Result', variables => [values %vars]); } elsif ($path->isa('Attean::Algebra::SequencePath')) { if (scalar(@children) == 1) { my $path = Attean::Algebra::Path->new( subject => $s, path => $children[0], object => $o ); return $self->evaluate($path, $active_graph); } else { my @paths; my $first = shift(@children); my $join = Attean::Variable->new(); my @new_vars = ($join->value); push(@paths, Attean::Algebra::Path->new( subject => $s, path => $first, object => $join )); foreach my $i (0 .. $#children) { my $newjoin = Attean::Variable->new(); my $obj = ($i == $#children) ? $o : $newjoin; push(@new_vars, $newjoin->value); push(@paths, Attean::Algebra::Path->new( subject => $join, path => $children[$i], object => $obj )); $join = $newjoin; } while (scalar(@paths) > 1) { my ($l, $r) = splice(@paths, 0, 2); unshift(@paths, Attean::Algebra::Join->new( children => [$l, $r] )); } return $self->evaluate(shift(@paths), $active_graph)->map(sub { shift->project_complement(@new_vars) }); } } elsif ($path->isa('Attean::Algebra::ZeroOrMorePath') or $path->isa('Attean::Algebra::OneOrMorePath')) { if ($s->does('Attean::API::TermOrTriple') and $o->does('Attean::API::Variable')) { my $v = {}; if ($path->isa('Attean::Algebra::ZeroOrMorePath')) { $self->_ALP($active_graph, $s, $child, $v); } else { my $iter = $self->_eval($active_graph, $s, $child); while (my $n = $iter->next) { $self->_ALP($active_graph, $n, $child, $v); } } my @results = map { Attean::Result->new( bindings => { $o->value => $_ } ) } (values %$v); return Attean::ListIterator->new(variables => [$o->value], values => \@results, item_type => 'Attean::API::Result'); } elsif ($s->does('Attean::API::Variable') and $o->does('Attean::API::Variable')) { my $nodes = $self->model->graph_nodes( $active_graph ); my @results; while (my $t = $nodes->next) { my $tr = Attean::Result->new( bindings => { $s->value => $t } ); my $p = Attean::Algebra::Path->new( subject => $t, path => $path, object => $o ); my $iter = $self->evaluate($p, $active_graph); while (my $r = $iter->next) { push(@results, $r->join($tr)); } } my %vars = map { $_ => 1 } ($s->value, $o->value); return Attean::ListIterator->new(variables => [keys %vars], values => \@results, item_type => 'Attean::API::Result'); } elsif ($s->does('Attean::API::Variable') and $o->does('Attean::API::TermOrTriple')) { my $pp = Attean::Algebra::InversePath->new( children => [$child] ); my $p = Attean::Algebra::Path->new( subject => $o, path => $pp, object => $s ); return $self->evaluate($p, $active_graph); } else { # Term ZeroOrMorePath(path) Term my $v = {}; $self->_ALP($active_graph, $s, $child, $v); my @results; foreach my $v (values %$v) { return Attean::ListIterator->new(variables => [], values => [Attean::Result->new()], item_type => 'Attean::API::Result') if ($v->equals($o)); } return Attean::ListIterator->new(variables => [], values => [], item_type => 'Attean::API::Result'); } } elsif ($path->isa('Attean::Algebra::ZeroOrOnePath')) { my $path = Attean::Algebra::Path->new( subject => $s, path => $child, object => $o ); my @iters; my %seen; push(@iters, $self->evaluate( $path, $active_graph )->grep(sub { return not($seen{shift->as_string}++); })); push(@iters, $self->_zeroLengthPath($s, $o, $active_graph)); my %vars; foreach my $iter (@iters) { $vars{$_}++ for (@{ $iter->variables }); } return Attean::IteratorSequence->new( iterators => \@iters, item_type => 'Attean::API::Result', variables => [keys %vars] ); } die "Unimplemented path type: $path"; } elsif ($algebra->isa('Attean::Algebra::Project')) { my $iter = $self->evaluate( $child, $active_graph ); my @vars = map { $_->value } @{ $algebra->variables }; return $iter->map(sub { my $r = shift; my $b = { map { my $t = $r->value($_); $t ? ($_ => $t) : () } @vars }; return Attean::Result->new( bindings => $b ); }, undef, variables => \@vars); #->debug('Project result'); } elsif ($algebra->isa('Attean::Algebra::Slice')) { my $iter = $self->evaluate( $child, $active_graph ); $iter = $iter->offset($algebra->offset) if ($algebra->offset > 0); $iter = $iter->limit($algebra->limit) if ($algebra->limit >= 0); return $iter; } elsif ($algebra->isa('Attean::Algebra::Union')) { my ($lhs, $rhs) = map { $self->evaluate($_, $active_graph) } @children; return Attean::IteratorSequence->new( iterators => [$lhs, $rhs], item_type => 'Attean::API::Result', variables => [$algebra->in_scope_variables] ); } elsif ($algebra->isa('Attean::Algebra::Ask')) { my $iter = $self->evaluate($child, $active_graph); my $result = $iter->next; return Attean::ListIterator->new(values => [$result ? Attean::Literal->true : Attean::Literal->false], item_type => 'Attean::API::Term'); } elsif ($algebra->isa('Attean::Algebra::Construct')) { my $iter = $self->evaluate($child, $active_graph); my $patterns = $algebra->triples; use Data::Dumper; my %seen; return Attean::CodeIterator->new( generator => sub { my $r = $iter->next; return unless ($r); my %mapping = map { my $t = $r->value($_); $t ? ("?$_" => $t) : (); } ($r->variables); my $mapper = Attean::TermMap->rewrite_map(\%mapping); my @triples; PATTERN: foreach my $p (@$patterns) { my @terms = map { ($_->does('Attean::API::TriplePattern')) ? $_->as_triple : $_ } $p->apply_map($mapper)->values; unless (all { $_->does('Attean::API::TermOrTriple') } @terms) { next PATTERN; } push(@triples, Attean::Triple->new(@terms)); } return @triples; }, item_type => 'Attean::API::Triple' )->grep(sub { return not($seen{shift->as_string}++); }); } elsif ($algebra->isa('Attean::Algebra::Table')) { my $vars = [map { $_->value } @{ $algebra->variables }]; return Attean::ListIterator->new(variables => $vars, values => $algebra->rows, item_type => 'Attean::API::Result'); } die "Unimplemented simple algebra evaluation for: $algebra"; } =item C<< evaluate_pattern( $pattern, $active_graph, \@new_vars, \%blanks ) >> Returns an L object with results produced by evaluating the triple- or quad-pattern C<< $pattern >> against the evaluator's C<< model >>, using the supplied C<< $active_graph >>. If the C<< ground_blanks >> option is false, replaces blank nodes in the pattern with fresh variables before evaluation, and populates C<< %blanks >> with pairs ($variable_name => $variable_node). Each new variable is also appended to C<< @new_vars >> as it is created. =cut sub evaluate_pattern { my $self = shift; my $t = shift; my $active_graph = shift || Carp::confess "No active-graph passed to Attean::SimpleQueryEvaluator->evaluate"; my $new_vars = shift; my $blanks = shift; my $q = $t->as_quad_pattern($active_graph); my @values; foreach my $v ($q->values) { if (not($self->ground_blanks) and $v->does('Attean::API::Blank')) { unless (exists $blanks->{$v->value}) { $blanks->{$v->value} = Attean::Variable->new(); push(@$new_vars, $blanks->{$v->value}->value); } push(@values, $blanks->{$v->value}); } else { push(@values, $v); } } return $self->model->get_bindings( @values ); } sub _ALP { my $self = shift; my $graph = shift; my $term = shift; my $path = shift; my $v = shift; return if (exists $v->{ $term->as_string }); $v->{ $term->as_string } = $term; my $iter = $self->_eval($graph, $term, $path); while (my $n = $iter->next) { $self->_ALP($graph, $n, $path, $v); } } sub _eval { my $self = shift; my $graph = shift; my $term = shift; my $path = shift; my $pp = Attean::Algebra::Path->new( subject => $term, path => $path, object => variable('o') ); my $iter = $self->evaluate($pp, $graph); my $terms = $iter->map(sub { shift->value('o') }, 'Attean::API::Term'); my %seen; return $terms->grep(sub { not $seen{ shift->as_string }++ }); } sub _zeroLengthPath { my $self = shift; my $s = shift; my $o = shift; my $graph = shift; my $s_term = ($s->does('Attean::API::TermOrTriple')); my $o_term = ($o->does('Attean::API::TermOrTriple')); if ($s_term and $o_term) { my @r; push(@r, Attean::Result->new()) if ($s->equals($o)); return Attean::ListIterator->new(variables => [], values => \@r, item_type => 'Attean::API::Result'); } elsif ($s_term) { my $name = $o->value; my $r = Attean::Result->new( bindings => { $name => $s } ); return Attean::ListIterator->new(variables => [$name], values => [$r], item_type => 'Attean::API::Result'); } elsif ($o_term) { my $name = $s->value; my $r = Attean::Result->new( bindings => { $name => $o } ); return Attean::ListIterator->new(variables => [$name], values => [$r], item_type => 'Attean::API::Result'); } else { my @vars = map { $_->value } ($s, $o); my $nodes = $self->model->graph_nodes( $graph ); return $nodes->map( sub { my $term = shift; Attean::Result->new( bindings => { map { $_ => $term } @vars } ); }, 'Attean::API::Result', variables => \@vars ); } } } package Attean::SimpleQueryEvaluator::ExpressionEvaluator 0.034 { use Moo; use Attean::RDF; use Scalar::Util qw(blessed); use Types::Standard qw(InstanceOf); use URI::Escape qw(uri_escape_utf8); use Encode qw(encode); use POSIX qw(ceil floor); use Digest; use UUID::Tiny ':std'; use List::MoreUtils qw(zip); use DateTime::Format::W3CDTF; use I18N::LangTags; use namespace::clean; has 'evaluator' => (is => 'ro', isa => InstanceOf['Attean::SimpleQueryEvaluator']); sub evaluate_expression { my $self = shift; my $expr = shift; my $row = shift; my $active_graph = shift; my $row_cache = shift || {}; my $impl = $self->impl($expr, $active_graph); my $result = eval { $impl->($row, row_cache => $row_cache) }; return $result; } sub impl { my $self = shift; my $expr = shift; my $active_graph = shift; my $op = $expr->operator; my $true = Attean::Literal->true; my $false = Attean::Literal->false; if ($expr->isa('Attean::ExistsExpression')) { my $pattern = $expr->pattern; return sub { my $r = shift; my $table = Attean::Algebra::Table->new( variables => [map { variable($_) } $r->variables], rows => [$r] ); my $join = Attean::Algebra::Join->new( children => [$table, $pattern] ); # TODO: substitute variables at top-level of EXISTS pattern my $iter = $self->evaluator->evaluate($join, $active_graph); return ($iter->next) ? $true : $false; }; } elsif ($expr->isa('Attean::ValueExpression')) { my $node = $expr->value; if ($node->does('Attean::API::Variable')) { return sub { return shift->value($node->value); }; } else { return sub { return $node }; } } elsif ($expr->isa('Attean::UnaryExpression')) { my ($child) = @{ $expr->children }; my $impl = $self->impl($child, $active_graph); if ($op eq '!') { return sub { my $term = $impl->(@_); return ($term->ebv) ? $false : $true; } } elsif ($op eq '-' or $op eq '+') { return sub { my $term = $impl->(@_); die "TypeError $op" unless (blessed($term) and $term->does('Attean::API::NumericLiteral')); my $v = $term->numeric_value; return Attean::Literal->new( value => eval "$op$v", datatype => $term->datatype ); }; } die "Unimplemented UnaryExpression evaluation: " . $expr->operator; } elsif ($expr->isa('Attean::BinaryExpression')) { my ($lhs, $rhs) = @{ $expr->children }; my ($lhsi, $rhsi) = map { $self->impl($_, $active_graph) } ($lhs, $rhs); if ($op eq '&&') { return sub { my ($r, %args) = @_; my $lbv = eval { $lhsi->($r, %args) }; my $rbv = eval { $rhsi->($r, %args) }; die "TypeError $op" unless ($lbv or $rbv); return $false if (not($lbv) and not($rbv->ebv)); return $false if (not($rbv) and not($lbv->ebv)); die "TypeError $op" unless ($lbv and $rbv); return ($lbv->ebv && $rbv->ebv) ? $true : $false; } } elsif ($op eq '||') { return sub { my ($r, %args) = @_; my $lbv = eval { $lhsi->($r, %args) }; return $true if ($lbv and $lbv->ebv); my $rbv = eval { $rhsi->($r, %args) }; die "TypeError $op" unless ($rbv); return $true if ($rbv->ebv); return $false if ($lbv); die "TypeError $op"; } } elsif ($op =~ m#^(?:[-+*/])$#) { # numeric operators: - + * / return sub { my ($r, %args) = @_; ($lhs, $rhs) = map { $_->($r, %args) } ($lhsi, $rhsi); for ($lhs, $rhs) { die "TypeError $op" unless (blessed($_) and $_->does('Attean::API::NumericLiteral')); } my $lv = $lhs->numeric_value; my $rv = $rhs->numeric_value; return Attean::Literal->new( value => eval "$lv $op $rv", datatype => $lhs->binary_promotion_type($rhs, $op) ); }; } elsif ($op =~ /^!?=$/) { return sub { my ($r, %args) = @_; ($lhs, $rhs) = map { $_->($r, %args) } ($lhsi, $rhsi); for ($lhs, $rhs) { die "TypeError $op" unless (blessed($_) and $_->does('Attean::API::TermOrTriple')); } my $ok; if ($lhs->does('Attean::API::Binding')) { $ok = $lhs->equals($rhs); } else { $ok = $lhs->equals($rhs); } $ok = not($ok) if ($op eq '!='); return $ok ? $true : $false; } } elsif ($op =~ /^[<>]=?$/) { return sub { my ($r, %args) = @_; ($lhs, $rhs) = map { $_->($r, %args) } ($lhsi, $rhsi); for ($lhs, $rhs) { die "TypeError $op" unless $_->does('Attean::API::TermOrTriple'); die "TypeError $op" if ($_->does('Attean::API::IRI')); # comparison of IRIs is only defined for `ORDER BY`, not for general expressions } my $c = ($lhs->compare($rhs)); return $true if (($c < 0 and ($op =~ /<=?/)) or ($c > 0 and ($op =~ />=?/)) or ($c == 0 and ($op =~ /=/))); return $false; } } die "Unexpected operator evaluation: $op"; } elsif ($expr->isa('Attean::FunctionExpression')) { my $func = $expr->operator; my @children = map { $self->impl($_, $active_graph) } @{ $expr->children }; my %type_roles = qw(URI IRI IRI IRI BLANK Blank LITERAL Literal NUMERIC NumericLiteral TRIPLE Triple); my %type_classes = qw(URI Attean::IRI IRI Attean::IRI STR Attean::Literal); return sub { my ($r, %args) = @_; my $row_cache = $args{row_cache} || {}; if ($func eq 'IF') { my $term = $children[0]->( $r, %args ); my $ebv = $term->ebv; return $ebv ? $children[1]->( $r, %args ) : $children[2]->( $r, %args ); } elsif ($func eq 'IN' or $func eq 'NOTIN') { ($true, $false) = ($false, $true) if ($func eq 'NOTIN'); my $child = shift(@children); my $term = $child->( $r, %args ); foreach my $c (@children) { if (my $value = eval { $c->( $r, %args ) }) { return $true if ($term->equals($value)); } } return $false; } elsif ($func eq 'COALESCE') { foreach my $c (@children) { my $t = eval { $c->( $r, %args ) }; next if ($@); return $t if $t; } return; } if ($func eq 'INVOKE') { my $furi = shift(@children)->( $r, %args )->value; if (my $f = Attean->get_global_function($furi)) { my @operands = map { $_->( $r, %args ) } @children; return $f->($self->evaluator->model, $active_graph, @operands); } elsif (my $fform = Attean->get_global_functional_form($furi)) { my @operands = map { eval { $_->( $r, %args ) } || undef } @children; return $fform->($self->evaluator->model, $active_graph, @operands); } else { die "No extension registered for <$furi>"; } } else { my @operands = map { $_->( $r, %args ) } @children; if ($func =~ /^(STR)$/) { return $type_classes{$1}->new($operands[0]->value); } elsif ($func =~ /^(SUBJECT|PREDICATE|OBJECT)$/) { my $pos = lc($func); my $term = $operands[0]->$pos(); return $term; } elsif ($func =~ /^([UI]RI)$/) { my $operand = $operands[0]; if ($operand->does('Attean::API::Literal')) { if ($operand->datatype->value ne 'http://www.w3.org/2001/XMLSchema#string') { die "TypeError: ${func} called with a datatyped-literal other than xsd:string"; } } my @base = $expr->has_base ? (base => $expr->base) : (); return $type_classes{$1}->new(value => $operands[0]->value, @base); } elsif ($func eq 'BNODE') { if (scalar(@operands)) { my $name = $operands[0]->value; if (my $b = $row_cache->{bnodes}{$name}) { return $b; } else { my $b = Attean::Blank->new(); $row_cache->{bnodes}{$name} = $b; return $b; } } return Attean::Blank->new(); } elsif ($func eq 'LANG') { die "TypeError: LANG" unless ($operands[0]->does('Attean::API::Literal')); return Attean::Literal->new($operands[0]->language // ''); } elsif ($func eq 'LANGMATCHES') { my ($lang, $match) = map { $_->value } @operands; if ($match eq '*') { # """A language-range of "*" matches any non-empty language-tag string.""" return ($lang ? $true : $false); } else { return (I18N::LangTags::is_dialect_of( $lang, $match )) ? $true : $false; } } elsif ($func eq 'DATATYPE') { return $operands[0]->datatype; } elsif ($func eq 'BOUND') { return $operands[0] ? $true : $false; } elsif ($func eq 'RAND') { return Attean::Literal->new( value => rand(), datatype => 'http://www.w3.org/2001/XMLSchema#double' ); } elsif ($func eq 'ABS') { return Attean::Literal->new( value => abs($operands[0]->value), $operands[0]->construct_args ); } elsif ($func =~ /^(?:CEIL|FLOOR)$/) { my $v = $operands[0]->value; return Attean::Literal->new( value => (($func eq 'CEIL') ? ceil($v) : floor($v)), $operands[0]->construct_args ); } elsif ($func eq 'ROUND') { return Attean::Literal->new( value => sprintf('%.0f', (0.000000000000001 + $operands[0]->numeric_value)), $operands[0]->construct_args ); } elsif ($func eq 'CONCAT') { my $all_lang = 1; my $all_str = 1; my $lang; if (scalar(@operands) == 0) { return Attean::Literal->new(value => ''); } foreach my $n (@operands) { die "CONCAT called with a non-literal argument" unless ($n->does('Attean::API::Literal')); if ($n->datatype->value ne 'http://www.w3.org/2001/XMLSchema#string') { die "CONCAT called with a datatyped-literal other than xsd:string"; } elsif ($n->language) { $all_str = 0; if (defined($lang) and $lang ne $n->language) { $all_lang = 0; } else { $lang = $n->language; } } else { $all_lang = 0; $all_str = 0; } } my %strtype; if ($all_lang and $lang) { $strtype{language} = $lang; } elsif ($all_str) { $strtype{datatype} = 'http://www.w3.org/2001/XMLSchema#string' } return Attean::Literal->new( value => join('', map { $_->value } @operands), %strtype ); } elsif ($func eq 'SUBSTR') { my $str = shift(@operands); my @args = map { $_->numeric_value } @operands; my $v = scalar(@args == 1) ? substr($str->value, $args[0]-1) : substr($str->value, $args[0]-1, $args[1]); return Attean::Literal->new( value => $v, $str->construct_args ); } elsif ($func eq 'STRLEN') { return Attean::Literal->integer(length($operands[0]->value)); } elsif ($func eq 'REPLACE') { my ($node, $pat, $rep) = @operands; die "TypeError: REPLACE called without a literal arg1 term" unless (blessed($node) and $node->does('Attean::API::Literal')); die "TypeError: REPLACE called without a literal arg2 term" unless (blessed($pat) and $pat->does('Attean::API::Literal')); die "TypeError: REPLACE called without a literal arg3 term" unless (blessed($rep) and $rep->does('Attean::API::Literal')); die "TypeError: REPLACE called with a datatyped (non-xsd:string) literal" if ($node->datatype and $node->datatype->value ne 'http://www.w3.org/2001/XMLSchema#string'); my ($value, $pattern, $replace) = map { $_->value } @operands; die "EvaluationError: REPLACE called with unsafe ?{} match pattern" if (index($pattern, '(?{') != -1 or index($pattern, '(??{') != -1); die "EvaluationError: REPLACE called with unsafe ?{} replace pattern" if (index($replace, '(?{') != -1 or index($replace, '(??{') != -1); $replace =~ s/\\/\\\\/g; $replace =~ s/\$(\d+)/\$$1/g; $replace =~ s/"/\\"/g; $replace = qq["$replace"]; no warnings 'uninitialized'; $value =~ s/$pattern/"$replace"/eeg; return Attean::Literal->new(value => $value, $node->construct_args); } elsif ($func =~ /^[UL]CASE$/) { return Attean::Literal->new( value => ($func eq 'UCASE' ? uc($operands[0]->value) : lc($operands[0]->value) ), $operands[0]->construct_args ); } elsif ($func eq 'ENCODE_FOR_URI') { return Attean::Literal->new( uri_escape_utf8($operands[0]->value) ); } elsif ($func eq 'CONTAINS') { my ($node, $pat) = @operands; my ($lit, $plit) = map { $_->value } @operands; die "TypeError: CONTAINS" if ($node->language and $pat->language and $node->language ne $pat->language); return (index($lit, $plit) >= 0) ? $true : $false; } elsif ($func eq 'STRSTARTS' or $func eq 'STRENDS') { my ($lit, $plit) = map { $_->value } @operands; if ($func eq 'STRENDS') { my $pos = length($lit) - length($plit); return (rindex($lit, $plit) == $pos) ? $true : $false; } else { return (index($lit, $plit) == 0) ? $true : $false; } } elsif ($func eq 'STRBEFORE' or $func eq 'STRAFTER') { my ($node, $substr) = @operands; die "$func called without a literal arg1 term" unless (blessed($node) and $node->does('Attean::API::Literal')); die "$func called without a literal arg2 term" unless (blessed($substr) and $substr->does('Attean::API::Literal')); die "$func called with a datatyped (non-xsd:string) literal" if ($node->datatype and $node->datatype->value ne 'http://www.w3.org/2001/XMLSchema#string'); my $lhs_simple = (not($node->language) and ($node->datatype->value eq 'http://www.w3.org/2001/XMLSchema#string')); my $rhs_simple = (not($substr->language) and ($substr->datatype->value eq 'http://www.w3.org/2001/XMLSchema#string')); if ($lhs_simple and $rhs_simple) { # ok } elsif ($node->language and $substr->language and $node->language eq $substr->language) { # ok } elsif ($node->language and $rhs_simple) { # ok } else { die "$func called with literals that are not argument compatible"; } my $value = $node->value; my $match = $substr->value; my $i = index($value, $match, 0); if ($i < 0) { return Attean::Literal->new(''); } else { if ($func eq 'STRBEFORE') { return Attean::Literal->new(value => substr($value, 0, $i), $node->construct_args); } else { return Attean::Literal->new(value => substr($value, $i+length($match)), $node->construct_args); } } } elsif ($func =~ /^(?:YEAR|MONTH|DAY|HOURS|MINUTES)$/) { my $method = lc($func =~ s/^(HOUR|MINUTE)S$/$1/r); my $dt = $operands[0]->datetime; return Attean::Literal->integer($dt->$method()); } elsif ($func eq 'SECONDS') { my $dt = $operands[0]->datetime; return Attean::Literal->decimal($dt->second()); } elsif ($func eq 'TZ' or $func eq 'TIMEZONE') { my $dt = $operands[0]->datetime; my $tz = $dt->time_zone; if ($tz->is_floating) { return Attean::Literal->new('') if ($func eq 'TZ'); die "TIMEZONE called with a dateTime without a timezone"; } return Attean::Literal->new('Z') if ($func eq 'TZ' and $tz->is_utc); if ($tz) { my $offset = $tz->offset_for_datetime( $dt ); my $hours = 0; my $minutes = 0; my $minus = ($func eq 'TZ') ? '+' : ''; if ($offset < 0) { $minus = '-'; $offset = -$offset; } my $duration = "${minus}PT"; if ($offset >= 60*60) { my $h = int($offset / (60*60)); $duration .= "${h}H" if ($h > 0); $hours = int($offset / (60*60)); $offset = $offset % (60*60); } if ($offset >= 60) { my $m = int($offset / 60); $duration .= "${m}M" if ($m > 0); $minutes = int($offset / 60); $offset = $offset % 60; } my $seconds = int($offset); my $s = int($offset); $duration .= "${s}S" if ($s > 0 or $duration eq 'PT'); return ($func eq 'TZ') ? Attean::Literal->new(sprintf('%s%02d:%02d', $minus, $hours, $minutes)) : Attean::Literal->new( value => $duration, datatype => "http://www.w3.org/2001/XMLSchema#dayTimeDuration"); } else { return Attean::Literal->new('') if ($func eq 'TZ'); die "TIMEZONE called without a valid dateTime"; } } elsif ($func eq 'NOW') { my $value = DateTime::Format::W3CDTF->new->format_datetime( DateTime->now ); return Attean::Literal->new( value => $value, datatype => 'http://www.w3.org/2001/XMLSchema#dateTime' ); } elsif ($func =~ /^(?:STR)?UUID$/) { return Attean::Literal->new(uc(uuid_to_string(create_uuid()))) if ($func eq 'STRUUID'); return Attean::IRI->new('urn:uuid:' . uc(uuid_to_string(create_uuid()))); } elsif ($func =~ /^(MD5|SHA1|SHA256|SHA384|SHA512)$/) { my $hash = $func =~ s/SHA/SHA-/r; my $digest = eval { Digest->new($hash)->add(encode('UTF-8', $operands[0]->value, Encode::FB_CROAK))->hexdigest }; return Attean::Literal->new($digest); } elsif ($func eq 'STRLANG') { my ($str, $lang) = @operands; my @values = map { $_->value } @operands; die "TypeError: STRLANG must be called with two plain literals" unless (blessed($str) and $str->does('Attean::API::Literal') and blessed($lang) and $lang->does('Attean::API::Literal')); die "TypeError: STRLANG not called with a simple literal" unless ($str->datatype->value eq 'http://www.w3.org/2001/XMLSchema#string' and not($str->language)); return Attean::Literal->new( value => $values[0], language => $values[1] ); } elsif ($func eq 'STRDT') { die "TypeError: STRDT" unless ($operands[0]->does('Attean::API::Literal') and not($operands[0]->language)); if (my $dt = $operands[0]->datatype) { die "TypeError: STRDT" unless ($dt->value eq 'http://www.w3.org/2001/XMLSchema#string'); } die "TypeError: STRDT" unless ($operands[1]->does('Attean::API::IRI')); my @values = map { $_->value } @operands; return Attean::Literal->new( value => $values[0], datatype => $values[1] ); } elsif ($func eq 'SAMETERM') { my ($a, $b) = @operands; die "TypeError: SAMETERM" unless (blessed($operands[0]) and blessed($operands[1])); my $cmp = eval { $a->compare($b) }; if (not($@) and $cmp) { return $false; } if ($a->does('Attean::API::Binding')) { my $ok = ($a->sameTerms($b)); return $ok ? $true : $false; } else { my $ok = ($a->value eq $b->value); return $ok ? $true : $false; } } elsif ($func =~ /^IS([UI]RI|BLANK|LITERAL|NUMERIC|TRIPLE)$/) { return $operands[0]->does("Attean::API::$type_roles{$1}") ? $true : $false; } elsif ($func eq 'REGEX') { my ($value, $pattern) = map { $_->value } @operands; return ($value =~ /$pattern/) ? $true : $false; } die "Unimplemented FunctionExpression evaluation: " . $expr->operator; } }; } elsif ($expr->isa('Attean::AggregateExpression')) { my $agg = $expr->operator; my ($child) = @{ $expr->children }; if ($agg eq 'COUNT') { if ($child) { my $impl = $self->impl($child, $active_graph); return sub { my ($rows, %args) = @_; my @terms = grep { blessed($_) } map { $impl->($_, %args) } @{ $rows }; if ($expr->distinct) { my %seen; @terms = grep { not($seen{$_->as_string}++) } @terms; } return Attean::Literal->integer(scalar(@terms)); }; } else { return sub { my ($rows, %args) = @_; return Attean::Literal->integer(scalar(@$rows)); }; } } elsif ($agg =~ /^(?:SAMPLE|MIN|MAX|SUM|AVG|GROUP_CONCAT|FOLD)$/) { my $impl = $self->impl($child, $active_graph); if ($agg eq 'SAMPLE') { return sub { my ($rows, %args) = @_; return $impl->( shift(@$rows), %args ) }; } elsif ($agg eq 'MIN' or $agg eq 'MAX') { my $expect = ($agg eq 'MIN') ? 1 : -1; return sub { my ($rows, %args) = @_; my $extrema; foreach my $r (@$rows) { my $t = $impl->( $r, %args ); return if (not($t) and $agg eq 'MIN'); # unbound is always minimal next if (not($t)); # unbound need not be considered for MAX $extrema = $t if (not($extrema) or $extrema->compare($t) == $expect); } return $extrema; }; } elsif ($agg eq 'SUM' or $agg eq 'AVG') { return sub { my ($rows, %args) = @_; my $count = 0; my $sum = Attean::Literal->integer(0); my %seen; foreach my $r (@$rows) { my $term = $impl->( $r, %args ); if ($expr->distinct) { next if ($seen{ $term->as_string }++); } if ($term->does('Attean::API::NumericLiteral')) { $count++; $sum = Attean::Literal->new( value => ($sum->numeric_value + $term->numeric_value), datatype => $sum->binary_promotion_type($term, '+') ); } else { die "TypeError: AVG"; } } if ($agg eq 'AVG') { $sum = not($count) ? undef : Attean::Literal->new( value => ($sum->numeric_value / $count), datatype => $sum->binary_promotion_type(Attean::Literal->integer($count), '/') ); } return $sum; }; } elsif ($agg eq 'GROUP_CONCAT') { my $sep = $expr->scalar_vars->{ 'seperator' } // ' '; return sub { my ($rows, %args) = @_; my %seen; my @strings; foreach my $r (@$rows) { my $term = eval { $impl->( $r, %args ) }; if ($expr->distinct) { next if ($seen{ blessed($term) ? $term->as_string : '' }++); } push(@strings, $term->value // ''); } return Attean::Literal->new(join($sep, sort @strings)); }; } elsif ($agg eq 'FOLD') { return sub { my ($rows, %args) = @_; my @children = @{ $expr->children }; my @impls = map { $self->impl($_, $active_graph) } @children; my $order = $expr->order || []; if (scalar(@$order)) { # sort $rows by the order condition my @cmps = @$order; my @exprs = map { $_->[1] } @cmps; my @dirs = map { $_->[0] eq 'ASC' } @cmps; my @sorted = map { $_->[0] } sort { my ($ar, $avalues) = @$a; my ($br, $bvalues) = @$b; my $c = 0; foreach my $i (0 .. $#cmps) { my ($av, $bv) = map { $_->[$i] } ($avalues, $bvalues); # Mirrors code in Attean::Plan::OrderBy->sort_rows if (not(blessed($av))) { $c = -1; } elsif (not(blessed($av))) { $c = 1; } elsif (blessed($av) and $av->does('Attean::API::Binding') and (not(defined($bv)) or not($bv->does('Attean::API::Binding')))) { $c = 1; } elsif (blessed($bv) and $bv->does('Attean::API::Binding') and (not(defined($av)) or not($av->does('Attean::API::Binding')))) { $c = -1; } else { $c = eval { $av ? $av->compare($bv) : 1 }; if ($@) { $c = 1; } } $c *= -1 if ($dirs[$i] == 0); last unless ($c == 0); } $c } map { my $r = $_; [$r, [map { $self->evaluate_expression( $_, $r, $active_graph, {} ) } @exprs]] } @$rows; $rows = \@sorted; } if (scalar(@impls) > 1) { my @values; foreach my $r (@$rows) { my ($key, $value) = map { eval { $_->( $r, %args ) } || undef } @impls; if (defined($key)) { push(@values, $key, $value); } } my $func = Attean->get_global_functional_form($AtteanX::Functions::CompositeMaps::MAP_TYPE_IRI); my $m = $func->(undef, undef, @values); return $m; } else { my %seen; my @values; foreach my $r (@$rows) { my $term = eval { $impl->( $r, %args ) }; if ($expr->distinct) { next if ($seen{ blessed($term) ? $term->as_string : '' }++); } push(@values, $term); } my $func = Attean->get_global_functional_form($AtteanX::Functions::CompositeLists::LIST_TYPE_IRI); my $l = $func->(undef, undef, @values); return $l; } }; } else { warn "Unexpected aggregate expression: $agg"; } } elsif ($agg eq 'CUSTOM') { my $iri = $expr->custom_iri; my $data = Attean->get_global_aggregate($iri); unless ($data) { die "No extension aggregate registered for <$iri>"; } my $start = $data->{'start'}; my $process = $data->{'process'}; my $finalize = $data->{'finalize'}; my $impl = $self->impl($child, $active_graph); return sub { my ($rows, %args) = @_; my $thunk = $start->($self->evaluator->model, $active_graph); foreach my $r (@$rows) { my $t = $impl->( $r, %args ); $process->($thunk, $t); } return $finalize->($thunk); }; } die "Unimplemented AggregateExpression evaluation: " . $expr->operator; } elsif ($expr->isa('Attean::CastExpression')) { my ($child) = @{ $expr->children }; my $impl = $self->impl( $child, $active_graph ); my $type = $expr->datatype; return sub { my ($r, %args) = @_; my $term = $impl->($r, %args); # TODO: reformat syntax for xsd:double my $cast = Attean::Literal->new( value => $term->value, datatype => $type ); return $cast->canonicalized_term_strict() if ($cast->does('Attean::API::CanonicalizingLiteral')); return $cast; } } else { Carp::confess "No impl for expression " . $expr->as_string; } } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/Literal.pm000644 000765 000024 00000000225 14636707547 020732 xustar00gregstaff000000 000000 30 mtime=1719373671.930458325 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/Literal.pm000644 000765 000024 00000007611 14636707547 016767 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::Literal - RDF Literals =head1 VERSION This document describes Attean::Literal version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my $langterm = Attean::Literal->new(value => 'foo', language => 'en-US'); $langterm->ntriples_string; # "foo"@en-US my $typeterm = Attean::Literal->new(value => '123', datatype => 'http://www.w3.org/2001/XMLSchema#integer'); $langterm->ntriples_string; # "123"^^ =head1 DESCRIPTION The Attean::Literal class represents RDF literals. It conforms to the L role. =head1 ATTRIBUTES The following attributes exist: =over 4 =item C<< value >> =item C<< language >> =item C<< datatype >> =back =head1 METHODS =over 4 =item C<< has_language >> Returns true if the literal has a language tag, false otherwise. =cut package Attean::Literal 0.034 { use Moo; use Types::Standard qw(Str Maybe InstanceOf); use Attean::API::Term; use IRI; use Sub::Install; use Sub::Util qw(set_subname); use Scalar::Util qw(blessed); use namespace::clean; my $XSD_STRING = IRI->new(value => 'http://www.w3.org/2001/XMLSchema#string'); has 'value' => (is => 'ro', isa => Str, required => 1); has 'language' => (is => 'ro', isa => Maybe[Str], predicate => 'has_language'); has 'datatype' => ( is => 'ro', isa => InstanceOf['Attean::IRI'], required => 1, coerce => sub { my $dt = shift; if (blessed($dt) and $dt->isa('Attean::IRI')) { return $dt; } else { return blessed($dt) ? Attean::IRI->new($dt->as_string) : Attean::IRI->new($dt) } }, default => sub { $XSD_STRING } ); has 'ntriples_string' => (is => 'ro', isa => Str, lazy => 1, builder => '_ntriples_string'); with 'Attean::API::Literal'; around BUILDARGS => sub { my $orig = shift; my $class = shift; return $class->$orig(@_) if (scalar(@_) == 1 and ref($_[0]) eq "HASH"); if (scalar(@_) == 1) { my $dt = IRI->new('http://www.w3.org/2001/XMLSchema#string'); return $class->$orig(value => shift, datatype => $dt); } return $class->$orig(@_); }; around 'datatype' => sub { my $orig = shift; my $self = shift; if ($self->has_language) { return Attean::IRI->new(value => 'http://www.w3.org/1999/02/22-rdf-syntax-ns#langString'); } else { return $self->$orig(@_); } }; sub _ntriples_string { my $self = shift; my $value = $self->value; $value =~ s/\\/\\\\/g; $value =~ s/\n/\\n/g; $value =~ s/\r/\\r/g; $value =~ s/"/\\"/g; if ($self->has_language) { return sprintf('"%s"@%s', $value, $self->language); } else { my $dt = $self->datatype->as_string; if ($dt eq 'http://www.w3.org/2001/XMLSchema#string') { return sprintf('"%s"', $value); } else { return sprintf('"%s"^^<%s>', $value, $dt); } } } =item C<< true >> The xsd:true term. =cut sub true { state $v = Attean::Literal->new( value => 'true', datatype => 'http://www.w3.org/2001/XMLSchema#boolean' ); return $v; } =item C<< false >> The xsd:false term. =cut sub false { state $v = Attean::Literal->new( value => 'false', datatype => 'http://www.w3.org/2001/XMLSchema#boolean' ); return $v; } { for my $method (qw(integer decimal float double)) { my $code = sub { my $class = shift; return $class->new( value => shift, datatype => "http://www.w3.org/2001/XMLSchema#$method" ); }; Sub::Install::install_sub({ code => set_subname("${method}", $code), as => "${method}" }); } } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/Algebra.pm000644 000765 000024 00000000225 14636707546 020672 xustar00gregstaff000000 000000 30 mtime=1719373670.993679425 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/Algebra.pm000644 000765 000024 00000133271 14636707546 016731 0ustar00gregstaff000000 000000 use v5.14; use warnings; use utf8; =head1 NAME Attean::Algebra - Representation of SPARQL algebra operators =head1 VERSION This document describes Attean::Algebra version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a utility package that defines all the Attean query algebra classes in the Attean::Algebra namespace: =over 4 =cut use Attean::API::Query; package Attean::Algebra::Query 0.034 { use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Types::Standard qw(Bool ArrayRef HashRef ConsumerOf); use Moo; use namespace::clean; has 'dataset' => (is => 'ro', isa => HashRef[ArrayRef[ConsumerOf['Attean::API::Term']]], default => sub { +{} }); has 'subquery' => (is => 'ro', isa => Bool, default => 0); with 'Attean::API::UnionScopeVariables', 'Attean::API::Algebra', 'Attean::API::UnaryQueryTree'; sub algebra_as_string { my $self = shift; my $name = $self->subquery ? 'SubQuery' : 'Query'; my %dataset = %{ $self->dataset }; my @default = @{ $dataset{ default } || [] }; my @named = @{ $dataset{ named } || [] }; my $has_dataset = (scalar(@default) + scalar(@named)); my $s = $name; if ($has_dataset) { my @parts; if (scalar(@default)) { push(@parts, 'Default graph(s): ' . join(', ', map { chomp; $_ } map { $_->as_sparql } @default)); } if (scalar(@named)) { push(@parts, 'Named graph(s): ' . join(', ', map { chomp; $_ } map { $_->as_sparql } @named)); } $s .= ' { ' . join('; ', @parts) . ' }'; } return $s; } sub sparql_tokens { my $self = shift; my $child = $self->child; my $l = AtteanX::SPARQL::Token->lbrace; my $r = AtteanX::SPARQL::Token->rbrace; my $from = AtteanX::SPARQL::Token->keyword('FROM'); my $named = AtteanX::SPARQL::Token->keyword('NAMED'); my %dataset = %{ $self->dataset }; my @default = @{ $dataset{ default } || [] }; my @named = @{ $dataset{ named } || [] }; my $has_dataset = (scalar(@default) + scalar(@named)); if ($child->does('Attean::API::SPARQLQuerySerializable')) { if ($self->subquery) { my @tokens; push(@tokens, $l); push(@tokens, $child->sparql_tokens->elements); push(@tokens, $r); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } else { my %args; if ($has_dataset) { $args{dataset} = $self->dataset; } return $child->query_tokens(%args); } } else { my $sel = AtteanX::SPARQL::Token->keyword('SELECT'); my $star = AtteanX::SPARQL::Token->star; my $where = AtteanX::SPARQL::Token->keyword('WHERE'); my @tokens; if ($self->subquery) { push(@tokens, $l); } push(@tokens, $sel, $star); if ($has_dataset) { foreach my $i (sort { $a->as_string cmp $b->as_string } @default) { push(@tokens, $from); push(@tokens, $i->sparql_tokens->elements); } foreach my $i (sort { $a->as_string cmp $b->as_string } @named) { push(@tokens, $from); push(@tokens, $named); push(@tokens, $i->sparql_tokens->elements); } } push(@tokens, $where); push(@tokens, $l); push(@tokens, $child->sparql_tokens->elements); push(@tokens, $r); if ($self->subquery) { push(@tokens, $r); } return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } } package Attean::Algebra::Update 0.034 { use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Types::Standard qw(Bool); use Moo; use namespace::clean; with 'Attean::API::UnionScopeVariables', 'Attean::API::Algebra', 'Attean::API::UnaryQueryTree'; sub algebra_as_string { return 'Update' } sub sparql_tokens { my $self = shift; my $child = $self->child; return $child->sparql_tokens; } } =item * L =cut package Attean::Algebra::Sequence 0.034 { use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Moo; use namespace::clean; with 'Attean::API::UnionScopeVariables', 'Attean::API::Algebra', 'Attean::API::QueryTree'; sub arity { my $self = shift; return scalar(@{ $self->children }); } sub algebra_as_string { return 'Sequence' } sub sparql_tokens { my $self = shift; my $semi = AtteanX::SPARQL::Token->semicolon; my @tokens; foreach my $t (@{ $self->children }) { push(@tokens, $t->sparql_tokens->elements); push(@tokens, $semi); } pop(@tokens); # remove last SEMICOLON token return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::Join 0.034 { use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Moo; use namespace::clean; with 'Attean::API::UnionScopeVariables', 'Attean::API::Algebra', 'Attean::API::QueryTree'; sub algebra_as_string { return 'Join' } sub sparql_tokens { my $self = shift; my $l = AtteanX::SPARQL::Token->lbrace; my $r = AtteanX::SPARQL::Token->rbrace; my @tokens; push(@tokens, $l); foreach my $t (@{ $self->children }) { push(@tokens, $t->sparql_subtokens->elements); } push(@tokens, $r); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::LeftJoin 0.034 { use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Moo; use Types::Standard qw(ConsumerOf); use namespace::clean; with 'Attean::API::UnionScopeVariables', 'Attean::API::Algebra', 'Attean::API::BinaryQueryTree'; has 'expression' => (is => 'ro', isa => ConsumerOf['Attean::API::Expression'], required => 1, default => sub { Attean::ValueExpression->new( value => Attean::Literal->true ) }); sub algebra_as_string { my $self = shift; return sprintf('LeftJoin { %s }', $self->expression->as_string); } sub tree_attributes { return qw(expression) }; sub sparql_tokens { my $self = shift; my $opt = AtteanX::SPARQL::Token->keyword('OPTIONAL'); my $l = AtteanX::SPARQL::Token->lbrace; my $r = AtteanX::SPARQL::Token->rbrace; my ($lhs, $rhs) = @{ $self->children }; my @tokens; push(@tokens, $l); push(@tokens, $lhs->sparql_subtokens->elements); push(@tokens, $r, $opt, $l); push(@tokens, $rhs->sparql_subtokens->elements); my $expr = $self->expression; my $is_true = 0; if ($expr->isa('Attean::ValueExpression')) { my $value = $expr->value; if ($value->equals(Attean::Literal->true)) { $is_true = 1; } } unless ($is_true) { my $f = AtteanX::SPARQL::Token->keyword('FILTER'); my $lparen = AtteanX::SPARQL::Token->lparen; my $rparen = AtteanX::SPARQL::Token->rparen; push(@tokens, $f); push(@tokens, $lparen); push(@tokens, $expr->sparql_tokens->elements); push(@tokens, $rparen); } push(@tokens, $r); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::Filter 0.034 { use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Moo; use Types::Standard qw(ConsumerOf); use namespace::clean; with 'Attean::API::UnionScopeVariables', 'Attean::API::Algebra', 'Attean::API::UnaryQueryTree'; has 'expression' => (is => 'ro', isa => ConsumerOf['Attean::API::Expression'], required => 1); sub algebra_as_string { my $self = shift; return sprintf('Filter { %s }', $self->expression->as_string); } sub tree_attributes { return qw(expression) }; sub sparql_tokens { my $self = shift; my $f = AtteanX::SPARQL::Token->keyword('FILTER'); my $l = AtteanX::SPARQL::Token->lparen; my $r = AtteanX::SPARQL::Token->rparen; my ($child) = @{ $self->children }; my $expr = $self->expression; my @tokens; push(@tokens, $child->sparql_tokens->elements); push(@tokens, $f); push(@tokens, $l); push(@tokens, $expr->sparql_tokens->elements); push(@tokens, $r); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::Union 0.034 { use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Moo; use Types::Standard qw(ConsumerOf); use namespace::clean; with 'Attean::API::UnionScopeVariables', 'Attean::API::Algebra', 'Attean::API::BinaryQueryTree'; sub algebra_as_string { return 'Union' } sub sparql_tokens { my $self = shift; my $union = AtteanX::SPARQL::Token->keyword('UNION'); my $l = AtteanX::SPARQL::Token->lbrace; my $r = AtteanX::SPARQL::Token->rbrace; my ($lhs, $rhs) = @{ $self->children }; my @tokens; push(@tokens, $l); push(@tokens, $lhs->sparql_subtokens->elements); push(@tokens, $r, $union, $l); push(@tokens, $rhs->sparql_subtokens->elements); push(@tokens, $r); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::Graph 0.034 { use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Moo; use Types::Standard qw(ConsumerOf); use namespace::clean; with 'Attean::API::Algebra', 'Attean::API::UnaryQueryTree'; has 'graph' => (is => 'ro', isa => ConsumerOf['Attean::API::TermOrVariable'], required => 1); sub in_scope_variables { my $self = shift; my $graph = $self->graph; my ($child) = @{ $self->children }; my @vars = $child->in_scope_variables; if ($graph->does('Attean::API::Variable')) { return Set::Scalar->new(@vars, $graph->value)->elements; } else { return @vars; } } sub algebra_as_string { my $self = shift; return sprintf('Graph %s', $self->graph->as_string); } sub tree_attributes { return qw(graph) }; sub sparql_tokens { my $self = shift; my $graph = AtteanX::SPARQL::Token->keyword('GRAPH'); my $l = AtteanX::SPARQL::Token->lbrace; my $r = AtteanX::SPARQL::Token->rbrace; my ($child) = @{ $self->children }; my @tokens; push(@tokens, $graph); push(@tokens, $self->graph->sparql_tokens->elements); push(@tokens, $l); push(@tokens, $child->sparql_subtokens->elements); push(@tokens, $r); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::Extend 0.034 { use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Moo; use Types::Standard qw(ConsumerOf); use namespace::clean; sub in_scope_variables { my $self = shift; my ($child) = @{ $self->children }; my @vars = $child->in_scope_variables; return Set::Scalar->new(@vars, $self->variable->value)->elements; } with 'Attean::API::Algebra', 'Attean::API::UnaryQueryTree'; has 'variable' => (is => 'ro', isa => ConsumerOf['Attean::API::Variable'], required => 1); has 'expression' => (is => 'ro', isa => ConsumerOf['Attean::API::Expression'], required => 1); sub algebra_as_string { my $self = shift; return sprintf('Extend { %s ↠%s }', $self->variable->as_string, $self->expression->as_string); } sub tree_attributes { return qw(variable expression) }; sub sparql_tokens { my $self = shift; my $bind = AtteanX::SPARQL::Token->keyword('BIND'); my $as = AtteanX::SPARQL::Token->keyword('AS'); my $l = AtteanX::SPARQL::Token->lparen; my $r = AtteanX::SPARQL::Token->rparen; my ($child) = @{ $self->children }; my $var = $self->variable; my $expr = $self->expression; my @tokens; push(@tokens, $child->sparql_tokens->elements); push(@tokens, $bind); push(@tokens, $l); push(@tokens, $expr->sparql_tokens->elements); push(@tokens, $as); push(@tokens, $var->sparql_tokens->elements); push(@tokens, $r); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::Unfold 0.031 { use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Moo; use Types::Standard qw(ArrayRef ConsumerOf); use namespace::clean; sub in_scope_variables { my $self = shift; my ($child) = @{ $self->children }; my @vars = $child->in_scope_variables; return Set::Scalar->new(@vars, map { $_->value } @{ $self->variables })->elements; } with 'Attean::API::Algebra', 'Attean::API::UnaryQueryTree'; has 'variables' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Variable']], required => 1); has 'expression' => (is => 'ro', isa => ConsumerOf['Attean::API::Expression'], required => 1); sub algebra_as_string { my $self = shift; my @vars = map { $_->as_string } @{ $self->variables }; my $vars = '(' . join(', ', @vars) . ')'; return sprintf('Unfold { %s ↠%s }', $vars, $self->expression->as_string); } sub tree_attributes { return qw(variables expression) }; sub sparql_tokens { my $self = shift; my $explode = AtteanX::SPARQL::Token->keyword('UNFOLD'); my $as = AtteanX::SPARQL::Token->keyword('AS'); my $l = AtteanX::SPARQL::Token->lparen; my $r = AtteanX::SPARQL::Token->rparen; my ($child) = @{ $self->children }; my @vars = @{ $self->variables }; my $expr = $self->expression; my @tokens; push(@tokens, $child->sparql_tokens->elements); push(@tokens, $explode); push(@tokens, $l); push(@tokens, $expr->sparql_tokens->elements); push(@tokens, $as); foreach my $i (0 .. $#vars) { my $var = $vars[$i]; if ($i > 0) { push(@tokens, AtteanX::SPARQL::Token->comma); } push(@tokens, $var->sparql_tokens->elements); } push(@tokens, $r); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::Minus 0.034 { use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Moo; use Types::Standard qw(ConsumerOf); use namespace::clean; with 'Attean::API::Algebra', 'Attean::API::BinaryQueryTree'; sub in_scope_variables { my $self = shift; my ($child) = @{ $self->children }; return $child->in_scope_variables; } sub algebra_as_string { return 'Minus' } sub sparql_tokens { my $self = shift; my $minus = AtteanX::SPARQL::Token->keyword('MINUS'); my $l = AtteanX::SPARQL::Token->lbrace; my $r = AtteanX::SPARQL::Token->rbrace; my ($lhs, $rhs) = @{ $self->children }; my @tokens; push(@tokens, $l); push(@tokens, $lhs->sparql_subtokens->elements); push(@tokens, $r, $minus, $l); push(@tokens, $rhs->sparql_subtokens->elements); push(@tokens, $r); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::Distinct 0.034 { use Moo; use namespace::clean; with 'Attean::API::SPARQLQuerySerializable'; with 'Attean::API::UnionScopeVariables', 'Attean::API::Algebra', 'Attean::API::UnaryQueryTree'; sub algebra_as_string { return 'Distinct' } } =item * L =cut package Attean::Algebra::Reduced 0.034 { use Moo; use namespace::clean; with 'Attean::API::SPARQLQuerySerializable'; with 'Attean::API::UnionScopeVariables', 'Attean::API::Algebra', 'Attean::API::UnaryQueryTree'; sub algebra_as_string { return 'Reduced' } } =item * L =cut package Attean::Algebra::Slice 0.034 { use Moo; use Types::Standard qw(Int); use namespace::clean; with 'Attean::API::SPARQLQuerySerializable'; with 'Attean::API::UnionScopeVariables', 'Attean::API::Algebra', 'Attean::API::UnaryQueryTree'; has 'limit' => (is => 'ro', isa => Int, default => -1); has 'offset' => (is => 'ro', isa => Int, default => 0); sub algebra_as_string { my $self = shift; my @str = ('Slice'); push(@str, "Limit=" . $self->limit) if ($self->limit >= 0); push(@str, "Offset=" . $self->offset) if ($self->offset > 0); return join(' ', @str); } } =item * L =cut package Attean::Algebra::Project 0.034 { use Types::Standard qw(ArrayRef ConsumerOf); use Moo; use namespace::clean; with 'Attean::API::SPARQLQuerySerializable'; with 'Attean::API::Algebra', 'Attean::API::UnaryQueryTree'; has 'variables' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Variable']], required => 1); sub in_scope_variables { my $self = shift; my ($child) = @{ $self->children }; my $set = Set::Scalar->new( $child->in_scope_variables ); my $proj = Set::Scalar->new( map { $_->value } @{ $self->variables } ); return $set->intersection($proj)->elements; } sub algebra_as_string { my $self = shift; return sprintf('Project { %s }', join(' ', map { '?' . $_->value } @{ $self->variables })); } sub tree_attributes { return qw(variables) }; } =item * L =cut package Attean::Algebra::Comparator 0.034 { use Moo; use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Types::Standard qw(Bool ConsumerOf); use namespace::clean; has 'ascending' => (is => 'ro', isa => Bool, default => 1); has 'expression' => (is => 'ro', isa => ConsumerOf['Attean::API::Expression'], required => 1); sub tree_attributes { return qw(expression) }; sub as_string { my $self = shift; if ($self->ascending) { return 'ASC(' . $self->expression->as_string . ')'; } else { return 'DESC(' . $self->expression->as_string . ')'; } } sub sparql_tokens { my $self = shift; my $asc = AtteanX::SPARQL::Token->keyword('ASC'); my $desc = AtteanX::SPARQL::Token->keyword('DESC'); my $l = AtteanX::SPARQL::Token->lparen; my $r = AtteanX::SPARQL::Token->rparen; my @tokens; if ($self->ascending) { push(@tokens, $self->expression->sparql_tokens->elements); } else { push(@tokens, $desc, $l); push(@tokens, $self->expression->sparql_tokens->elements); push(@tokens, $r); } return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::OrderBy 0.034 { use Moo; use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Types::Standard qw(ArrayRef InstanceOf); use namespace::clean; with 'Attean::API::SPARQLQuerySerializable'; with 'Attean::API::UnionScopeVariables', 'Attean::API::Algebra', 'Attean::API::UnaryQueryTree'; has 'comparators' => (is => 'ro', isa => ArrayRef[InstanceOf['Attean::Algebra::Comparator']], required => 1); sub tree_attributes { return qw(comparators) }; sub algebra_as_string { my $self = shift; return sprintf('Order { %s }', join(', ', map { $_->as_string } @{ $self->comparators })); } } =item * L =cut package Attean::Algebra::BGP 0.034 { use Moo; use Attean::RDF; use Set::Scalar; use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Types::Standard qw(ArrayRef ConsumerOf); use namespace::clean; with 'Attean::API::Algebra', 'Attean::API::NullaryQueryTree', 'Attean::API::CanonicalizingBindingSet'; has 'triples' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::TriplePattern']], default => sub { [] }); sub in_scope_variables { my $self = shift; my $set = Set::Scalar->new(); foreach my $t (@{ $self->triples }) { my @vars = $t->referenced_variables(); $set->insert(@vars); } return $set->elements; } sub sparql_tokens { my $self = shift; my @tokens; my $dot = AtteanX::SPARQL::Token->dot; foreach my $t (@{ $self->triples }) { push(@tokens, $t->sparql_tokens->elements); push(@tokens, $dot); } return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } sub algebra_as_string { my $self = shift; return 'BGP { ' . join(', ', map { $_->as_string } @{ $self->triples }) . ' }'; } sub elements { my $self = shift; return @{ $self->triples }; } sub canonicalize { my $self = shift; my ($algebra, $mapping) = $self->canonical_bgp_with_mapping(); my @proj = sort map { sprintf("(?v%03d AS $_)", $mapping->{$_}{id}) } grep { $mapping->{$_}{type} eq 'variable' } (keys %$mapping); foreach my $var (keys %$mapping) { $algebra = Attean::Algebra::Extend->new( children => [$algebra], variable => variable($var), expression => Attean::ValueExpression->new( value => variable($mapping->{$var}{id}) ), ); } } sub canonical_bgp_with_mapping { my $self = shift; my ($triples, $mapping) = $self->canonical_set_with_mapping(); my $algebra = Attean::Algebra::BGP->new( triples => $triples ); return ($algebra, $mapping); } sub tree_attributes { return qw(triples) }; } =item * L =cut package Attean::Algebra::Service 0.034 { use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Moo; use Types::Standard qw(ConsumerOf Bool); use namespace::clean; with 'Attean::API::Algebra', 'Attean::API::UnaryQueryTree', 'Attean::API::UnionScopeVariables'; has 'endpoint' => (is => 'ro', isa => ConsumerOf['Attean::API::TermOrVariable'], required => 1); has 'silent' => (is => 'ro', isa => Bool, default => 0); sub algebra_as_string { my $self = shift; my $endpoint = $self->endpoint->as_sparql; chomp($endpoint); return sprintf('Service %s', $endpoint); } sub tree_attributes { return qw(endpoint) }; sub sparql_tokens { my $self = shift; my $service = AtteanX::SPARQL::Token->keyword('SERVICE'); my $l = AtteanX::SPARQL::Token->lbrace; my $r = AtteanX::SPARQL::Token->rbrace; my ($child) = @{ $self->children }; my @tokens; push(@tokens, $service); if ($self->silent) { push(@tokens, AtteanX::SPARQL::Token->keyword('SILENT')); } push(@tokens, $self->endpoint->sparql_tokens->elements); push(@tokens, $l); push(@tokens, $child->sparql_subtokens->elements); push(@tokens, $r); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::Path 0.034 { use Moo; use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Types::Standard qw(ArrayRef ConsumerOf); use namespace::clean; with 'Attean::API::Algebra', 'Attean::API::NullaryQueryTree'; has 'subject' => (is => 'ro', isa => ConsumerOf['Attean::API::TermOrVariableOrTriplePattern'], required => 1); has 'path' => (is => 'ro', isa => ConsumerOf['Attean::API::PropertyPath'], required => 1); has 'object' => (is => 'ro', isa => ConsumerOf['Attean::API::TermOrVariableOrTriplePattern'], required => 1); sub in_scope_variables { my $self = shift; my @vars = map { $_->value } grep { $_->does('Attean::API::Variable') } ($self->subject, $self->object); return Set::Scalar->new(@vars)->elements; } sub tree_attributes { return qw(subject path object) }; sub algebra_as_string { my $self = shift; return 'Path { ' . join(', ', map { $_->as_string } map { $self->$_() } qw(subject path object)) . ' }'; } sub sparql_tokens { my $self = shift; my @tokens; foreach my $t ($self->subject, $self->path, $self->object) { push(@tokens, $t->sparql_tokens->elements); } return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::Group 0.034 { use utf8; use Moo; use Attean::API::Query; use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Types::Standard qw(ArrayRef ConsumerOf); use namespace::clean; with 'Attean::API::SPARQLQuerySerializable'; with 'Attean::API::Algebra', 'Attean::API::UnaryQueryTree'; has 'groupby' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Expression']]); has 'aggregates' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::AggregateExpression']]); sub BUILD { my $self = shift; foreach my $a (@{ $self->aggregates }) { my $op = $a->operator; if ($op eq 'RANK') { if (scalar(@{ $self->aggregates }) > 1) { die "Cannot use both aggregates and RANKing in grouping operator"; } } } } sub in_scope_variables { my $self = shift; my $aggs = $self->aggregates // []; my $groups = $self->groupby // []; my %vars; foreach my $a (@$aggs) { $vars{ $a->variable->value }++; } foreach my $e (@$groups) { if ($e->isa('Attean::ValueExpression')) { my $value = $e->value; if ($value->does('Attean::API::Variable')) { $vars{ $value->value }++; } } } return keys %vars; } sub algebra_as_string { my $self = shift; my @aggs; my $aggs = $self->aggregates // []; my $groups = $self->groupby // []; foreach my $a (@$aggs) { my $v = $a->variable->as_string; my $op = $a->operator; my $d = $a->distinct ? "DISTINCT " : ''; my ($e) = ((map { $_->as_string } @{ $a->children }), ''); my $s = "$v ↠${op}($d$e)"; push(@aggs, $s); } return sprintf('Group { %s } aggregate { %s }', join(', ', map { $_->as_string() } @$groups), join(', ', @aggs)); } sub tree_attributes { return qw(groupby aggregates) }; } =item * L =cut package Attean::Algebra::NegatedPropertySet 0.034 { use Moo; use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Types::Standard qw(ArrayRef ConsumerOf); use namespace::clean; with 'Attean::API::PropertyPath'; has 'predicates' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::IRI']], required => 0, default => sub { [] }); has 'reversed' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::IRI']], required => 0, default => sub { [] }); sub as_string { my $self = shift; my @forward = map { $_->ntriples_string } @{ $self->predicates }; my @rev = map { '^' . $_->ntriples_string } @{ $self->reversed }; return sprintf("!(%s)", join('|', @forward, @rev)); } sub algebra_as_string { return 'NPS' } sub tree_attributes { return qw(predicates reversed) }; sub as_sparql { my $self = shift; my @forward = map { $_->as_sparql } @{ $self->predicates }; my @rev = map { '^' . $_->as_sparql } @{ $self->reversed }; return sprintf("!(%s)", join('|', @forward, @rev)); } sub sparql_tokens { my $self = shift; my $bang = AtteanX::SPARQL::Token->op_bang; my $or = AtteanX::SPARQL::Token->path_or; my $hat = AtteanX::SPARQL::Token->path_hat; my $l = AtteanX::SPARQL::Token->lparen; my $r = AtteanX::SPARQL::Token->rparen; my @tokens; push(@tokens, $bang, $l); foreach my $t (@{ $self->predicates }) { push(@tokens, $t->sparql_tokens->elements); push(@tokens, $or); } foreach my $t (@{ $self->reversed }) { push(@tokens, $hat); push(@tokens, $t->sparql_tokens->elements); push(@tokens, $or); } pop(@tokens); # remove last OR token push(@tokens, $r); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::PredicatePath 0.034 { use Moo; use Types::Standard qw(ConsumerOf); use namespace::clean; with 'Attean::API::PropertyPath'; has 'predicate' => (is => 'ro', isa => ConsumerOf['Attean::API::IRI'], required => 1); sub as_string { my $self = shift; return $self->predicate->ntriples_string; } sub algebra_as_string { my $self = shift; return 'Property Path ' . $self->as_string; } sub tree_attributes { return qw(predicate) }; sub as_sparql { my $self = shift; return $self->predicate->as_sparql; } sub sparql_tokens { my $self = shift; return $self->predicate->sparql_tokens; } } =item * L =cut package Attean::Algebra::InversePath 0.034 { use Moo; use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Types::Standard qw(ConsumerOf); use namespace::clean; with 'Attean::API::UnaryPropertyPath'; sub prefix_name { return "^" } sub as_sparql { my $self = shift; my ($path) = @{ $self->children }; return '^' . $self->path->as_sparql; } sub sparql_tokens { my $self = shift; my $hat = AtteanX::SPARQL::Token->path_hat; my $l = AtteanX::SPARQL::Token->lparen; my $r = AtteanX::SPARQL::Token->rparen; my @tokens; foreach my $t (@{ $self->children }) { push(@tokens, $t->sparql_tokens->elements); } if (scalar(@tokens) > 1) { unshift(@tokens, $hat, $l); push(@tokens, $r); } else { unshift(@tokens, $hat); } return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::SequencePath 0.034 { use Moo; use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use namespace::clean; with 'Attean::API::NaryPropertyPath'; sub separator { return "/" } sub as_sparql { my $self = shift; my @paths = @{ $self->children }; return '(' . join('/', map { $_->as_sparql } @paths) . ')'; } sub sparql_tokens { my $self = shift; my $slash = AtteanX::SPARQL::Token->slash; my @tokens; foreach my $t (@{ $self->children }) { push(@tokens, $t->sparql_tokens->elements); push(@tokens, $slash); } pop(@tokens); # remove last SLASH token return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::AlternativePath 0.034 { use Moo; use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use namespace::clean; with 'Attean::API::NaryPropertyPath'; sub separator { return "|" } sub as_sparql { my $self = shift; my @paths = @{ $self->children }; return '(' . join('|', map { $_->as_sparql } @paths) . ')'; } sub sparql_tokens { my $self = shift; my $or = AtteanX::SPARQL::Token->path_or; my @tokens; foreach my $t (@{ $self->children }) { push(@tokens, $t->sparql_tokens->elements); push(@tokens, $or); } pop(@tokens); # remove last OR token return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::ZeroOrMorePath 0.034 { use Moo; use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Types::Standard qw(ConsumerOf); use namespace::clean; with 'Attean::API::UnaryPropertyPath'; sub postfix_name { return "*" } sub as_sparql { my $self = shift; my ($path) = @{ $self->children }; return $self->path->as_sparql . '*'; } sub sparql_tokens { my $self = shift; my $star = AtteanX::SPARQL::Token->star; my $l = AtteanX::SPARQL::Token->lparen; my $r = AtteanX::SPARQL::Token->rparen; my @tokens; foreach my $t (@{ $self->children }) { push(@tokens, $t->sparql_tokens->elements); } if (scalar(@tokens) > 1) { unshift(@tokens, $l); push(@tokens, $r); } push(@tokens, $star); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::OneOrMorePath 0.034 { use Moo; use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Types::Standard qw(ConsumerOf); use namespace::clean; with 'Attean::API::UnaryPropertyPath'; sub postfix_name { return "+" } sub as_sparql { my $self = shift; my ($path) = @{ $self->children }; return $self->path->as_sparql . '+'; } sub sparql_tokens { my $self = shift; my $plus = AtteanX::SPARQL::Token->op_plus; my $l = AtteanX::SPARQL::Token->lparen; my $r = AtteanX::SPARQL::Token->rparen; my @tokens; foreach my $t (@{ $self->children }) { push(@tokens, $t->sparql_tokens->elements); } if (scalar(@tokens) > 1) { unshift(@tokens, $l); push(@tokens, $r); } push(@tokens, $plus); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::ZeroOrOnePath 0.034 { use Moo; use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Types::Standard qw(ConsumerOf); use namespace::clean; with 'Attean::API::UnaryPropertyPath'; sub postfix_name { return "?" } sub as_sparql { my $self = shift; my ($path) = @{ $self->children }; return $self->path->as_sparql . '?'; } sub sparql_tokens { my $self = shift; my $q = AtteanX::SPARQL::Token->question; my $l = AtteanX::SPARQL::Token->lparen; my $r = AtteanX::SPARQL::Token->rparen; my @tokens; foreach my $t (@{ $self->children }) { push(@tokens, $t->sparql_tokens->elements); } if (scalar(@tokens) > 1) { unshift(@tokens, $l); push(@tokens, $r); } push(@tokens, $q); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::Table 0.034 { use Moo; use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Types::Standard qw(ArrayRef ConsumerOf); use namespace::clean; with 'Attean::API::Algebra', 'Attean::API::NullaryQueryTree'; has variables => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Variable']]); has rows => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Result']]); sub in_scope_variables { my $self = shift; return map { $_->value } @{ $self->variables }; } sub tree_attributes { return qw(variables rows) }; sub algebra_as_string { return 'Table' } sub sparql_tokens { my $self = shift; my $values = AtteanX::SPARQL::Token->keyword('VALUES'); my $lparen = AtteanX::SPARQL::Token->lparen; my $rparen = AtteanX::SPARQL::Token->rparen; my $lbrace = AtteanX::SPARQL::Token->lbrace; my $rbrace = AtteanX::SPARQL::Token->rbrace; my @tokens; push(@tokens, $values); push(@tokens, $lparen); foreach my $var (@{ $self->variables }) { push(@tokens, $var->sparql_tokens->elements); } push(@tokens, $rparen); push(@tokens, $lbrace); foreach my $row (@{ $self->rows }) { push(@tokens, $lparen); foreach my $val ($row->values) { # TODO: verify correct serialization of UNDEF push(@tokens, $val->sparql_tokens->elements); } push(@tokens, $rparen); } push(@tokens, $rbrace); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::Ask 0.034 { use Moo; use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use namespace::clean; with 'Attean::API::SPARQLQuerySerializable'; with 'Attean::API::Algebra', 'Attean::API::UnaryQueryTree'; sub in_scope_variables { return; } sub algebra_as_string { return 'Ask' } } =item * L =cut package Attean::Algebra::Construct 0.034 { use Moo; use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Types::Standard qw(ArrayRef ConsumerOf); use namespace::clean; with 'Attean::API::SPARQLQuerySerializable'; with 'Attean::API::Algebra', 'Attean::API::UnaryQueryTree'; has 'triples' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::TriplePattern']]); sub in_scope_variables { return qw(subject predicate object); } sub tree_attributes { return; } sub algebra_as_string { my $self = shift; my $triples = $self->triples; return sprintf('Construct { %s }', join(' . ', map { $_->as_string } @$triples)); } } =item * L =cut package Attean::Algebra::Describe 0.034 { use Moo; use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Types::Standard qw(ArrayRef ConsumerOf); use namespace::clean; with 'Attean::API::SPARQLQuerySerializable'; with 'Attean::API::Algebra', 'Attean::API::UnaryQueryTree'; has 'terms' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::TermOrVariable']]); sub in_scope_variables { return qw(subject predicate object); } sub tree_attributes { return; } sub algebra_as_string { return 'Describe' } } =item * L =cut package Attean::Algebra::Load 0.034 { use Moo; use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Types::Standard qw(Bool ConsumerOf); use namespace::clean; with 'Attean::API::Algebra', 'Attean::API::NullaryQueryTree'; has 'silent' => (is => 'ro', isa => Bool, default => 0); has 'url' => (is => 'ro', isa => ConsumerOf['Attean::API::IRI'], required => 1); has 'graph' => (is => 'ro', isa => ConsumerOf['Attean::API::Term'], predicate => 'has_graph'); sub in_scope_variables { return; } sub tree_attributes { return; } sub algebra_as_string { my $self = shift; return 'Load ' . $self->url->as_string; } sub sparql_tokens { my $self = shift; my @tokens; push(@tokens, AtteanX::SPARQL::Token->keyword('LOAD')); if ($self->silent) { push(@tokens, AtteanX::SPARQL::Token->keyword('SILENT')); } push(@tokens, $self->url->sparql_tokens->elements); if ($self->has_graph) { push(@tokens, AtteanX::SPARQL::Token->keyword('INTO')); push(@tokens, AtteanX::SPARQL::Token->keyword('GRAPH')); push(@tokens, $self->graph->sparql_tokens->elements); } return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::Clear 0.034 { use Moo; use Scalar::Util qw(blessed); use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Types::Standard qw(Enum Bool ConsumerOf); use namespace::clean; with 'Attean::API::Algebra', 'Attean::API::NullaryQueryTree'; has 'drop' => (is => 'ro', isa => Bool, default => 0); has 'silent' => (is => 'ro', isa => Bool, default => 0); has 'target' => (is => 'ro', isa => Enum[qw(GRAPH DEFAULT NAMED ALL)], required => 1); has 'graph' => (is => 'ro', isa => ConsumerOf['Attean::API::Term']); sub BUILD { my $self = shift; if ($self->target eq 'GRAPH') { unless (blessed($self->graph)) { die "Attean::Algebra::Clear operations with a GRAPH target must include a graph IRI"; } } } sub in_scope_variables { return; } sub tree_attributes { return; } sub algebra_as_string { my $self = shift; return $self->drop ? 'Drop' : 'Clear'; } sub sparql_tokens { my $self = shift; my @tokens; push(@tokens, AtteanX::SPARQL::Token->keyword($self->drop ? 'DROP' : 'CLEAR')); if ($self->silent) { push(@tokens, AtteanX::SPARQL::Token->keyword('SILENT')); } if ($self->target =~ /^(DEFAULT|NAMED|ALL)$/) { push(@tokens, AtteanX::SPARQL::Token->keyword($self->target)); } else { push(@tokens, AtteanX::SPARQL::Token->keyword('GRAPH')); push(@tokens, $self->graph->sparql_tokens->elements); } return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::Create 0.034 { use Moo; use Scalar::Util qw(blessed); use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Types::Standard qw(Bool ConsumerOf); use namespace::clean; with 'Attean::API::Algebra', 'Attean::API::NullaryQueryTree'; has 'silent' => (is => 'ro', isa => Bool, default => 0); has 'graph' => (is => 'ro', isa => ConsumerOf['Attean::API::Term'], required => 1); sub in_scope_variables { return; } sub tree_attributes { return; } sub algebra_as_string { return 'Create' } sub sparql_tokens { my $self = shift; my @tokens; push(@tokens, AtteanX::SPARQL::Token->keyword('CREATE')); if ($self->silent) { push(@tokens, AtteanX::SPARQL::Token->keyword('SILENT')); } push(@tokens, AtteanX::SPARQL::Token->keyword('GRAPH')); push(@tokens, $self->graph->sparql_tokens->elements); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::Add 0.034 { use Moo; use Scalar::Util qw(blessed); use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Types::Standard qw(Enum Bool ConsumerOf); use namespace::clean; with 'Attean::API::Algebra', 'Attean::API::NullaryQueryTree'; has 'silent' => (is => 'ro', isa => Bool, default => 0); has 'drop_source' => (is => 'ro', isa => Bool, default => 0); has 'drop_destination' => (is => 'ro', isa => Bool, default => 0); has 'source' => (is => 'ro', isa => ConsumerOf['Attean::API::Term'], predicate => 'has_source'); has 'destination' => (is => 'ro', isa => ConsumerOf['Attean::API::Term'], predicate => 'has_destination'); sub in_scope_variables { return; } sub tree_attributes { return; } sub algebra_as_string { my $self = shift; return ($self->drop_source and $self->drop_destination) ? 'Move' : ($self->drop_destination) ? 'Copy' : 'Add'; } sub sparql_tokens { my $self = shift; my @tokens; my $op = ($self->drop_source and $self->drop_destination) ? 'MOVE' : ($self->drop_destination) ? 'COPY' : 'ADD'; push(@tokens, AtteanX::SPARQL::Token->keyword($op)); if ($self->silent) { push(@tokens, AtteanX::SPARQL::Token->keyword('SILENT')); } if ($self->has_source) { push(@tokens, AtteanX::SPARQL::Token->keyword('GRAPH')); push(@tokens, $self->source->sparql_tokens->elements); } else { push(@tokens, AtteanX::SPARQL::Token->keyword('DEFAULT')); } push(@tokens, AtteanX::SPARQL::Token->keyword('TO')); if ($self->has_destination) { push(@tokens, AtteanX::SPARQL::Token->keyword('GRAPH')); push(@tokens, $self->destination->sparql_tokens->elements); } else { push(@tokens, AtteanX::SPARQL::Token->keyword('DEFAULT')); } return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } =item * L =cut package Attean::Algebra::Modify 0.034 { use Moo; use Scalar::Util qw(blessed); use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use List::MoreUtils qw(all any); use Types::Standard qw(HashRef ArrayRef ConsumerOf); use namespace::clean; with 'Attean::API::Algebra', 'Attean::API::QueryTree'; has 'dataset' => (is => 'ro', isa => HashRef, default => sub { +{} }); has 'insert' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::TripleOrQuadPattern']], default => sub { [] }); has 'delete' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::TripleOrQuadPattern']], default => sub { [] }); sub in_scope_variables { return; } sub tree_attributes { return; } sub _op_type { my $self = shift; my $i = scalar(@{ $self->insert }); my $d = scalar(@{ $self->delete }); my $w = scalar(@{ $self->children }); my $ig = all { $_->is_ground } @{ $self->insert }; my $dg = all { $_->is_ground } @{ $self->delete }; if ($i and not $d) { # INSERT return ($ig and not $w) ? 'ID' : 'I'; } elsif ($d and not $i) { # DELETE return ($dg and not $w) ? 'DD' : 'D'; } else { # INSERT + DELETE return 'U' } } around 'blank_nodes' => sub { my $orig = shift; my $self = shift; my @blanks = $orig->($self, @_); my %seen = map { $_->value => 1 } @blanks; foreach my $data ($self->insert, $self->delete) { my @triples = @{ $data }; my @b = grep { $_->does('Attean::API::Blank') } map { $_->values } @triples; push(@blanks, grep { not $seen{$_->value}++ } @b); } return @blanks; }; sub algebra_as_string { my $self = shift; my $level = shift; my $indent = ' ' x ($level + 1); state $S = { 'ID' => 'Insert Data', 'I' => 'Insert', 'DD' => 'Delete Data', 'D' => 'Delete', 'U' => 'Update', }; my $op = $self->_op_type(); my $s = $S->{ $op }; my @data; my $ic = scalar(@{ $self->insert }); my $dc = scalar(@{ $self->delete }); if ($ic) { my $name = $dc ? 'Insert Data' : 'Data'; push(@data, [$name, $self->insert]); } if ($dc) { my $name = $ic ? 'Delete Data' : 'Data'; push(@data, [$name, $self->delete]); } foreach my $data (@data) { my ($name, $quads) = @$data; $s .= "\n-${indent} $name"; foreach my $q (@$quads) { $s .= "\n-${indent} " . $q->as_string; } } return $s; } sub sparql_tokens { my $self = shift; my $op = $self->_op_type(); my $l = AtteanX::SPARQL::Token->lbrace; my $r = AtteanX::SPARQL::Token->rbrace; my $dot = AtteanX::SPARQL::Token->dot; my $data = AtteanX::SPARQL::Token->keyword('DATA'); my $insert = AtteanX::SPARQL::Token->keyword('INSERT'); my $delete = AtteanX::SPARQL::Token->keyword('DELETE'); my $where = AtteanX::SPARQL::Token->keyword('WHERE'); my $using = AtteanX::SPARQL::Token->keyword('USING'); my $named = AtteanX::SPARQL::Token->keyword('NAMED'); # TODO: Support 'DELETE WHERE' shortcut syntax # TODO: Support WITH my @dataset; my $dataset = $self->dataset; my @default = @{ $dataset->{default} || [] }; my @named = values %{ $dataset->{named} || {} }; if (scalar(@default) or scalar(@named)) { foreach my $g (sort { $a->as_string cmp $b->as_string } @default) { push(@dataset, $using, $g->sparql_tokens->elements); } foreach my $g (sort { $a->as_string cmp $b->as_string } @named) { push(@dataset, $using, $named, $g->sparql_tokens->elements); } } my @tokens; if ($op eq 'ID' or $op eq 'DD') { my $statements = ($op eq 'ID') ? $self->insert : $self->delete; my $kw = ($op eq 'ID') ? $insert : $delete; push(@tokens, $kw); push(@tokens, $data); push(@tokens, $l); foreach my $t (@{ $statements }) { push(@tokens, $t->sparql_tokens->elements); push(@tokens, $dot); } push(@tokens, $r); } elsif ($op eq 'I' or $op eq 'D') { my $statements = ($op eq 'I') ? $self->insert : $self->delete; my $kw = ($op eq 'I') ? $insert : $delete; push(@tokens, $kw); push(@tokens, $l); foreach my $t (@{ $statements }) { push(@tokens, $t->sparql_tokens->elements); push(@tokens, $dot); } push(@tokens, $r); push(@tokens, @dataset); push(@tokens, $where); push(@tokens, $l); foreach my $c (@{ $self->children }) { push(@tokens, $c->sparql_tokens->elements); } push(@tokens, $r); } else { foreach my $x ([$delete, $self->delete], [$insert, $self->insert]) { my ($kw, $statements) = @$x; push(@tokens, $kw); push(@tokens, $l); foreach my $t (@{ $statements }) { push(@tokens, $t->sparql_tokens->elements); push(@tokens, $dot); } push(@tokens, $r); } push(@tokens, @dataset); push(@tokens, $where); push(@tokens, $l); foreach my $c (@{ $self->children }) { push(@tokens, $c->sparql_tokens->elements); } push(@tokens, $r); } return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/TermMap.pm000644 000765 000024 00000000224 14636707550 020674 xustar00gregstaff000000 000000 29 mtime=1719373672.08920138 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/TermMap.pm000644 000765 000024 00000010212 14636707550 016721 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::TermMap - Mapping terms to new terms =head1 VERSION This document describes Attean::TermMap version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my $m = Attean::TermMap->short_blank_map; my $new_blank = $m->map( Attean::Blank->new('abcdefg') ); say $new_blank->ntriples_string; # _:a =head1 DESCRIPTION The Attean::TermMap class represents a one-way mapping process from and to L objects. This mapping may rename the blank identifiers, skolemize nodes, or map the nodes in some other, custom way. It conforms to the L role. =head1 ATTRIBUTES =over 4 =item C<< mapper >> A CODE reference that will map L objects to (possibly different) term objects. =back =head1 CLASS METHODS =over 4 =cut package Attean::TermMap 0.034 { use Moo; use Types::Standard qw(CodeRef); use Attean::API::Binding; use UUID::Tiny ':std'; use namespace::clean; with 'Attean::Mapper'; has 'mapper' => (is => 'ro', isa => CodeRef, default => sub { shift }, required => 1); around BUILDARGS => sub { my $orig = shift; my $class = shift; if (scalar(@_) == 1) { return $class->$orig(mapper => shift); } return $class->$orig(@_); }; =item C<< canonicalization_map >> Returns a new L that canonicalizes recognized typed L values. =cut sub canonicalization_map { my $class = shift; my %map; return $class->new(mapper => sub { my $term = shift; return $term unless ($term->does('Attean::API::Literal')); if ($term->does('Attean::API::CanonicalizingLiteral')) { my $c = eval { $term->canonicalized_term }; return ($@) ? undef : $c; } return $term; }); } =item C<< uuid_blank_map >> Returns a new L that renames blank nodes with UUID values. =cut sub uuid_blank_map { my $class = shift; my %map; return $class->new(mapper => sub { my $term = shift; return $term unless ($term->does('Attean::API::Blank')); my $id = $term->value; return $map{$id} if (defined($map{$id})); my $uuid = unpack('H*', create_uuid()); my $new = Attean::Blank->new( 'b' . $uuid ); $map{$id} = $new; return $new; }); } =item C<< short_blank_map >> Returns a new L that renames blank nodes with short alphabetic names (e.g. _:a, _:b). =cut sub short_blank_map { my $class = shift; my %map; my $next = 'a'; return $class->new(mapper => sub { my $term = shift; return $term unless ($term->does('Attean::API::Blank')); my $id = $term->value; if (defined(my $t = $map{$id})) { return $t; } else { my $new = Attean::Blank->new( $next++ ); $map{$id} = $new; return $new; } }); } =item C<< rewrite_map( \%map ) >> Given C<< %map >> whose keys are term C<< as_string >> serializations, and objects are L objects, returns a new term map object that maps terms matching entries in C<< %map >>, and all other terms to themselves. =cut sub rewrite_map { my $class = shift; my $map = shift; return $class->new(mapper => sub { my $term = shift; return $map->{ $term->as_string } if (exists $map->{ $term->as_string }); return $term; }); } =back =head1 METHODS =over 4 =item C<< map( $term ) >> Returns the term that is mapped to by the supplied C<< $term >>. =cut sub map { my $self = shift; my $term = shift; return $self->mapper->( $term ); } =item C<< binding_mapper >> Returns a mapping function reference that maps L objects by mapping their constituent mapped L objects. =cut sub binding_mapper { my $self = shift; return sub { my $binding = shift; return $binding->apply_map($self); } } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/AggregateExpression.pod000644 000765 000024 00000000225 14636707546 023451 xustar00gregstaff000000 000000 30 mtime=1719373670.966935272 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/AggregateExpression.pod000644 000765 000024 00000002702 14636707546 021502 0ustar00gregstaff000000 000000 =head1 NAME Attean::AggregateExpression - Representation of aggregate expression trees =head1 VERSION This document describes Attean::AggregateExpression version 0.034 =head1 DESCRIPTION The Attean::AggregateExpression class represents an expression tree where the root node is an aggregate operation (e.g. SUM(?a) or COALESCE(?a/?b, ?c, 0)). =head1 ROLES This role consumes the L role. =head1 ATTRIBUTES The following attributes exist: =over 4 =item C<< operator >> The name of the aggregate operator, from the allowable set: COUNT, SUM, MIN, MAX, AVG, GROUP_CONCAT, SAMPLE. =item C<< scalar_vars >> A HASH reference of scalar variables. The only scalar variable defined for SPARQL 1.1 is C<'seperator'>, a string separator used with the GROUP_CONCAT aggregate. =item C<< distinct >> A boolean indicating whether the aggregate should operate over distinct term sets, or full multisets. =item C<< variable >> A L object which will be bound to the produced aggregate value in results. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/BindingEqualityTest.pm000644 000765 000024 00000000225 14636707547 023266 xustar00gregstaff000000 000000 30 mtime=1719373671.779591337 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/BindingEqualityTest.pm000644 000765 000024 00000024416 14636707547 021325 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::BindingEqualityTest - Test for equality of binding sets with bnode isomorphism =head1 VERSION This document describes Attean::BindingEqualityTest version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my $test = Attean::BindingEqualityTest->new(); if ($test->equals($iter_a, $iter_b)) { say "Iterators contain equivalent bindings"; } =head1 DESCRIPTION ... =head1 METHODS =over 4 =cut package Attean::BindingEqualityTest::_Iter { sub new { my $class = shift; my @iters = @_; my @values = $class->_materialize([], @iters); return bless(\@values, $class); } sub _materialize { my $class = shift; my $v = shift; my @iters = @_; if (scalar(@iters)) { my $i = shift(@iters); my @values; while (my $vv = $i->next) { my $prefix = [@$v, @$vv]; push(@values, $class->_materialize($prefix, @iters)); } return @values; } else { return $v; } } sub next { my $self = shift; return shift(@$self); } } package Attean::BindingEqualityTest 0.034 { use v5.14; use warnings; use Moo; use Types::Standard qw(CodeRef ConsumerOf Str); use Data::Dumper; use Algorithm::Combinatorics qw(permutations); use Scalar::Util qw(blessed); use List::Util qw(shuffle); use Attean::RDF; use Digest::MD5 qw(md5_hex); use namespace::clean; with 'MooX::Log::Any'; has error => (is => 'rw', isa => Str, init_arg => undef); sub _coerce { my $o = shift; if ($o->does('Attean::API::Model')) { return $o->get_quads; } elsif ($o->does('Attean::API::Iterator')) { return $o; } return; } =item C<< equals ( $graph1, $graph2 ) >> Returns true if the invocant and $graph represent two equal RDF graphs (e.g. there exists a bijection between the RDF statements of the invocant and $graph). =cut sub equals { my $self = shift; $self->error(''); return $self->_check_equality(@_) ? 1 : 0; } sub _check_equality { my $self = shift; my ($a, $b) = map { _coerce($_) } @_; my @graphs = ($a, $b); my ($ba, $nba) = $self->split_blank_statements($a); my ($bb, $nbb) = $self->split_blank_statements($b); if (scalar(@$nba) != scalar(@$nbb)) { my $nbac = scalar(@$nba); my $nbbc = scalar(@$nbb); # warn "====================================================\n"; # warn "BindingEqualityTest count of non-blank statements didn't match:\n"; # warn "-------- a\n"; # foreach my $t (@$nba) { # warn $t->as_string . "\n"; # } # warn "-------- b\n"; # foreach my $t (@$nbb) { # warn $t->as_string . "\n"; # } $self->error("count of non-blank statements didn't match ($nbac != $nbbc)"); return 0; } my $bac = scalar(@$ba); my $bbc = scalar(@$bb); if ($bac != $bbc) { $self->error("count of blank statements didn't match ($bac != $bbc)"); return 0; } my $mapper = Attean::TermMap->canonicalization_map; for ($nba, $nbb) { @$_ = sort map { $_->apply_map($mapper)->as_string } @$_; } foreach my $i (0 .. $#{ $nba }) { unless ($nba->[$i] eq $nbb->[$i]) { # warn "====================================================\n"; # warn "BindingEqualityTest non-blank statements didn't match:\n"; # warn "-------- a\n"; # foreach my $t (@$nba) { # warn $t . "\n"; # } # warn "-------- b\n"; # foreach my $t (@$nbb) { # warn $t . "\n"; # } $self->error("non-blank triples don't match:\n" . Dumper($nba->[$i], $nbb->[$i])); return 0; } } return _find_mapping($self, $ba, $bb, 1); } =item C<< is_subgraph_of ( $graph1, $graph2 ) >> Returns true if the invocant is a subgraph of $graph. (i.e. there exists an injection of RDF statements from the invocant to $graph.) =cut sub is_subgraph_of { my $self = shift; $self->error(''); return $self->_check_subgraph(@_) ? 1 : 0; } =item C<< injection_map ( $graph1, $graph2 ) >> If the invocant is a subgraph of $graph, returns a mapping of blank node identifiers from the invocant graph to $graph as a hashref. Otherwise returns false. The solution is not always unique; where there exist multiple solutions, the solution returned is arbitrary. =cut sub injection_map { my $self = shift; $self->error(''); my $map = $self->_check_subgraph(@_); return $map if $map; return; } sub _check_subgraph { my $self = shift; my ($a, $b) = map { _coerce($_) } @_; my @graphs = ($a, $b); my ($ba, $nba) = $self->split_blank_statements($a); my ($bb, $nbb) = $self->split_blank_statements($b); if (scalar(@$nba) > scalar(@$nbb)) { $self->error("invocant had too many blank node statements to be a subgraph of argument"); return 0; } elsif (scalar(@$ba) > scalar(@$bb)) { $self->error("invocant had too many non-blank node statements to be a subgraph of argument"); return 0; } my %NBB = map { $_->as_string => 1 } @$nbb; foreach my $st (@$nba) { unless ($NBB{ $st->as_string }) { return 0; } } return _find_mapping($self, $ba, $bb); } sub _statement_blank_irisets { my $self = shift; my @st = @_; my %blank_ids_b_iris; foreach my $st (@st) { my @iris = map { $_->value } grep { $_->does('Attean::API::IRI') } $st->values; unless (scalar(@iris)) { push(@iris, '_'); } foreach my $n (grep { $_->does('Attean::API::Blank') } $st->values) { foreach my $i (@iris) { $blank_ids_b_iris{$n->value}{$i}++; } } } my %iri_blanks; foreach my $bid (sort keys %blank_ids_b_iris) { my $d = Digest::MD5->new(); foreach my $iri (sort keys %{ $blank_ids_b_iris{$bid} }) { $d->add($iri); } $iri_blanks{$d->hexdigest}{$bid}++; } return \%iri_blanks; } sub _find_mapping { my $self = shift; my $ba = shift; my $bb = shift; my $equal = shift || 0; # warn "########### _find_mapping:\n"; # warn "============ A\n"; # foreach my $t (@$ba) { # warn $t->as_string . "\n"; # } # warn "============ B\n"; # foreach my $t (@$bb) { # warn $t->as_string . "\n"; # } if (scalar(@$ba) == 0) { return {}; } my %blank_ids_a; foreach my $st (@$ba) { foreach my $n ($st->blanks) { $blank_ids_a{ $n->value }++; } } my %blank_ids_b; foreach my $st (@$bb) { foreach my $n ($st->blanks) { $blank_ids_b{ $n->value }++; } } my (@ka, @kb); my $kbp; # if ($equal) { # # if we're testing for equality, and not just finding an injection mapping, # # we can avoid unnecessary work by restricting mappings to those where each # # permutation only maps blank nodes to other blank nodes that appear in # # similar bindings (in this case they appear with all the same IRIs) # my $ba_iri_blanks = $self->_statement_blank_irisets(@$ba); # # my $bb_iri_blanks = $self->_statement_blank_irisets(@$bb); # # my $ba_keys = join('|', sort keys %$ba_iri_blanks); # my $bb_keys = join('|', sort keys %$bb_iri_blanks); # unless ($ba_keys eq $bb_keys) { # $self->error("didn't find blank node mapping\n"); # return 0; # } # # my @iters; # foreach my $k (sort keys %$ba_iri_blanks) { # unless (scalar(@{[keys %{ $ba_iri_blanks->{$k} }]}) == scalar(@{[keys %{ $bb_iri_blanks->{$k} }]})) { # $self->error("didn't find blank node mapping\n"); # return 0; # } # push(@ka, keys %{ $ba_iri_blanks->{$k} }); # push(@kb, keys %{ $bb_iri_blanks->{$k} }); # my $i = permutations([keys %{ $bb_iri_blanks->{$k} }]); # push(@iters, $i); # } # # if (scalar(@iters) == 1) { # $kbp = shift(@iters); # } else { # $kbp = Attean::BindingEqualityTest::_Iter->new(@iters); # } # } else { @ka = keys %blank_ids_a; @kb = keys %blank_ids_b; $kbp = permutations( [shuffle @kb] ); # } my $canon_map = Attean::TermMap->canonicalization_map; my %bb_master; foreach my $bb_item (@$bb) { my $k = $bb_item->apply_map($canon_map)->as_string; $bb_master{ $k }++; } # my %bb_master = map { $_->apply_map($canon_map)->as_string => 1 } @$bb; my $count = 0; MAPPING: while (my $mapping = $kbp->next) { my %mapping_str; @mapping_str{ @ka } = @$mapping; my %mapping = map { Attean::Blank->new($_)->as_string => Attean::Blank->new($mapping_str{$_}) } (keys %mapping_str); my $mapper = Attean::TermMap->rewrite_map(\%mapping); $self->log->trace("trying mapping: " . Dumper($mapping)); my %bb = %bb_master; foreach my $st (@$ba) { my $mapped_st = $st->apply_map($mapper)->as_string; # warn ">>>>>>>\n"; # warn "-> " . $st->as_string . "\n"; # warn "-> " . $mapped_st . "\n"; $self->log->trace("checking for '$mapped_st' in " . Dumper(\%bb)); if ($bb{ $mapped_st }) { $self->log->trace("Found mapping for binding: " . Dumper($mapped_st)); if (--$bb{ $mapped_st } == 0) { delete $bb{ $mapped_st }; } } else { $self->log->trace("No mapping found for binding: " . Dumper($mapped_st)); # warn "No mapping found for binding: " . Dumper($mapped_st); # warn Dumper(\%bb); next MAPPING; } } $self->error("found mapping: " . Dumper(\%mapping_str)); return \%mapping_str; } # warn "didn't find blank node mapping:\n"; # warn "============ A\n"; # foreach my $t (@$ba) { # warn $t->as_string . "\n"; # } # warn "============ B\n"; # foreach my $t (@$bb) { # warn $t->as_string . "\n"; # } $self->error("didn't find blank node mapping\n"); return 0; } =item C<< split_blank_statements( $iter ) >> Returns two array refs containing bindings from C<< $iter >>, with bindings containing blank nodes and bindings without any blank nodes, respectively. =cut sub split_blank_statements { my $self = shift; my $iter = shift; my (@blanks, @nonblanks); while (my $st = $iter->next) { unless ($st->does('Attean::API::Binding')) { die "Unexpected non-binding value found in BindingEqualityTest: " . $st->as_string; } if ($st->has_blanks) { push(@blanks, $st); } else { push(@nonblanks, $st); } } return (\@blanks, \@nonblanks); } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/QueryPlanner.pm000644 000765 000024 00000000225 14636707550 021755 xustar00gregstaff000000 000000 30 mtime=1719373672.006796415 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/QueryPlanner.pm000644 000765 000024 00000114220 14636707550 020005 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::QueryPlanner - Query planner =head1 VERSION This document describes Attean::QueryPlanner version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my $planner = Attean::QueryPlanner->new(); my $default_graphs = [ Attean::IRI->new('http://example.org/') ]; my $plan = $planner->plan_for_algebra( $algebra, $model, $default_graphs ); my $iter = $plan->evaluate($model); while (my $result = $iter->next()) { say $result->as_string; } =head1 DESCRIPTION The Attean::QueryPlanner class is a base class implementing common behavior for query planners. Subclasses will need to consume or compose the L role. Trivial sub-classes may consume L, while more complex planners may choose to implement complex join planning (e.g. L). =head1 ATTRIBUTES =over 4 =cut use Attean::Algebra; use Attean::Plan; use Attean::Expression; package Attean::QueryPlanner 0.034 { use Moo; use Encode qw(encode); use Attean::RDF; use Scalar::Util qw(blessed reftype); use List::Util qw(reduce); use List::MoreUtils qw(all any); use Types::Standard qw(Int ConsumerOf InstanceOf); use URI::Escape; use Algorithm::Combinatorics qw(subsets); use List::Util qw(min); use Math::Cartesian::Product; use namespace::clean; with 'Attean::API::QueryPlanner', 'MooX::Log::Any'; has 'counter' => (is => 'rw', isa => Int, default => 0); has 'table_threshold' => (is => 'rw', isa => Int, default => 10); =back =head1 METHODS =over 4 =item C<< new_temporary( $type ) >> Returns a new unique (in the context of the query planner) ID string that may be used for things like fresh (temporary) variables. The C<< $type >> string is used in the generated name to aid in identifying different uses for the names. =cut sub new_temporary { my $self = shift; my $type = shift; my $c = $self->counter; $self->counter($c+1); return sprintf('.%s-%d', $type, $c); } =item C<< plan_for_algebra( $algebra, $model, \@active_graphs, \@default_graphs ) >> Returns the first plan returned from C<< plans_for_algebra >>. =cut sub plan_for_algebra { my $self = shift; my @plans = $self->plans_for_algebra(@_); return shift(@plans); } =item C<< plans_for_algebra( $algebra, $model, \@active_graphs, \@default_graphs ) >> Returns L objects representing alternate query plans for evaluating the query C<< $algebra >> against the C<< $model >>, using the supplied C<< $active_graph >>. =cut sub plans_for_algebra { my $self = shift; my $algebra = shift; my $model = shift; my $active_graphs = shift; my $default_graphs = shift; my %args = @_; if ($model->does('Attean::API::CostPlanner')) { my @plans = $model->plans_for_algebra($algebra, $self, $active_graphs, $default_graphs, %args); if (@plans) { return @plans; # trust that the model knows better than us what plans are best } else { $self->log->info("*** Model did not provide plans: $model"); } } Carp::confess "No algebra passed for evaluation" unless ($algebra); # TODO: propagate interesting orders my $interesting = []; my @children = @{ $algebra->children }; my ($child) = $children[0]; if ($algebra->isa('Attean::Algebra::Query') or $algebra->isa('Attean::Algebra::Update')) { return $self->plans_for_algebra($algebra->child, $model, $active_graphs, $default_graphs, %args); } elsif ($algebra->isa('Attean::Algebra::BGP')) { my $triples = $algebra->triples; my @triples = @$triples; my %blanks; foreach my $i (0 .. $#triples) { my $t = $triples[$i]; my @nodes = $t->values; my $changed = 0; foreach (@nodes) { if ($_->does('Attean::API::Blank')) { $changed++; my $id = $_->value; unless (exists $blanks{$id}) { $blanks{$id} = Attean::Variable->new(value => $self->new_temporary('blank')); } $_ = $blanks{$id}; } } if ($changed) { my $new = Attean::TriplePattern->new(@nodes); $triples[$i] = $new; } } my $bgp = Attean::Algebra::BGP->new( triples => \@triples ); my @plans = $self->bgp_join_plans($bgp, $model, $active_graphs, $default_graphs, $interesting, map { [$self->access_plans($model, $active_graphs, $_)] } @triples); return @plans; } elsif ($algebra->isa('Attean::Algebra::Join')) { return $self->group_join_plans($model, $active_graphs, $default_graphs, $interesting, map { [$self->plans_for_algebra($_, $model, $active_graphs, $default_graphs, %args)] } @children); } elsif ($algebra->isa('Attean::Algebra::Distinct') or $algebra->isa('Attean::Algebra::Reduced')) { my @plans = $self->plans_for_algebra($child, $model, $active_graphs, $default_graphs, %args); my @dist; foreach my $p (@plans) { if ($p->distinct) { push(@dist, $p); } else { my @vars = @{ $p->in_scope_variables }; my $cmps = $p->ordered; if ($self->_comparators_are_stable_and_cover_vars($cmps, @vars)) { # the plan has a stable ordering which covers all the variables, so we can just uniq the iterator push(@dist, Attean::Plan::Unique->new(children => [$p], distinct => 1, ordered => $p->ordered)); } else { # TODO: if the plan isn't distinct, but is ordered, we can use a batched implementation push(@dist, Attean::Plan::HashDistinct->new(children => [$p], distinct => 1, ordered => $p->ordered)); } } } return @dist; } elsif ($algebra->isa('Attean::Algebra::Filter')) { # TODO: simple range relation filters can be handled differently if that filter operates on a variable that is part of the ordering my $expr = $algebra->expression; my $w = Attean::TreeRewriter->new(types => ['Attean::API::DirectedAcyclicGraph']); $w->register_pre_handler(sub { my ($t, $parent, $thunk) = @_; if ($t->isa('Attean::ExistsExpression')) { my $pattern = $t->pattern; my $plan = $self->plan_for_algebra($pattern, $model, $active_graphs, $default_graphs, @_); unless ($plan->does('Attean::API::BindingSubstitutionPlan')) { die 'Exists plan does not consume Attean::API::BindingSubstitutionPlan: ' . $plan->as_string; } my $new = Attean::ExistsPlanExpression->new( plan => $plan, ); return (1, 0, $new); } return (0, 1, $t); }); my ($changed, $rewritten) = $w->rewrite($expr, {}); if ($changed) { $expr = $rewritten; } my $var = $self->new_temporary('filter'); my %exprs = ($var => $expr); my @plans; foreach my $plan ($self->plans_for_algebra($child, $model, $active_graphs, $default_graphs, %args)) { my $distinct = $plan->distinct; my $ordered = $plan->ordered; if ($expr->isa('Attean::ValueExpression') and $expr->value->does('Attean::API::Variable')) { my $filtered = Attean::Plan::EBVFilter->new(children => [$plan], variable => $expr->value->value, distinct => $distinct, ordered => $ordered); push(@plans, $filtered); } else { my @vars = ($var); my @inscope = ($var, @{ $plan->in_scope_variables }); my @pvars = map { Attean::Variable->new($_) } @{ $plan->in_scope_variables }; my $extend = Attean::Plan::Extend->new(children => [$plan], expressions => \%exprs, distinct => 0, ordered => $ordered, active_graphs => $active_graphs); my $filtered = Attean::Plan::EBVFilter->new(children => [$extend], variable => $var, distinct => 0, ordered => $ordered); my $proj = $self->new_projection($filtered, $distinct, @{ $plan->in_scope_variables }); push(@plans, $proj); } } return @plans; } elsif ($algebra->isa('Attean::Algebra::OrderBy')) { # TODO: no-op if already ordered my @cmps = @{ $algebra->comparators }; my ($exprs, $ascending, $svars) = $self->_order_by($algebra); my @plans; foreach my $plan ($self->plans_for_algebra($child, $model, $active_graphs, $default_graphs, interesting_order => $algebra->comparators, %args)) { my $distinct = $plan->distinct; if (scalar(@cmps) == 1 and $cmps[0]->expression->isa('Attean::ValueExpression') and $cmps[0]->expression->value->does('Attean::API::Variable')) { # TODO: extend this to handle more than one comparator, so long as they are *all* just variables (and not complex expressions) # If we're sorting by just a variable name, don't bother creating new variables for the sort expressions, use the underlying variable directy my @vars = @{ $plan->in_scope_variables }; my @pvars = map { Attean::Variable->new($_) } @{ $plan->in_scope_variables }; my $var = $cmps[0]->expression->value->value; my $ascending = { $var => $cmps[0]->ascending }; my $ordered = Attean::Plan::OrderBy->new(children => [$plan], variables => [$var], ascending => $ascending, distinct => $distinct, ordered => \@cmps); push(@plans, $ordered); } else { my @vars = (@{ $plan->in_scope_variables }, keys %$exprs); my @pvars = map { Attean::Variable->new($_) } @{ $plan->in_scope_variables }; my $extend = Attean::Plan::Extend->new(children => [$plan], expressions => $exprs, distinct => 0, ordered => $plan->ordered, active_graphs => $active_graphs); my $ordered = Attean::Plan::OrderBy->new(children => [$extend], variables => $svars, ascending => $ascending, distinct => 0, ordered => \@cmps); my $proj = $self->new_projection($ordered, $distinct, @{ $plan->in_scope_variables }); push(@plans, $proj); } } return @plans; } elsif ($algebra->isa('Attean::Algebra::LeftJoin')) { my $l = [$self->plans_for_algebra($children[0], $model, $active_graphs, $default_graphs, %args)]; my $r = [$self->plans_for_algebra($children[1], $model, $active_graphs, $default_graphs, %args)]; return $self->join_plans($model, $active_graphs, $default_graphs, $l, $r, 'left', $algebra->expression); } elsif ($algebra->isa('Attean::Algebra::Minus')) { my $l = [$self->plans_for_algebra($children[0], $model, $active_graphs, $default_graphs, %args)]; my $r = [$self->plans_for_algebra($children[1], $model, $active_graphs, $default_graphs, %args)]; return $self->join_plans($model, $active_graphs, $default_graphs, $l, $r, 'minus'); } elsif ($algebra->isa('Attean::Algebra::Project')) { my $vars = $algebra->variables; my @vars = map { $_->value } @{ $vars }; my $vars_key = join(' ', sort @vars); my $distinct = 0; my @plans = map { ($vars_key eq join(' ', sort @{ $_->in_scope_variables })) ? $_ # no-op if plan is already properly-projected : $self->new_projection($_, $distinct, @vars) } $self->plans_for_algebra($child, $model, $active_graphs, $default_graphs, %args); return @plans; } elsif ($algebra->isa('Attean::Algebra::Graph')) { my $graph = $algebra->graph; if ($graph->does('Attean::API::Term')) { if (my $available = $args{available_graphs}) { # the list of available graphs has been restricted, and this # graph is not available so return an empty table plan. unless (any { $_->equals($graph) } @$available) { my $plan = Attean::Plan::Table->new( variables => [], rows => [], distinct => 0, ordered => [] ); return $plan; } } return $self->plans_for_algebra($child, $model, [$graph], $default_graphs, %args); } else { my $gvar = $graph->value; my $graphs = $model->get_graphs; my @plans; my %vars = map { $_ => 1 } $child->in_scope_variables; $vars{ $gvar }++; my @vars = keys %vars; my %available; if (my $available = $args{available_graphs}) { foreach my $a (@$available) { $available{ $a->value }++; } $graphs = $graphs->grep(sub { $available{ $_->value } }); } my @branches; my %ignore = map { $_->value => 1 } @$default_graphs; while (my $graph = $graphs->next) { next if $ignore{ $graph->value }; my %exprs = ($gvar => Attean::ValueExpression->new(value => $graph)); # TODO: rewrite $child pattern here to replace any occurrences of the variable $gvar to $graph my @plans = map { Attean::Plan::Extend->new(children => [$_], expressions => \%exprs, distinct => 0, ordered => $_->ordered, active_graphs => $active_graphs); } $self->plans_for_algebra($child, $model, [$graph], $default_graphs, %args); push(@branches, \@plans); } if (scalar(@branches) == 1) { @plans = @{ shift(@branches) }; } else { cartesian { push(@plans, Attean::Plan::Union->new(children => [@_], distinct => 0, ordered => [])) } @branches; } return @plans; } } elsif ($algebra->isa('Attean::Algebra::Table')) { my $rows = $algebra->rows; my $vars = $algebra->variables; my @vars = map { $_->value } @{ $vars }; if (scalar(@$rows) < $self->table_threshold) { return Attean::Plan::Table->new( variables => $vars, rows => $rows, distinct => 0, ordered => [] ); } else { my $iter = Attean::ListIterator->new( item_type => 'Attean::API::Result', variables => \@vars, values => $rows ); return Attean::Plan::Iterator->new( iterator => $iter, distinct => 0, ordered => [] ); } } elsif ($algebra->isa('Attean::Algebra::Service')) { my $endpoint = $algebra->endpoint; my $silent = $algebra->silent; my $sparql = sprintf('SELECT * WHERE { %s }', $child->as_sparql); my @vars = $child->in_scope_variables; my $plan = Attean::Plan::Service->new( request_signer => $self->request_signer, endpoint => $endpoint, silent => $silent, sparql => $sparql, distinct => 0, in_scope_variables => \@vars, ordered => [] ); return $plan; } elsif ($algebra->isa('Attean::Algebra::Slice')) { my $limit = $algebra->limit; my $offset = $algebra->offset; my @plans; foreach my $plan ($self->plans_for_algebra($child, $model, $active_graphs, $default_graphs, %args)) { my $vars = $plan->in_scope_variables; push(@plans, Attean::Plan::Slice->new(children => [$plan], limit => $limit, offset => $offset, distinct => $plan->distinct, ordered => $plan->ordered)); } return @plans; } elsif ($algebra->isa('Attean::Algebra::Union')) { # TODO: if both branches are similarly ordered, we can use Attean::Plan::Merge to keep the resulting plan ordered my @vars = keys %{ { map { map { $_ => 1 } $_->in_scope_variables } @children } }; my @plansets = map { [$self->plans_for_algebra($_, $model, $active_graphs, $default_graphs, %args)] } @children; my @plans; cartesian { push(@plans, Attean::Plan::Union->new(children => \@_, distinct => 0, ordered => [])) } @plansets; return @plans; } elsif ($algebra->isa('Attean::Algebra::Extend')) { my $var = $algebra->variable->value; my $expr = $algebra->expression; my %exprs = ($var => $expr); my @vars = $algebra->in_scope_variables; my @plans; foreach my $plan ($self->plans_for_algebra($child, $model, $active_graphs, $default_graphs, %args)) { my $extend = Attean::Plan::Extend->new(children => [$plan], expressions => \%exprs, distinct => 0, ordered => $plan->ordered, active_graphs => $active_graphs); push(@plans, $extend); } return @plans; } elsif ($algebra->isa('Attean::Algebra::Group')) { my $aggs = $algebra->aggregates; my $groups = $algebra->groupby; my %exprs; foreach my $expr (@$aggs) { my $var = $expr->variable->value; $exprs{$var} = $expr; } my @plans; foreach my $plan ($self->plans_for_algebra($child, $model, $active_graphs, $default_graphs, %args)) { my $extend = Attean::Plan::Aggregate->new(children => [$plan], aggregates => \%exprs, groups => $groups, distinct => 0, ordered => [], active_graphs => $active_graphs); push(@plans, $extend); } return @plans; } elsif ($algebra->isa('Attean::Algebra::Ask')) { my @plans; foreach my $plan ($self->plans_for_algebra($child, $model, $active_graphs, $default_graphs, %args)) { return Attean::Plan::Exists->new(children => [$plan], distinct => 1, ordered => []); } return @plans; } elsif ($algebra->isa('Attean::Algebra::Path')) { my $s = $algebra->subject; my $path = $algebra->path; my $o = $algebra->object; my @algebra = $self->simplify_path($s, $path, $o); my @join; if (scalar(@algebra)) { my @triples; while (my $pa = shift(@algebra)) { if ($pa->isa('Attean::TriplePattern')) { push(@triples, $pa); } else { if (scalar(@triples)) { push(@join, Attean::Algebra::BGP->new( triples => [@triples] )); @triples = (); } push(@join, $pa); } } if (scalar(@triples)) { push(@join, Attean::Algebra::BGP->new( triples => [@triples] )); } my @vars = $algebra->in_scope_variables; my @joins = $self->group_join_plans($model, $active_graphs, $default_graphs, $interesting, map { [$self->plans_for_algebra($_, $model, $active_graphs, $default_graphs, %args)] } @join); my @plans; foreach my $j (@joins) { push(@plans, Attean::Plan::Project->new(children => [$j], variables => [map { Attean::Variable->new($_) } @vars], distinct => 0, ordered => [])); } return @plans; } elsif ($path->isa('Attean::Algebra::ZeroOrMorePath') or $path->isa('Attean::Algebra::OneOrMorePath')) { my $skip = $path->isa('Attean::Algebra::OneOrMorePath') ? 1 : 0; my $begin = Attean::Variable->new(value => $self->new_temporary('pp')); my $end = Attean::Variable->new(value => $self->new_temporary('pp')); my $s_var = $s->does('Attean::API::Variable'); my $o_var = $o->does('Attean::API::Variable'); my $child = $path->children->[0]; my $a; if ($s_var and not($o_var)) { my $inv = Attean::Algebra::InversePath->new( children => [$child] ); $a = Attean::Algebra::Path->new( subject => $end, path => $inv, object => $begin ); } else { $a = Attean::Algebra::Path->new( subject => $begin, path => $child, object => $end ); } my @cplans = $self->plans_for_algebra($a, $model, $active_graphs, $default_graphs, %args); my @plans; foreach my $cplan (@cplans) { my $plan = Attean::Plan::ALPPath->new( subject => $s, children => [$cplan], object => $o, graph => $active_graphs, skip => $skip, step_begin => $begin, step_end => $end, distinct => 0, ordered => [] ); push(@plans, $plan); } return @plans; } elsif ($path->isa('Attean::Algebra::ZeroOrOnePath')) { my $a = Attean::Algebra::Path->new( subject => $s, path => $path->children->[0], object => $o ); my @children = $self->plans_for_algebra($a, $model, $active_graphs, $default_graphs, %args); my @plans; foreach my $plan (@children) { push(@plans, Attean::Plan::ZeroOrOnePath->new( subject => $s, children => [$plan], object => $o, graph => $active_graphs, distinct => 0, ordered => [] )); } return @plans; } else { die "Cannot simplify property path $path: " . $algebra->as_string; } } elsif ($algebra->isa('Attean::Algebra::Construct')) { my @children = $self->plans_for_algebra($child, $model, $active_graphs, $default_graphs, %args); my @plans; foreach my $plan (@children) { push(@plans, Attean::Plan::Construct->new(triples => $algebra->triples, children => [$plan], distinct => 0, ordered => [])); } return @plans; } elsif ($algebra->isa('Attean::Algebra::Describe')) { my @children = $self->plans_for_algebra($child, $model, $active_graphs, $default_graphs, %args); my @plans; foreach my $plan (@children) { push(@plans, Attean::Plan::Describe->new(terms => $algebra->terms, graph => $active_graphs, children => [$plan], distinct => 0, ordered => [])); } return @plans; } elsif ($algebra->isa('Attean::Algebra::Clear')) { my $plan_class = $algebra->drop ? 'Attean::Plan::Drop' : 'Attean::Plan::Clear'; my $target = $algebra->target; if ($target eq 'GRAPH') { return Attean::Plan::Clear->new(graphs => [$algebra->graph]); } else { my %default = map { $_->value => 1 } @$active_graphs; my $graphs = $model->get_graphs; my @graphs; while (my $graph = $graphs->next) { if ($target eq 'ALL') { push(@graphs, $graph); } else { if ($target eq 'DEFAULT' and $default{ $graph->value }) { push(@graphs, $graph); } elsif ($target eq 'NAMED' and not $default{ $graph->value }) { push(@graphs, $graph); } } } return $plan_class->new(graphs => \@graphs); } } elsif ($algebra->isa('Attean::Algebra::Add')) { my $triple = triplepattern(variable('s'), variable('p'), variable('o')); my $child; my $default_source = 0; if (my $from = $algebra->source) { ($child) = $self->access_plans( $model, $active_graphs, $triple->as_quad_pattern($from) ); } else { $default_source++; my $bgp = Attean::Algebra::BGP->new( triples => [$triple] ); ($child) = $self->plans_for_algebra($bgp, $model, $active_graphs, $default_graphs, %args); } my $dest; my $default_dest = 0; if (my $g = $algebra->destination) { $dest = $triple->as_quad_pattern($g); } else { $default_dest++; $dest = $triple->as_quad_pattern($default_graphs->[0]); } my @plans; my $run_update = 1; if ($default_dest and $default_source) { $run_update = 0; } elsif ($default_dest or $default_source) { # } elsif ($algebra->source->equals($algebra->destination)) { $run_update = 0; } if ($run_update) { if ($algebra->drop_destination) { my @graphs = $algebra->has_destination ? $algebra->destination : @$default_graphs; unshift(@plans, Attean::Plan::Clear->new(graphs => [@graphs])); } push(@plans, Attean::Plan::TripleTemplateToModelQuadMethod->new( graph => $default_graphs->[0], order => ['add_quad'], patterns => {'add_quad' => [$dest]}, children => [$child], )); if ($algebra->drop_source) { my @graphs = $algebra->has_source ? $algebra->source : @$default_graphs; push(@plans, Attean::Plan::Clear->new(graphs => [@graphs])); } } my $plan = (scalar(@plans) == 1) ? shift(@plans) : Attean::Plan::Sequence->new( children => \@plans ); return $plan; } elsif ($algebra->isa('Attean::Algebra::Modify')) { unless ($child) { # This is an INSERT/DELETE DATA algebra with ground data and no pattern $child = Attean::Algebra::BGP->new( triples => [] ); } my $dataset = $algebra->dataset; my @default = @{ $dataset->{default} || [] }; my @named = values %{ $dataset->{named} || {} }; my @active_graphs = @$active_graphs; my @default_graphs = @$default_graphs; if (scalar(@default) or scalar(@named)) { # change the available named graphs # change the active graph(s) @active_graphs = @default; @default_graphs = @default; $args{ available_graphs } = [@named]; } else { # no custom dataset } my @children = $self->plans_for_algebra($child, $model, \@active_graphs, \@default_graphs, %args); my $i = $algebra->insert; my $d = $algebra->delete; my %patterns; my @order; if (scalar(@$d)) { push(@order, 'remove_quad'); $patterns{ 'remove_quad' } = $d; } if (scalar(@$i)) { push(@order, 'add_quad'); $patterns{ 'add_quad' } = $i; } return map { Attean::Plan::TripleTemplateToModelQuadMethod->new( graph => $default_graphs->[0], order => \@order, patterns => \%patterns, children => [$_], ) } @children; } elsif ($algebra->isa('Attean::Algebra::Load')) { my $pattern = triplepattern(variable('subject'), variable('predicate'), variable('object')); my $load = Attean::Plan::Load->new( url => $algebra->url->value, silent => $algebra->silent ); my $graph = $algebra->has_graph ? $algebra->graph : $default_graphs->[0]; my $plan = Attean::Plan::TripleTemplateToModelQuadMethod->new( graph => $graph, order => ['add_quad'], patterns => {'add_quad' => [$pattern]}, children => [$load], ); return $plan; } elsif ($algebra->isa('Attean::Algebra::Create')) { return Attean::Plan::Sequence->new( children => [] ); } elsif ($algebra->isa('Attean::Algebra::Sequence')) { my @plans; foreach my $child (@{ $algebra->children }) { my ($plan) = $self->plans_for_algebra($child, $model, $active_graphs, $default_graphs, %args); push(@plans, $plan); } return Attean::Plan::Sequence->new( children => \@plans ); } elsif ($algebra->isa('Attean::Algebra::Unfold')) { my @plans = $self->plans_for_algebra($child, $model, $active_graphs, $default_graphs, %args); my @unfold; foreach my $p (@plans) { push(@unfold, Attean::Plan::Unfold->new( children => [$p], expression => $algebra->expression, variables => $algebra->variables, active_graphs => $active_graphs )); } return @unfold; } die "Unimplemented algebra evaluation for: " . $algebra->as_string; } # sub plans_for_unbounded_path { # my $self = shift; # my $algebra = shift; # my $model = shift; # my $active_graphs = shift; # my $default_graphs = shift; # my %args = @_; # # my $s = $algebra->subject; # my $path = $algebra->path; # my $o = $algebra->object; # # return Attean::Plan::ALPPath->new(distinct => 0, ordered => []); # } sub _package { my $self = shift; my @args = @_; my @bgptriples = map { @{ $_->triples } } grep { $_->isa('Attean::Algebra::BGP') } @args; my @triples = grep { $_->isa('Attean::TriplePattern') } @args; my @rest = grep { not $_->isa('Attean::Algebra::BGP') and not $_->isa('Attean::TriplePattern') } @args; if (scalar(@rest) == 0) { return Attean::Algebra::BGP->new( triples => [@bgptriples, @triples] ); } else { my $p = Attean::Algebra::BGP->new( triples => [@bgptriples, @triples] ); while (scalar(@rest) > 0) { $p = Attean::Algebra::Join->new( children => [$p, shift(@rest)] ); } return $p; } } =item C<< simplify_path( $subject, $path, $object ) >> Return a simplified L object corresponding to the given property path. =cut sub simplify_path { my $self = shift; my $s = shift; my $path = shift; my $o = shift; if ($path->isa('Attean::Algebra::SequencePath')) { my $jvar = Attean::Variable->new(value => $self->new_temporary('pp')); my ($lhs, $rhs) = @{ $path->children }; my @paths; push(@paths, $self->simplify_path($s, $lhs, $jvar)); push(@paths, $self->simplify_path($jvar, $rhs, $o)); return $self->_package(@paths); } elsif ($path->isa('Attean::Algebra::InversePath')) { my ($ipath) = @{ $path->children }; return $self->simplify_path($o, $ipath, $s); } elsif ($path->isa('Attean::Algebra::PredicatePath')) { my $pred = $path->predicate; return Attean::TriplePattern->new($s, $pred, $o); } elsif ($path->isa('Attean::Algebra::AlternativePath')) { my ($l, $r) = @{ $path->children }; my $la = $self->_package($self->simplify_path($s, $l, $o)); my $ra = $self->_package($self->simplify_path($s, $r, $o)); return Attean::Algebra::Union->new( children => [$la, $ra] ); } elsif ($path->isa('Attean::Algebra::NegatedPropertySet')) { my @branches; my @preds = @{ $path->predicates }; if (scalar(@preds)) { my $pvar = Attean::Variable->new(value => $self->new_temporary('nps')); my $pvar_e = Attean::ValueExpression->new( value => $pvar ); my $t = Attean::TriplePattern->new($s, $pvar, $o); my @vals = map { Attean::ValueExpression->new( value => $_ ) } @preds; my $expr = Attean::FunctionExpression->new( children => [$pvar_e, @vals], operator => 'notin' ); my $bgp = Attean::Algebra::BGP->new( triples => [$t] ); my $f_fwd = Attean::Algebra::Filter->new( children => [$bgp], expression => $expr ); push(@branches, $f_fwd); } my @rev = @{ $path->reversed }; if (scalar(@rev)) { my $pvar = Attean::Variable->new(value => $self->new_temporary('nps_rev')); my $pvar_e = Attean::ValueExpression->new( value => $pvar ); my $t = Attean::TriplePattern->new($o, $pvar, $s); my @vals = map { Attean::ValueExpression->new( value => $_ ) } @rev; my $expr = Attean::FunctionExpression->new( children => [$pvar_e, @vals], operator => 'notin' ); my $bgp = Attean::Algebra::BGP->new( triples => [$t] ); my $f_rev = Attean::Algebra::Filter->new( children => [$bgp], expression => $expr ); push(@branches, $f_rev); } if (scalar(@branches) == 1) { return shift(@branches); } else { return Attean::Algebra::Union->new( children => \@branches ); } } else { return; } } =item C<< new_projection( $plan, $distinct, @variable_names ) >> Return a new L<< Attean::Plan::Project >> plan over C<< $plan >>, projecting the named variables. C<< $disctinct >> should be true if the caller can guarantee that the resulting plan will produce distinct results, false otherwise. This method takes care of computing plan metadata such as the resulting ordering. =cut sub new_projection { my $self = shift; my $plan = shift; my $distinct = shift; my @vars = @_; my $order = $plan->ordered; my @pvars = map { Attean::Variable->new($_) } @vars; my %pvars = map { $_ => 1 } @vars; my @porder; CMP: foreach my $cmp (@{ $order }) { my @cmpvars = $self->_comparator_referenced_variables($cmp); foreach my $v (@cmpvars) { unless ($pvars{ $v }) { # projection is dropping a variable used in this comparator # so we lose any remaining ordering that the sub-plan had. last CMP; } } # all the variables used by this comparator are available after # projection, so the resulting plan will continue to be ordered # by this comparator push(@porder, $cmp); } return Attean::Plan::Project->new(children => [$plan], variables => \@pvars, distinct => $distinct, ordered => \@porder); } =item C<< bgp_join_plans( $bgp, $model, \@active_graphs, \@default_graphs, \@interesting_order, \@plansA, \@plansB, ... ) >> Returns a list of alternative plans for the join of a set of triples. The arguments C<@plansA>, C<@plansB>, etc. represent alternative plans for each triple participating in the join. =cut sub bgp_join_plans { my $self = shift; my $bgp = shift; my $model = shift; my $active = shift; my $default = shift; my $interesting = shift; my @triples = @_; if (scalar(@triples)) { my @plans = $self->joins_for_plan_alternatives($model, $active, $default, $interesting, @triples); my @triples = @{ $bgp->triples }; # If the BGP does not contain any blanks, then the results are # guaranteed to be distinct. Otherwise, we have to assume they're # not distinct. my $distinct = 1; LOOP: foreach my $t (@triples) { foreach my $b ($t->values_consuming_role('Attean::API::Blank')) { $distinct = 0; last LOOP; } foreach my $b ($t->values_consuming_role('Attean::API::Variable')) { if ($b->value =~ /^[.]/) { # variable names starting with a dot represent placeholders introduced during query planning (with C) # they are not projectable, and so may cause an otherwise distinct result to become non-distinct $distinct = 0; last LOOP; } } } # Set the distinct flag on each of the top-level join plans that # represents the entire BGP. (Sub-plans won't ever be marked as # distinct, but that shouldn't matter to the rest of the planning # process.) if ($distinct) { foreach my $p (@plans) { $p->distinct(1); } } return @plans; } else { # The empty BGP is a special case -- it results in a single join-identity result my $r = Attean::Result->new( bindings => {} ); my $plan = Attean::Plan::Table->new( rows => [$r], variables => [], distinct => 1, ordered => [] ); return $plan; } } =item C<< group_join_plans( $model, \@active_graphs, \@default_graphs, \@interesting_order, \@plansA, \@plansB, ... ) >> Returns a list of alternative plans for the join of a set of sub-plans. The arguments C<@plansA>, C<@plansB>, etc. represent alternative plans for each sub-plan participating in the join. =cut sub group_join_plans { my $self = shift; return $self->joins_for_plan_alternatives(@_); } =item C<< joins_for_plan_alternatives( $model, \@active_graphs, \@default_graphs, $interesting, \@plan_A, \@plan_B, ... ) >> Returns a list of alternative plans that may all be used to produce results matching the join of C<< plan_A >>, C< plan_B >>, etc. Each plan array here (e.g. C<< @plan_A >>) should contain equivalent plans. =cut sub joins_for_plan_alternatives { my $self = shift; my $model = shift; my $active_graphs = shift; my $default_graphs = shift; my $interesting = shift; my @args = @_; # each $args[$i] here is an array reference containing alternate plans for element $i die "This query planner does not seem to consume a Attean::API::JoinPlanner role (which is necessary for query planning)"; } =item C<< access_plans( $model, $active_graphs, $pattern ) >> Returns a list of alternative L objects that may be used to produce results matching the L $pattern in the context of C<< $active_graphs >>. =cut # $pattern is a Attean::API::TripleOrQuadPattern object # Return a Attean::API::Plan object that represents the evaluation of $pattern. # e.g. different plans might represent different ways of producing the matches (table scan, index match, etc.) sub access_plans { my $self = shift; my $model = shift; my $active_graphs = shift; my $pattern = shift; my @vars = map { $_->value } $pattern->values_consuming_role('Attean::API::Variable'); my %vars; my $dup = 0; foreach my $v (@vars) { $dup++ if ($vars{$v}++); } my $distinct = 0; # TODO: is this pattern distinct? does it have blank nodes? my @nodes = $pattern->values; unless ($nodes[3]) { $nodes[3] = $active_graphs; } my $plan = Attean::Plan::Quad->new( subject => $nodes[0], predicate => $nodes[1], object => $nodes[2], graph => $nodes[3], values => \@nodes, distinct => $distinct, ordered => [], ); return $plan; } =item C<< join_plans( $model, \@active_graphs, \@default_graphs, \@plan_left, \@plan_right, $type [, $expr] ) >> Returns a list of alternative plans for the join of one plan from C<< @plan_left >> and one plan from C<< @plan_right >>. The join C<< $type >> must be one of C<< 'inner' >>, C<< 'left' >>, or C<< 'minus' >>, indicating the join algorithm to be used. If C<< $type >> is C<< 'left' >>, then the optional C<< $expr >> may be used to supply a filter expression that should be used by the SPARQL left-join algorithm. =cut # $lhs and $rhs are both Attean::API::Plan objects # Return a Attean::API::Plan object that represents the evaluation of $lhs ⋈ $rhs. # The $left and $minus flags indicate the type of the join to be performed (⟕ and ▷, respectively). # e.g. different plans might represent different join algorithms (nested loop join, hash join, etc.) or different orderings ($lhs ⋈ $rhs or $rhs ⋈ $lhs) sub join_plans { my $self = shift; my $model = shift; my $active_graphs = shift; my $default_graphs = shift; my $lplans = shift; my $rplans = shift; my $type = shift; my $left = ($type eq 'left'); my $minus = ($type eq 'minus'); my $expr = shift; my @plans; Carp::confess unless (reftype($lplans) eq 'ARRAY'); foreach my $lhs (@{ $lplans }) { foreach my $rhs (@{ $rplans }) { my @vars = (@{ $lhs->in_scope_variables }, @{ $rhs->in_scope_variables }); my %vars; my %join_vars; foreach my $v (@vars) { if ($vars{$v}++) { $join_vars{$v}++; } } my @join_vars = keys %join_vars; if ($left) { if (scalar(@join_vars) > 0) { push(@plans, Attean::Plan::HashJoin->new(children => [$lhs, $rhs], left => 1, expression => $expr, join_variables => \@join_vars, distinct => 0, ordered => [])); } push(@plans, Attean::Plan::NestedLoopJoin->new(children => [$lhs, $rhs], left => 1, expression => $expr, join_variables => \@join_vars, distinct => 0, ordered => $lhs->ordered)); } elsif ($minus) { # we can't use a hash join for MINUS queries, because of the definition of MINUS having a special case for compatible results that have disjoint domains push(@plans, Attean::Plan::NestedLoopJoin->new(children => [$lhs, $rhs], anti => 1, join_variables => \@join_vars, distinct => 0, ordered => $lhs->ordered)); } else { if (scalar(@join_vars) > 0) { # if there's shared variables (hopefully), we can also use a hash join push(@plans, Attean::Plan::HashJoin->new(children => [$lhs, $rhs], join_variables => \@join_vars, distinct => 0, ordered => [])); push(@plans, Attean::Plan::HashJoin->new(children => [$rhs, $lhs], join_variables => \@join_vars, distinct => 0, ordered => [])); # } else { # warn "No join vars for $lhs ⋈ $rhs"; } # nested loop joins work in all cases push(@plans, Attean::Plan::NestedLoopJoin->new(children => [$lhs, $rhs], join_variables => \@join_vars, distinct => 0, ordered => $lhs->ordered)); push(@plans, Attean::Plan::NestedLoopJoin->new(children => [$rhs, $lhs], join_variables => \@join_vars, distinct => 0, ordered => $rhs->ordered)); } } } return @plans; } sub _comparator_referenced_variables { my $self = shift; my %vars; while (my $c = shift) { my $expr = $c->expression; foreach my $v ($expr->in_scope_variables) { $vars{$v}++; } } return keys %vars; } sub _comparators_are_stable_and_cover_vars { my $self = shift; my $cmps = shift; my @vars = @_; my %unseen = map { $_ => 1 } @vars; foreach my $c (@$cmps) { return 0 unless ($c->expression->is_stable); foreach my $v ($self->_comparator_referenced_variables($c)) { delete $unseen{$v}; } } my @keys = keys %unseen; return (scalar(@keys) == 0); } sub _order_by { my $self = shift; my $algebra = shift; my ($exprs, $ascending, $svars); my @cmps = @{ $algebra->comparators }; my %ascending; my %exprs; my @svars; foreach my $i (0 .. $#cmps) { my $var = $self->new_temporary('order'); my $cmp = $cmps[$i]; push(@svars, $var); $ascending{$var} = $cmp->ascending; $exprs{$var} = $cmp->expression; } return (\%exprs, \%ascending, \@svars); } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/SPARQLClient.pm000644 000765 000024 00000000224 14636707550 021470 xustar00gregstaff000000 000000 29 mtime=1719373672.07360228 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/SPARQLClient.pm000644 000765 000024 00000007117 14636707550 017527 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::SPARQLClient - RDF blank nodes =head1 VERSION This document describes Attean::SPARQLClient version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my $client = Attean::SPARQLClient->new(endpoint => 'http://example.org/sparql'); my $results = $client->query('SELECT * WHERE { ?s ?p ?o }'); while (my $r = $results->next) { say $r->as_string; } =head1 DESCRIPTION The Attean::SPARQLClient class provides an API to execute SPARQL queries against a remote SPARQL Protocol endpoint. =head1 ATTRIBUTES The following attributes exist: =over 4 =item C<< endpoint >> A URL of the remote service implementing the SPARQL 1.1 Protocol. This value is a L, but can be coerced from a string. =item C<< silent >> =item << user_agent >> =item C<< request_signer >> =back =head1 METHODS =over 4 =cut package Attean::SPARQLClient 0.034 { use Moo; use Types::Standard qw(ConsumerOf Bool Str InstanceOf); use Encode qw(encode); use Scalar::Util qw(blessed); use URI::Escape; use Attean::RDF qw(iri); use namespace::clean; has 'endpoint' => (is => 'ro', isa => ConsumerOf['Attean::API::IRI'], coerce => sub { iri(shift) }, required => 1); has 'silent' => (is => 'ro', isa => Bool, default => 0); has 'user_agent' => (is => 'rw', isa => InstanceOf['LWP::UserAgent'], default => sub { my $ua = LWP::UserAgent->new(); $ua->agent("Attean/$Attean::VERSION " . $ua->_agent); $ua }); has 'request_signer' => (is => 'rw'); =item C<< query_request( $sparql ) >> Returns an HTTP::Request object for the given SPARQL query string. =cut sub query_request { my $self = shift; my $sparql = shift; my $endpoint = $self->endpoint->value; my $uri = URI->new($endpoint); my %params = $uri->query_form; $params{'query'} = $sparql; $uri->query_form(%params); my $url = $uri->as_string; my $req = HTTP::Request->new('GET', $url); if (my $signer = $self->request_signer) { $signer->sign($req); } return $req; } =item C<< query( $sparql ) >> Executes the given SPARQL query string at the remote endpoint. If execution is successful, returns an Attean::API::Iterator object with the results. If execution fails but the client C<< silent >> flag is true, returns an empty iterator. Otherwise raises an error via C<< die >>. =cut sub query { my $self = shift; my $sparql = shift; my $req = $self->query_request($sparql); my $silent = $self->silent; my $ua = $self->user_agent; my $response = $ua->request($req); if (blessed($response) and $response->is_success) { my $type = $response->header('Content-Type'); my $pclass = Attean->get_parser(media_type => $type) or die "No parser for media type: $type"; my $parser = $pclass->new(); my $xml = $response->decoded_content; my $bytes = encode('UTF-8', $xml, Encode::FB_CROAK); return $parser->parse_iter_from_bytes($bytes); } elsif ($silent) { my $b = Attean::Result->new( bindings => {} ); return Attean::ListIterator->new(variables => [], values => [$b], item_type => 'Attean::API::Result'); } else { die "SPARQL Protocol error: " . $response->status_line; } } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO L =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/Result.pm000644 000765 000024 00000000225 14636707550 020606 xustar00gregstaff000000 000000 30 mtime=1719373672.038392468 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/Result.pm000644 000765 000024 00000004617 14636707550 016646 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::Result - SPARQL Result =head1 VERSION This document describes Attean::Result version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my $result = Attean::Result->new(bindings => { name => $literal, homepage => $iri } ); my @vars = $result->variables; # ('name', 'homepage') my $term = $result->value('name'); # $term == $literal =head1 DESCRIPTION The Attean::Result class represents a SPARQL result (a set of bindings from variable names to Ls). It conforms to the L role. =head1 METHODS =over 4 =cut package Attean::Result 0.034 { use Moo; use Types::Standard qw(HashRef ConsumerOf); use Attean::API::Binding; use namespace::clean; with 'Attean::API::Result'; =item C<< bindings >> Returns the HASH reference containing the variable bindings for this result. =cut has 'bindings' => (is => 'ro', isa => HashRef[ConsumerOf['Attean::API::TermOrTriple']], default => sub { +{} }); # sub BUILD { # my $self = shift; # my $args = shift; # use Data::Dumper; # my $b = $args->{bindings}; # my $keys = [keys %$b]; # if (scalar(@$keys) == 2) { # Carp::cluck 'NEW RESULT CONSTRUCTED with variables ' . Dumper($keys); # } # } =item C<< value( $name ) >> Returns the term object bound to the C<< $name >>d variable, or undef if the name does not map to a term. =cut sub value { my $self = shift; my $k = shift; return $self->bindings->{$k}; } =item C<< variables >> Returns a list of the variable names that are bound to terms in this result object. =cut sub variables { my $self = shift; return keys %{ $self->bindings }; } =item C<< as_string >> Returns a string serialization of the variable bindings contained in the result. =cut sub as_string { my $self = shift; my @vars = $self->variables; my @strs = map { join('=', $_, $self->value($_)->ntriples_string) } sort $self->variables; return '{' . join(', ', @strs) . '}'; } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/API.pm000644 000765 000024 00000000225 14636707547 017747 xustar00gregstaff000000 000000 30 mtime=1719373671.762572982 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API.pm000644 000765 000024 00000015647 14636707547 016014 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::API - Utility package for loading all Attean role packages. =head1 VERSION This document describes Attean::API version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a utility package that will load all the Attean-related Moo roles in the Attean::API namespace. =head1 METHODS =over 4 =cut package Attean::API::ResultOrTerm 0.034 { use Moo::Role; } package Attean::API::BlankOrIRI 0.034 { use Moo::Role; with 'Attean::API::Term', 'Attean::API::BlankOrIRIOrTriple'; } package Attean::API::BlankOrIRIOrTriple 0.034 { use Moo::Role; } package Attean::API::TermOrTriple 0.034 { use Moo::Role; } package Attean::API::TermOrVariable 0.034 { use Scalar::Util qw(blessed); use Sub::Install; use Sub::Util qw(set_subname); use Moo::Role; with 'Attean::API::SPARQLSerializable'; sub equals { my ($a, $b) = @_; return ($a->as_string eq $b->as_string); } sub is_bound { my $self = shift; return (! $self->does('Attean::API::Variable')); } sub apply_binding { my $self = shift; my $class = ref($self); my $bind = shift; if ($self->does('Attean::API::Variable')) { my $name = $self->value; my $replace = $bind->value($name); if (defined($replace) and blessed($replace)) { return $replace; } else { return $self; } } else { return $self; } } BEGIN { my %types = ( variable => 'Variable', blank => 'Blank', literal => 'Literal', resource => 'IRI', iri => 'IRI', ); while (my ($name, $role) = each(%types)) { my $method = "is_$name"; my $code = sub { return shift->does("Attean::API::$role") }; Sub::Install::install_sub({ code => set_subname($method, $code), as => $method }); } } } package Attean::API::TermOrVariableOrTriplePattern 0.034 { use Scalar::Util qw(blessed); use Sub::Install; use Sub::Util qw(set_subname); use Moo::Role; with 'Attean::API::SPARQLSerializable'; sub is_bound { my $self = shift; return (! $self->does('Attean::API::Variable')); } sub apply_binding { my $self = shift; my $class = ref($self); my $bind = shift; if ($self->does('Attean::API::Variable')) { my $name = $self->value; my $replace = $bind->value($name); if (defined($replace) and blessed($replace)) { return $replace; } else { return $self; } } else { return $self; } } BEGIN { my %types = ( variable => 'Variable', blank => 'Blank', literal => 'Literal', resource => 'IRI', iri => 'IRI', pattern => 'TriplePattern' ); while (my ($name, $role) = each(%types)) { my $method = "is_$name"; my $code = sub { return shift->does("Attean::API::$role") }; Sub::Install::install_sub({ code => set_subname($method, $code), as => $method }); } } } package Attean::Mapper 0.034 { use Moo::Role; requires 'map'; # my $that = $object->map($this) } package Attean::API::Variable 0.034 { use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Moo::Role; with 'Attean::API::TermOrVariable'; =item C<< as_string >> Returns a string representation of the variable.' =cut sub as_string { my $self = shift; return '?' . $self->value; } sub sparql_tokens { my $self = shift; my $t = AtteanX::SPARQL::Token->fast_constructor( VAR, -1, -1, -1, -1, [$self->value] ); return Attean::ListIterator->new( values => [$t], item_type => 'AtteanX::SPARQL::Token' ); } } package Attean::API::CanonicalizingBindingSet 0.034 { use Attean::RDF; use Moo::Role; use namespace::clean; with 'MooX::Log::Any'; requires 'elements'; sub canonical_set { my $self = shift; my ($set) = $self->canonical_set_with_mapping; return $set; } sub canonical_set_with_mapping { my $self = shift; my @t = $self->elements; my @tuples = map { [ $_->tuples_string, $_, {} ] } @t; my $replacements = 0; foreach my $p (@tuples) { my ($str, $t) = @$p; foreach my $pos ($t->variables) { my $term = $t->value($pos); my $tstr = $term->ntriples_string; if ($term->does('Attean::API::Blank') or $term->does('Attean::API::Variable')) { $str =~ s/\Q$tstr\E/~/; $str .= "#$tstr"; $p->[2]{$pos} = $tstr; $replacements++; $p->[0] = $str; } } } @tuples = sort { $a->[0] cmp $b->[0] } @tuples; my $counter = 1; my %mapping; foreach my $i (0 .. $#tuples) { my $p = $tuples[$i]; my ($str, $t) = @$p; my $item_class = ref($t); my ($next, $last) = ('')x2; $last = $tuples[$i-1][0] if ($i > 0); $next = $tuples[$i+1][0] if ($i < $#tuples); next if ($str eq $last or $str eq $next); foreach my $pos (reverse $t->variables) { if (defined(my $tstr = $p->[2]{$pos})) { $tstr =~ /^([?]|_:)([^#]+)$/; my $prefix = $1; my $name = $2; my $key = "$prefix$name"; delete $p->[2]{$pos}; my $id = (exists($mapping{$key})) ? $mapping{$key}{id} : sprintf("v%03d", $counter++); my $type = ($prefix eq '?' ? 'variable' : 'blank'); $mapping{ $key } = { id => $id, prefix => $prefix, type => $type }; my %t = $p->[1]->mapping; $t{ $pos } = ($type eq 'blank') ? Attean::Blank->new($id) : Attean::Variable->new($id); my $t = $item_class->new( %t ); $p->[1] = $t; $p->[0] = $t->tuples_string; } } } foreach my $p (@tuples) { my ($str, $t) = @$p; my $item_class = ref($t); foreach my $pos (reverse $t->variables) { if (defined(my $tstr = $p->[2]{$pos})) { $tstr =~ /^([?]|_:)([^#]+)$/; my $prefix = $1; my $name = $2; my $key = "$prefix$name"; delete $p->[2]{$pos}; unless (exists($mapping{$key})) { $self->error("Cannot canonicalize binding set"); return; } my $id = $mapping{$key}{id}; my $type = ($prefix eq '?' ? 'variable' : 'blank'); $mapping{ $key } = { id => $id, prefix => $prefix, type => $type }; my %t = $p->[1]->mapping; $t{ $pos } = ($type eq 'blank') ? Attean::Blank->new($id) : Attean::Variable->new($id); my $t = $item_class->new( %t ); $p->[1] = $t; $p->[0] = $t->tuples_string; } } } @tuples = sort { $a->[0] cmp $b->[0] } @tuples; my $elements = [ map { $_->[1] } @tuples ]; return ($elements, \%mapping); } } package Attean::API 0.034 { use Attean::API::Term; use Attean::API::Store; use Attean::API::Model; use Attean::API::Iterator; use Attean::API::Parser; use Attean::API::Serializer; use Attean::API::Query; use Attean::API::Expression; use Attean::API::Plan; use Attean::API::QueryPlanner; use Attean::Variable; use Attean::Blank; use Attean::IRI; } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/Variable.pm000644 000765 000024 00000000225 14636707550 021055 xustar00gregstaff000000 000000 30 mtime=1719373672.152792005 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/Variable.pm000644 000765 000024 00000003275 14636707550 017114 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::Variable - Pattern matching variables =head1 VERSION This document describes Attean::Variable version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my $term = Attean::Variable->new('name'); $term->ntriples_string; # ?name =head1 DESCRIPTION The Attean::Variable class represents variables for use in pattern matching. It conforms to the L role. =head1 ATTRIBUTES =over 4 =item C<< value >> =item C<< ntriples_string >> =back =cut package Attean::Variable 0.034 { use Moo; use Types::Standard qw(Str); use UUID::Tiny ':std'; use namespace::clean; has 'value' => (is => 'ro', isa => Str, required => 1); has 'ntriples_string' => (is => 'ro', isa => Str, lazy => 1, builder => '_ntriples_string'); with 'Attean::API::Variable'; with 'Attean::API::TermOrVariable'; with 'Attean::API::TermOrVariableOrTriplePattern'; around BUILDARGS => sub { my $orig = shift; my $class = shift; if (scalar(@_) == 0) { my $uuid = unpack('H*', create_uuid()); return $class->$orig(value => 'v' . $uuid); } elsif (scalar(@_) == 1) { return $class->$orig(value => shift); } return $class->$orig(@_); }; sub _ntriples_string { my $self = shift; return '?' . $self->value; } } 1; __END__ =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/TripleModel.pm000644 000765 000024 00000000225 14636707550 021550 xustar00gregstaff000000 000000 30 mtime=1719373672.137284108 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/TripleModel.pm000644 000765 000024 00000022547 14636707550 017612 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::TripleModel - RDF model backed by a set of triple-stores =head1 VERSION This document describes Attean::TripleModel version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my $model = Attean::TripleModel->new( stores => { 'http://example.org/graph1' => $store1, 'http://example.org/graph2' => $store2, } ); =head1 DESCRIPTION The Attean::TripleModel class represents a model that is backed by a set of L objects, identified by an IRI string. It conforms to the L role. The Attean::TripleModel constructor requires one named argument: =over 4 =item stores A hash mapping graph IRI values to L objects representing the backing triple-store for that graph. =back =head1 METHODS =over 4 =cut package Attean::TripleModel 0.034 { use Moo; use Types::Standard qw(ArrayRef ConsumerOf HashRef); use Scalar::Util qw(reftype blessed); use namespace::clean; with 'MooX::Log::Any'; with 'Attean::API::Model'; with 'Attean::API::CostPlanner'; has 'stores' => ( is => 'ro', isa => HashRef[ConsumerOf['Attean::API::TripleStore']], required => 1, default => sub { +{} }, ); =item C<< size >> =cut sub size { my $self = shift; my $count = 0; foreach my $store (values %{ $self->stores }) { $count += $store->size; } return $count; } =item C<< count_quads >> =cut sub count_quads { my $self = shift; # TODO: don't materialize results here just to count them my $iter = $self->get_quads( @_ ); my $count = 0; while (my $r = $iter->next) { $count++; } return $count; } =item C<< count_quads_estimate >> =cut sub count_quads_estimate { my $self = shift; my ($s, $p, $o, $g) = @_; if (blessed($g) and $g->does('Attean::API::IRI')) { if (my $store = $self->stores->{ $g->value }) { return $store->count_quads_estimate(@_); } else { return 0; } } else { return $self->count_quads(@_); } } =item C<< holds >> =cut sub holds { my $self = shift; return ($self->count_quads_estimate(@_) > 0) } =item C<< get_graphs >> =cut sub get_graphs { my $self = shift; my @graphs = map { Attean::IRI->new($_) } keys %{ $self->stores }; return Attean::ListIterator->new( values => \@graphs, item_type => 'Attean::API::Term' ); } =item C<< get_quads ( $subject, $predicate, $object, $graph ) >> Returns an L for quads in the model that match the supplied C<< $subject >>, C<< $predicate >>, C<< $object >>, and C<< $graph >>. Any of these terms may be undefined or a L object, in which case that term will be considered as a wildcard for the purposes of matching. The returned iterator conforms to both L and L. =cut sub get_quads { my $self = shift; my @nodes = @_[0..3]; foreach my $i (0..3) { my $t = $nodes[$i] // Attean::Variable->new(); if (not(ref($t)) or reftype($t) ne 'ARRAY') { $nodes[$i] = [$t]; } } my @iters; foreach my $s (@{ $nodes[0] }) { foreach my $p (@{ $nodes[1] }) { foreach my $o (@{ $nodes[2] }) { foreach my $g (@{ $nodes[3] }) { my $iter = $self->_get_quads($s, $p, $o, $g); push(@iters, $iter); } } } } if (scalar(@iters) <= 1) { return shift(@iters); } else { return Attean::IteratorSequence->new( iterators => \@iters, item_type => $iters[0]->item_type ); } } sub _get_quads { my $self = shift; my $s = shift; my $p = shift; my $o = shift; my $g = shift; if (blessed($g) and $g->does('Attean::API::IRI')) { if (my $store = $self->stores->{ $g->value }) { my $iter = $store->get_triples($s, $p, $o); return $iter->as_quads($g); } } elsif (blessed($g) and $g->does('Attean::API::Variable')) { my @iters; while (my ($g, $store) = each %{ $self->stores }) { my $iter = $store->get_triples($s, $p, $o); my $graph = Attean::IRI->new($g); my $quads = $iter->map(sub { $_->as_quad($graph) }, 'Attean::API::Quad'); push(@iters, $quads); } my $iter = Attean::IteratorSequence->new( iterators => \@iters, item_type => $iters[0]->item_type ); return $iter; } else { my $name = (blessed($g) and $g->can('as_string')) ? $g->as_string : "$g"; $self->log->warn("TripleModel cannot produce quads for non-IRI graph: $name"); } return Attean::ListIterator->new( values => [], item_type => 'Attean::API::Quad' ); } =item C<< plans_for_algebra( $algebra, $planner, $active_graphs, $default_graphs ) >> Delegates to an underlying store if the active graph is bound to the store, and the store consumes Attean::API::CostPlanner. =cut sub plans_for_algebra { my $self = shift; my $algebra = shift; my $planner = shift; my $active_graphs = shift; my $default_graphs = shift; my @plans; if (scalar(@$active_graphs) == 1) { my $graph = $active_graphs->[0]; if (my $store = $self->stores->{ $graph->value }) { if ($store->does('Attean::API::CostPlanner')) { push(@plans, $store->plans_for_algebra($algebra, $planner, $active_graphs, $default_graphs)); } } } return @plans; } =item C<< cost_for_plan( $plan ) >> Attempts to delegate to all the underlying stores if that store consumes Attean::API::CostPlanner. =cut sub cost_for_plan { my $self = shift; my $plan = shift; foreach my $store (values %{ $self->stores }) { if ($store->does('Attean::API::CostPlanner')) { if (defined(my $cost = $store->cost_for_plan($plan, @_))) { return $cost; } } } return; } } package Attean::AddativeTripleModelRole 0.034 { use Scalar::Util qw(blessed); use Types::Standard qw(CodeRef); use Moo::Role; with 'Attean::API::Model'; has 'store_constructor' => (is => 'ro', isa => CodeRef, required => 1); =item C<< add_store( $graph => $store ) >> Add the L C<< $store >> object to the model using the IRI string value C<< $graph >> as the graph name. =cut sub add_store { my $self = shift; my $graph = shift; my $iri = blessed($graph) ? $graph->value : $graph; my $store = shift; die if exists $self->stores->{ $iri }; $self->stores->{ $iri } = $store; } =item C<< create_graph( $graph ) >> Create a new L and add it to the model using the L C<< $graph >> as the graph name. The store is constructed by using this object's C<< store_constructor >> attribute: my $store = $self->store_constructor->($graph); =cut sub create_graph { my $self = shift; my $graph = shift; my $iri = $graph->value; return if exists $self->stores->{ $iri }; my $store = $self->store_constructor->($graph); $self->stores->{ $iri } = $store; }; =item C<< drop_graph( $graph ) >> Removes the store associated with the given C<< $graph >>. =cut sub drop_graph { my $self = shift; my $g = shift; if ($g->does('Attean::API::IRI')) { delete $self->stores->{ $g->value }; } } } package Attean::MutableTripleModel 0.034 { use Moo; use Types::Standard qw(ArrayRef ConsumerOf HashRef); use Scalar::Util qw(reftype); use namespace::clean; extends 'Attean::TripleModel'; with 'Attean::API::MutableModel'; has 'stores' => ( is => 'ro', isa => HashRef[ConsumerOf['Attean::API::MutableTripleStore']], required => 1, default => sub { +{} }, ); =item C<< add_quad ( $quad ) >> Adds the specified C<$quad> to the underlying model. =cut sub add_quad { my $self = shift; my $q = shift; my $g = $q->graph; die "Cannot add a quad whose graph is not an IRI" unless ($g->does('Attean::API::IRI')); my $v = $g->value; if (my $store = $self->stores->{ $v }) { $store->add_triple( $q->as_triple ); } else { Carp::confess "No such graph: $v"; } } =item C<< remove_quad ( $quad ) >> Removes the specified C<< $quad >> from the underlying store. =cut sub remove_quad { my $self = shift; my $q = shift; my $g = $q->graph; if ($g->does('Attean::API::IRI')) { my $v = $g->value; if (my $store = $self->stores->{ $v }) { $store->remove_triple( $q->as_triple ); } } } sub create_graph { die; } =item C<< drop_graph( $graph ) >> Removes the store associated with the given C<< $graph >>. =cut sub drop_graph { my $self = shift; my $g = shift; if ($g->does('Attean::API::IRI')) { delete $self->stores->{ $g->value }; } } =item C<< clear_graph( $graph ) >> Removes all quads with the given C<< $graph >>. =cut sub clear_graph { my $self = shift; my $g = shift; $self->drop_graph($g); $self->create_graph($g); } } package Attean::AddativeTripleModel 0.034 { use Moo; use Scalar::Util qw(blessed); use Types::Standard qw(CodeRef); use namespace::clean; extends 'Attean::TripleModel'; with 'Attean::AddativeTripleModelRole'; } package Attean::AddativeMutableTripleModel 0.034 { use Moo; use Scalar::Util qw(blessed); use Types::Standard qw(CodeRef); use namespace::clean; extends 'Attean::MutableTripleModel'; with 'Attean::AddativeTripleModelRole'; } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/IteratorSequence.pm000644 000765 000024 00000000224 14636707547 022617 xustar00gregstaff000000 000000 29 mtime=1719373671.89898414 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/IteratorSequence.pm000644 000765 000024 00000004515 14636707547 020655 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::IteratorSequence - Iterator implementation backed by zero or more sub-iterators =head1 VERSION This document describes Attean::IteratorSequence version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my $iter = Attean::IteratorSequence->new(iterators => [$iter1, $iter2]); =head1 DESCRIPTION The Attean::IteratorSequence class represents a typed iterator that is backed by zero or more sub-iterators. When iterated over, it will return all the elements of all of its sub-iterators, in order, before returning undef. It conforms to the L role. The Attean::IteratorSequence constructor requires two named arguments: =over 4 =item iterators An array reference containing zero or more L objects. =item item_type A string representing the type of the items that will be returned from the iterator. =back =head1 METHODS =over 4 =cut package Attean::IteratorSequence 0.034 { use Moo; use Types::Standard qw(ArrayRef ConsumerOf); use namespace::clean; with 'Attean::API::Iterator'; has iterators => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Iterator']], default => sub { [] }); =item C<< next >> Returns the iterator's next item, or undef upon reaching the end of iteration. =cut sub next { my $self = shift; my $list = $self->iterators; while (1) { return unless (scalar(@$list)); my $iter = $list->[0]; my $item = $iter->next; unless (defined($item)) { shift(@$list); next; } return $item; } } =item C<< push( $iterator ) >> Adds the new C<< $iterator >> to the end of the array of sub-iterators. After this call, C<< $iterator >> will be owned by the IteratorSequence, so making any method calls on C<< $iterator >> after this point may produce unexpected results. =cut sub push { my $self = shift; my $iter = shift; push(@{ $self->iterators }, $iter); return; } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/RDF.pm000644 000765 000024 00000000225 14636707550 017743 xustar00gregstaff000000 000000 30 mtime=1719373672.022275896 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/RDF.pm000644 000765 000024 00000006103 14636707550 015773 0ustar00gregstaff000000 000000 =head1 NAME Attean::RDF - Utility package for exporting shorthand functions for constructing RDF objects =head1 VERSION This document describes Attean::RDF version 0.034 =head1 SYNOPSIS use v5.14; use Attean::RDF; my $s = blank('b'); my $p = iri('http://xmlns.com/foaf/0.1/name'); my $o = langliteral("Eve", "en"); my $triple = triple($s, $p, $o); say $triple->as_string; # _:b "Eve"@en . =head1 DESCRIPTION This is a utility package for exporting shorthand functions for constructing RDF objects such as IRIs, Literals, Blanks, Triples, etc. =head1 FUNCTIONS All of the functions defined in this package may be exported (and are exported by default). =over 4 =cut package Attean::RDF 0.034 { use v5.14; use warnings; require Exporter::Tiny; our @ISA = qw(Exporter::Tiny); our @EXPORT = qw(iri blank literal dtliteral langliteral variable triple quad triplepattern quadpattern bgp); require Attean; use List::MoreUtils qw(zip); use namespace::clean; =item C<< variable( $value ) >> C<< Attean::Variable->new($value) >> =cut sub variable { return Attean::Variable->new(@_); } =item C<< iri( $value ) >> C<< Attean::IRI->new($value) >> =cut sub iri { return Attean::IRI->new(@_); } =item C<< blank( $value ) >> C<< Attean::Blank->new($value) >> =cut sub blank { return Attean::Blank->new(@_); } =item C<< literal( $value ) >> C<< Attean::Literal->new($value) >> =cut sub literal { return Attean::Literal->new(@_); } =item C<< dtliteral( $value, $dt ) >> C<< Attean::Literal->new( value => $value, datatype => $dt ) >> =cut sub dtliteral { my @k = qw(value datatype); return Attean::Literal->new(zip @k, @_); } =item C<< langliteral( $value, $lang ) >> C<< Attean::Literal->new( value => $value, language => $lang ) >> =cut sub langliteral { my @k = qw(value language); return Attean::Literal->new(zip @k, @_); } =item C<< triple( @terms ) >> C<< Attean::Triple->new( @terms ) >> =cut sub triple { return Attean::Triple->new(@_); } =item C<< triplepattern( @terms ) >> C<< Attean::TriplePattern->new( @terms ) >> =cut sub triplepattern { return Attean::TriplePattern->new(@_); } =item C<< quad( @terms ) >> C<< Attean::Quad->new( @terms ) >> =cut sub quad { return Attean::Quad->new(@_); } =item C<< quadpattern( @terms ) >> C<< Attean::QuadPattern->new( @terms ) >> =cut sub quadpattern { return Attean::QuadPattern->new(@_); } =item C<< bgp( @triplepatterns ) >> C<< Attean::Algebra::BGP->new( triples => \@triplepatterns ) >> =cut sub bgp { return Attean::Algebra::BGP->new(triples => \@_); } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO L L =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/000755 000765 000024 00000000000 14636711137 015427 5ustar00gregstaff000000 000000 Attean-0.034/lib/Attean/PaxHeader/ListIterator.pm000644 000765 000024 00000000225 14636707547 021763 xustar00gregstaff000000 000000 30 mtime=1719373671.914498953 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/ListIterator.pm000644 000765 000024 00000005235 14636707547 020020 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::ListIterator - Iterator implementation backed by a list/array of values =head1 VERSION This document describes Attean::ListIterator version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my @values = map { Attean::Literal->new($_) } (1,2,3); my $iter = Attean::ListIterator->new( values => \@values, item_type => 'Attean::API::Term', ); say $iter->next->value; # 1 say $iter->next->value; # 2 say $iter->next->value; # 3 =head1 DESCRIPTION The Attean::ListIterator class represents a typed iterator. It conforms to the L role. The Attean::ListIterator constructor requires two named arguments: =over 4 =item values An array reference containing the items to iterate over. =item item_type A string representing the type of the items that will be returned from the iterator. =back =head1 METHODS =over 4 =cut package Attean::ListIterator 0.034 { use Moo; use Scalar::Util qw(blessed); use Type::Tiny::Role; use Types::Standard qw(ArrayRef Int); use namespace::clean; has values => (is => 'ro', isa => ArrayRef, required => 1); has current => (is => 'rw', isa => Int, init_arg => undef, default => 0); sub BUILD { my $self = shift; my $role = $self->item_type; foreach my $item (@{ $self->values }) { if (Role::Tiny->is_role($role)) { die "ListIterator item <$item> is not a $role" unless (blessed($item) and $item->does($role)); } } } =item C<< reset >> Resets the iterator's internal state so that iteration begins again at the beginning of the values array. =cut sub reset { my $self = shift; $self->current(0); } =item C<< next >> Returns the iterator's next item, or undef upon reaching the end of iteration. =cut sub next { my $self = shift; my $list = $self->values; my $index = $self->current; my $item = $list->[$index]; return unless defined($item); $self->current(1+$index); return $item; } =item C<< size >> Returns the number of elements still remaining in the iterator until it is fully consumed or until C<< reset >> is called. =cut sub size { my $self = shift; return scalar(@{ $self->values }) - $self->current; } with 'Attean::API::RepeatableIterator'; } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/Triple.pm000644 000765 000024 00000000225 14636707550 020567 xustar00gregstaff000000 000000 30 mtime=1719373672.121386816 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/Triple.pm000644 000765 000024 00000004174 14636707550 016625 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::Triple - RDF Triples =head1 VERSION This document describes Attean::Triple version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my $triple = Attean::Triple->new( $s, $p, $o ); =head1 DESCRIPTION The Attean::Triple class represents an RDF triple. It conforms to the L role. =head1 ROLES This role consumes L. =head1 METHODS =over 4 =item C<< subject >> =item C<< predicate >> =item C<< object >> =back =cut package Attean::TriplePattern 0.034 { use Moo; use Scalar::Util qw(blessed); use Attean::RDF; use Attean::API::Binding; has 'subject' => (is => 'ro', required => 1); has 'predicate' => (is => 'ro', required => 1); has 'object' => (is => 'ro', required => 1); with 'Attean::API::TriplePattern'; sub as_quadpattern { my $self = shift; my $graph = shift; # TODO: deprecate this in favor of as_quad_pattern() provided by Attean::API::TriplePattern return $self->as_quad_pattern($graph); } sub ntriples_string { my $self = shift; return join(' ', '<<', (map { $self->$_()->ntriples_string() } qw(subject predicate object)), '>>'); } } package Attean::Triple 0.034 { use Moo; use Attean::API::Binding; has 'subject' => (is => 'ro', does => 'Attean::API::BlankOrIRI', required => 1); has 'predicate' => (is => 'ro', does => 'Attean::API::IRI', required => 1); has 'object' => (is => 'ro', does => 'Attean::API::Term', required => 1); with 'Attean::API::Triple'; around BUILDARGS => sub { my $orig = shift; my $class = shift; if (scalar(@_) == 3) { my %args; @args{ $class->variables } = @_; return $class->$orig(%args); } return $class->$orig(@_); }; } 1; __END__ =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/TreeRewriter.pm000644 000765 000024 00000000225 14636707550 021753 xustar00gregstaff000000 000000 30 mtime=1719373672.105185292 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/TreeRewriter.pm000644 000765 000024 00000012261 14636707550 020005 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::TreeRewriter - Walk and rewrite subtrees =head1 VERSION This document describes Attean::TreeRewriter version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my $w = Attean::TreeRewriter->new(); my ($rewritten, $tree) = $w->rewrite($tree, $thunk); if ($rewritten) { ... } =head1 DESCRIPTION The Attean::TreeRewriter class walks the nodes of query trees and rewrites sub-trees based on handlers that have been registered prior to rewriting. =head1 ROLES None. =head1 METHODS =over 4 =cut package Attean::TreeRewriter 0.034 { use Moo; use Types::Standard qw(CodeRef ArrayRef Str); use Scalar::Util qw(blessed refaddr); use namespace::clean; with 'MooX::Log::Any'; has types => (is => 'rw', isa => ArrayRef[Str], default => sub { ['Attean::API::DirectedAcyclicGraph'] }); has pre_handlers => (is => 'rw', isa => ArrayRef[CodeRef], default => sub { [] }); =item C<< register_pre_handler( \&code ) >> Register a handler that will be called for each sub-tree during tree rewriting. The function will be called as C<< &code( $tree, $parent_node, $thunk ) >> where C<< $thunk >> is an opaque value passed to C<< rewrite >>. The function must return a list C<< ($handled, $descend, $rewritten) >>. C<< $handled >> is a boolean indicating whether the handler function rewrote the sub-tree, which is returned as C<< $rewritten >>. The C<< $descend >> boolean value indicates whether the the tree rewriting should continue downwards in the tree. =cut sub register_pre_handler { my $self = shift; my $code = shift; push(@{ $self->pre_handlers }, $code); } sub _fire_pre_handlers { my $self = shift; my ($t, $parent, $thunk) = @_; my $main_descend = 0; foreach my $cb (@{ $self->pre_handlers }) { my ($handled, $descend, $rewritten) = $cb->($t, $parent, $thunk); unless (defined($descend)) { $descend = 1; } if ($handled) { return ($descend, $rewritten); } elsif ($descend) { $main_descend = 1; } } return ($main_descend, undef); } =item C<< rewrite( $tree, $thunk, \%seen, $parent ) >> Rewrites the given C<< $tree >> using the registered handler functions. C<< $thunk >> is passed through to each handler function. C<< %seen >> is currently unused. C<< $parent >> is passed through to the handler functions as the value of the pseudo-parent tree node for C<< $tree >>. Returns a list C<< ($handled, $tree) >> with C<< $handled >> indicating whether rewriting was performed, with the corresponding rewritten C<< $tree >>. =cut sub rewrite { my $self = shift; my $tree = shift; my $thunk = shift; my $seen = shift || {}; my $parent = shift; my $ok = 0; # if ($seen->{ refaddr($tree) }++) { # return (0, $tree); # } foreach my $type (@{ $self->types }) { if (blessed($tree) and $tree->does($type)) { $ok++; } } unless ($ok) { $self->log->debug(ref($tree) . ' does not conform to any rewrite roles'); return (0, $tree); } my ($descend, $rewritten) = $self->_fire_pre_handlers($tree, $parent, $thunk); if ($rewritten) { if (refaddr($rewritten) == refaddr($tree)) { return (0, $tree); } if ($descend) { (undef, my $rewritten2) = $self->rewrite($rewritten, $thunk, $seen, $parent); my $changed = (refaddr($rewritten) != refaddr($rewritten2)); return ($changed, $rewritten2); } else { return (1, $rewritten); } } if ($descend) { my @children; my %attributes; my $changed = 0; if ($tree->does('Attean::API::DirectedAcyclicGraph')) { my @c = @{ $tree->children }; foreach my $i (0 .. $#c) { my $p = $c[$i]; my ($childchanged, $child) = $self->rewrite($p, $thunk, $seen, $tree); push(@children, $childchanged ? $child : $p); if ($childchanged) { $self->log->debug("Child $p changed for parent $tree"); $changed = 1; } } } if ($tree->can('tree_attributes')) { foreach my $attr ($tree->tree_attributes) { my $p = $tree->$attr(); if (ref($p) eq 'ARRAY') { my @patterns; foreach my $pp (@$p) { # warn "- $attr: $pp\n"; my ($childchanged, $child) = $self->rewrite($pp, $thunk, $seen, $tree); if ($childchanged) { $changed = 1; } push(@patterns, $child); } $attributes{$attr} = \@patterns; } else { # warn "- $attr: $p\n"; my ($childchanged, $child) = $self->rewrite($p, $thunk, $seen, $tree); $attributes{$attr} = $child; if ($childchanged) { $changed = 1; } } } } if ($changed) { my $class = ref($tree); $rewritten = $class->new( %attributes, children => \@children ); # (undef, $rewritten) = $self->rewrite($rewritten, $thunk, $seen, $parent); return (1, $rewritten); } } return (0, $tree); } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/Blank.pm000644 000765 000024 00000000225 14636707547 020365 xustar00gregstaff000000 000000 30 mtime=1719373671.795937645 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/Blank.pm000644 000765 000024 00000003172 14636707547 016420 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::Blank - RDF blank nodes =head1 VERSION This document describes Attean::Blank version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my $term = Attean::Blank->new('b1'); $term->ntriples_string; # _:b1 =head1 DESCRIPTION The Attean::Blank class represents RDF blank nodes. It conforms to the L role. =head1 ROLES This role consumes L, which provides the following methods: =over 4 =item C<< value >> =back =cut package Attean::Blank 0.034 { use Moo; use Types::Standard qw(Str); use UUID::Tiny ':std'; use namespace::clean; has 'value' => (is => 'ro', isa => Str, required => 1); has 'ntriples_string' => (is => 'ro', isa => Str, lazy => 1, builder => '_ntriples_string'); with 'Attean::API::Blank'; around BUILDARGS => sub { my $orig = shift; my $class = shift; if (scalar(@_) == 0) { my $uuid = unpack('H*', create_uuid()); return $class->$orig(value => 'b' . $uuid); } elsif (scalar(@_) == 1) { my $value = shift // ''; return $class->$orig(value => $value); } return $class->$orig(@_); }; sub _ntriples_string { my $self = shift; return '_:' . $self->value; } } 1; __END__ =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/Expression.pm000644 000765 000024 00000000225 14636707547 021475 xustar00gregstaff000000 000000 30 mtime=1719373671.837015926 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/Expression.pm000644 000765 000024 00000030455 14636707547 017534 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::Expression - SPARQL Expressions =head1 VERSION This document describes Attean::Expression version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my $binding = Attean::Result->new(); my $value = Attean::ValueExpression->new( value => Attean::Literal->integer(2) ); my $plus = Attean::BinaryExpression->new( children => [$value, $value], operator => '+' ); my $result = $plus->evaluate($binding); say $result->numeric_value; # 4 =head1 DESCRIPTION This is a utility package that defines all the Attean SPARQL expression classes consisting of logical, numeric, and function operators, constant terms, and variables. Expressions may be evaluated in the context of a L object, and either return a L object or throw a type error exception. The expression classes are: =over 4 =cut use Attean::API::Expression; =item * L =cut package Attean::ValueExpression 0.034 { use Moo; use Types::Standard qw(ConsumerOf); use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use namespace::clean; with 'Attean::API::SPARQLSerializable'; with 'Attean::API::Expression'; has 'value' => (is => 'ro', isa => ConsumerOf['Attean::API::TermOrVariableOrTriplePattern']); sub arity { return 0 } sub BUILDARGS { my $class = shift; return $class->SUPER::BUILDARGS(@_, operator => '_value'); } sub tree_attributes { return qw(operator) } sub is_stable { return 1; } sub as_string { my $self = shift; my $str = $self->value->ntriples_string; if ($str =~ m[^"(true|false)"\^\^$]) { return $1; } elsif ($str =~ m[^"(\d+)"\^\^$]) { return $1 } return $str; } sub in_scope_variables { my $self = shift; if ($self->value->does('Attean::API::Variable')) { return $self->value->value; } return; } sub sparql_tokens { my $self = shift; return $self->value->sparql_tokens; } sub unaggregated_variables { my $self = shift; if ($self->value->does('Attean::API::Variable')) { return $self->value; } return; } } =item * L =cut package Attean::UnaryExpression 0.034 { use Moo; use Types::Standard qw(Enum); use namespace::clean; with 'Attean::API::UnaryExpression', 'Attean::API::Expression', 'Attean::API::UnaryQueryTree'; my %map = ('NOT' => '!'); around 'BUILDARGS' => sub { my $orig = shift; my $class = shift; my $args = $class->$orig(@_); my $op = $args->{operator}; $args->{operator} = $map{uc($op)} if (exists $map{uc($op)}); return $args; }; sub BUILD { my $self = shift; state $type = Enum[qw(+ - !)]; $type->assert_valid($self->operator); } sub tree_attributes { return qw(operator) } sub is_stable { my $self = shift; foreach my $c (@{ $self->children }) { return 0 unless ($c->is_stable); } return 1; } } =item * L =cut package Attean::BinaryExpression 0.034 { use Moo; use Types::Standard qw(Enum); use namespace::clean; with 'Attean::API::BinaryExpression'; sub BUILD { my $self = shift; state $type = Enum[qw(+ - * / < <= > >= != = && ||)]; $type->assert_valid($self->operator); } sub tree_attributes { return qw(operator) } sub is_stable { my $self = shift; foreach my $c (@{ $self->children }) { return 0 unless ($c->is_stable); } return 1; } } =item * L =cut package Attean::FunctionExpression 0.034 { use Moo; use Types::Standard qw(Enum ConsumerOf HashRef); use Types::Common::String qw(UpperCaseStr); use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use namespace::clean; has 'operator' => (is => 'ro', isa => UpperCaseStr, coerce => UpperCaseStr->coercion, required => 1); has 'base' => (is => 'rw', isa => ConsumerOf['Attean::IRI'], predicate => 'has_base'); with 'Attean::API::NaryExpression'; with 'Attean::API::SPARQLSerializable'; around 'BUILDARGS' => sub { my $orig = shift; my $class = shift; my $args = $class->$orig(@_); if ($args->{operator} eq 'ISURI') { $args->{operator} = 'ISIRI'; } $args->{operator} = UpperCaseStr->coercion->($args->{operator}); return $args; }; sub BUILD { my $self = shift; state $type = Enum[qw(INVOKE IN NOTIN STR LANG LANGMATCHES DATATYPE BOUND IRI URI BNODE RAND ABS CEIL FLOOR ROUND CONCAT SUBSTR STRLEN REPLACE UCASE LCASE ENCODE_FOR_URI CONTAINS STRSTARTS STRENDS STRBEFORE STRAFTER YEAR MONTH DAY HOURS MINUTES SECONDS TIMEZONE TZ NOW UUID STRUUID MD5 SHA1 SHA256 SHA384 SHA512 COALESCE IF STRLANG STRDT SAMETERM ISIRI ISBLANK ISLITERAL ISNUMERIC REGEX TRIPLE ISTRIPLE SUBJECT PREDICATE OBJECT)]; $type->assert_valid($self->operator); } sub tree_attributes { return qw(operator) } sub is_stable { my $self = shift; return 0 if ($self->operator =~ m/^(?:RAND|BNODE|UUID|STRUUID|NOW)$/); foreach my $c (@{ $self->children }) { return 0 unless ($c->is_stable); } return 1; } sub sparql_tokens { my $self = shift; my $func = AtteanX::SPARQL::Token->keyword($self->operator); my $lparen = AtteanX::SPARQL::Token->lparen; my $rparen = AtteanX::SPARQL::Token->rparen; my $comma = AtteanX::SPARQL::Token->comma; my @tokens; push(@tokens, $func, $lparen); foreach my $t (@{ $self->children }) { push(@tokens, $t->sparql_tokens->elements); push(@tokens, $comma); } if (scalar(@tokens) > 2) { pop(@tokens); # remove the last comma } push(@tokens, $rparen); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } package Attean::AggregateExpression 0.034 { use Moo; use Types::Standard qw(Bool Enum Str HashRef ConsumerOf Maybe ArrayRef); use Types::Common::String qw(UpperCaseStr); use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use namespace::clean; around 'BUILDARGS' => sub { my $orig = shift; my $class = shift; my $args = $class->$orig(@_); $args->{operator} = UpperCaseStr->coercion->($args->{operator}); return $args; }; sub BUILD { my ($self, $args) = @_; state $type = Enum[qw(COUNT SUM MIN MAX AVG GROUP_CONCAT SAMPLE RANK CUSTOM FOLD)]; $type->assert_valid(shift->operator); } has 'custom_iri' => (is => 'ro', isa => Maybe[Str]); has 'operator' => (is => 'ro', isa => UpperCaseStr, coerce => UpperCaseStr->coercion, required => 1); has 'scalar_vars' => (is => 'ro', isa => HashRef, default => sub { +{} }); has 'distinct' => (is => 'ro', isa => Bool, default => 0); has 'variable' => (is => 'ro', isa => ConsumerOf['Attean::API::Variable'], required => 1); has 'order' => (is => 'ro', isa => ArrayRef, required => 1, default => sub { [] }); with 'Attean::API::AggregateExpression'; with 'Attean::API::SPARQLSerializable'; sub tree_attributes { return qw(operator scalar_vars variable) } sub is_stable { my $self = shift; foreach my $expr (@{ $self->groups }, values %{ $self->aggregates }) { return 0 unless ($expr->is_stable); } return 1; } sub sparql_tokens { my $self = shift; my $distinct = AtteanX::SPARQL::Token->keyword('DISTINCT'); my $func = AtteanX::SPARQL::Token->keyword($self->operator); my $lparen = AtteanX::SPARQL::Token->lparen; my $rparen = AtteanX::SPARQL::Token->rparen; my $comma = AtteanX::SPARQL::Token->comma; my @tokens; push(@tokens, $func); push(@tokens, $lparen); if ($self->distinct) { push(@tokens, $distinct); } foreach my $t (@{ $self->children }) { push(@tokens, $t->sparql_tokens->elements); push(@tokens, $comma); } if (scalar(@tokens) > 2) { pop(@tokens); # remove the last comma } my $vars = $self->scalar_vars; my @keys = keys %$vars; if (scalar(@keys)) { die "TODO: Implement SPARQL serialization for aggregate scalar vars"; } push(@tokens, $rparen); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } package Attean::CastExpression 0.034 { use Moo; use Types::Standard qw(Enum ConsumerOf); use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use namespace::clean; with 'Attean::API::SPARQLSerializable'; with 'Attean::API::UnaryExpression', 'Attean::API::Expression', 'Attean::API::UnaryQueryTree'; has 'datatype' => (is => 'ro', isa => ConsumerOf['Attean::API::IRI']); sub BUILDARGS { my $class = shift; return $class->SUPER::BUILDARGS(@_, operator => '_cast'); } sub BUILD { my $self = shift; state $type = Enum[map { "http://www.w3.org/2001/XMLSchema#$_" } qw(integer decimal float double string boolean dateTime)]; $type->assert_valid($self->datatype->value); } sub tree_attributes { return qw(operator datatype) } sub is_stable { my $self = shift; foreach my $c (@{ $self->children }) { return 0 unless ($c->is_stable); } return 1; } sub sparql_tokens { my $self = shift; my $dt = AtteanX::SPARQL::Token->fast_constructor( IRI, -1, -1, -1, -1, [$self->datatype->value] ), my $lparen = AtteanX::SPARQL::Token->lparen; my $rparen = AtteanX::SPARQL::Token->rparen; my $comma = AtteanX::SPARQL::Token->comma; my @tokens; push(@tokens, $dt, $lparen); foreach my $t (@{ $self->children }) { push(@tokens, $t->sparql_tokens->elements); push(@tokens, $comma); } if (scalar(@tokens) > 2) { pop(@tokens); # remove the last comma } push(@tokens, $rparen); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } package Attean::ExistsExpression 0.034 { use Moo; use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Types::Standard qw(ConsumerOf); use namespace::clean; with 'Attean::API::SPARQLSerializable'; with 'Attean::API::Expression'; sub arity { return 0 } sub BUILDARGS { my $class = shift; return $class->SUPER::BUILDARGS(@_, operator => '_exists'); } has 'pattern' => (is => 'ro', isa => ConsumerOf['Attean::API::Algebra']); sub as_string { my $self = shift; my $sparql = $self->pattern->as_sparql; $sparql =~ s/\s+/ /g; return "EXISTS { $sparql }"; } sub tree_attributes { return qw(operator pattern) } sub is_stable { my $self = shift; # TODO: need deep analysis of exists pattern to tell if this is stable # (there might be an unstable filter expression deep inside the pattern) return 0; } sub sparql_tokens { my $self = shift; my $exists = AtteanX::SPARQL::Token->keyword('EXISTS'); my $lbrace = AtteanX::SPARQL::Token->lbrace; my $rbrace = AtteanX::SPARQL::Token->rbrace; my $child = $self->pattern; my @tokens; push(@tokens, $exists, $lbrace); push(@tokens, $child->sparql_tokens->elements); push(@tokens, $rbrace); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } sub unaggregated_variables { my $self = shift; return map { Attean::Variable->new($_) } $self->pattern->in_scope_variables; } } package Attean::ExistsPlanExpression 0.034 { use Moo; use Types::Standard qw(ConsumerOf); use namespace::clean; with 'Attean::API::Expression'; sub arity { return 0 } sub BUILDARGS { my $class = shift; return $class->SUPER::BUILDARGS(@_, operator => '_existsplan'); } has 'plan' => (is => 'ro', isa => ConsumerOf['Attean::API::BindingSubstitutionPlan']); sub as_string { my $self = shift; # TODO: implement as_string for EXISTS patterns return "Attean::ExistsPlanExpression { ... }"; } sub as_sparql { my $self = shift; my %args = @_; my $level = $args{level} // 0; my $sp = $args{indent} // ' '; my $indent = $sp x $level; # TODO: implement as_string for EXISTS patterns return "EXISTS { " . $self->pattern->as_sparql( level => $level+1, indent => $sp ) . " }"; } sub tree_attributes { return qw(operator plan) } sub is_stable { my $self = shift; # TODO: need deep analysis of exists pattern to tell if this is stable # (there might be an unstable filter expression deep inside the pattern) return 0; } sub unaggregated_variables { my $self = shift; die "unaggregated_variables cannot be called on Attean::ExistsPlanExpression"; } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/PaxHeader/CodeIterator.pm000644 000765 000024 00000000225 14636707604 021714 xustar00gregstaff000000 000000 30 mtime=1719373700.032817461 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/CodeIterator.pm000644 000765 000024 00000004525 14636707604 017752 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::CodeIterator - Iterator implementation backed by a generator function =head1 VERSION This document describes Attean::CodeIterator version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my $iter = Attean::CodeIterator->new( generator => sub { state $value = 0; Attean::Literal->new(++$value) }, item_type => 'Attean::API::Term', ); say $iter->next->value; # 1 say $iter->next->value; # 2 say $iter->next->value; # 3 =head1 DESCRIPTION The Attean::CodeIterator class represents a typed iterator. It conforms to the L role. The Attean::CodeIterator constructor requires two named arguments: =over 4 =item generator A code reference that when called will return either the iterator's next item, or undef upon reaching the end of iteration. =item item_type A L object representing the type of the items that will be returned from the iterator. =back =head1 METHODS =over 4 =cut package Attean::CodeIterator 0.034 { use Moo; use Type::Tiny::Role; use Scalar::Util qw(blessed); use Types::Standard qw(CodeRef ArrayRef); use Role::Tiny (); use namespace::clean; with 'Attean::API::Iterator'; has generator => (is => 'ro', isa => CodeRef, required => 1); has _buffer => (is => 'ro', isa => ArrayRef, init_arg => undef, default => sub { [] }); =item C<< next >> Returns the iterator's next item, or undef upon reaching the end of iteration. =cut sub next { my $self = shift; my $buffer = $self->_buffer; if (scalar(@$buffer)) { return shift(@$buffer); } my @items = $self->generator->(); my $item = shift(@items); return unless defined($item); if (scalar(@items)) { push(@$buffer, @items); } my $role = $self->item_type; if (Role::Tiny->is_role($role)) { unless (blessed($item) and $item->does($role)) { die "CodeIterator item is not a $role: $item"; } } return $item; } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/Plan.pm000644 000765 000024 00000000225 14636707547 020641 xustar00gregstaff000000 000000 30 mtime=1719373671.346311642 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/Plan.pm000644 000765 000024 00000015510 14636707547 016673 0ustar00gregstaff000000 000000 use v5.14; use warnings; use utf8; =head1 NAME Attean::API::Plan - Query plan =head1 VERSION This document describes Attean::API::Plan version 0.034 =head1 DESCRIPTION The Attean::API::Plan role defines a common API for all query plans. =head1 ATTRIBUTES =over 4 =item C<< cost >> =item C<< distinct >> =item C<< item_type >> =item C<< in_scope_variables >> =item C<< ordered >> =back =head1 REQUIRED METHODS The following methods are required by the L role: =over 4 =item C<< impl( $model ) >> Returns a code reference that when called (without arguments), returns an L object. =back =head1 METHODS =over 4 =item C<< has_cost >> =cut use Type::Tiny::Role; package Attean::API::Plan 0.034 { use Scalar::Util qw(blessed); use Types::Standard qw(ArrayRef CodeRef Str Object InstanceOf Bool Num Int); use Moo::Role; has 'cost' => (is => 'rw', isa => Int, predicate => 'has_cost'); has 'distinct' => (is => 'rw', isa => Bool, required => 1, default => 0); has 'item_type' => (is => 'ro', isa => Str, required => 1, default => 'Attean::API::Result'); has 'in_scope_variables' => (is => 'ro', isa => ArrayRef[Str], required => 1); has 'ordered' => (is => 'ro', isa => ArrayRef, required => 1, default => sub { [] }); requires 'impl'; requires 'plan_as_string'; =item C<< as_string >> Returns a tree-structured string representation of this plan, including children. =cut sub as_string { my $self = shift; my $string = ''; $self->walk( prefix => sub { my $a = shift; my $level = shift; my $parent = shift; my $indent = ' ' x $level; my @flags; push(@flags, 'distinct') if ($a->distinct); if (scalar(@{ $a->ordered })) { my @orders; foreach my $c (@{ $a->ordered }) { my $dir = $c->ascending ? "↑" : "↓"; my $s = $dir . $c->expression->as_string; push(@orders, $s); } push(@flags, "order: " . join('; ', @orders)); } if (defined(my $cost = $a->cost)) { push(@flags, "cost: $cost"); } $string .= "-$indent " . $a->plan_as_string($level); if (scalar(@flags)) { $string .= ' (' . join(' ', @flags) . ")"; } $string .= "\n"; }); return $string; } =item C<< evaluate( $model ) >> Evaluates this plan and returns the resulting iterator. =cut sub evaluate { my $self = shift; my $impl = $self->impl(@_); return $impl->(); } =item C<< in_scope_variables_union( @plans ) >> Returns the set union of C<< in_scope_variables >> of the given plan objects. =cut sub in_scope_variables_union { my @plans = grep { blessed($_) } @_; my %vars = map { $_ => 1 } map { @{ $_->in_scope_variables } } @plans; return keys %vars; } =item C<< subplans_of_type_are_variable_connected( $type ) >> Returns true if the subpatterns of the given C<< $type >> are all connected through their C<< in_scope_variables >>, false otherwise (implying a cartesian product if the connecting plans perform some form of join. =cut sub subplans_of_type_are_variable_connected { my $self = shift; my @types = @_; my @c = $self->subpatterns_of_type(@types); return $self->_plans_are_variable_connected(@c); } =item C<< children_are_variable_connected( $type ) >> Returns true if the children of this plan are all connected through their C<< in_scope_variables >>, false otherwise (implying a cartesian product if this plan performs some form of join. =cut sub children_are_variable_connected { my $self = shift; my @c = @{ $self->children }; return $self->_plans_are_variable_connected(@c); } sub _plans_are_variable_connected { # TODO: In the worst case, this is going to run in O(n^2) in the number # of children. Better indexing of the children by variables can speed # this up. my $self = shift; my @c = @_; # warn "===========================\n"; # foreach my $c (@c) { # warn $c->as_string; # } return 1 unless (scalar(@c)); my %vars_by_child; foreach my $i (0 .. $#c) { my $c = $c[$i]; foreach my $var (@{ $c->in_scope_variables }) { $vars_by_child{$i}{$var}++; } } # my @remaining = keys %vars_by_child; return 1 unless (scalar(@remaining)); my $current = shift(@remaining); # warn 'Starting with ' . $c[$current]->as_string; my %seen_vars = %{ $vars_by_child{$current} }; LOOP: while (scalar(@remaining)) { foreach my $i (0 .. $#remaining) { my $candidate = $remaining[$i]; my @candidate_vars = keys %{ $vars_by_child{$candidate} }; foreach my $var (@candidate_vars) { if (exists $seen_vars{ $var }) { foreach my $var (@candidate_vars) { $seen_vars{$var}++; } # warn "connected with $var: " . $c[$candidate]->as_string; splice(@remaining, $i, 1); next LOOP; } } } # warn 'Not fully connected'; return 0; } # warn 'Fully connected'; return 1; } } package Attean::API::BindingSubstitutionPlan 0.034 { use Moo::Role; with 'Attean::API::Plan'; requires 'substitute_impl'; # $code = $plan->impl($model, $binding); sub impl { my $self = shift; my $model = shift; my $b = Attean::Result->new(); return $self->substitute_impl($model, $b); } } package Attean::API::UnionScopeVariablesPlan 0.034 { use Moo::Role; with 'Attean::API::Plan'; around 'BUILDARGS' => sub { my $orig = shift; my $class = shift; my %args = @_; my @vars = Attean::API::Plan->in_scope_variables_union( @{ $args{children} } ); if (exists $args{in_scope_variables}) { Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor"; } $args{in_scope_variables} = [@vars]; return $orig->( $class, %args ); }; } package Attean::API::Plan::Join 0.034 { use Types::Standard qw(CodeRef); use Types::Standard qw(ArrayRef Str ConsumerOf Bool); use Moo::Role; with 'Attean::API::Plan', 'Attean::API::BinaryQueryTree'; with 'Attean::API::UnionScopeVariablesPlan'; has 'join_variables' => (is => 'ro', isa => ArrayRef[Str], required => 1); has 'anti' => (is => 'ro', isa => Bool, default => 0); # is this an anti-join has 'left' => (is => 'ro', isa => Bool, default => 0); # is this a left, outer-join # if this is a left, outer-join, this is the filter expression that acts as part of the join operation (see the SPARQL semantics for LeftJoin for more details) has 'expression' => (is => 'ro', isa => ConsumerOf['Attean::API::Expression'], required => 0, default => sub { Attean::ValueExpression->new( value => Attean::Literal->true ) }); } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/PushParser.pod000644 000765 000024 00000000225 14636707547 022211 xustar00gregstaff000000 000000 30 mtime=1719373671.378743648 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/PushParser.pod000644 000765 000024 00000004176 14636707547 020251 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::PushParser - Role for parsers that natively call a callback function for each parsed item =head1 VERSION This document describes Attean::API::PushParser version 0.034 =head1 DESCRIPTION The Attean::API::PushParser role defines parsers that can efficiently call a callback function for each object constructed from the parsed data. This role adds methods that builds on this functionality to allow parsing data using different approaches. =head1 ROLES This role consumes the L role. =head1 REQUIRED METHODS Classes consuming this role must provide the following methods: =over 4 =item C<< parse_cb_from_io( $fh ) >> Calls the C<< $parser->handler >> function once for each object that result from parsing the data read from the L object C<< $fh >>. =item C<< parse_cb_from_bytes( $data ) >> Calls the C<< $parser->handler >> function once for each object that result from parsing the data read from the UTF-8 encoded byte string C<< $data >>. =back =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< parse_iter_from_io( $fh ) >> Returns an L that result from parsing the data read from the L object C<< $fh >>. =item C<< parse_iter_from_bytes( $data ) >> Returns an L that result from parsing the data read from the UTF-8 encoded byte string C<< $data >>. =item C<< parse_list_from_io( $fh ) >> Returns a list of all objects that result from parsing the data read from the L object C<< $fh >>. =item C<< parse_list_from_bytes( $data ) >> Returns a list of all objects that result from parsing the data read from the UTF-8 encoded byte string C<< $data >>. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/Store.pm000644 000765 000024 00000000225 14636707547 021043 xustar00gregstaff000000 000000 30 mtime=1719373671.579067623 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/Store.pm000644 000765 000024 00000011370 14636707547 017075 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::API::Store - Triple/quad store role =head1 VERSION This document describes Attean::Store version 0.034 =head1 DESCRIPTION The Attean::Store role is an empty role that more specialized roles conform to: =over 4 =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =back =cut package Attean::API::Store 0.034 { use Moo::Role; } package Attean::API::TripleStore 0.034 { use Scalar::Util qw(blessed); use Moo::Role; with 'Attean::API::Store'; requires 'get_triples'; before 'get_triples' => sub { if (scalar(@_) == 2 and blessed($_[1]) and not($_[1]->does('Attean::API::TermOrVariable'))) { my $type = ref($_[0]); die "get_triples called with a single $type argument, but expecting a list of terms/variables"; } }; sub count_triples { my $self = shift; my $iter = $self->get_triples(@_); my $count = 0; while (my $r = $iter->next) { $count++; } return $count; } sub count_triples_estimate { my $self = shift; return $self->count_triples(@_); } sub size { my $self = shift; return $self->count_triples(); } sub holds { my $self = shift; return ($self->count_triples_estimate(@_) > 0) } } package Attean::API::MutableTripleStore 0.034 { use Moo::Role; with 'Attean::API::TripleStore'; requires 'add_triple'; requires 'remove_triple'; before 'add_triple' => sub { my $self = shift; my $quad = shift; unless ($quad->is_ground) { die "Cannot add a non-ground triple (with variables) to a model"; } }; } package Attean::API::ETagCacheableTripleStore 0.034 { use Moo::Role; with 'Attean::API::TripleStore'; requires 'etag_value_for_triples'; } package Attean::API::TimeCacheableTripleStore 0.034 { use Moo::Role; with 'Attean::API::TripleStore'; requires 'mtime_for_triples'; } package Attean::API::QuadStore 0.034 { use Scalar::Util qw(blessed); use Moo::Role; with 'Attean::API::Store'; requires 'get_quads'; before 'get_quads' => sub { if (scalar(@_) == 2 and blessed($_[1]) and not($_[1]->does('Attean::API::TermOrVariable'))) { my $type = ref($_[0]); die "get_quads called with a single $type argument, but expecting a list of terms/variables"; } }; sub count_quads { my $self = shift; my $iter = $self->get_quads(@_); my $count = 0; while (my $r = $iter->next) { $count++; } return $count; } sub count_quads_estimate { my $self = shift; return $self->count_quads(@_); } sub holds { my $self = shift; return ($self->count_quads_estimate(@_) > 0) } sub get_graphs { my $self = shift; my $iter = $self->get_quads(@_); my %graphs; while (my $r = $iter->next) { my $g = $r->graph; $graphs{ $g->as_string }++; } return Attean::ListIterator->new( values => [map { Attean::IRI->new($_) } keys %graphs], item_type => 'Attean::API::Term' ); } sub size { my $self = shift; return $self->count_quads(); } } package Attean::API::MutableQuadStore 0.034 { use Role::Tiny (); use Moo::Role; use Type::Tiny::Role; with 'Attean::API::QuadStore'; requires 'add_quad'; requires 'remove_quad'; requires 'create_graph'; requires 'drop_graph'; requires 'clear_graph'; before 'add_quad' => sub { my $self = shift; my $quad = shift; unless ($quad->is_ground) { die "Cannot add a non-ground quad (with variables) to a store"; } }; sub add_iter { my $self = shift; my $iter = shift; my $type = $iter->item_type; use Data::Dumper; die "Iterator type $type isn't quads" unless (Role::Tiny::does_role($type, 'Attean::API::Quad')); while (my $q = $iter->next) { $self->add_quad($q); } } } package Attean::API::ETagCacheableQuadStore 0.034 { use Moo::Role; with 'Attean::API::QuadStore'; requires 'etag_value_for_quads'; } package Attean::API::TimeCacheableQuadStore 0.034 { use Moo::Role; with 'Attean::API::QuadStore'; requires 'mtime_for_quads'; } package Attean::API::BulkUpdatableStore 0.034 { use Moo::Role; requires 'begin_bulk_updates'; requires 'end_bulk_updates'; } package Attean::API::RDFStarStore 0.034 { use Moo::Role; with 'Attean::API::Store'; } 1; __END__ =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/Result.pod000644 000765 000024 00000000225 14636707547 021373 xustar00gregstaff000000 000000 30 mtime=1719373671.513123378 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/Result.pod000644 000765 000024 00000002131 14636707547 017420 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::Result - Role representing a set of variable bindings =head1 VERSION This document describes Attean::API::Result version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a Moo role representing quad patterns. =head1 ROLES This role consumes L. =head1 METHODS =over 4 =item C<< join( $result ) >> Returns the combined variable binding set if the referent and C<< $result >> are compatible (as defined by the SPARQL semantics), or C<< undef >> otherwise. =item C<< apply_map( $mapper ) >> Returns a new variable binding set object with all terms mapped through the given L object C<< $mapper >>. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/PullParser.pod000644 000765 000024 00000000225 14636707547 022206 xustar00gregstaff000000 000000 30 mtime=1719373671.362647909 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/PullParser.pod000644 000765 000024 00000004115 14636707547 020237 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::PullParser - Role for parsers that natively return an iterator =head1 VERSION This document describes Attean::API::PullParser version 0.034 =head1 DESCRIPTION The Attean::API::PullParser role defines parsers that can efficiently construct and return an iterator of the parsed data. This role adds methods that builds on this functionality to allow parsing data using different approaches. =head1 ROLES This role consumes the L role. =head1 REQUIRED METHODS Classes consuming this role must provide the following methods: =over 4 =item C<< parse_iter_from_io( $fh ) >> Returns an L that result from parsing the data read from the L object C<< $fh >>. =item C<< parse_iter_from_bytes( $data ) >> Returns an L that result from parsing the data read from the UTF-8 encoded byte string C<< $data >>. =back =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< parse_cb_from_io( $fh ) >> Calls the C<< $parser->handler >> function once for each object that result from parsing the data read from the L object C<< $fh >>. =item C<< parse_cb_from_bytes( $data ) >> Calls the C<< $parser->handler >> function once for each object that result from parsing the data read from the UTF-8 encoded byte string C<< $data >>. =item C<< parse_list_from_io( $fh ) >> Returns a list of all objects that result from parsing the data read from the L object C<< $fh >>. =item C<< parse_list_from_bytes( $data ) >> Returns a list of all objects that result from parsing the data read from the UTF-8 encoded byte string C<< $data >>. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/ResultParser.pod000644 000765 000024 00000000225 14636707547 022550 xustar00gregstaff000000 000000 30 mtime=1719373671.528855178 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/ResultParser.pod000644 000765 000024 00000001716 14636707547 020605 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::ResultParser - Role for parsers of L objects =head1 VERSION This document describes Attean::API::ResultParser version 0.034 =head1 DESCRIPTION The Attean::API::ResultParser role defines parsers of L objects. =head1 ROLES This role consumes the L role. =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< handled_type >> Returns a L object for objects which consume the L role. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/Query.pm000644 000765 000024 00000000225 14636707547 021054 xustar00gregstaff000000 000000 30 mtime=1719373671.464103659 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/Query.pm000644 000765 000024 00000042407 14636707547 017113 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::API::Query - Utility package defining query-related roles =head1 VERSION This document describes Attean::API::Query version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a utility package for defining query-related roles: =over 4 =item * L =cut package Attean::API::DirectedAcyclicGraph 0.034 { use Scalar::Util qw(refaddr); use Types::Standard qw(ArrayRef ConsumerOf); use Moo::Role; # =item C<< children >> # # An ARRAY reference of L objects. # # =back # # =cut has 'children' => ( is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::DirectedAcyclicGraph']], default => sub { [] }, ); # =item C<< is_leaf >> # # Returns true if the referent has zero C<< children >>, false otherwise. # # =cut sub is_leaf { my $self = shift; return not(scalar(@{ $self->children })); } # =item C<< walk( prefix => \&pre_cb, postfix => \&pre_cb ) >> # # Walks the graph rooted at the referent, calling C<< &pre_cb >> (if supplied) # before descending, and C<< &post_cb >> (if supplied) after descending. The # callback functions are passed the current graph walk node as the single # argument. # # =cut sub walk { my $self = shift; my %args = @_; my $level = $args{ level } // 0; my $parent = $args{ parent }; if (my $cb = $args{ prefix }) { $cb->( $self, $level, $parent ); } foreach my $c (@{ $self->children }) { $c->walk( %args, level => (1+$level), parent => $self ); } if (my $cb = $args{ postfix }) { $cb->( $self, $level, $parent ); } } # =item C<< has_only_subtree_types( @classes ) >> # # Returns true if the invocant and all of its sub-trees are instances of only # the listed classes, false otherwise. # # =cut sub has_only_subtree_types { my $self = shift; my @types = @_; my %types = map { $_ => 1 } @types; return 0 unless (exists $types{ ref($self) }); my %classes; $self->walk( prefix => sub { my $plan = shift; $classes{ref($plan)}++; }); foreach my $type (@types) { delete $classes{$type}; } my @keys = keys %classes; return (scalar(@keys) == 0) ? 1 : 0; } # =item C<< cover( prefix => \&pre_cb, postfix => \&pre_cb ) >> # # Similar to C<< walk >>, walks the graph rooted at the referent, calling # C<< &pre_cb >> (if supplied) before descending, and C<< &post_cb >> (if # supplied) after descending. However, unlike C<< walk >>, each node in the graph # is visited only once. # # =cut sub cover { my $self = shift; return $self->_cover({}, @_); } sub _cover { my $self = shift; my $seen = shift; my %cb = @_; return if ($seen->{refaddr($self)}++); if (my $cb = $cb{ prefix }) { $cb->( $self ); } foreach my $c (@{ $self->children }) { $c->_cover( $seen, %cb ); } if (my $cb = $cb{ postfix }) { $cb->( $self ); } } sub subpatterns_of_type { my $self = shift; my @types = @_; my @p; $self->walk( prefix => sub { my $a = shift; foreach my $t (@types) { push(@p, $a) if ($a->isa($t) or $a->does($t)); } }); return @p; } } package Attean::API::SPARQLSerializable 0.034 { use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Encode qw(decode_utf8); use Attean::API::Iterator; use Attean::API::Serializer; use AtteanX::Serializer::SPARQL; use Moo::Role; requires 'sparql_tokens'; sub as_sparql { my $self = shift; my $s = AtteanX::Serializer::SPARQL->new(); my $i = $self->sparql_tokens; my $bytes = $s->serialize_iter_to_bytes($i); return decode_utf8($bytes); } sub sparql_subtokens { my $self = shift; if ($self->does('Attean::API::SPARQLQuerySerializable')) { my $l = AtteanX::SPARQL::Token->lbrace; my $r = AtteanX::SPARQL::Token->rbrace; my @tokens; push(@tokens, $l); push(@tokens, $self->sparql_tokens->elements); push(@tokens, $r); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } else { return $self->sparql_tokens; } } sub dataset_tokens { my $self = shift; my $dataset = shift; my @default = @{ $dataset->{ default } || [] }; my @named = @{ $dataset->{ named } || [] }; my $has_dataset = (scalar(@default) + scalar(@named)); my @tokens; if ($has_dataset) { my $from = AtteanX::SPARQL::Token->keyword('FROM'); my $named = AtteanX::SPARQL::Token->keyword('NAMED'); foreach my $i (sort { $a->as_string cmp $b->as_string } @default) { push(@tokens, $from); push(@tokens, $i->sparql_tokens->elements); } foreach my $i (sort { $a->as_string cmp $b->as_string } @named) { push(@tokens, $from); push(@tokens, $named); push(@tokens, $i->sparql_tokens->elements); } } return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } sub query_tokens { my $self = shift; my %args = @_; my $dataset = $args{dataset} || {}; my $as = AtteanX::SPARQL::Token->keyword('AS'); my $lparen = AtteanX::SPARQL::Token->lparen; my $rparen = AtteanX::SPARQL::Token->rparen; my $algebra = $self; my %modifiers; my $form = 'SELECT'; if ($algebra->isa('Attean::Algebra::Ask')) { $form = 'ASK'; ($algebra) = @{ $algebra->children }; } elsif ($algebra->isa('Attean::Algebra::Describe')) { $form = 'DESCRIBE'; $modifiers{describe} = $algebra->terms; ($algebra) = @{ $algebra->children }; } elsif ($algebra->isa('Attean::Algebra::Construct')) { $form = 'CONSTRUCT'; $modifiers{construct} = $algebra->triples; ($algebra) = @{ $algebra->children }; } unless ($form eq 'CONSTRUCT' or $form eq 'DESCRIBE') { while ($algebra->isa('Attean::Algebra::Extend') or $algebra->isa('Attean::Algebra::Group') or $algebra->isa('Attean::Algebra::OrderBy') or $algebra->isa('Attean::Algebra::Distinct') or $algebra->isa('Attean::Algebra::Reduced') or $algebra->isa('Attean::Algebra::Slice') or $algebra->isa('Attean::Algebra::Project')) { # TODO: Handle HAVING # TODO: Error if Slice appears before distinct/reduced if ($algebra->isa('Attean::Algebra::Distinct')) { $modifiers{ distinct } = 1; } elsif ($algebra->isa('Attean::Algebra::Reduced')) { $modifiers{ reduced } = 1; } elsif ($algebra->isa('Attean::Algebra::Slice')) { if ($algebra->limit >= 0) { $modifiers{ limit } = $algebra->limit; } if ($algebra->offset > 0) { $modifiers{ offset } = $algebra->offset; } } elsif ($algebra->isa('Attean::Algebra::OrderBy')) { $modifiers{order} = $algebra->comparators; } elsif ($algebra->isa('Attean::Algebra::Extend')) { my $v = $algebra->variable; my $name = $v->value; my $expr = $algebra->expression; my @tokens; push(@tokens, $lparen); push(@tokens, $expr->sparql_tokens->elements); push(@tokens, $as); push(@tokens, $v->sparql_tokens->elements); push(@tokens, $rparen); $modifiers{project_expression_tokens}{$name} = \@tokens; } elsif ($algebra->isa('Attean::Algebra::Project')) { my $vars = $algebra->variables; my ($child) = @{ $algebra->children }; my @vars = sort(map { $_->value } @$vars); my @subvars = sort($child->in_scope_variables); if (scalar(@vars) == scalar(@subvars) and join('.', @vars) eq join('.', @subvars)) { # this is a SELECT * query } else { foreach my $v (@$vars) { my $name = $v->value; unless ($modifiers{project_variables}{$name}++) { push(@{ $modifiers{project_variables_order} }, $name); } } } } elsif ($algebra->isa('Attean::Algebra::Group')) { my $aggs = $algebra->aggregates; my $groups = $algebra->groupby; foreach my $agg (@$aggs) { my $v = $agg->variable; my $name = $v->value; my @tokens; push(@tokens, $lparen); push(@tokens, $agg->sparql_tokens->elements); push(@tokens, $as); push(@tokens, $v->sparql_tokens->elements); push(@tokens, $rparen); unless ($modifiers{project_variables}{$name}++) { push(@{ $modifiers{project_variables_order} }, $name); } $modifiers{project_expression_tokens}{$name} = \@tokens; } foreach my $group (@$groups) { push(@{ $modifiers{groups} }, $group->sparql_tokens->elements); } } else { die "Unexpected pattern type encountered in query_tokens: " . ref($algebra); } ($algebra) = @{ $algebra->children }; } } my @tokens; my $where = AtteanX::SPARQL::Token->keyword('WHERE'); my $lbrace = AtteanX::SPARQL::Token->lbrace; my $rbrace = AtteanX::SPARQL::Token->rbrace; if ($form eq 'SELECT') { push(@tokens, AtteanX::SPARQL::Token->keyword('SELECT')); if ($modifiers{distinct}) { push(@tokens, AtteanX::SPARQL::Token->keyword('DISTINCT')); } elsif ($modifiers{reduced}) { push(@tokens, AtteanX::SPARQL::Token->keyword('REDUCED')); } if (my $p = $modifiers{project_variables_order}) { foreach my $name (@$p) { if (my $etokens = $modifiers{project_expression_tokens}{$name}) { push(@tokens, @$etokens); } else { my $v = Attean::Variable->new( value => $name ); push(@tokens, $v->sparql_tokens->elements); } } } else { push(@tokens, AtteanX::SPARQL::Token->star); } push(@tokens, $self->dataset_tokens($dataset)->elements); push(@tokens, $where); if ($algebra->isa('Attean::Algebra::Join')) { # don't emit extraneous braces at the top-level push(@tokens, $algebra->sparql_tokens->elements); } else { push(@tokens, $lbrace); push(@tokens, $algebra->sparql_tokens->elements); push(@tokens, $rbrace); } if (my $groups = $modifiers{groups}) { push(@tokens, AtteanX::SPARQL::Token->keyword('GROUP')); push(@tokens, AtteanX::SPARQL::Token->keyword('BY')); push(@tokens, @$groups); } if (my $expr = $modifiers{having}) { push(@tokens, AtteanX::SPARQL::Token->keyword('HAVING')); push(@tokens, $expr->sparql_tokens->elements); } if (my $comps = $modifiers{order}) { push(@tokens, AtteanX::SPARQL::Token->keyword('ORDER')); push(@tokens, AtteanX::SPARQL::Token->keyword('BY')); foreach my $c (@$comps) { push(@tokens, $c->sparql_tokens->elements); } } if (exists $modifiers{limit}) { push(@tokens, AtteanX::SPARQL::Token->keyword('LIMIT')); push(@tokens, AtteanX::SPARQL::Token->integer($modifiers{limit})); } if (exists $modifiers{offset}) { push(@tokens, AtteanX::SPARQL::Token->keyword('OFFSET')); push(@tokens, AtteanX::SPARQL::Token->integer($modifiers{offset})); } } elsif ($form eq 'DESCRIBE') { push(@tokens, AtteanX::SPARQL::Token->keyword('DESCRIBE')); foreach my $t (@{ $modifiers{describe} }) { push(@tokens, $t->sparql_tokens->elements); } push(@tokens, $self->dataset_tokens($dataset)->elements); push(@tokens, $where); push(@tokens, $lbrace); push(@tokens, $algebra->sparql_tokens->elements); push(@tokens, $rbrace); } elsif ($form eq 'CONSTRUCT') { push(@tokens, AtteanX::SPARQL::Token->keyword('CONSTRUCT')); push(@tokens, $lbrace); foreach my $t (@{ $modifiers{construct} }) { push(@tokens, $t->sparql_tokens->elements); push(@tokens, AtteanX::SPARQL::Token->dot); } push(@tokens, $rbrace); push(@tokens, $self->dataset_tokens($dataset)->elements); push(@tokens, $where); push(@tokens, $lbrace); push(@tokens, $algebra->sparql_tokens->elements); push(@tokens, $rbrace); } elsif ($form eq 'ASK') { push(@tokens, AtteanX::SPARQL::Token->keyword('ASK')); push(@tokens, $self->dataset_tokens($dataset)->elements); push(@tokens, $lbrace); push(@tokens, $algebra->sparql_tokens->elements); push(@tokens, $rbrace); } else { die "Unexpected query for '$form' in query_tokens"; } return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } package Attean::API::SPARQLQuerySerializable 0.034 { use Moo::Role; use namespace::clean; with 'Attean::API::SPARQLSerializable'; sub sparql_tokens { my $self = shift; return $self->query_tokens; } } =item * L =cut package Attean::API::Algebra 0.034 { use Moo::Role; use Types::Standard qw(ArrayRef ConsumerOf); with 'Attean::API::SPARQLSerializable'; has 'hints' => (is => 'rw', isa => ArrayRef[ArrayRef[ConsumerOf['Attean::API::Term']]], default => sub { [] }); requires 'as_sparql'; requires 'in_scope_variables'; # variables that will be in-scope after this operation is evaluated sub unary { my $self = shift; return unless (scalar(@{ $self->children }) == 1); return $self->children->[0]; } sub algebra_as_string { my $self = shift; return "$self"; } sub as_string { my $self = shift; my $string = ''; $self->walk( prefix => sub { my $a = shift; my $level = shift; my $parent = shift; my $indent = ' ' x $level; $string .= "-$indent " . $a->algebra_as_string($level) . "\n"; }); return $string; } sub blank_nodes { my $self = shift; my %blanks; $self->walk( prefix => sub { my $a = shift; if ($a->isa('Attean::Algebra::BGP')) { my @triples = @{ $a->triples }; my @nodes = grep { $_->does('Attean::API::Blank') } map { $_->values } @triples; foreach my $b (@nodes) { $blanks{ $b->value } = $b; } } elsif ($a->isa('Attean::Algebra::Path')) { my @nodes = grep { $_->does('Attean::API::Blank') } ($a->subject, $a->object); foreach my $b (@nodes) { $blanks{ $b->value } = $b; } } }); return values %blanks; } sub BUILD {} if ($ENV{ATTEAN_TYPECHECK}) { around 'BUILD' => sub { my $orig = shift; my $self = shift; $self->$orig(@_); my $name = ref($self); $name =~ s/^.*://; if ($self->can('arity')) { my $arity = $self->arity; my $children = $self->children; my $size = scalar(@$children); unless ($size == $arity) { Carp::confess "${name} algebra construction with bad number of children (expected $arity, but got $size)"; } } } } } =item * L =cut package Attean::API::QueryTree 0.034 { use Moo::Role; with 'Attean::API::DirectedAcyclicGraph'; } =item * L =cut package Attean::API::NullaryQueryTree 0.034 { use Moo::Role; sub arity { return 0 } with 'Attean::API::QueryTree'; } =item * L =cut package Attean::API::UnaryQueryTree 0.034 { use Moo::Role; sub arity { return 1 } with 'Attean::API::QueryTree'; sub child { my $self = shift; return $self->children->[0]; } } =item * L =cut package Attean::API::BinaryQueryTree 0.034 { use Moo::Role; sub arity { return 2 } with 'Attean::API::QueryTree'; } =item * L =cut package Attean::API::PropertyPath 0.034 { use Moo::Role; with 'Attean::API::QueryTree'; requires 'as_string'; requires 'as_sparql'; } =item * L =cut package Attean::API::UnaryPropertyPath 0.034 { use Types::Standard qw(ConsumerOf); use Moo::Role; sub arity { return 1 } # has 'path' => (is => 'ro', isa => ConsumerOf['Attean::API::PropertyPath'], required => 1); sub prefix_name { "" } sub postfix_name { "" } sub as_string { my $self = shift; my ($path) = @{ $self->children }; my $pstr = $path->as_string; if ($path->does('Attean::API::UnaryPropertyPath')) { $pstr = "($pstr)"; } my $str = sprintf("%s%s%s", $self->prefix_name, $pstr, $self->postfix_name); return $str; } sub algebra_as_string { my $self = shift; return "Property Path " . $self->prefix_name . $self->postfix_name; } with 'Attean::API::PropertyPath', 'Attean::API::UnaryQueryTree'; } =item * L =cut package Attean::API::NaryPropertyPath 0.034 { use Types::Standard qw(ArrayRef ConsumerOf); use Moo::Role; # has 'children' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::PropertyPath']], required => 1); requires 'separator'; sub as_string { my $self = shift; my @children = @{ $self->children }; if (scalar(@children) == 1) { return $children[0]->as_string; } else { return sprintf("(%s)", join($self->separator, map { $_->as_string } @children)); } } sub algebra_as_string { my $self = shift; return "Property Path " . $self->separator; } with 'Attean::API::PropertyPath'; } =item * L =cut package Attean::API::UnionScopeVariables 0.034 { use Moo::Role; sub in_scope_variables { my $self = shift; my $set = Set::Scalar->new(); foreach my $c (@{ $self->children }) { $set->insert( $c->in_scope_variables ); } return $set->elements; } } =item * L =cut package Attean::API::IntersectionScopeVariables 0.034 { use Moo::Role; sub in_scope_variables { my $self = shift; my @c = @{ $self->children }; return unless scalar(@c); my $set = Set::Scalar->new(shift(@c)->in_scope_variables); foreach my $c (@c) { my $rhs = Set::Scalar->new($c->in_scope_variables); $set = $set->intersection($rhs); } return $set->elements; } } 1; =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/AbbreviatingParser.pod000644 000765 000024 00000000225 14636707547 023667 xustar00gregstaff000000 000000 30 mtime=1719373671.014449324 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/AbbreviatingParser.pod000644 000765 000024 00000002336 14636707547 021723 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::AbbreviatingParser - Role for parsers that use construct absolute IRIs based on prefixed names or base IRIs =head1 VERSION This document describes Attean::API::AbbreviatingParser version 0.034 =head1 DESCRIPTION The Attean::API::AbbreviatingParser role defines an API for parsers of RDF and SPARQL result data that construct absolute IRIs during parsing by using IRI prefixes and base IRIs. =head1 ROLES This role consumes the L role. =head1 ATTRIBUTES The following attributes exist: =over 4 =item C<< base >> An L object representing the base against which relative IRIs in the parsed data are resolved (may be set explicitly or set by a directive in the input data). =item C<< namespaces >> A HASH reference mapping prefix strings to L objects. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/MutableTripleStore.pod000644 000765 000024 00000000224 14636707547 023702 xustar00gregstaff000000 000000 29 mtime=1719373671.31155618 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/MutableTripleStore.pod000644 000765 000024 00000002150 14636707547 021731 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::MutableTripleStore - Role representing mutable triple stores =head1 VERSION This document describes Attean::API::MutableTripleStore version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a Moo role that mutable triple storess consume. It defines the required methods for updating data. =head1 ROLES This role consumes the L role. =head1 REQUIRED METHODS Classes consuming this role must provide the following methods: =over 4 =item C<< add_triple( $triple ) >> Adds the L C<$triple> to the store. =item C<< remove_triple( $triple ) >> Removes the L C<$triple> from the store. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/TripleOrQuad.pod000644 000765 000024 00000000225 14636707547 022470 xustar00gregstaff000000 000000 30 mtime=1719373671.679024122 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/TripleOrQuad.pod000644 000765 000024 00000001265 14636707547 020524 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::TripleOrQuad - Role representing triples and quads =head1 VERSION This document describes Attean::API::TripleOrQuad version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a Moo role that both Triple and Quad objects consume. =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/QuadPattern.pod000644 000765 000024 00000000224 14636707547 022344 xustar00gregstaff000000 000000 29 mtime=1719373671.42932474 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/QuadPattern.pod000644 000765 000024 00000002322 14636707547 020374 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::QuadPattern - Role representing quad patterns =head1 VERSION This document describes Attean::API::QuadPattern version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a Moo role representing quad patterns. =head1 ROLES This role consumes L and L, which provide the following methods: =over 4 =item C<< mapping >> =item C<< values >> =item C<< tuples_string >> =item C<< as_string >> =back =head1 METHODS =over 4 =item C<< variables >> Returns the list of variable names: C<< qw(subject predicate object graph) >>. =item C<< value( $key ) >> Returns the L value bound to the variable named C<< $key >> (which must be present in the C<< variables >> list), undef otherwise. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/Blank.pod000644 000765 000024 00000000225 14636707547 021144 xustar00gregstaff000000 000000 30 mtime=1719373671.114598853 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/Blank.pod000644 000765 000024 00000002064 14636707547 017176 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::Blank - Role representing RDF blank terms =head1 VERSION This document describes Attean::API::Blank version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a Moo role that Blank RDF terms consume. =head1 ROLES This role consumes the L and L roles. =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< ebv >> Returns the boolean value of this term. =item C<< compare( $blank ) >> Returns -1, 0, or 1 if C<< $blank >> is less than, equal to, or greater than the referent based on SPARQL sorting order. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/TriplePattern.pod000644 000765 000024 00000000225 14636707547 022712 xustar00gregstaff000000 000000 30 mtime=1719373671.711866564 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/TriplePattern.pod000644 000765 000024 00000002575 14636707547 020753 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::TriplePattern - Role representing triple patterns =head1 VERSION This document describes Attean::API::TriplePattern version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a Moo role representing triple patterns. =head1 ROLES This role consumes L and L, which provide the following methods: =over 4 =item C<< mapping >> =item C<< values >> =item C<< tuples_string >> =item C<< as_string >> =back =head1 METHODS =over 4 =item C<< variables >> Returns the list of variable names: C<< qw(subject predicate object) >>. =item C<< value( $key ) >> Returns the L value bound to the variable named C<< $key >> (which must be present in the C<< variables >> list), undef otherwise. =item C<< as_quad_pattern( $graph ) >> Returns a new L object with the referent's subject, predicate, and object, and the supplied C<< $graph >>. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/TermSerializer.pod000644 000765 000024 00000000225 14636707547 023056 xustar00gregstaff000000 000000 30 mtime=1719373671.645712247 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/TermSerializer.pod000644 000765 000024 00000002167 14636707547 021114 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::TermSerializer - Role for serializers of L objects =head1 VERSION This document describes Attean::API::TermSerializer version 0.034 =head1 DESCRIPTION The Attean::API::TermSerializer role defines serializers of L objects. =head1 ROLES This role consumes the L roles which provide the following methods: =over 4 =item C<< serialize_list_to_io( $fh, @elements ) >> =item C<< serialize_list_to_bytes( @elements ) >> =back =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< handled_type >> Returns a L object for objects which consume the L role. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/MutableModel.pod000644 000765 000024 00000000225 14636707547 022467 xustar00gregstaff000000 000000 30 mtime=1719373671.295968038 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/MutableModel.pod000644 000765 000024 00000005162 14636707547 020523 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::MutableModel - Role representing mutable models =head1 VERSION This document describes Attean::API::MutableModel version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a Moo role that mutable models consume. It defines the required methods for updating data, and provides default functionality. =head1 ROLES This role consumes the L role. =head1 REQUIRED METHODS Classes consuming this role must provide the following methods: =over 4 =item C<< add_quad( $quad ) >> Adds the L C<$quad> to the model. =item C<< remove_quad( $quad ) >> Removes the L C<$quad> from the model. =item C<< create_graph( $graph ) >> Creates a new, empty graph in the model with the L identifier C<$graph>. If the model does not support empty graphs, this operation may be a no-op. =item C<< drop_graph( $graph ) >> Removes the graph in the model with the L identifier C<$graph>. =item C<< clear_graph( $graph ) >> Removes all quads that belong to the graph in the model with the L identifier C<$graph>. If the model does not support empty graphs, this operation may be an alias for C<< drop_graph( $graph ) >>. =back =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< load_triples( $format, $graph => $data ) >> Parses the serialized triples contained in the string C<$data> using the C<$format> parser (see L). Triples resulting from parsing are turned into quads using the C<$graph> identifier, and added to the model. =item C<< load_triples_from_io( $format, $graph => $data ) >> Parses the serialized triples read from the filehandle C<$io> using the C<$format> parser (see L). Triples resulting from parsing are turned into quads using the C<$graph> identifier, and added to the model. =item C<< add_iter( $iter ) >> Adds all the quads from the L C<$iter> to the model. =item C<< add_list( $graph, @elements ) >> Adds an rdf:List encoded list of C<@elements> to the model in the C<$graph>. Returns the L head of the list. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/Literal.pod000644 000765 000024 00000000225 14636707547 021511 xustar00gregstaff000000 000000 30 mtime=1719373671.228980266 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/Literal.pod000644 000765 000024 00000002354 14636707547 017545 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::Literal - Role representing RDF Literal terms =head1 VERSION This document describes Attean::API::Literal version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a Moo role that Literal RDF terms consume. =head1 ROLES This role consumes the L and L roles. =head1 ATTRIBUTES The following attributes exist: =over 4 =item C<< language >> A language tag string. =item C<< datatype >> An L datatype. =back =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< ebv >> Returns the boolean value of this term. =item C<< compare( $literal ) >> Returns -1, 0, or 1 if C<< $literal >> is less than, equal to, or greater than the referent based on SPARQL sorting order. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/Term.pm000644 000765 000024 00000000225 14636707547 020656 xustar00gregstaff000000 000000 30 mtime=1719373671.596146433 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/Term.pm000644 000765 000024 00000045457 14636707547 016725 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::API::Term - RDF Terms =head1 VERSION This document describes Attean::API::Term version 0.034 =head1 DESCRIPTION The Attean::API::Term role defines a common API for all RDF terms. =head1 REQUIRED METHODS The following methods are required by the L role: =over 4 =item C<< value >> Returns the term's value string. =item C<< ntriples_string >> Returns an N-Triples-compatible string serialization. =back =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< as_string >> Returns a string serialization of the term. =cut package Attean::API::Term 0.034 { use Moo::Role; with 'Attean::API::TermOrVariable', 'Attean::API::ResultOrTerm'; with 'Attean::API::TermOrVariableOrTriplePattern'; requires 'value'; # => (is => 'ro', isa => 'Str', required => 1); requires 'ntriples_string'; sub as_string { shift->ntriples_string(); } =item C<< ebv >> Returns true if the term has a true SPARQL "effective boolean value", false otherwise. =cut requires 'ebv'; requires 'compare'; requires 'sameTerms'; =item C<< order ( $other ) >> Similar to C<< compare >>, but provides the ordering semantics of ORDER BY. =cut sub order { my $self = shift; return $self->compare(@_); } sub __ntriples_string { my $self = shift; my $value = $self->value; if ($value =~ m/^[\x20\x23-\x5a\x5d-\x7e]*$/o) { return $value; } my @chars = split(//, $value); my $string = ''; while (scalar(@chars)) { my $c = shift(@chars); my $o = ord($c); if ($o < 0x8) { $string .= sprintf("\\u%04X", $o); } elsif ($o == 0x9) { $string .= "\\t"; } elsif ($o == 0xA) { $string .= "\\n"; } elsif ($o < 0xC) { $string .= sprintf("\\u%04X", $o); } elsif ($o == 0xD) { $string .= "\\r"; } elsif ($o < 0x1F) { $string .= sprintf("\\u%04X", $o); } elsif ($o < 0x21) { $string .= $c; } elsif ($o == 0x22) { $string .= "\""; } elsif ($o < 0x5B) { $string .= $c; } elsif ($o == 0x5C) { $string .= "\\"; } elsif ($o < 0x7E) { $string .= $c; } elsif ($o < 0xFFFF) { $string .= sprintf("\\u%04X", $o); } else { $string .= sprintf("\\U%08X", $o); } } return $string; } with 'Attean::API::TermOrTriple'; } package Attean::API::Literal 0.034 { use IRI; use Scalar::Util qw(blessed); use Types::Standard qw(Maybe Str ConsumerOf); use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Attean::API::Query; use Moo::Role; with 'Attean::API::Term'; with 'Attean::API::SPARQLSerializable'; with 'Attean::API::TermOrVariableOrTriplePattern'; requires 'language'; # => (is => 'ro', isa => 'Maybe[Str]', predicate => 'has_language'); requires 'datatype'; # => (is => 'ro', isa => 'Attean::API::IRI', required => 1, coerce => 1, default => sub { IRI->new(value => 'http://www.w3.org/2001/XMLSchema#string') }); sub BUILD {} around 'BUILDARGS' => sub { my $orig = shift; my $class = shift; my $args = $class->$orig(@_); if (my $lang = $args->{language}) { my $oldlang = $lang; # http://tools.ietf.org/html/bcp47#section-2.1.1 # All subtags use lowercase letters $lang = lc($lang); # with 2 exceptions: subtags that neither appear at the start of the tag nor occur after singletons # i.e. there's a subtag of length at least 2 preceding the exception; and a following subtag or end-of-tag # 1. two-letter subtags are all uppercase $lang =~ s{(?<=\w\w-)(\w\w)(?=($|-))}{\U$1}g; # 2. four-letter subtags are titlecase $lang =~ s{(?<=\w\w-)(\w\w\w\w)(?=($|-))}{\u\L$1}g; $args->{language} = $lang; } return $args; }; around 'BUILD' => sub { my $orig = shift; my $self = shift; $self->$orig(@_); if (my $dt = $self->datatype) { my $type = $dt->value; if ($type =~ qr<^http://www[.]w3[.]org/2001/XMLSchema#(?:integer|decimal|float|double|non(?:Positive|Negative)Integer|(?:positive|negative)Integer|long|int|short|byte|unsigned(?:Long|Int|Short|Byte))$>) { Moo::Role->apply_roles_to_object($self, 'Attean::API::NumericLiteral'); } elsif ($type eq 'http://www.w3.org/2001/XMLSchema#boolean') { Moo::Role->apply_roles_to_object($self, 'Attean::API::BooleanLiteral'); } elsif ($type eq 'http://www.w3.org/2001/XMLSchema#dateTime') { Moo::Role->apply_roles_to_object($self, 'Attean::API::DateTimeLiteral'); } elsif (my $role = Attean->get_datatype_role($type)) { Moo::Role->apply_roles_to_object($self, $role); } } }; sub sparql_tokens { my $self = shift; my @tokens; my $dt = $self->datatype; if ($self->does('Attean::API::NumericLiteral') and $dt->value eq 'http://www.w3.org/2001/XMLSchema#integer') { if ($self->value =~ /^\d+$/) { my $t = AtteanX::SPARQL::Token->fast_constructor( INTEGER, -1, -1, -1, -1, [$self->value] ); return Attean::ListIterator->new( values => [$t], item_type => 'AtteanX::SPARQL::Token' ); } } my $t = AtteanX::SPARQL::Token->fast_constructor( STRING1D, -1, -1, -1, -1, [$self->value] ); push(@tokens, $t); if (my $lang = $self->language) { my $l = AtteanX::SPARQL::Token->fast_constructor( LANG, -1, -1, -1, -1, ["$lang"] ); push(@tokens, $l); } else { if ($dt->value ne 'http://www.w3.org/2001/XMLSchema#string') { push(@tokens, AtteanX::SPARQL::Token->hathat); push(@tokens, $dt->sparql_tokens->elements); } } return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } sub ebv { my $self = shift; my $value = $self->value; my $dt = $self->datatype->value; if ($dt eq 'http://www.w3.org/2001/XMLSchema#boolean') { return ($value eq 'true' or $value eq '1'); } else { return (length($value) > 0); } } sub compare { my ($a, $b) = @_; return 1 unless blessed($b); return 1 unless ($b->does('Attean::API::Literal') or $b->does('Attean::API::Binding')); return -1 if ($b->does('Attean::API::Binding')); my $c = ((($a->language // '') cmp ($b->language // '')) || ($a->datatype->value cmp $b->datatype->value) || ($a->value cmp $b->value)); return $c; } =item C<< sameTerms( $other ) >> =cut sub sameTerms { my $lhs = shift; my $rhs = shift; return 0 unless ($rhs->does('Attean::API::Literal')); return 0 unless ($lhs->value eq $rhs->value); return 0 unless ($lhs->datatype->value eq $rhs->datatype->value); return 1; } if ($ENV{ATTEAN_TYPECHECK}) { my %map = ( language => Maybe[Str], datatype => ConsumerOf['Attean::API::IRI'], ); foreach my $method (keys %map) { my $type = $map{$method}; around $method => sub { my $orig = shift; my $self = shift; my $class = ref($self); my $value = $self->$orig(@_); my $err = $type->validate($value); if ($err) { my $name = $type->display_name; die "${class}'s $method failed conformance check for $name: $value"; } return $value; }; } } sub construct_args { my $self = shift; my %args; $args{language} = $self->language if ($self->language); $args{datatype} = $self->datatype if ($self->datatype); return %args; } sub argument_compatible { my $self = shift; my @terms = @_; if (my $l = $self->language) { foreach my $t (@terms) { return 0 unless ($t->does('Attean::API::Literal')); if ($t->language) { return 0 unless (defined($t->language)); return 0 unless ($t->language eq $l); } else { return 0 unless ($t->datatype->value eq 'http://www.w3.org/2001/XMLSchema#string'); } } return 1; } elsif ($self->datatype->value eq 'http://www.w3.org/2001/XMLSchema#string') { foreach my $t (@terms) { return 0 unless ($t->does('Attean::API::Literal')); return 0 if ($t->language); return 0 unless (blessed($t->datatype)); return 0 unless ($t->datatype->value eq 'http://www.w3.org/2001/XMLSchema#string'); } return 1; } return 0; } sub _ntriples_string { my $self = shift; my $str = sprintf('"%s"', $self->__ntriples_string); if (my $l = $self->language) { return join('@', $str, $l); } else { my $dt = $self->datatype; if ($dt->value eq 'http://www.w3.org/2001/XMLSchema#string') { return $str; } else { return join('^^', $str, $dt->ntriples_string); } } } around as_sparql => sub { my $orig = shift; my $self = shift; my $s = $self->$orig(@_); if ($s =~ m[^"(true|false)"\^\^$]) { return $1; } return $s; }; } package Attean::API::DateTimeLiteral 0.034 { use DateTime::Format::W3CDTF; use Moo::Role; sub datetime { my $self = shift; my $w3c = DateTime::Format::W3CDTF->new; return $w3c->parse_datetime( $self->value ); } } package Attean::API::CanonicalizingLiteral 0.034 { use Moo::Role; requires 'canonicalized_term'; requires 'canonicalized_term_strict'; } package Attean::API::BooleanLiteral 0.034 { use Scalar::Util qw(blessed looks_like_number); use Moo::Role; sub canonicalized_term_strict { my $self = shift; my $value = $self->value; if ($value =~ m/^(true|false|0|1)$/) { return ($value eq 'true' or $value eq '1') ? Attean::Literal->true : Attean::Literal->false; } else { die "Bad lexical form for xsd:boolean: '$value'"; } } sub canonicalized_term { my $self = shift; my $value = $self->value; if ($value =~ m/^(true|false|0|1)$/) { return ($value eq 'true' or $value eq '1') ? Attean::Literal->true : Attean::Literal->false; } else { return $self; } } with 'Attean::API::Literal', 'Attean::API::CanonicalizingLiteral'; } package Attean::API::NumericLiteral 0.034 { use Scalar::Util qw(blessed looks_like_number); use Moo::Role; sub equals { my ($a, $b) = @_; return 0 unless ($b->does('Attean::API::NumericLiteral')); return $a->numeric_value == $b->numeric_value; } sub compare { my ($a, $b) = @_; return 1 unless blessed($b); return 1 unless ($b->does('Attean::API::Literal') or $b->does('Attean::API::Binding')); return -1 if ($b->does('Attean::API::Binding')); if ($b->does('Attean::API::NumericLiteral')) { return $a->numeric_value <=> $b->numeric_value; } else { return 1; # Attean::API::Literal::compare($a, $b); } } sub canonicalized_term_strict { my $self = shift; return $self->_canonicalized_term(1, @_); } sub canonicalized_term { my $self = shift; return $self->_canonicalized_term(0, @_); } sub _canonicalized_term { my $self = shift; my $strict = shift; my $value = $self->value; my $type = $self->datatype->value; $type =~ s/^.*#//; if ($type eq 'integer') { if ($value =~ m/^([-+])?(\d+)$/) { my $sign = $1 || ''; my $num = $2; $sign = '' if ($sign eq '+'); $num =~ s/^0+(\d)/$1/; return Attean::Literal->integer("${sign}${num}"); } else { die "Bad lexical form for xsd:integer: '$value'" if ($strict); return $self; } } elsif ($type eq 'negativeInteger') { if ($value =~ m/^-(\d+)$/) { my $num = $1; $num =~ s/^0+(\d)/$1/; return Attean::Literal->new(value => "-${num}", datatype => 'http://www.w3.org/2001/XMLSchema#negativeInteger'); } else { die "Bad lexical form for xsd:integer: '$value'" if ($strict); return $self; } } elsif ($type eq 'decimal') { if ($value =~ m/^([-+])?((\d+)([.]\d*)?)$/) { my $sign = $1 || ''; my $num = $2; my $int = $3; my $frac = $4; $sign = '' if ($sign eq '+'); $num =~ s/^0+(.)/$1/; $num =~ s/[.](\d+)0+$/.$1/; if ($num =~ /^[.]/) { $num = "0$num"; } if ($num !~ /[.]/) { $num = "${num}.0"; } return Attean::Literal->decimal("${sign}${num}"); } elsif ($value =~ m/^([-+])?([.]\d+)$/) { my $sign = $1 || ''; my $num = $2; $sign = '' if ($sign eq '+'); $num =~ s/^0+(.)/$1/; return Attean::Literal->decimal("${sign}${num}"); } else { die "Bad lexical form for xsd:deciaml: '$value'" if ($strict); return $self; } } elsif ($type eq 'float') { if ($value =~ m/^(?:([-+])?(?:(\d+(?:\.\d*)?|\.\d+)([Ee][-+]?\d+)?|(INF)))|(NaN)$/) { my $sign = $1; my $inf = $4; my $nan = $5; no warnings 'uninitialized'; $sign = '' if ($sign eq '+'); return Attean::Literal->float("${sign}$inf") if ($inf); return Attean::Literal->float($nan) if ($nan); $value = sprintf('%E', $value); $value =~ m/^(?:([-+])?(?:(\d+(?:\.\d*)?|\.\d+)([Ee][-+]?\d+)?|(INF)))|(NaN)$/; $sign = $1; $inf = $4; $nan = $5; my $num = $2; my $exp = $3; $num =~ s/[.](\d+?)0+/.$1/; $exp =~ tr/e/E/; $exp =~ s/E[+]/E/; $exp =~ s/E(-?)0+([1-9])$/E$1$2/; $exp =~ s/E(-?)0+$/E${1}0/; return Attean::Literal->float("${sign}${num}${exp}"); } else { die "Bad lexical form for xsd:float: '$value'" if ($strict); return $self; } } elsif ($type eq 'boolean') { if ($value =~ m/^(true|false|0|1)$/) { return ($value eq 'true' or $value eq '1') ? Attean::Literal->true : Attean::Literal->false; } else { die "Bad lexical form for xsd:boolean: '$value'" if ($strict); return $self; } } elsif ($type eq 'double') { if ($value =~ m/^(?:([-+])?(?:(\d+(?:\.\d*)?|\.\d+)([Ee][-+]?\d+)?|(INF)))|(NaN)$/) { my $sign = $1; my $inf = $4; my $nan = $5; no warnings 'uninitialized'; $sign = '' if ($sign eq '+'); return Attean::Literal->double("${sign}$inf") if ($inf); return Attean::Literal->double($nan) if ($nan); $value = sprintf('%E', $value); $value =~ m/^(?:([-+])?(?:(\d+(?:\.\d*)?|\.\d+)([Ee][-+]?\d+)?|(INF)))|(NaN)$/; $sign = $1; $inf = $4; $nan = $5; my $num = $2; my $exp = $3; $num =~ s/[.](\d+?)0+/.$1/; $exp =~ tr/e/E/; $exp =~ s/E[+]/E/; $exp =~ s/E(-?)0+([1-9])$/E$1$2/; $exp =~ s/E(-?)0+$/E${1}0/; return Attean::Literal->double("${sign}${num}${exp}"); } else { die "Bad lexical form for xsd:double: '$value'" if ($strict); return $self; } } else { warn "No canonicalization for type $type"; } return $self; } sub is_integer_type { my $self = shift; my $type = $self->datatype->value; return scalar($type =~ qr<^http://www[.]w3[.]org/2001/XMLSchema#(?:integer|non(?:Positive|Negative)Integer|(?:positive|negative)Integer|long|int|short|byte|unsigned(?:Long|Int|Short|Byte))$>); } sub ebv { my $self = shift; return ($self->numeric_value != 0); } sub numeric_value { my $self = shift; my $v = $self->value; return (looks_like_number($v)) ? eval $v : undef; } { my %type_hierarchy = ( 'integer' => 'decimal', 'nonPositiveInteger' => 'integer', 'negativeInteger' => 'nonPositiveInteger', 'long' => 'integer', 'int' => 'long', 'short' => 'int', 'byte' => 'short', 'nonNegativeInteger' => 'integer', 'unsignedLong' => 'nonNegativeInteger', 'unsignedInt' => 'unsignedLong', 'unsignedShort' => 'unsignedInt', 'unsignedByte' => 'unsignedShort', 'positiveInteger' => 'nonNegativeInteger', ); sub _lca { my ($lhs, $rhs) = @_; for ($lhs, $rhs) { s/^.*#//; } return "http://www.w3.org/2001/XMLSchema#$lhs" if ($lhs eq $rhs); my $cur = $lhs; my %ancestors = ($cur => 1); while ($cur = $type_hierarchy{$cur}) { $ancestors{$cur}++; return "http://www.w3.org/2001/XMLSchema#$cur" if ($cur eq $rhs); } $cur = $rhs; while ($cur = $type_hierarchy{$cur}) { return "http://www.w3.org/2001/XMLSchema#$cur" if exists $ancestors{$cur}; } return; } sub binary_promotion_type { my $self = shift; my $rhs = shift; my $op = shift; if ($op =~ m<^[-+*]$>) { # return common numeric type if (my $type = _lca($self->datatype->value, $rhs->datatype->value)) { return $type; } return 'http://www.w3.org/2001/XMLSchema#double'; } elsif ($op eq '/') { if ($self->is_integer_type and $rhs->is_integer_type) { # return xsd:decimal if both operands are integers return 'http://www.w3.org/2001/XMLSchema#decimal'; } if (my $type = _lca($self->datatype->value, $rhs->datatype->value)) { return $type; } return 'http://www.w3.org/2001/XMLSchema#double'; } die "Unexpected numeric operation in binary_promotion_type: $op"; } } with 'Attean::API::Literal', 'Attean::API::CanonicalizingLiteral'; } package Attean::API::Blank 0.034 { use Scalar::Util qw(blessed); use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Attean::API::Query; use Moo::Role; sub ebv { return 1; } with 'Attean::API::Term', 'Attean::API::BlankOrIRI', 'Attean::API::BlankOrIRIOrTriple'; ; with 'Attean::API::SPARQLSerializable'; sub sparql_tokens { my $self = shift; my $t = AtteanX::SPARQL::Token->fast_constructor( BNODE, -1, -1, -1, -1, [$self->value] ); return Attean::ListIterator->new( values => [$t], item_type => 'AtteanX::SPARQL::Token' ); } sub compare { my ($a, $b) = @_; return 1 unless blessed($b); return -1 unless ($b->does('Attean::API::Blank')); return ($a->value cmp $b->value); } =item C<< sameTerms( $other ) >> =cut sub sameTerms { my $lhs = shift; my $rhs = shift; return 0 unless ($rhs->does('Attean::API::Blank')); return 0 unless ($lhs->value eq $rhs->value); return 1; } } package Attean::API::IRI 0.034 { use IRI; use Scalar::Util qw(blessed); use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Attean::API::Query; use Moo::Role; sub ebv { return 1; } with 'Attean::API::Term', 'Attean::API::BlankOrIRI', 'Attean::API::BlankOrIRIOrTriple'; with 'Attean::API::SPARQLSerializable'; sub sparql_tokens { my $self = shift; my @tokens; if ($self->value eq '') { push(@tokens, AtteanX::Parser::Turtle::Token->a); } else { push(@tokens, AtteanX::SPARQL::Token->fast_constructor( IRI, -1, -1, -1, -1, [$self->value] )); } return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } sub compare { my ($a, $b) = @_; return 1 unless blessed($b); return -1 if ($b->does('Attean::API::Literal') or $b->does('Attean::API::Binding')); return 1 unless ($b->does('Attean::API::IRI')); return ($a->value cmp $b->value); } =item C<< sameTerms( $other ) >> =cut sub sameTerms { my $lhs = shift; my $rhs = shift; return 0 unless ($rhs->does('Attean::API::IRI')); return 0 unless ($lhs->value eq $rhs->value); return 1; } sub _ntriples_string { my $self = shift; return sprintf('<%s>', $self->__ntriples_string); } around as_sparql => sub { my $orig = shift; my $self = shift; if ($self->value eq 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type') { return 'a'; } return $self->$orig(@_); }; } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/Variable.pod000644 000765 000024 00000000225 14636707547 021642 xustar00gregstaff000000 000000 30 mtime=1719373671.745631747 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/Variable.pod000644 000765 000024 00000001573 14636707547 017700 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::Variable - Role representing term variables =head1 VERSION This document describes Attean::API::Variable version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a Moo role representing variables that may be used in triple and quad patterns. =head1 ROLES This role consumes L. =head1 METHODS =over 4 =item C<< as_string >> Returns a SPARQL-like string serialization of the variable. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/QuadSerializer.pod000644 000765 000024 00000000225 14636707547 023041 xustar00gregstaff000000 000000 30 mtime=1719373671.445525223 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/QuadSerializer.pod000644 000765 000024 00000002167 14636707547 021077 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::QuadSerializer - Role for serializers of L objects =head1 VERSION This document describes Attean::API::QuadSerializer version 0.034 =head1 DESCRIPTION The Attean::API::QuadSerializer role defines serializers of L objects. =head1 ROLES This role consumes the L roles which provide the following methods: =over 4 =item C<< serialize_list_to_io( $fh, @elements ) >> =item C<< serialize_list_to_bytes( @elements ) >> =back =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< handled_type >> Returns a L object for objects which consume the L role. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/Triple.pod000644 000765 000024 00000000225 14636707547 021354 xustar00gregstaff000000 000000 30 mtime=1719373671.662303792 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/Triple.pod000644 000765 000024 00000002432 14636707547 017405 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::Triple - Role representing triples =head1 VERSION This document describes Attean::API::Triple version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a Moo role representing triples. =head1 ROLES This role consumes L, L, L and L, which provide the following methods: =over 4 =item C<< mapping >> =item C<< variables >> =item C<< values >> =item C<< value >> =item C<< tuples_string >> =item C<< as_string >> =item C<< as_quad_pattern >> =item C<< apply_map >> =back =head1 METHODS =over 4 =item C<< as_quad( $graph ) >> Returns an L object with the referent's subject, predicate, and object, and the supplied C<< $graph >>. =item C<< subject >> =item C<< predicate >> =item C<< object >> =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/AggregateExpression.pod000644 000765 000024 00000000225 14636707547 024063 xustar00gregstaff000000 000000 30 mtime=1719373671.048029184 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/AggregateExpression.pod000644 000765 000024 00000002166 14636707547 022120 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::AggregateExpression - Role representing an aggregate expression tree =head1 VERSION This document describes Attean::API::AggregateExpression version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a Moo role representing aggregate expressions. =head1 ROLES This role consumes L. =head1 REQUIRED METHODS Classes consuming this role must provide the following methods: =over 4 =item C<< operator() >> The name of the aggregate operator. =item C<< scalar_vars() >> A HASH reference of scalar variables. The only scalar variable defined for SPARQL 1.1 is C<'seperator'>, a string separator used with the GROUP_CONCAT aggregate. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/QueryPlanner.pm000644 000765 000024 00000000225 14636707547 022374 xustar00gregstaff000000 000000 30 mtime=1719373671.481376291 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/QueryPlanner.pm000644 000765 000024 00000042763 14636707547 020440 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::API::IDPJoinPlanner - Iterative dynamic programming query planning role =head1 VERSION This document describes Attean::API::IDPJoinPlanner version 0.034 =head1 SYNOPSIS extends 'Attean::QueryPlanner'; with 'Attean::API::IDPJoinPlanner'; =head1 DESCRIPTION The Attean::API::IDPJoinPlanner role provides a query planner the C<< joins_for_plan_alternatives >> method, as well as the cost estimation methods that consume the L role. =head1 ATTRIBUTES =over 4 =back =head1 METHODS =over 4 =cut package Attean::API::QueryPlanner 0.034 { use Types::Standard qw(CodeRef Object); use Moo::Role; requires 'plan_for_algebra'; # plan_for_algebra($algebra, $model, \@default_graphs) has 'request_signer' => (is => 'rw', isa => Object); } package Attean::API::CostPlanner 0.034 { use Scalar::Util qw(refaddr); use Types::Standard qw(CodeRef); use Moo::Role; use namespace::clean; with 'Attean::API::QueryPlanner'; requires 'plans_for_algebra'; # plans_for_algebra($algebra, $model, \@active_graphs, \@default_graphs) requires 'cost_for_plan'; # cost_for_plan($plan, $model) before 'cost_for_plan' => sub { my $self = shift; my $plan = shift; my $model = shift; if (refaddr($self) == refaddr($model)) { Carp::confess "Model and planner objects cannot be the same in call to cost_for_plan"; } elsif ($self->does('Attean::API::Model') and $model->does('Attean::API::Model')) { Carp::confess "Model and planner objects cannot both consume Attean::API::Model in call to cost_for_plan"; } }; sub plan_for_algebra { my $self = shift; my $algebra = shift; my $model = shift; my $default_graphs = shift; my $active_graphs = $default_graphs; my @plans = sort { $self->cost_for_plan($a, $model) <=> $self->cost_for_plan($b, $model) } $self->plans_for_algebra($algebra, $model, $active_graphs, $default_graphs); my $plan = shift(@plans); return $plan; } } package Attean::API::JoinPlanner 0.034 { use Moo::Role; requires 'joins_for_plan_alternatives'; } package Attean::API::NaiveJoinPlanner 0.034 { use Math::Cartesian::Product; use Moo::Role; with 'Attean::API::JoinPlanner'; with 'Attean::API::QueryPlanner'; sub joins_for_plan_alternatives { my $self = shift; my $model = shift; my $active_graphs = shift; my $default_graphs = shift; my $interesting = shift; my @args = @_; # each $args[$i] here is an array reference containing alternate plans for element $i my $plans = shift(@args); while (scalar(@args)) { my $next = shift(@args); my @plans = $self->join_plans($model, $active_graphs, $default_graphs, $plans, $next, 'inner'); $plans = \@plans; } my @plans = @$plans; return @plans; } } package Attean::API::SimpleCostPlanner 0.034 { use Types::Standard qw(Int); use Scalar::Util qw(blessed); use Moo::Role; with 'Attean::API::CostPlanner'; with 'MooX::Log::Any'; has 'keep' => (is => 'ro', isa => Int, default => 5); around 'joins_for_plan_alternatives' => sub { my $orig = shift; my $self = shift; my $model = shift; my @plans = $orig->($self, $model, @_); return $self->prune_plans($model, [], \@plans); }; sub prune_plans { my $self = shift; my $model = shift; my $interesting = shift; my @plans = @{ shift || [] }; no sort 'stable'; my @sorted = map { $_->[1] } sort { $a->[0] <=> $b->[0] } map { [$self->cost_for_plan($_, $model), $_] } @plans; return ($self->keep) ? splice(@sorted, 0, $self->keep) : @sorted; } sub cost_for_plan { my $self = shift; my $plan = shift; my $model = shift; Carp::confess "No model given" unless (blessed($model) and $model->does('Attean::API::Model')); if ($plan->has_cost) { return $plan->cost; } else { if ($model->does('Attean::API::CostPlanner')) { if (defined(my $cost = $model->cost_for_plan($plan, $self))) { $plan->cost($cost); $self->log->info('Model \''.ref($model).'\' did cost planning for \''.ref($plan).'\' and got cost '.$cost); return $cost; } } my $cost = 1; my @children = @{ $plan->children }; if ($plan->isa('Attean::Plan::Quad')) { my @vars = map { $_->value } grep { blessed($_) and $_->does('Attean::API::Variable') } $plan->values; return scalar(@vars); } elsif ($plan->isa('Attean::Plan::Table')) { my $rows = $plan->rows; $cost = scalar(@$rows); } elsif ($plan->isa('Attean::Plan::NestedLoopJoin')) { my $lcost = $self->cost_for_plan($children[0], $model); my $rcost = $self->cost_for_plan($children[1], $model); if ($lcost == 0) { $cost = $rcost; } elsif ($rcost == 0) { $cost = $lcost; } else { $cost = $lcost * $rcost; } # a cartesian nested loop join is bad, but the algorithm already # has to check for all possible joins, so it's not as bad as # a cartesian hash join (below) $cost *= 10 unless ($plan->children_are_variable_connected); } elsif ($plan->isa('Attean::Plan::HashJoin')) { my $joined = $plan->children_are_variable_connected; my $lcost = $self->cost_for_plan($children[0], $model); my $rcost = $self->cost_for_plan($children[1], $model); $cost = ($lcost + $rcost); $cost += ($lcost < $rcost); # To let the plan with cheaper rhs win $cost *= 100 unless ($plan->children_are_variable_connected); } elsif ($plan->isa('Attean::Plan::Service')) { my $scost = 10; foreach my $c (@{ $plan->children }) { $scost += $self->cost_for_plan($c, $model); } $cost = 5 * $scost; } elsif ($plan->isa('Attean::Plan::Unique')) { $cost = 0; # consider a filter on the iterator (like unique) to be essentially free foreach my $c (@{ $plan->children }) { $cost += $self->cost_for_plan($c, $model); } } else { foreach my $c (@{ $plan->children }) { $cost += $self->cost_for_plan($c, $model); } } $plan->cost($cost); if ($self->log->is_trace) { $self->log->trace("Cost $cost estimated for\n".$plan->as_string); } else { $self->log->debug('Estimated cost for \''.ref($plan).'\' is '.$cost); } return $cost; } } } package Attean::API::IDPJoinPlanner 0.034 { use Encode qw(encode); use Attean::RDF; use LWP::UserAgent; use Scalar::Util qw(blessed reftype); use List::Util qw(reduce); use List::MoreUtils qw(all any); use Types::Standard qw(Int ConsumerOf InstanceOf); use URI::Escape; use Algorithm::Combinatorics qw(subsets); use List::Util qw(min); use Math::Cartesian::Product; use Moo::Role; with 'Attean::API::JoinPlanner'; with 'Attean::API::SimpleCostPlanner'; sub joins_for_plan_alternatives { my $self = shift; my $model = shift; my $active_graphs = shift; my $default_graphs = shift; my $interesting = shift; my @args = @_; # each $args[$i] here is an array reference containing alternate plans for element $i my $k = 3; # this is the batch size over which to do full dynamic programming # initialize $optPlan{$i} to be a set of alternate plans for evaluating element $i my %optPlan; foreach my $i (0 .. $#args) { $optPlan{$i} = [$self->prune_plans($model, $interesting, $args[$i])]; } my @todo = (0 .. $#args); # initialize the todo list to all elements my $next_symbol = 'a'; # when we start batching together sub-plans, we'll rename them with letters (e.g. elements 1, 2, and 4 might become 'a', and then 3, 5, and 'a' become 'b') # until we've joined all the elements in todo and are left with a set of plans for the join of all elements while (scalar(@todo) > 1) { $k = ($k < scalar(@todo)) ? $k : scalar(@todo); # in case we're joining fewer than the batch size foreach my $i (2 .. $k) { # we've already initialized plans for evaluating single elements; now consider plans for groups of elements (with group sizes 2, 3, ..., $k) foreach my $s (subsets(\@todo, $i)) { # pick a subset of size $i of the elements that need to be planned my $s_key = join('.', sort @$s); $optPlan{$s_key} = []; foreach my $o (subsets($s)) { # partition the subset s into two (o and not_o) next if (scalar(@$o) == 0); # only consider proper, non-empty subsets next if (scalar(@$o) == scalar(@$s)); # only consider proper, non-empty subsets my $o_key = join('.', sort @$o); my %o = map { $_ => 1 } @$o; my $not_o_key = join('.', sort grep { not exists $o{$_} } @$s); my $lhs = $optPlan{$o_key}; # get the plans for evaluating o my $rhs = $optPlan{$not_o_key}; # get the plans for evaluating not_o # compute and store all the possible ways to evaluate s (o ⋈ not_o) push(@{ $optPlan{$s_key} }, $self->join_plans($model, $active_graphs, $default_graphs, $lhs, $rhs, 'inner')); $optPlan{$s_key} = [$self->prune_plans($model, $interesting, $optPlan{$s_key})]; } } } # find the minimum cost plan $p that computes the join over $k elements (the elements end up in @v) my %min_plans; foreach my $w (subsets(\@todo, $k)) { my $w_key = join('.', sort @$w); my $plans = $optPlan{$w_key}; my @costs = map { $self->cost_for_plan($_, $model) => [$_, $w] } @$plans; my %costs = @costs; my $min = min keys %costs; my @min_plans; while (my ($cost, $data) = splice(@costs, 0, 2)) { if ($cost == $min) { push(@min_plans, $data); } } $min_plans{ $min } = \@min_plans; } my $min_cost = min keys %min_plans; my $min_plans = $min_plans{$min_cost}; my @min_plans; my $min_key; foreach my $d (@$min_plans) { my ($p, $v) = @$d; my $v_key = join('.', sort @$v); if (not(defined($min_key)) or $min_key eq $v_key) { push(@min_plans, $p); $min_key = $v_key; } } # my ($p, $v) = @$min_plan; # my $v_key = join('.', sort @$v); # warn "Choosing join for $v_key\n"; # generate a new symbol $t to stand in for $p, the join over the elements in @v my $t = $next_symbol++; # remove elements in @v from the todo list, and replace them by the new composite element $t $optPlan{$t} = [@min_plans]; my %v = map { $_ => 1 } split(/[.]/, $min_key); push(@todo, $t); @todo = grep { not exists $v{$_} } @todo; # also remove subsets of @v from the optPlan hash as they are now covered by $optPlan{$t} foreach my $o (subsets([keys %v])) { my $o_key = join('.', sort @$o); # warn "deleting $o_key\n"; delete $optPlan{$o_key}; } } my $final_key = join('.', sort @todo); # use Data::Dumper; # warn Dumper($optPlan{$final_key}); return $self->prune_plans($model, $interesting, $optPlan{$final_key}); } sub prune_plans { my $self = shift; my $model = shift; my $interesting = shift; my @plans = @{ shift || [] }; no sort 'stable'; my @sorted = map { $_->[1] } sort { $a->[0] <=> $b->[0] } map { [$self->cost_for_plan($_, $model), $_] } @plans; if ($self->log->is_trace) { $self->log->trace('============= Plan iteration separator =============='); foreach my $plan (@sorted){ $self->log->trace("Cost: " . $self->cost_for_plan($plan, $model) . " for plan:\n". $plan->as_string); } } return splice(@sorted, 0, 5); } # Return a cost value for $plan. This value is basically opaque, except # that it will be used to sort plans by cost when determining which is the # cheapest plan to evaluate. sub cost_for_plan { my $self = shift; my $plan = shift; my $model = shift; Carp::confess "No model given" unless (blessed($model) and $model->does('Attean::API::Model')); if ($plan->has_cost) { return $plan->cost; } else { if ($model->does('Attean::API::CostPlanner')) { if (defined(my $cost = $model->cost_for_plan($plan, $self))) { $plan->cost($cost); $self->log->info('Model \''.ref($model).'\' did cost planning for \''.ref($plan).'\' and got cost '.$cost); return $cost; } } my $cost = 1; my @children = @{ $plan->children }; if ($plan->isa('Attean::Plan::Quad')) { my @vars = map { $_->value } grep { blessed($_) and $_->does('Attean::API::Variable') } $plan->values; # This gives a cost increasing at a reasonable pace $cost = $self->_hsp_heuristic_triple_sum($plan) * scalar(@vars); } elsif ($plan->isa('Attean::Plan::Table')) { my $rows = $plan->rows; $cost = scalar(@$rows); } elsif ($plan->isa('Attean::Plan::NestedLoopJoin')) { my $lcost = $self->cost_for_plan($children[0], $model); my $rcost = $self->cost_for_plan($children[1], $model); if ($lcost == 0) { $cost = $rcost; } elsif ($rcost == 0) { $cost = $lcost; } else { my $mult = $self->_penalize_joins($plan); # warn "$mult * ($lcost * $rcost) [$children[0] $children[1]]"; $cost = $mult * $lcost * $rcost; } } elsif ($plan->isa('Attean::Plan::HashJoin')) { my $lcost = $self->cost_for_plan($children[0], $model); my $rcost = $self->cost_for_plan($children[1], $model); if ($lcost == 0) { $cost = $rcost; } elsif ($rcost == 0) { $cost = $lcost; } else { my $mult = $self->_penalize_joins($plan); # warn "$mult * ($lcost + $rcost)"; $cost = $mult * ($lcost + $rcost); $cost += ($lcost < $rcost); # To let the plan with cheaper rhs win } } elsif ($plan->isa('Attean::Plan::Service')) { my $scost = 10; foreach my $c (@{ $plan->children }) { $scost += $self->cost_for_plan($c, $model); } $cost = 5 * $scost; } elsif ($plan->isa('Attean::Plan::Unique')) { $cost = 0; # consider a filter on the iterator (like unique) to be essentially free foreach my $c (@{ $plan->children }) { $cost += $self->cost_for_plan($c, $model); } } else { foreach my $c (@{ $plan->children }) { $cost += $self->cost_for_plan($c, $model); } } # Costs must be integers for comparisons to work in the IDP planning algorithm $cost = int($cost); $plan->cost($cost); return $cost; } } # The below function finds a number to aid sorting # It takes into account Heuristic 1 and 4 of the HSP paper, see REFERENCES # as well as that it was noted in the text that rdf:type is usually less selective. # By assigning the integers to nodes, depending on whether they are in # triple (subject, predicate, object), variables, rdf:type and # literals, and sum them, they may be sorted. See code for the actual # values used. # Denoting s for bound subject, p for bound predicate, a for rdf:type # as predicate, o for bound object and l for literal object and ? for # variable, we get the following order, most of which are identical to # the HSP: # spl: 6 # spo: 8 # sao: 10 # s?l: 14 # s?o: 16 # ?pl: 25 # ?po: 27 # ?ao: 29 # sp?: 30 # sa?: 32 # ??l: 33 # ??o: 35 # s??: 38 # ?p?: 49 # ?a?: 51 # ???: 57 # Note that this number is not intended as an estimate of selectivity, # merely a sorting key, but further research may possibly create such # numbers. sub _hsp_heuristic_triple_sum { my ($self, $t) = @_; my $sum = 0; if ($t->subject->does('Attean::API::Variable')) { $sum = 20; } else { $sum = 1; } if ($t->predicate->does('Attean::API::Variable')) { $sum += 10; } else { if ($t->predicate->equals(iri('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'))) { $sum += 4; } else { $sum += 2; } } if ($t->object->does('Attean::API::Variable')) { $sum += 27; } elsif ($t->object->does('Attean::API::Literal')) { $sum += 3; } else { $sum += 5; } return $sum; } # The following method returns a factor used to penalize certain types of joins. # It penalizes cartesian joins heavily, but also uses HSP Heuristic 2 (see REFERENCES) sub _penalize_joins { my ($self, $plan) = @_; my $jv = $plan->join_variables; my @children = @{ $plan->children }; my $mult = 1; if (scalar(@$jv)) { if ( all { $_->isa('Attean::Plan::Quad') } @children[0..1]) { my $var = ${$jv}[0]; # We will join on this my @lnodes = $children[0]->values; my @rnodes = $children[1]->values; # Now, find where the join variables are in the triple patterns my %joinpos; for (my $i = 0; $i <= 2; $i++) { if ($lnodes[$i]->does('Attean::API::Variable') && $lnodes[$i]->value eq $var) { $joinpos{l} = $i; } if ($rnodes[$i]->does('Attean::API::Variable') && $rnodes[$i]->value eq $var) { $joinpos{r} = $i; } last if scalar keys(%joinpos) >= 2; # Perhaps a bit premature optimization } my $joinpos = join("", sort values(%joinpos)); # We can now match on this string my %costs = ('12' => 1.1, # The penalty numbers come mostly out from thin air '01' => 1.2, '02' => 1.5, '22' => 1.6, '00' => 1.8, '11' => 2); if (exists $costs{$joinpos}) { $mult = $costs{$joinpos}; } #warn "Penalty: $mult for quads:\n" . $children[0]->as_string . $children[1]->as_string } } else { $mult = 5; # penalize cartesian joins } return $mult; } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 REFERENCES The seminal reference for Iterative Dynamic Programming is "Iterative dynamic programming: a new class of query optimization algorithms" by D. Kossmann and K. Stocker, ACM Transactions on Database Systems (2000). The heuristics to order triple patterns in this module is influenced by L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/TermOrVariable.pod000644 000765 000024 00000000225 14636707547 022773 xustar00gregstaff000000 000000 30 mtime=1719373671.612309627 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/TermOrVariable.pod000644 000765 000024 00000002146 14636707547 021026 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::TermOrVariable - Role representing terms and variables =head1 VERSION This document describes Attean::API::TermOrVariable version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a Moo role that both terms and variables consume, and is used as a constraint for nodes in triple and quad patterns. =head1 METHODS =over 4 =item C<< equals( $other ) >> Returns true if the referent and C<< $other >> are value-equal, false otherwise. =item C<< is_bound >> Returns true if the referent is bound. Note that in pattern matching, C may also be used, so typically, you would need to check if (defined($term) && $term->is_bound) { ... to check. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/ResultSerializer.pod000644 000765 000024 00000000225 14636707547 023425 xustar00gregstaff000000 000000 30 mtime=1719373671.545219069 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/ResultSerializer.pod000644 000765 000024 00000002203 14636707547 021452 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::ResultSerializer - Role for serializers of L objects =head1 VERSION This document describes Attean::API::ResultSerializer version 0.034 =head1 DESCRIPTION The Attean::API::ResultSerializer role defines serializers of L objects. =head1 ROLES This role consumes the L roles which provide the following methods: =over 4 =item C<< serialize_list_to_io( $fh, @elements ) >> =item C<< serialize_list_to_bytes( @elements ) >> =back =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< handled_type >> Returns a L object for objects which consume the L role. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/TripleSerializer.pod000644 000765 000024 00000000225 14636707547 023406 xustar00gregstaff000000 000000 30 mtime=1719373671.728990955 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/TripleSerializer.pod000644 000765 000024 00000002203 14636707547 021433 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::TripleSerializer - Role for serializers of L objects =head1 VERSION This document describes Attean::API::TripleSerializer version 0.034 =head1 DESCRIPTION The Attean::API::TripleSerializer role defines serializers of L objects. =head1 ROLES This role consumes the L roles which provide the following methods: =over 4 =item C<< serialize_list_to_io( $fh, @elements ) >> =item C<< serialize_list_to_bytes( @elements ) >> =back =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< handled_type >> Returns a L object for objects which consume the L role. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/AtOnceParser.pod000644 000765 000024 00000000225 14636707547 022443 xustar00gregstaff000000 000000 30 mtime=1719373671.079945635 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/AtOnceParser.pod000644 000765 000024 00000004220 14636707547 020471 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::AtOnceParser - Role for parsers that natively parse all input before returning any data =head1 VERSION This document describes Attean::API::AtOnceParser version 0.034 =head1 DESCRIPTION The Attean::API::AtOnceParser role defines parsers that must parse all input data before any objects are constructed and returned or passed to callback functions. This role adds methods that builds on this functionality to allow parsing data using different approaches. =head1 ROLES This role consumes the L role. =head1 REQUIRED METHODS Classes consuming this role must provide the following methods: =over 4 =item C<< parse_list_from_io( $fh ) >> Returns a list of all objects that result from parsing the data read from the L object C<< $fh >>. =item C<< parse_list_from_bytes( $data ) >> Returns a list of all objects that result from parsing the data read from the UTF-8 encoded byte string C<< $data >>. =back =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< parse_iter_from_io( $fh ) >> Returns an L that result from parsing the data read from the L object C<< $fh >>. =item C<< parse_iter_from_bytes( $data ) >> Returns an L that result from parsing the data read from the UTF-8 encoded byte string C<< $data >>. =item C<< parse_cb_from_io( $fh ) >> Calls the C<< $parser->handler >> function once for each object that result from parsing the data read from the L object C<< $fh >>. =item C<< parse_cb_from_bytes( $data ) >> Calls the C<< $parser->handler >> function once for each object that result from parsing the data read from the UTF-8 encoded byte string C<< $data >>. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/Iterator.pm000644 000765 000024 00000000225 14636707547 021540 xustar00gregstaff000000 000000 30 mtime=1719373671.212698204 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/Iterator.pm000644 000765 000024 00000030513 14636707547 017572 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::API::Iterator - Typed iterator =head1 VERSION This document describes Attean::API::Iterator version 0.034 =head1 DESCRIPTION The Attean::API::Iterator role defines a common API for typed iterators. This package also defines several type-specific iterator roles: =over 4 =item * L =item * L =item * L =item * L =back These roles will automatically be applied to iterators during construction when appropriate. =head1 ATTRIBUTES The following attributes exist: =over 4 =item C<< item_type >> A string indicating the type of elements returned by the iterator. =back =head1 REQUIRED METHODS The following methods are required by the L role: =over 4 =item C<< next >> Returns the next element from the iterator, or C<< undef >> upon exhaustion. =back =head1 METHODS The L role provides default implementations of the following methods: =over 4 =item C<< elements >> Returns a list of all remaining elements in the iterator. =item C<< map( \&mapper [, $result_type] ) >> Returns a new L object with each element mapped using the supplied C<< &mapper >> function. If the iterator elements are of the same type as those in the referent iterator, only a mapping function is required. Otherwise, the supplied L C<< $result_type >> object must indicate the new iterator's type information. =item C<< grep( \&filter ) >> Returns a new L object that filters elements from the referent iterator based on whether calling C<< &filter( $element ) >> for each C<< $element >> results in a true value. =item C<< offset( $offset ) >> Returns the L referent after skipping the first C<< $offset >> elements. =item C<< limit( $limit ) >> Returns a new L object which returns the first C<< $limit >> elements of the referent. =item C<< materialize >> Returns a new L object containing all the elements from the referent. =cut package Attean::API::Iterator 0.034 { use Scalar::Util qw(blessed); use Types::Standard qw(Str Object InstanceOf); use Carp qw(confess); use Moo::Role; has 'item_type' => (is => 'ro', isa => Str, required => 1); requires 'next'; sub BUILD {} around 'BUILD' => sub { my $orig = shift; my $self = shift; my $args = shift; $self->$orig($args); my $role = $self->item_type; if (Moo::Role->is_role($role)) { my $check = sub { my $check = shift; return ($role eq $check or Moo::Role::does_role($role, $check)); }; if ($check->('Attean::API::Quad')) { Moo::Role->apply_roles_to_object($self, 'Attean::API::QuadIterator'); } elsif ($check->('Attean::API::Triple')) { Moo::Role->apply_roles_to_object($self, 'Attean::API::TripleIterator'); } elsif ($check->('Attean::API::TripleOrQuad')) { Moo::Role->apply_roles_to_object($self, 'Attean::API::MixedStatementIterator'); } elsif ($check->('Attean::API::Result')) { Moo::Role->apply_roles_to_object($self, 'Attean::API::ResultIterator'); my $vars = $args->{variables} // confess "Construction of a Attean::API::ResultIterator must include a variables list"; $self->variables($vars); } elsif ($check->('Attean::API::Term')) { Moo::Role->apply_roles_to_object($self, 'Attean::API::TermIterator'); } elsif ($check->('Attean::API::ResultOrTerm')) { Moo::Role->apply_roles_to_object($self, 'Attean::API::ResultOrTermIterator'); $self->variables($args->{variables} || []); } if ($self->does('Attean::API::RepeatableIterator') and $check->('Attean::API::Binding')) { Moo::Role->apply_roles_to_object($self, 'Attean::API::CanonicalizingBindingSet'); } } }; if ($ENV{ATTEAN_TYPECHECK}) { around 'next' => sub { my $orig = shift; my $self = shift; my $type = $self->item_type; my $class = ref($self); my $term = $self->$orig(@_); return unless defined($term); if (blessed($term)) { unless ($term->does($type) or $term->isa($type)) { die "${class} returned an element that failed conformance check for $type: $term"; } } return $term; }; } sub elements { my $self = shift; my @elements; while (my $item = $self->next) { push(@elements, $item); } return @elements; } sub map { my $self = shift; my $block = shift; my $type = shift || $self->item_type; my $generator; if (blessed($block) and $block->does('Attean::Mapper')) { $generator = sub { my $item = $self->next(); return unless defined($item); my $new = $block->map($item); return $new; } } else { my @buffer; $generator = sub { while (1) { return shift(@buffer) if (scalar(@buffer)); my $item = $self->next(); return unless defined($item); local($_) = $item; push(@buffer, $block->($item)); } } } # copy variables into new iterator if $self does ::ResultIterator or ::ResultOrTermIterator my %args = @_; if ($self->can('variables') and not exists $args{variables}) { $args{variables} = $self->variables; } return Attean::CodeIterator->new( %args, item_type => $type, generator => $generator ); } sub grep { my $self = shift; my $block = shift; # copy variables into new iterator if $self does ::ResultIterator or ::ResultOrTermIterator my %args = @_; if ($self->can('variables') and not exists $args{variables}) { $args{variables} = $self->variables; } Attean::CodeIterator->new( %args, item_type => $self->item_type, generator => sub { while (1) { my $item = $self->next(); return unless defined($item); local($_) = $item; return $item if ($block->($item)); } } ); } sub offset { my $self = shift; my $offset = shift; $self->next for (1 .. $offset); return $self; } sub limit { my $self = shift; my $limit = shift; # copy variables into new iterator if $self does ::ResultIterator or ::ResultOrTermIterator my %args = @_; if ($self->can('variables') and not exists $args{variables}) { $args{variables} = $self->variables; } Attean::CodeIterator->new( %args, item_type => $self->item_type, generator => sub { return unless $limit; my $item = $self->next(); return unless defined($item); $limit--; return $item; } ); } sub materialize { my $self = shift; my @data = $self->elements; my %args = @_; if ($self->can('variables') and not exists $args{variables}) { $args{variables} = $self->variables; } return Attean::ListIterator->new( %args, values => \@data, item_type => $self->item_type ); } =item C<< debug( [$name] ) >> Print each item as it is consumed (with the string generated by C<< as_string >>), prepended by C<< $name >>. =cut sub debug { my $self = shift; my $name = shift // 'Iterator item'; return $self->grep(sub { my $r = shift; say "$name: " . $r->as_string; return 1; }); } } package Attean::API::StringyItemIterator 0.034 { use Moo::Role; sub uniq { my $self = shift; my %seen; return $self->grep(sub { my $r = shift; return not($seen{ $r->as_string }++); }); } } package Attean::API::RepeatableIterator 0.034 { use Moo::Role; requires 'reset'; sub elements { my $self = shift; my @elements; while (my $item = $self->next) { push(@elements, $item); } $self->reset; return @elements; } sub peek { my $self = shift; my $item = $self->next; $self->reset; return $item; } sub materialize { my $self = shift; return $self; } sub size { my $self = shift; my @elements = $self->elements; return scalar(@elements); } with 'Attean::API::Iterator'; } package Attean::API::CanonicalizingBindingIterator { use Moo::Role; sub canonicalize { my $self = shift; my $mapper = Attean::TermMap->canonicalization_map; return $self->map(sub { shift->apply_map( $mapper ) }); } } package Attean::API::ResultOrTermIterator 0.034 { use Moo::Role; use Types::Standard qw(ArrayRef Str); has 'variables' => (is => 'rw', isa => ArrayRef[Str], default => sub { [] }); with 'Attean::API::StringyItemIterator'; sub canonicalize { my $self = shift; my $mapper = Attean::TermMap->canonicalization_map; return $self->map(sub{ my $item = shift; if ($item->does('Attean::API::Term')) { return $mapper->map($item); } else { my %values = map { $_ => $mapper->map($item->value($_)) } $item->variables; return Attean::Result->new( bindings => \%values ); } }); } around 'grep' => sub { my $orig = shift; my $self = shift; my $block = shift; my $iter = $orig->($self, $block, @_); Attean::CodeIterator->new( item_type => $iter->item_type, generator => sub { return $iter->next(); }, variables => $self->variables, ); }; } package Attean::API::StatementIterator 0.034 { use Moo::Role; use Scalar::Util qw(blessed); with 'Attean::API::StringyItemIterator'; requires 'variables'; sub matching_pattern { my $self = shift; my @nodes = @_; if (scalar(@nodes) == 1 and $nodes[0]->does('Attean::API::QuadPattern')) { my $pattern = $nodes[0]; @nodes = $pattern->values; } my %bound; my @pos_names = $self->variables; foreach my $pos (0 .. $#pos_names) { my $n = $nodes[ $pos ]; if (blessed($n)) { $bound{ $pos_names[$pos] } = $n; } } my $pattern = Attean::QuadPattern->new( %bound ); return $self->grep(sub { my $q = shift; my $binding = $pattern->unify($q); return $binding ? 1 : 0; }); } } package Attean::API::TripleIterator 0.034 { use Moo::Role; with 'Attean::API::CanonicalizingBindingIterator'; with 'Attean::API::StatementIterator'; sub as_quads { my $self = shift; my $graph = shift; return $self->map(sub { $_->as_quad($graph) }, 'Attean::API::Quad'); } sub variables { return qw(subject predicate object); } } package Attean::API::QuadIterator 0.034 { use Moo::Role; with 'Attean::API::CanonicalizingBindingIterator'; with 'Attean::API::StatementIterator'; sub variables { return qw(subject predicate object graph); } } package Attean::API::MixedStatementIterator 0.034 { use Moo::Role; with 'Attean::API::CanonicalizingBindingIterator'; with 'Attean::API::StringyItemIterator'; sub as_quads { my $self = shift; my $graph = shift; return $self->map( sub { $_->does('Attean::API::Quad') ? $_ : $_->as_quad($graph) }, 'Attean::API::Quad' ); } } package Attean::API::ResultIterator 0.034 { use Types::Standard qw(Str ArrayRef); use Moo::Role; with 'Attean::API::CanonicalizingBindingIterator'; with 'Attean::API::StringyItemIterator'; has 'variables' => (is => 'rw', isa => ArrayRef[Str], required => 1); sub join { my $self = shift; my $rhs = shift; my @vars = keys %{ { map { $_ => 1 } (@{ $self->variables }, @{ $rhs->variables }) } }; my @rhs = $rhs->elements; my @results; while (my $lhs = $self->next) { foreach my $rhs (@rhs) { if (my $j = $lhs->join($rhs)) { push(@results, $j); } } } return Attean::ListIterator->new( values => \@results, item_type => $self->item_type, variables => \@vars); } with 'Attean::API::ResultOrTermIterator'; } package Attean::API::TermIterator 0.034 { use Moo::Role; sub canonicalize { my $self = shift; my $mapper = Attean::TermMap->canonicalization_map; return $self->map( $mapper ); } with 'Attean::API::CanonicalizingBindingIterator'; with 'Attean::API::StringyItemIterator'; } 1; __END__ =back =head2 Methods on Roles Supporting Stringification For iterators over roles that provide an C method, extra methods are provided. These iterators are: Attean::API::ResultOrTermIterator Attean::API::StatementIterator Attean::API::MixedStatementIterator Attean::API::ResultIterator Attean::API::TermIterator They provide the following methods: =over 4 =item C<< uniq >> Returns a new iterator providing unique results (based on the stringified value of the underlying elements). =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO L =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/MixedStatementSerializer.pod000644 000765 000024 00000000225 14636707547 025102 xustar00gregstaff000000 000000 30 mtime=1719373671.262221895 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/MixedStatementSerializer.pod000644 000765 000024 00000002255 14636707547 023136 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::MixedStatementSerializer - Role for serializers of L objects =head1 VERSION This document describes Attean::API::MixedStatementSerializer version 0.034 =head1 DESCRIPTION The Attean::API::MixedStatementSerializer role defines serializers of L objects. =head1 ROLES This role consumes the L roles which provide the following methods: =over 4 =item C<< serialize_list_to_io( $fh, @elements ) >> =item C<< serialize_list_to_bytes( @elements ) >> =back =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< handled_type >> Returns a L object for objects which consume the L role. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/Model.pm000644 000765 000024 00000000225 14636707547 021007 xustar00gregstaff000000 000000 30 mtime=1719373671.280174282 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/Model.pm000644 000765 000024 00000042044 14636707547 017043 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::API::Model - RDF Model =head1 VERSION This document describes Attean::API::Model version 0.034 =head1 DESCRIPTION The Attean::API::Model role defines a common API for all RDF models to conform to. It is provides a consistent interface for probing, counting, and retrieving Ls matching a pattern, as well as related functionality such as enumerating the graph names, and extracting structured data from the models' quads. =head1 REQUIRED METHODS The following methods are required by the L role: =over 4 =item C<< get_quads( $subject, $predicate, $object, $graph ) >> Returns an L for quads in the model that match the supplied C<< $subject >>, C<< $predicate >>, C<< $object >>, and C<< $graph >>. Any of these terms may be: * An L object, in which case matching is equality-based * A L object or C<< undef >>, in which case that term will be considered as a wildcard for the purposes of matching * An ARRAY reference of L objects, in which case the matching will be equality-based on the disjunction of the supplied terms The returned iterator conforms to both L and L. =item C<< count_quads( $subject, $predicate, $object, $graph ) >> Returns the number of quads in the model matching the supplied pattern (using the same matching semantics as C<< get_quads >>). =item C<< count_quads_estimate( $subject, $predicate, $object, $graph ) >> Returns an estimate of the number of quads in the model matching the supplied pattern (using the same matching semantics as C<< get_quads >>). This estimate is guaranteed to non-zero if the count returned from an equivalent call to `count_quads` would return a non-zero result. =item C<< get_graphs >> Returns an L of distinct L objects that are used in the graph position of quads in the model. =back =head1 METHODS The L role provides default implementations of the following methods: =over 4 =item C<< get_bindings( $subject, $predicate, $object, $graph ) >> Returns an L of L objects corresponding to quads in the model matching the supplied pattern. For each L in the pattern list, a mapping will be present in the corresponding result object. For example, C<< $model->get_bindings( variable('s') ) >> will return an iterator of results containing just a mapping from C<< 's' >> to subjects of all quads in the model. =item C<< get_list( $graph, $head ) >> Returns an L of L objects that are members of the rdf:List with the specified C<< $head >> (and matching restricted to only the specified C<< $graph >>). To check if a certain term is a list, the C method may be used, for example: $model->holds($head, iri('http://www.w3.org/1999/02/22-rdf-syntax-ns#first'), undef, $graph)) will return true if a given term C<$head> is a list. =item C<< get_sequence( $graph, $head ) >> Returns an L of L objects that are members of the rdf:Sequence with the specified C<< $head >> (and matching restricted to only the specified C<< $graph >>). =item C<< subjects( $predicate, $object, $graph ) >> Returns an L of L objects of all subjects of quads matching the supplied pattern (using the same matching semantics as C<< get_quads >>). The objects returned will not necessarily be unique. It will instead be equivalent to calling C<< get_quads >> and accessing C<< $quad->subject >> for each C<< $quad >> value returned by the iterator. For an iterator of unique subjects, use C<< $model->subjects->uniq >>. =item C<< predicates( $subject, $object, $graph ) >> Returns an L of L objects of all predicates of quads matching the supplied pattern (using the same matching semantics as C<< get_quads >> with an C<< undef >> predicate). The objects returned will not necessarily be unique (see the note for C<< subjects >> above). =item C<< objects( $subject, $predicate, $graph ) >> Returns an L of L objects of all objects of quads matching the supplied pattern (using the same matching semantics as C<< get_quads >> with an C<< undef >> object). The objects returned will not necessarily be unique (see the note for C<< subjects >> above). =item C<< graphs( $subject, $predicate, $object ) >> Returns an L of L objects of all graphs of quads matching the supplied pattern (using the same matching semantics as C<< get_quads >> with an C<< undef >> graph). The objects returned will not necessarily be unique (see the note for C<< subjects >> above). =item C<< graph_nodes( $graph ) >> Returns an L of L objects of unique subjects and objects present in the specified C<< $graph >>. =item C<< holds($s, $p, $o, $g) >> =item C<< holds($triple_pattern) >> =item C<< holds($quad_pattern) >> Returns true if the triple/quad pattern matches any data in the model, false otherwise. =item C<< algebra_holds($algebra, $graph) >> =item C<< algebra_holds($algebra, \@graphs) >> Returns true if the algebra, evaluated with the supplied default graph(s) matches any data in the model, false otherwise. This is equivalent to the result of an ASK query over the supplied algebra. =item C<< evaluate($algebra, [ $default_graph | \@default_graphs ]) >> Returns an L of L objects which result from evaluating the given query algebra (e.g. one obtained from parsing a query with L) with the supplied default graph(s) against data in the model. =cut use Attean::API::Binding; package Attean::API::Model 0.034 { use Sub::Install; use Sub::Util qw(set_subname); use URI::Namespace; use Scalar::Util qw(blessed); use List::MoreUtils qw(uniq); use Math::Cartesian::Product; use Data::Dumper; use Moo::Role; # get_quads($s, $p, $o, $g) # or: # get_quads([$s1, $s2, ...], \@p, \@o, \@g) requires 'get_quads'; sub get_bindings { my $self = shift; my @nodes = @_; my @pos = Attean::API::Quad->variables; # my %vars; my %bound; my %projected_vars; foreach my $i (0 .. $#nodes) { my $n = $nodes[$i]; $bound{ $pos[ $i ] } = $n; if (blessed($n) and $n->does('Attean::API::Binding')) { foreach my $v ($n->referenced_variables) { $projected_vars{ $v }++; } } elsif (blessed($n) and $n->isa('Attean::Variable')) { my $name = $n->value; # $vars{ $pos[ $i ] } = $name; $projected_vars{ $name }++; } } my @patterns; cartesian { my %bound; foreach my $i (0 .. $#_) { my $n = $_[$i]; $bound{ $pos[ $i ] } = $n; } push(@patterns, Attean::QuadPattern->new( %bound )); } map { ref($_) eq 'ARRAY' ? $_ : [$_] } @nodes; my $quads = $self->get_quads(@nodes); unless (blessed($quads)) { return Attean::ListIterator->new(values => [], item_type => 'Attean::API::Result', variables => []); } return $quads->map(sub { my $q = shift; # warn 'model got quad: ' . $q->as_string . "\n"; foreach my $pattern (@patterns) { # warn 'model using pattern: ' . $pattern->as_string . "\n"; if (my $b = $pattern->unify($q)) { # warn 'unified binding: ' . $b->as_string; my $g = $pattern->ground($b); # warn "get_bindings unification: " . $b->as_string; # warn "get_bindings ground: " . $g->as_string; # warn 'project vars: ' . Dumper([keys %projected_vars]); my $p = $b->project(keys %projected_vars); # warn "get_bindings result: " . $p->as_string; return $p; } } return; }, 'Attean::API::Result', variables => [keys %projected_vars]); } requires 'count_quads'; requires 'count_quads_estimate'; requires 'get_graphs'; requires 'holds'; sub get_list { my $self = shift; die "get_list called without a graph name" unless (scalar(@_)); my $graph = shift; die "get_list called without a list head" unless (scalar(@_)); my $head = shift; my $rdf_first = Attean::IRI->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#first'); my $rdf_rest = Attean::IRI->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#rest'); my $rdf_nil = Attean::IRI->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#nil'); my @elements; my %seen; while (blessed($head) and not($head->does('Attean::API::IRI') and $head->value eq $rdf_nil->value)) { if ($seen{ $head->as_string }++) { die "Loop found during rdf:List traversal"; } my @n = $self->objects( $head, $rdf_first )->elements; if (scalar(@n) != 1) { die "Invalid structure found during rdf:List traversal"; } push(@elements, @n); ($head) = $self->objects( $head, $rdf_rest )->elements; } return Attean::ListIterator->new(values => \@elements, item_type => 'Attean::API::Term' ); } sub get_sequence { my $self = shift; my $graph = shift; my $head = shift; my $rdf = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'; my @elements; my $i = 1; while (1) { my $term = Attean::IRI->new("${rdf}_$i"); my @elem = $self->objects( $head, $term, $graph )->elements; last unless (scalar(@elem)); if (scalar(@elem) > 1) { my $count = scalar(@elem); die "Invalid structure found during rdf:Seq access: $count elements found for element $i"; } my $elem = $elem[0]; last unless (blessed($elem)); push(@elements, $elem); $i++; } return Attean::ListIterator->new(values => \@elements, item_type => 'Attean::API::Term' ); } { # auto-generate methods subjects, predicates, objects, and graphs my @pos = Attean::API::Quad->variables; my %pos = map { $pos[$_] => $_ } (0 .. $#pos); for my $method (@pos) { my $code = sub { my $self = shift; my @nodes = @_; $#nodes = 3; splice(@nodes, $pos{$method}, 0, undef); $#nodes = 3; my $iter = $self->get_quads(@nodes); my $nodes = $iter->map( sub { $_->$method() }, 'Attean::API::Term', ); return $nodes; }; Sub::Install::install_sub({ code => set_subname("${method}s", $code), as => "${method}s" }); } } sub graph_nodes { my $self = shift; my $graph = shift; my $s = $self->subjects(undef, undef, $graph); my $o = $self->objects(undef, undef, $graph); my $union = Attean::IteratorSequence->new( iterators => [$s, $o], item_type => 'Attean::API::Term' ); my %seen; return $union->grep(sub {not($seen{shift->as_string}++)}); } sub evaluate { my $self = shift; my $algebra = shift || die "No algebra available in evaluate call"; my $default_graphs = shift || die "No default graphs available in evaluate call"; $default_graphs = [$default_graphs] if (blessed($default_graphs)); unless (blessed($algebra) and $algebra->does('Attean::API::Algebra')) { die "Unexpected argument to evaluate: " . Dumper($algebra); } my $planner = Attean::IDPQueryPlanner->new(); my $plan = $planner->plan_for_algebra($algebra, $self, $default_graphs); my $iter = $plan->evaluate($self); return $iter; } sub algebra_holds { my $self = shift; my $algebra = shift || die "No algebra available in algebra_holds call"; my $default_graphs = shift || die "No default graphs available in algebra_holds call"; $default_graphs = [$default_graphs] if (blessed($default_graphs)); unless (blessed($algebra) and $algebra->does('Attean::API::Algebra')) { die "Unexpected argument to algebra_holds: " . Dumper($algebra); } unless ($algebra->isa('Attean::Algebra::Ask')) { $algebra = Attean::Algebra::Ask->new(children => [$algebra]); } my $planner = Attean::IDPQueryPlanner->new(); my $plan = $planner->plan_for_algebra($algebra, $self, $default_graphs); my $iter = $plan->evaluate($self); my $r = $iter->next; my $ebv = eval { $r->ebv }; return 0 if ($@); return $ebv; } sub holds { my $self = shift; return 0 unless scalar(@_); if (not defined($_[0]) or (blessed($_[0]) and $_[0]->does('Attean::API::TermOrVariable'))) { # firt argument is undef or a term/variable, so we assume this is a call with up to 3 term/variable/undef args return ($self->count_quads_estimate(@_) > 0); } elsif (blessed($_[0]) and $_[0]->does('Attean::API::TripleOrQuadPattern')) { my $t = shift; return ($self->count_quads_estimate($t->values) > 0); } else { die "Unexpected argument to holds: " . Dumper($_[0]); } } } package Attean::API::MutableModel 0.034 { use Attean::RDF; use LWP::UserAgent; use Encode qw(encode); use Scalar::Util qw(blessed); use Role::Tiny (); use Moo::Role; requires 'add_quad'; requires 'remove_quad'; requires 'create_graph'; requires 'drop_graph'; requires 'clear_graph'; requires 'add_iter'; with 'Attean::API::Model'; sub load_urls_into_graph { my $self = shift; my $graph = shift; my @urls = @_; my $ua = LWP::UserAgent->new(); my $accept = Attean->acceptable_parsers( handles => 'Attean::API::Triple' ); $ua->default_headers->push_header( 'Accept' => $accept ); foreach my $u (@urls) { my $url = blessed($u) ? $u->value : $u; my $resp = $ua->get($url); if ($resp->is_success) { my $ct = $resp->header('Content-Type'); my $pclass = Attean->get_parser( media_type => $ct, filename => $url ) // Attean->get_parser('ntriples'); if ($pclass) { my $p = $pclass->new(base => iri($url)); my $str = $resp->decoded_content; my $bytes = encode('UTF-8', $str, Encode::FB_CROAK); my $iter = eval { $p->parse_iter_from_bytes( $bytes ) }; if ($@) { die "Failed to parse URL $url: $@"; } $self->add_iter($iter->as_quads($graph)); } else { die "No parser found for content type $ct: $url"; } } else { die $resp->status_line; } } } # $model->load_triples( 'turtle', iri('http://example.org/graph1') => "@prefix foaf: ...", iri('http://example.org/graph2') => "@prefix foaf: ..." ); sub load_triples { my $self = shift; my $format = shift; my $class = Attean->get_parser($format) || die "Failed to load parser for '$format'"; my $parser = $class->new() || die "Failed to construct parser for '$format'"; while (scalar(@_)) { my ($graph, $string) = splice(@_, 0, 2); my $iter = $parser->parse_iter_from_bytes(encode('UTF-8', $string, Encode::FB_CROAK)); my $quads = $iter->as_quads($graph); $self->add_iter($quads); } } sub load_triples_from_io { my $self = shift; my $format = shift; my $class = Attean->get_parser($format) || die "Failed to load parser for '$format'"; my $parser = $class->new() || die "Failed to construct parser for '$format'"; while (scalar(@_)) { my ($graph, $fh) = splice(@_, 0, 2); my $iter = $parser->parse_iter_from_io($fh); my $quads = $iter->as_quads($graph); $self->add_iter($quads); } } sub add_iter { my $self = shift; my $iter = shift; my $type = $iter->item_type; die "Iterator type $type isn't quads" unless (Role::Tiny::does_role($type, 'Attean::API::Quad')); while (my $q = $iter->next) { $self->add_quad($q); } } sub add_list { my $self = shift; die "add_list called without a graph name" unless (scalar(@_)); my $graph = shift; my @elements = @_; my $rdf_first = Attean::IRI->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#first'); my $rdf_rest = Attean::IRI->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#rest'); my $rdf_nil = Attean::IRI->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#nil'); if (scalar(@elements) == 0) { return $rdf_nil; } else { my $head = Attean::Blank->new(); my $node = shift(@elements); my $rest = $self->add_list($graph, @elements); $self->add_quad( Attean::Quad->new($head, $rdf_first, $node, $graph) ); $self->add_quad( Attean::Quad->new($head, $rdf_rest, $rest, $graph) ); return $head; } } } package Attean::API::ETagCacheableModel 0.034 { use Moo::Role; requires 'etag_value_for_quads'; } package Attean::API::TimeCacheableModel 0.034 { use Moo::Role; requires 'mtime_for_quads'; } package Attean::API::BulkUpdatableModel 0.034 { use Moo::Role; with 'Attean::API::MutableModel'; requires 'begin_bulk_updates'; requires 'end_bulk_updates'; around [qw(load_triples load_triples_from_io add_iter add_list)] => sub { my $orig = shift; my $self = shift; $self->begin_bulk_updates(); $self->$orig(@_); $self->end_bulk_updates(); }; # End bulk updates the moment a read operation is performed... before [qw(get_quads get_bindings count_quads count_quads_estimate get_graphs subject predicate object graph)] => sub { my $self = shift; $self->end_bulk_updates(); }; } package Attean::API::RDFStarModel 0.034 { use Moo::Role; with 'Attean::API::Model'; } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/Parser.pm000644 000765 000024 00000000225 14636707547 021203 xustar00gregstaff000000 000000 30 mtime=1719373671.330029496 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/Parser.pm000644 000765 000024 00000025650 14636707547 017243 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::API::Parser - Parser role =head1 VERSION This document describes Attean::API::Parser version 0.034 =head1 DESCRIPTION The Attean::API::Parser role defines a common API for all parsers of typed objects from data (either a byte string or a filehandle). =head1 ATTRIBUTES The following attributes exist: =over 4 =item C<< handler >> A code reference that will be called during callback-variant parsing methods. This attribute has a default (no-op function), so specifying it is not necessary if using iterator- or list-variant parsing methods. =back =head1 REQUIRED METHODS The following methods are required by the L role: =over 4 =item C<< canonical_media_type >> Returns the canonical media type string for the format of this parser. =item C<< media_types >> Returns an ARRAY reference of media type strings that are acceptable as input to this parser. =item C<< handled_type >> Returns a L object representing the type of items that result from parsing. =item C<< file_extensions >> Returns an ARRAY reference of file extensions commonly associated with the media types supported by the parser (and returned by C<< media_types >>). File extensions should NOT include a leading dot. =cut use Type::Tiny::Role; package Attean::API::Parser 0.034 { use Types::Standard qw(CodeRef Bool); use Moo::Role; use Scalar::Util qw(blessed); use namespace::clean; has 'handler' => (is => 'rw', isa => CodeRef, default => sub { sub {} }); has 'lazy_iris' => (is => 'rw', isa => Bool, default => 0); requires 'canonical_media_type'; # => (is => 'ro', isa => 'Str', init_arg => undef); requires 'media_types'; # => (is => 'ro', isa => 'ArrayRef[Str]', init_arg => undef); requires 'handled_type'; # => (is => 'ro', isa => 'Type::Tiny', init_arg => undef); requires 'file_extensions'; # => (is => 'ro', isa => 'ArrayRef[Str]', init_arg => undef); =item C<< new_iri( value => $value ) >> Constructs and returns a new L object, respecting the parser's C attribute. =cut sub new_iri { my $self = shift; my %args; if ($self->lazy_iris) { $args{lazy} = 1; } else { $args{lazy} = 0; } if (scalar(@_) == 1) { $args{value} = shift; } else { %args = (%args, @_); } return Attean::IRI->new(%args); } =item C<< new_literal( value => $value, [ datatype => $dt, ] [ language => $lang ]) >> Constructs and returns a new L object. =cut sub new_literal { my $self = shift; my %args = @_; return Attean::Literal->new(%args); } sub file_extensions { return [] } } package Attean::API::AbbreviatingParser 0.034 { use Types::Standard qw(ConsumerOf InstanceOf Maybe); use Types::Namespace qw( NamespaceMap ); use Scalar::Util qw(blessed); use Moo::Role; with 'Attean::API::Parser'; has 'base' => (is => 'rw', isa => ConsumerOf['Attean::API::IRI'], coerce => sub { blessed($_[0]) ? Attean::IRI->new($_[0]->as_string) : Attean::IRI->new($_[0]) }, predicate => 'has_base'); has 'namespaces' => (is => 'ro', isa => Maybe[NamespaceMap]); } package Attean::API::CDTBlankNodeMappingParser 0.034 { use Types::Standard qw(HashRef ConsumerOf InstanceOf Maybe Bool); use Scalar::Util qw(blessed); use UUID::Tiny ':std'; use Data::Dumper; use Moo::Role; with 'Attean::API::Parser'; has 'blank_nodes' => (is => 'ro', isa => Maybe[HashRef[ConsumerOf['Attean::API::Blank']]]); has 'parse_id' => (is => 'rw', default => sub { unpack('H*', create_uuid()) }); has 'enable_cdt_rewriting' => (is => 'rw', isa => Bool, default => 1); foreach my $method (qw(parse_iter_from_io parse_iter_from_bytes parse_cb_from_io parse_cb_from_bytes)) { around $method => sub { my $orig = shift; my $self = $_[0]; $self->parse_id(unpack('H*', create_uuid())); my $term = $orig->(@_); return $term; }; } around 'new_literal' => sub { my $orig = shift; my $self = $_[0]; my $term = $orig->(@_); if ($self->enable_cdt_rewriting) { my $dt = $term->datatype(); if (blessed($dt) and ($dt->value eq 'http://w3id.org/awslabs/neptune/SPARQL-CDTs/Map' or $dt->value eq 'http://w3id.org/awslabs/neptune/SPARQL-CDTs/List')) { return AtteanX::Functions::CompositeLists::rewrite_lexical($term, $self->blank_nodes, $self->parse_id); } } return $term; }; } package Attean::API::PushParser 0.034 { use Moo::Role; with 'Attean::API::Parser'; requires 'parse_cb_from_io'; # parse_cb_from_io($io) requires 'parse_cb_from_bytes'; # parse_cb_from_bytes($data) sub parse_iter_from_io { my $self = shift; my @values = $self->parse_list_from_io(@_); if ($self->does('Attean::API::ResultParser') or $self->does('Attean::API::ResultOrTermParser')) { my %vars; foreach my $r (@values) { if ($r->does('Attean::API::Result')) { foreach my $v ($r->variables) { $vars{$v}++; } } } return Attean::ListIterator->new( variables => [keys %vars], values => \@values, item_type => $self->handled_type->role, ); } else { return Attean::ListIterator->new( values => \@values, item_type => $self->handled_type->role, ); } } sub parse_iter_from_bytes { my $self = shift; my @values = $self->parse_list_from_bytes(@_); if ($self->does('Attean::API::ResultParser') or $self->does('Attean::API::ResultOrTermParser')) { my %vars; foreach my $r (@values) { if ($r->does('Attean::API::Result')) { foreach my $v ($r->variables) { $vars{$v}++; } } } return Attean::ListIterator->new( variables => [keys %vars], values => \@values, item_type => $self->handled_type->role, ); } else { return Attean::ListIterator->new( values => \@values, item_type => $self->handled_type->role, ); } } sub parse_list_from_io { my $self = shift; my @values; $self->handler(sub { push(@values, shift); }); $self->parse_cb_from_io(@_); return @values; } sub parse_list_from_bytes { my $self = shift; my @values; $self->handler(sub { push(@values, shift); }); $self->parse_cb_from_bytes(@_); return @values; } } package Attean::API::PullParser 0.034 { use Moo::Role; with 'Attean::API::Parser'; requires 'parse_iter_from_io'; # $iter = parse_iter_from_io($io) requires 'parse_iter_from_bytes'; # $iter = parse_iter_from_bytes($data) sub parse_cb_from_io { my $self = shift; my $io = shift; my $handler = $self->handler; my $iter = $self->parse_iter_from_io($io); while (my $item = $iter->next) { $handler->( $item ) } } sub parse_cb_from_bytes { my $self = shift; my $data = shift; my $handler = $self->handler; my $iter = $self->parse_iter_from_bytes($data); while (defined(my $item = $iter->next)) { $handler->( $item ) } } sub parse_list_from_io { my $self = shift; my $io = shift; my $iter = $self->parse_iter_from_io($io); my @list; while (defined(my $item = $iter->next)) { push(@list, $item); } return @list; } sub parse_list_from_bytes { my $self = shift; my $data = shift; my $iter = $self->parse_iter_from_bytes($data); my @list; while (defined(my $item = $iter->next)) { push(@list, $item); } return @list; } } package Attean::API::AtOnceParser 0.034 { use Moo::Role; with 'Attean::API::Parser'; requires 'parse_list_from_io'; # @list = parse_list_from_io($io) requires 'parse_list_from_bytes'; # @list = parse_list_from_bytes($data) sub parse_cb_from_io { my $self = shift; my $io = shift; my $handler = $self->handler; my $iter = $self->parse_iter_from_io($io); while (my $item = $iter->next) { $handler->( $item ) } } sub parse_cb_from_bytes { my $self = shift; my $data = shift; my $handler = $self->handler; my $iter = $self->parse_iter_from_bytes($data); while (defined(my $item = $iter->next)) { $handler->( $item ) } } sub parse_iter_from_io { my $self = shift; my @values = $self->parse_list_from_io(@_); if ($self->does('Attean::API::ResultParser') or $self->does('Attean::API::ResultOrTermParser')) { my %vars; foreach my $r (@values) { if ($r->does('Attean::API::Result')) { foreach my $v ($r->variables) { $vars{$v}++; } } } return Attean::ListIterator->new( variables => [keys %vars], values => \@values, item_type => $self->handled_type->role, ); } else { return Attean::ListIterator->new( values => \@values, item_type => $self->handled_type->role, ); } } sub parse_iter_from_bytes { my $self = shift; my @values = $self->parse_list_from_bytes(@_); if ($self->does('Attean::API::ResultParser') or $self->does('Attean::API::ResultOrTermParser')) { my %vars; foreach my $r (@values) { if ($r->does('Attean::API::Result')) { foreach my $v ($r->variables) { $vars{$v}++; } } } return Attean::ListIterator->new( variables => [keys %vars], values => \@values, item_type => $self->handled_type->role, ); } else { return Attean::ListIterator->new( values => \@values, item_type => $self->handled_type->role, ); } } } package Attean::API::TermParser 0.034 { # Parser returns objects that conform to Attean::API::Term use Moo::Role; with 'Attean::API::Parser'; sub handled_type { state $ITEM_TYPE = Type::Tiny::Role->new(role => 'Attean::API::Term'); return $ITEM_TYPE; } } package Attean::API::TripleParser 0.034 { # Parser returns objects that conform to Attean::API::Triple use Moo::Role; with 'Attean::API::Parser'; sub handled_type { state $ITEM_TYPE = Type::Tiny::Role->new(role => 'Attean::API::Triple'); return $ITEM_TYPE; } } package Attean::API::QuadParser 0.034 { # Parser returns objects that conform to Attean::API::Quad use Moo::Role; with 'Attean::API::Parser'; sub handled_type { state $ITEM_TYPE = Type::Tiny::Role->new(role => 'Attean::API::Quad'); return $ITEM_TYPE; } } package Attean::API::MixedStatementParser 0.034 { # Parser returns objects that conform to either Attean::API::Triple or Attean::API::Quad use Moo::Role; with 'Attean::API::Parser'; sub handled_type { state $ITEM_TYPE = Type::Tiny::Role->new(role => 'Attean::API::TripleOrQuad'); return $ITEM_TYPE; } } package Attean::API::ResultOrTermParser 0.034 { # Parser returns objects that conform to either Attean::API::Result or Attean::API::Term use Moo::Role; with 'Attean::API::Parser'; sub handled_type { state $ITEM_TYPE = Type::Tiny::Role->new(role => 'Attean::API::ResultOrTerm'); return $ITEM_TYPE; } } package Attean::API::ResultParser 0.034 { # Parser returns objects that conform to Attean::API::Result use Moo::Role; with 'Attean::API::Parser'; sub handled_type { state $ITEM_TYPE = Type::Tiny::Role->new(role => 'Attean::API::Result'); return $ITEM_TYPE; } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/Serializer.pm000644 000765 000024 00000000225 14636707547 022060 xustar00gregstaff000000 000000 30 mtime=1719373671.562557615 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/Serializer.pm000644 000765 000024 00000014011 14636707547 020105 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::API::Serializer - Serializer role =head1 VERSION This document describes Attean::API::Serializer version 0.034 =head1 DESCRIPTION The Attean::API::Serializer role defines a common API for all serializers of typed objects to data (either a byte string or printed to a filehandle). =head1 REQUIRED METHODS The following methods are required by the L role: =over 4 =item C<< canonical_media_type >> Returns the canonical media type string for the format of this serializer. =item C<< media_types >> Returns an ARRAY reference of media type strings that also identify the format produced by this serializer. =item C<< handled_type >> Returns a L object representing the type of items that are consumed during serialization. =item C<< file_extensions >> Returns an ARRAY reference of file extensions commonly associated with the media types supported by the serializer (and returned by C<< media_types >>). File extensions should NOT include a leading dot. =item C<< serialize_iter_to_io( $fh, $iterator ) >> Serializes the elements from the L C<< $iterator >> to the L object C<< $fh >>. =item C<< serialize_iter_to_bytes( $fh ) >> Serializes the elements from the L C<< $iterator >> and returns the serialization as a UTF-8 encoded byte string. =back =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< serialize_list_to_io( $fh, @elements ) >> Serializes the objects in C<< @elements >> to the L object C<< $fh >>. =item C<< serialize_list_to_bytes( @elements ) >> Serializes the objects in C<< @elements >> and returns the serialization as a UTF-8 encoded byte string. =back =cut use Type::Tiny; package Attean::API::Serializer 0.034 { use Moo::Role; use Carp qw(confess); requires 'canonical_media_type'; # => (is => 'ro', isa => 'Str', init_arg => undef); requires 'media_types'; # => (is => 'ro', isa => 'ArrayRef[Str]', init_arg => undef); requires 'handled_type'; # => (is => 'ro', isa => 'Type::Tiny', init_arg => undef); requires 'file_extensions'; # => (is => 'ro', isa => 'ArrayRef[Str]', init_arg => undef); requires 'serialize_iter_to_io'; # serialize_iter_to_io($io, $iter) requires 'serialize_iter_to_bytes'; # $data = serialize_iter_to_bytes($iter) before 'serialize_iter_to_io' => sub { my $self = shift; my $io = shift || confess "No filehandle passed to serialize_iter_to_io"; my $iter = shift || confess "No iterator passed to serialize_iter_to_io"; }; before 'serialize_iter_to_bytes' => sub { my $self = shift; my $iter = shift || confess "No iterator passed to serialize_iter_to_bytes"; }; sub serialize_list_to_io { my $self = shift; my $io = shift; my $iter = Attean::ListIterator->new( values => [@_], item_type => $self->handled_type->role ); return $self->serialize_iter_to_io($io, $iter); } sub serialize_list_to_bytes { my $self = shift; my $iter = Attean::ListIterator->new( values => [@_], item_type => $self->handled_type->role ); return $self->serialize_iter_to_bytes($iter); } sub file_extensions { return [] } } package Attean::API::AbbreviatingSerializer 0.034 { # Serializer that can make use of a base IRI and/or prefix IRI mappings use Types::Standard qw(InstanceOf ConsumerOf Maybe Bool); use Types::Namespace qw( NamespaceMap ); use Moo::Role; with 'Attean::API::Serializer'; has base => (is => 'ro', isa => ConsumerOf['Attean::API::IRI'], predicate => 'has_base'); has namespaces => (is => 'ro', isa => Maybe[NamespaceMap], predicate => 'has_namespaces'); has omit_base => (is => 'ro', isa => Bool, default => 0); } package Attean::API::AppendableSerializer 0.034 { # Serializer for a format that allows multiple serialization calls to be appended and remain syntactically valid use Moo::Role; with 'Attean::API::Serializer'; } package Attean::API::TermSerializer 0.034 { use Moo::Role; with 'Attean::API::Serializer'; sub handled_type { state $ITEM_TYPE = Type::Tiny::Role->new(role => 'Attean::API::Term'); return $ITEM_TYPE; } } package Attean::API::TripleSerializer 0.034 { use Moo::Role; with 'Attean::API::Serializer'; sub handled_type { state $ITEM_TYPE = Type::Tiny::Role->new(role => 'Attean::API::Triple'); return $ITEM_TYPE; } } package Attean::API::QuadSerializer 0.034 { use Moo::Role; with 'Attean::API::Serializer'; sub handled_type { state $ITEM_TYPE = Type::Tiny::Role->new(role => 'Attean::API::Quad'); return $ITEM_TYPE; } } package Attean::API::MixedStatementSerializer 0.034 { use Moo::Role; with 'Attean::API::Serializer'; sub handled_type { state $ITEM_TYPE = Type::Tiny::Role->new(role => 'Attean::API::TripleOrQuad'); return $ITEM_TYPE; } } package Attean::API::ResultSerializer 0.034 { use Moo::Role; with 'Attean::API::Serializer'; sub handled_type { state $ITEM_TYPE = Type::Tiny::Role->new(role => 'Attean::API::Result'); return $ITEM_TYPE; } around 'serialize_list_to_io' => sub { my $orig = shift; my $self = shift; my $io = shift; my @vars; if (scalar(@_)) { @vars = $_[0]->variables; } my $iter = Attean::ListIterator->new( values => [@_], item_type => $self->handled_type->role, variables => \@vars ); return $self->serialize_iter_to_io($io, $iter); }; around 'serialize_list_to_bytes' => sub { my $orig = shift; my $self = shift; my @vars; if (scalar(@_)) { @vars = $_[0]->variables; } my $iter = Attean::ListIterator->new( values => [@_], item_type => $self->handled_type->role, variables => \@vars ); return $self->serialize_iter_to_bytes($iter); }; } 1; __END__ =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/TripleParser.pod000644 000765 000024 00000000224 14636707547 022530 xustar00gregstaff000000 000000 29 mtime=1719373671.69538343 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/TripleParser.pod000644 000765 000024 00000001716 14636707547 020566 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::TripleParser - Role for parsers of L objects =head1 VERSION This document describes Attean::API::TripleParser version 0.034 =head1 DESCRIPTION The Attean::API::TripleParser role defines parsers of L objects. =head1 ROLES This role consumes the L role. =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< handled_type >> Returns a L object for objects which consume the L role. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/BlankOrIRI.pod000644 000765 000024 00000000225 14636707547 022011 xustar00gregstaff000000 000000 30 mtime=1719373671.133312407 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/BlankOrIRI.pod000644 000765 000024 00000001350 14636707547 020040 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::BlankOrIRI - Role representing blank or IRI terms =head1 VERSION This document describes Attean::API::BlankOrIRI version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a Moo role that both Blank and IRI terms consume, and is used as a constraint for triple and quad subjects. =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/BulkUpdatableModel.pod000644 000765 000024 00000000225 14636707547 023615 xustar00gregstaff000000 000000 30 mtime=1719373671.152076249 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/BulkUpdatableModel.pod000644 000765 000024 00000003060 14636707547 021644 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::BulkUpdatableModel - Role representing models that can perform bulk update operations =head1 VERSION This document describes Attean::API::BulkUpdatableModel version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a Moo role for Ls that can perform bulk update operations. Model-provided mutating methods (e.g. C, C, and C) are automatically wrapped in matching C and C calls. Read-only model methods (e.g. C, C, C, C, C, C, C, and C) are automatically preceded by a C call. =head1 REQUIRED METHODS Classes consuming this role must provide the following methods: =over 4 =item C<< begin_bulk_updates >> Indicates that all subsequent updates (until a call to C) should be performed in bulk. =item C<< end_bulk_updates >> Indicates that pending bulk updates should be performed. The model must allow calls to this method, even when no matching call to C was made. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/AbbreviatingSerializer.pod000644 000765 000024 00000000223 14636707547 024542 xustar00gregstaff000000 000000 28 mtime=1719373671.0318317 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/AbbreviatingSerializer.pod000644 000765 000024 00000003136 14636707547 022577 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::AbbreviatingSerializer - Role for serializers that can abbreviate IRIs as prefixed names or relative IRIs =head1 VERSION This document describes Attean::API::AbbreviatingSerializer version 0.034 =head1 DESCRIPTION The Attean::API::AbbreviatingSerializer role defines an API for serializers of RDF and SPARQL result data that can abbreviate IRI values as prefixed names or relative IRIs. =head1 ROLES This role consumes the L roles which provide the following methods: =over 4 =item C<< serialize_list_to_io( $fh, @elements ) >> =item C<< serialize_list_to_bytes( @elements ) >> =back =head1 ATTRIBUTES The following attributes exist: =over 4 =item C<< base >> An L object representing the base against which relative IRIs in the serialized data should be resolved. =item C<< namespaces >> A L object representing prefix and namespace URI pairs that can be used to create abbreviations. =item C<< omit_base >> A boolean attribute that can be set to true if the serializer should not include the base URI in the serialized output. This is useful for making relative URIs that can be resolved by other systems. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/IRI.pod000644 000765 000024 00000000225 14636707547 020540 xustar00gregstaff000000 000000 30 mtime=1719373671.193185153 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/IRI.pod000644 000765 000024 00000002050 14636707547 016565 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::IRI - Role representing RDF IRI terms =head1 VERSION This document describes Attean::API::IRI version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a Moo role that IRI RDF terms consume. =head1 ROLES This role consumes the L and L roles. =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< ebv >> Returns the boolean value of this term. =item C<< compare( $iri ) >> Returns -1, 0, or 1 if C<< $iri >> is less than, equal to, or greater than the referent based on SPARQL sorting order. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/AppendableSerializer.pod000644 000765 000024 00000000225 14636707547 024202 xustar00gregstaff000000 000000 30 mtime=1719373671.064239375 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/AppendableSerializer.pod000644 000765 000024 00000002067 14636707547 022237 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::AppendableSerializer - Role for serializers that can be repeatedly invoked while keeping output valid =head1 VERSION This document describes Attean::API::AppendableSerializer version 0.034 =head1 DESCRIPTION The Attean::API::AppendableSerializer role defines serializers that allow multiple serialization calls to be appended to the same output (either filehandle or a byte string) and remain syntactically valid. =head1 ROLES This role consumes the L roles which provide the following methods: =over 4 =item C<< serialize_list_to_io( $fh, @elements ) >> =item C<< serialize_list_to_bytes( @elements ) >> =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/Quad.pod000644 000765 000024 00000000225 14636707547 021007 xustar00gregstaff000000 000000 30 mtime=1719373671.395091665 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/Quad.pod000644 000765 000024 00000002155 14636707547 017042 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::Quad - Role representing quads =head1 VERSION This document describes Attean::API::Quad version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a Moo role representing quads. =head1 ROLES This role consumes L, L, L and L, which provide the following methods: =over 4 =item C<< mapping >> =item C<< variables >> =item C<< values >> =item C<< value >> =item C<< tuples_string >> =item C<< as_string >> =item C<< apply_map >> =back =head1 METHODS =over 4 =item C<< subject >> =item C<< predicate >> =item C<< object >> =item C<< graph >> =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/Binding.pm000644 000765 000024 00000000225 14636707547 021321 xustar00gregstaff000000 000000 30 mtime=1719373671.097578623 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/Binding.pm000644 000765 000024 00000047523 14636707547 017364 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::API::Binding - Name to term bindings =head1 VERSION This document describes Attean::API::Binding version 0.034 =head1 DESCRIPTION The Attean::API::Binding role defines a common API for all objects that map names to L objects. This includes triples, quads, and SPARQL results (variable bindings). =head1 REQUIRED METHODS Classes consuming this role must provide the following methods: =over 4 =item C<< value( $name ) >> Returns the L object mapped to the variable named C<< $name >>, or C<< undef >> if no such term is mapped. =item C<< variables >> Returns a list of the variable names mapped to L objects in this mapping. =item C<< apply_map( $mapper ) >> Returns a new mapping object (of the same class as the referent) with term objects rewritten using the supplied L object C<< $mapper >>. =back =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< mapping >> Returns a HASH mapping variable names to L objects. =item C<< values >> Returns a list of L objects corresponding to the variable names returned by the referent's C<< variables >> method. =item C<< tuples_string >> Returns a string serialization of the L objects in the order they are returned by the referent's C<< values >> method. =item C<< as_string >> Returns a string serialization of the variable bindings. =item C<< has_blanks >> Returns true if any variable is bound to an L term, false otherwise. =cut use Type::Tiny::Role; package Attean::API::Binding 0.034 { use Scalar::Util qw(blessed); use List::MoreUtils qw(zip); use Moo::Role; requires 'value'; requires 'variables'; requires 'apply_map'; sub mapping { my $self = shift; my @k = $self->variables; my @v = $self->values; return zip @k, @v; } sub values { my $self = shift; return map { $self->value($_) } $self->variables; } sub tuples_string { my $self = shift; my @strs = map { $_->ntriples_string } $self->values; return join(' ', @strs) . ' .'; } sub as_string { shift->tuples_string(); } sub has_blanks { my $self = shift; foreach my $term ($self->values) { return 1 if ($term->does('Attean::API::Blank')); if ($term->does('Attean::API::Binding')) { return 1 if ($term->has_blanks); } } return 0; } =item C<< sameTerms( $other ) >> =cut sub sameTerms { my $self = shift; my $other = shift; return 0 unless ($other->does('Attean::API::Binding')); my @variables = sort $self->variables; my @other_vars = sort $other->variables; return 0 unless (scalar(@variables) == scalar(@other_vars)); foreach my $i (0 .. $#variables) { return 0 unless $variables[$i] eq $other_vars[$i]; } foreach my $v (@variables) { my $value = $self->value($v); my $other_value = $other->value($v); return 0 unless $value->sameTerms($other_value); } return 1; } =item C<< equals( $other ) >> =cut sub equals { my $self = shift; my $other = shift; return 0 unless ($other->does('Attean::API::Binding')); my @variables = sort $self->variables; my @other_vars = sort $other->variables; unless (scalar(@variables) == scalar(@other_vars)) { return 0; } foreach my $i (0 .. $#variables) { unless ($variables[$i] eq $other_vars[$i]) { return 0; } } foreach my $v (@variables) { my $value = $self->value($v); my $other_value = $other->value($v); if ($value->does('Attean::API::Binding')) { unless ($value->equals($other_value)) { return 0; } } else { unless (0 == $value->compare($other_value)) { return 0; } } } return 1; } =item C<< blanks >> Returns all the values in this mapping (recursively, if any values are embedded bindings) that are blank nodes. =cut sub blanks { my $self = shift; my %nodes; foreach my $term ($self->values) { if ($term->does('Attean::API::Blank')) { $nodes{ $term->value } = $term; } if ($term->does('Attean::API::Binding')) { foreach my $b ($term->blanks) { $nodes{ $b->value } = $b; } } } return CORE::values %nodes; } =item C<< referenced_variables >> Returns a list of the names of any variable values that are referenced in this binding (recursively, if any values are embedded bindings). =cut sub referenced_variables { my $self = shift; my %vars; foreach my $v ($self->values) { if ($v->does('Attean::API::Variable')) { $vars{$v->value}++; } elsif ($v->does('Attean::API::Binding')) { foreach my $name ($v->referenced_variables) { $vars{$name}++; } } } return keys %vars; } =item C<< is_ground >> Returns tue is all the bound values consume L, false otherwise. =cut sub is_ground { my $self = shift; my @non_terms = grep { not($_->does('Attean::API::Term')) } $self->values; my @bad = grep { not($_->does('Attean::API::Binding') and $_->is_ground) } @non_terms; return (scalar(@bad) == 0); } =item C<< values_consuming_role( $role ) >> Returns the list of bound values that consume C<< $role >>. =cut sub values_consuming_role { my $self = shift; my $role = shift; return grep { $_->does($role) } $self->values; } =item C<< tree_attributes >> Returns the variables which are bound in this object. =cut sub tree_attributes { my $self = shift; return $self->variables; } =item C<< apply_bindings( $binding ) >> Construct a new binding by replacing variables with their bound values from C<< $binding >>. =cut sub apply_bindings { my $self = shift; my $class = ref($self); my $bind = shift; my %data; foreach my $k ($self->variables) { my $v = $self->value($k); if ($v->does('Attean::API::TriplePattern')) { my $replace = $v->apply_bindings($bind); $data{ $k } = $replace; } elsif ($v->does('Attean::API::Variable')) { my $name = $v->value; my $replace = $bind->value($name); if (defined($replace) and blessed($replace)) { $data{ $k } = $replace; } else { $data{ $k } = $v; } } else { $data{ $k } = $v; } } return $class->new( bindings => \%data ); } } package Attean::API::TripleOrQuadPattern 0.034 { use Encode qw(encode); use List::MoreUtils qw(zip); use Scalar::Util qw(blessed); use Attean::RDF; use Attean::API::Query; use Moo::Role; with 'Attean::API::SPARQLSerializable'; around BUILDARGS => sub { my $orig = shift; my $class = shift; my @args = @_; if (scalar(@args) == 0 or not(defined($_[0])) or blessed($args[0])) { my @names = $class->variables; foreach my $i (0 .. $#names) { my $k = $names[$i]; my $v = $args[$i]; unless (defined($v)) { $args[$i] = Attean::RDF::variable($k); } } my %args; @args{ $class->variables } = @args; return $class->$orig(%args); } elsif (scalar(@args) == 2) { if (defined($args[0]) and $args[0] eq 'bindings') { return $class->$orig(%{ $args[1] }); } } if (scalar(@_) % 2) { Carp::cluck; } my %args = @_; foreach my $k ($class->variables) { if (not(exists $args{$k}) or not($args{$k})) { $args{$k} = Attean::RDF::variable($k); } } return $class->$orig(%args); }; sub apply_map { my $self = shift; my $class = ref($self); my $mapper = shift; my %values; foreach my $pos ($self->variables) { my $value = $self->value($pos); if ($value->does('Attean::API::Binding')) { $values{$pos} = $value->apply_map($mapper); } else { $values{$pos} = $mapper->map($value); } } return $class->new( %values ); } sub apply_statement { my $self = shift; my $class = ref($self); my $bind = shift; my %data; foreach my $k ($self->variables) { my $v = $self->value($k); if ($v->does('Attean::API::Variable')) { my $name = $v->value; my $replace = $bind->value($name); if (defined($replace) and blessed($replace)) { $data{ $k } = $replace; } else { $data{ $k } = $v; } } } return Attean::Result->new( bindings => \%data ); } sub canonicalize { my $self = shift; my $type = ref($self); my $role = $self->does('Attean::API::TriplePattern') ? 'Attean::API::TriplePattern' : 'Attean::API::QuadPattern'; my $iter = Attean::ListIterator->new( values => [$self], item_type => $role ); my $triples = $iter->canonical_set(); my ($t) = @$triples; return $t; } sub ground { my $self = shift; my $result = shift; my %bindings; my @vars = $self->variables(); foreach my $pos (@vars) { my $pp = $self->$pos(); if ($pp->does('Attean::API::Variable')) { $bindings{ $pos } = $result->value($pp->value); } elsif ($pp->does('Attean::API::TriplePattern')) { my $sub_ground = $pp->ground($result); $bindings{ $pos } = $sub_ground; } else { $bindings{ $pos } = $pp; } } return scalar(@vars) == 3 ? Attean::Triple->new( %bindings ) : Attean::Quad->new( %bindings ); } sub unify { my $self = shift; my $quad = shift; my %binding; foreach my $pos ($self->variables) { my $pp = $self->$pos(); my $qp = $quad->$pos(); if ($pp->does('Attean::API::Variable')) { if (my $already = $binding{ $pp->value }) { return unless $already->equals($qp); } $binding{ $pp->value } = $qp; } elsif ($pp->does('Attean::API::TriplePattern')) { return unless ($qp->does('Attean::API::Triple')); my $sub_binding = $pp->unify($qp); return unless $sub_binding; my $bkeys = Set::Scalar->new(keys %binding); my $sbkeys = Set::Scalar->new($sub_binding->variables); my $i = $bkeys->intersection($sbkeys); for my $key ($i->elements) { # variable bound in multiple places with different values return unless ($binding{$key}->equals($sub_binding->value($key))); } my $mapping = {$sub_binding->mapping}; @binding{ keys %$mapping } = values %$mapping; } else { # bound position doesn't match use Data::Dumper; if ($pp->does('Attean::API::QuadPattern')) { Carp::cluck 'XXX unify: ' . Dumper($self); } return unless ($pp->equals($qp)); } } # warn 'final mapping: ' . Dumper(\%binding); return Attean::Result->new( bindings => \%binding ); } =item C<< parse ( $string ) >> Returns a triple or quad pattern object using the variables and/or terms parsed from C<< $string >> in SPARQL syntax. =cut sub parse { my $self = shift; my $class = ref($self) || $self; my $string = shift; my $bytes = encode('UTF-8', $string, Encode::FB_CROAK); my $parser = Attean->get_parser('SPARQL')->new(@_); my @values = $parser->parse_nodes($bytes); my @keys = $self->variables; my $f = scalar(@values); my $e = scalar(@keys); unless ($e == $f) { die "${class}->parse found wrong number of nodes (found $f but expecting $e)"; } return $self->new(zip @keys, @values); } } package Attean::API::TripleOrQuad 0.034 { use List::MoreUtils qw(any); use Carp; use Moo::Role; with 'Attean::API::TripleOrQuadPattern'; sub BUILD { my $self = shift; if (any { $_->does('Attean::API::Variable') } $self->values) { croak 'Use a Pattern class to construct when using variables'; } } } package Attean::API::TriplePattern 0.034 { use List::MoreUtils qw(zip); use Scalar::Util qw(blessed); use Moo::Role; sub variables { return qw(subject predicate object) } sub value { my $self = shift; my $key = shift; return $self->$key() if ($key =~ /^(subject|predicate|object)$/); die "Unrecognized binding name '$key'"; } sub as_quad_pattern { my $self = shift; my $graph = shift; my @keys = Attean::API::Quad->variables; my @values = ($self->values, $graph); return Attean::QuadPattern->new(zip @keys, @values); } sub as_triple { my $self = shift; unless ($self->is_ground) { die "Not a ground triple: " . $self->as_string; } my @terms = map { $_->does('Attean::API::TriplePattern') ? $_->as_triple : $_ } $self->values; return Attean::Triple->new(@terms); } sub apply_triple { my $self = shift; return $self->apply_statement(@_); } sub sparql_tokens { my $self = shift; my @tokens; foreach my $t ($self->values) { if ($t->does('Attean::API::TriplePattern')) { push(@tokens, AtteanX::SPARQL::Token->ltlt); push(@tokens, $t->sparql_tokens->elements); push(@tokens, AtteanX::SPARQL::Token->gtgt); } else { push(@tokens, $t->sparql_tokens->elements); } } return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } requires 'subject'; requires 'predicate'; requires 'object'; with 'Attean::API::TripleOrQuadPattern', 'Attean::API::Binding', 'Attean::API::TermOrVariableOrTriplePattern'; } package Attean::API::Triple 0.034 { use Scalar::Util qw(blessed); use Moo::Role; if ($ENV{ATTEAN_TYPECHECK}) { my %map = ( subject => 'Attean::API::BlankOrIRIOrTriple', predicate => 'Attean::API::IRI', object => 'Attean::API::TermOrTriple' ); foreach my $method (keys %map) { my $role = $map{$method}; around $method => sub { my $orig = shift; my $self = shift; my $class = ref($self); my $term = $self->$orig(@_); my $type = Type::Tiny::Role->new( role => $role ); my $err = $type->validate($term); if ($err) { die "${class}'s $method failed conformance check for role $role: " . $term->as_string; } return $term; }; } } sub as_quad { my $self = shift; my $graph = shift; return Attean::Quad->new($self->values, $graph); } sub ntriples_string { my $self = shift; my @values = $self->values; return join(' ', '<<', (map { $_->ntriples_string } @values), '>>'); } sub order { my $self = shift; return _compare('order', $self, @_); } sub compare { my $self = shift; return _compare('compare', $self, @_); } sub _compare { my $cmp_method = shift; my ($a, $b) = @_; return 1 unless blessed($b); if (not $b->does('Attean::API::Triple')) { # this is a type-error for equality testing, but special handling is needed in calling code for ORDER BY in which Triples sort last (after literals) die "TypeError: cannot compare an RDF-star triple and a non-triple"; } foreach my $pos ($a->variables) { my $at = $a->$pos(); my $bt = $b->$pos(); my $c = $at->$cmp_method($bt); # If they are equal, continue. otherwise check if either term is an IRI. # This is because term equality is defined for IRIs, but < and > isn't. next unless ($c); unless ($Attean::API::Binding::ALLOW_IRI_COMPARISON) { for ($at, $bt) { if ($_->does('Attean::API::IRI')) { # Carp::cluck "TypeError comparison of IRI " . $at->ntriples_string . " <=> " . $bt->ntriples_string . "\n"; # last; die "TypeError comparison of IRI" if ($_->does('Attean::API::IRI')); # comparison of IRIs is only defined for `ORDER BY`, not for general expressions } } } if ($c) { return $c; } } return 0; # return $a->ntriples_string cmp $b->ntriples_string; } with 'Attean::API::TriplePattern', 'Attean::API::TripleOrQuad', 'Attean::API::Binding', 'Attean::API::TermOrVariableOrTriplePattern'; with 'Attean::API::BlankOrIRIOrTriple'; with 'Attean::API::TermOrTriple'; } package Attean::API::QuadPattern 0.034 { use Scalar::Util qw(blessed); use List::MoreUtils qw(zip); use Moo::Role; sub variables { return qw(subject predicate object graph) } sub value { my $self = shift; my $key = shift; return $self->$key() if ($key =~ /^(subject|predicate|object|graph)$/); die "Unrecognized binding name '$key'"; } sub as_quad { my $self = shift; unless ($self->is_ground) { die "Not a ground quad: " . $self->as_string; } return Attean::Quad->new($self->values); } sub apply_quad { my $self = shift; return $self->apply_statement(@_); } sub as_triple_pattern { my $self = shift; my @keys = Attean::API::Triple->variables; my @values = $self->values; @values = @values[0 .. scalar(@keys)-1]; return Attean::TriplePattern->new(zip @keys, @values); } sub sparql_tokens { my $self = shift; my @tokens; push(@tokens, AtteanX::SPARQL::Token->keyword('GRAPH')); push(@tokens, $self->graph->sparql_tokens->elements); push(@tokens, AtteanX::SPARQL::Token->lbrace()); my @values = ($self->values)[0..2]; foreach my $t (@values) { push(@tokens, $t->sparql_tokens->elements); } push(@tokens, AtteanX::SPARQL::Token->rbrace()); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } requires 'subject'; requires 'predicate'; requires 'object'; requires 'graph'; with 'Attean::API::TripleOrQuadPattern', 'Attean::API::Binding'; } package Attean::API::Quad 0.034 { use Moo::Role; if ($ENV{ATTEAN_TYPECHECK}) { my $type = Type::Tiny::Role->new( role => 'Attean::API::BlankOrIRI' ); around 'graph' => sub { my $orig = shift; my $self = shift; my $class = ref($self); my $term = $self->$orig(@_); my $err = $type->validate($term); die "${class}'s graph failed conformance check for role Attean::API::BlankOrIRI: $term" if ($err); return $term; }; } sub as_triple { my $self = shift; my @values = $self->values; return Attean::Triple->new(@values[0..2]); } with 'Attean::API::QuadPattern'; with 'Attean::API::TripleOrQuad', 'Attean::API::TripleOrQuadPattern', 'Attean::API::Triple'; } package Attean::API::Result 0.034 { use Scalar::Util qw(refaddr); use Types::Standard qw(HashRef); use Moo::Role; has 'eval_stash' => (is => 'rw', isa => HashRef); sub BUILD { my $self = shift; if (not $self->eval_stash) { $self->eval_stash({}); } } sub shared_domain { my $self = shift; my $class = ref($self); my $rowb = shift; my %keysa; my @keysa = $self->variables; @keysa{ @keysa } = (1) x scalar(@keysa); my @shared = grep { exists $keysa{ $_ } } ($rowb->variables); return @shared; } sub join { my $self = shift; my $class = ref($self); my $rowb = shift; my @shared = $self->shared_domain($rowb); foreach my $key (@shared) { my $val_a = $self->value($key); my $val_b = $rowb->value($key); my $equal = (refaddr($val_a) == refaddr($val_b)) || $val_a->equals( $val_b ); unless ($equal) { return; } } my $row = { (map { $_ => $self->value($_) } grep { defined($self->value($_)) } $self->variables), (map { $_ => $rowb->value($_) } grep { defined($rowb->value($_)) } $rowb->variables) }; my $joined = Attean::Result->new( bindings => $row ); return $joined; } =item C<< project( @keys ) >> Returns a new L binding which contains variable-value mappings from the invocant for every variable name in C<< @keys >>. =cut sub project { my $self = shift; my @vars = @_; my %bindings; foreach my $v (@vars) { my $term = $self->value($v); $bindings{ $v } = $term if ($term); } return Attean::Result->new( bindings => \%bindings ); } sub project_complement { my $self = shift; my %vars = map { $_ => 1 } @_; my %bindings; foreach my $v ($self->variables) { unless ($vars{$v}) { my $term = $self->value($v); $bindings{ $v } = $term; } } return Attean::Result->new( bindings => \%bindings ); } sub apply_map { my $self = shift; my $class = ref($self); my $mapper = shift; my %values; foreach my $var ($self->variables) { my $value = $self->value($var); if ($value->does('Attean::API::Binding')) { $values{$var} = $value->apply_map($mapper); } else { my $term = $mapper->map($value); if ($term) { $values{$var} = $term; } } } return $class->new( bindings => \%values ); } with 'Attean::API::Binding', 'Attean::API::ResultOrTerm'; } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/MixedStatementParser.pod000644 000765 000024 00000000225 14636707547 024225 xustar00gregstaff000000 000000 30 mtime=1719373671.245419153 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/MixedStatementParser.pod000644 000765 000024 00000001770 14636707547 022262 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::MixedStatementParser - Role for parsers of L objects =head1 VERSION This document describes Attean::API::MixedStatementParser version 0.034 =head1 DESCRIPTION The Attean::API::MixedStatementParser role defines parsers of L objects. =head1 ROLES This role consumes the L role. =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< handled_type >> Returns a L object for objects which consume the L role. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/TermParser.pod000644 000765 000024 00000000225 14636707547 022201 xustar00gregstaff000000 000000 30 mtime=1719373671.628666935 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/TermParser.pod000644 000765 000024 00000001702 14636707547 020231 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::TermParser - Role for parsers of L objects =head1 VERSION This document describes Attean::API::TermParser version 0.034 =head1 DESCRIPTION The Attean::API::TermParser role defines parsers of L objects. =head1 ROLES This role consumes the L role. =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< handled_type >> Returns a L object for objects which consume the L role. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/QuadParser.pod000644 000765 000024 00000000225 14636707547 022164 xustar00gregstaff000000 000000 30 mtime=1719373671.412877603 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/QuadParser.pod000644 000765 000024 00000001702 14636707547 020214 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::QuadParser - Role for parsers of L objects =head1 VERSION This document describes Attean::API::QuadParser version 0.034 =head1 DESCRIPTION The Attean::API::QuadParser role defines parsers of L objects. =head1 ROLES This role consumes the L role. =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< handled_type >> Returns a L object for objects which consume the L role. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/Expression.pm000644 000765 000024 00000000225 14636707547 022106 xustar00gregstaff000000 000000 30 mtime=1719373671.174211281 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/Expression.pm000644 000765 000024 00000014704 14636707547 020144 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME Attean::API::Expression - SPARQL expressions =head1 VERSION This document describes Attean::API::Expression version 0.034 =head1 DESCRIPTION The Attean::API::Expression role defines a common API for SPARQL expressions consisting of logical, numeric, and function operators, constant terms, and variables. Expressions may be evaluated in the context of a L object, and either return a L object or throw a type error exception. =head1 ROLES This role consumes the L role which provide the following methods: =over 4 =item C<< is_leaf >> =item C<< walk( prefix => \&pre_cb, postfix => \&pre_cb ) >> =item C<< cover( prefix => \&pre_cb, postfix => \&pre_cb ) >> =back and the following attributes: =over 4 =item C<< children >> =back =head1 ATTRIBUTES The following attributes exist: =over 4 =item C<< operator >> A string indicating the expression operator (e.g. C<'+'> or C<'||'>). =back =head1 REQUIRED METHODS The following methods are required by the L role: =over 4 =item C<< as_string >> Returns a string serialization of the expression object. =back =cut package Attean::API::Expression 0.034 { use Types::Standard qw(Str); use Moo::Role; with 'Attean::API::DirectedAcyclicGraph', 'Attean::API::UnionScopeVariables'; has 'operator' => (is => 'ro', isa => Str, required => 1); requires 'is_stable'; # is stable for sorting (won't change across evaluations) requires 'unaggregated_variables'; requires 'as_string'; requires 'as_sparql'; sub BUILD {} if ($ENV{ATTEAN_TYPECHECK}) { around 'BUILD' => sub { my $orig = shift; my $self = shift; $self->$orig(@_); my $name = ref($self); $name =~ s/^.*://; if ($self->can('arity')) { my $arity = $self->arity; if (defined($arity)) { my $children = $self->children; my $size = scalar(@$children); unless ($size == $arity) { die "${name} expression construction with bad number of children (expected $arity, but got $size)"; } } } } } } package Attean::API::UnaryExpression 0.034 { use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Moo::Role; with 'Attean::API::Expression', 'Attean::API::UnaryQueryTree'; with 'Attean::API::SPARQLSerializable'; sub as_string { my $self = shift; my ($data) = @{ $self->children }; return sprintf("%s(%s)", $self->operator, $data->as_string); } my %ops = ( '!' => AtteanX::SPARQL::Token->fast_constructor( BANG, -1, -1, -1, -1, ['!'] ), '-' => AtteanX::SPARQL::Token->fast_constructor( MINUS, -1, -1, -1, -1, ['-'] ), '+' => AtteanX::SPARQL::Token->fast_constructor( PLUS, -1, -1, -1, -1, ['+'] ), ); sub unaggregated_variables { my $self = shift; my ($child) = @{ $self->children }; return $child->unaggregated_variables; } sub sparql_tokens { my $self = shift; my $op = $ops{$self->operator} // die "No operator found in Attean::API::UnaryExpression->sparql_tokens"; my @tokens; push(@tokens, $op); foreach my $t (@{ $self->children }) { push(@tokens, $t->sparql_tokens->elements); } return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } package Attean::API::BinaryExpression 0.034 { use AtteanX::SPARQL::Constants; use AtteanX::SPARQL::Token; use Moo::Role; with 'Attean::API::Expression', 'Attean::API::BinaryQueryTree'; with 'Attean::API::SPARQLSerializable'; sub as_string { my $self = shift; my ($lhs, $rhs) = @{ $self->children }; return sprintf("(%s %s %s)", $lhs->as_string, $self->operator, $rhs->as_string); } sub unaggregated_variables { my $self = shift; return map { $_->unaggregated_variables } @{ $self->children }; } my %ops = ( '-' => AtteanX::SPARQL::Token->fast_constructor( MINUS, -1, -1, -1, -1, ['-'] ), '+' => AtteanX::SPARQL::Token->fast_constructor( PLUS, -1, -1, -1, -1, ['+'] ), '*' => AtteanX::SPARQL::Token->fast_constructor( STAR, -1, -1, -1, -1, ['*'] ), '/' => AtteanX::SPARQL::Token->fast_constructor( SLASH, -1, -1, -1, -1, ['/'] ), '<' => AtteanX::SPARQL::Token->fast_constructor( LT, -1, -1, -1, -1, ['<'] ), '>' => AtteanX::SPARQL::Token->fast_constructor( GT, -1, -1, -1, -1, ['>'] ), '<=' => AtteanX::SPARQL::Token->fast_constructor( LE, -1, -1, -1, -1, ['<='] ), '>=' => AtteanX::SPARQL::Token->fast_constructor( GE, -1, -1, -1, -1, ['>='] ), '!=' => AtteanX::SPARQL::Token->fast_constructor( NOTEQUALS, -1, -1, -1, -1, ['!='] ), '=' => AtteanX::SPARQL::Token->fast_constructor( EQUALS, -1, -1, -1, -1, ['='] ), '&&' => AtteanX::SPARQL::Token->fast_constructor( ANDAND, -1, -1, -1, -1, ['&&'] ), '||' => AtteanX::SPARQL::Token->fast_constructor( OROR, -1, -1, -1, -1, ['||'] ), ); sub sparql_tokens { my $self = shift; my $op = $ops{$self->operator} // die "No operator found in Attean::API::BinaryExpression->sparql_tokens"; my @tokens; foreach my $t (@{ $self->children }) { push(@tokens, $t->sparql_tokens->elements); push(@tokens, $op); } pop(@tokens); return Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::SPARQL::Token' ); } } package Attean::API::NaryExpression 0.034 { use Moo::Role; with 'Attean::API::Expression', 'Attean::API::QueryTree'; sub as_string { my $self = shift; my @children = map { $_->as_string } @{ $self->children }; return sprintf("%s(%s)", $self->operator, join(', ', @children)); } sub as_sparql { my $self = shift; return $self->as_string; } sub unaggregated_variables { my $self = shift; return map { $_->unaggregated_variables } @{ $self->children }; } } package Attean::API::AggregateExpression 0.034 { use Moo::Role; requires 'operator'; requires 'scalar_vars'; with 'Attean::API::Expression', 'Attean::API::DirectedAcyclicGraph'; sub as_string { my $self = shift; my @children = map { $_->as_string } @{ $self->children }; return sprintf("%s(%s)", $self->operator, join(', ', @children)); } sub as_sparql { my $self = shift; return $self->as_string; } sub unaggregated_variables { return; } } 1; __END__ =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Attean/API/PaxHeader/RepeatableIterator.pod000644 000765 000024 00000000225 14636707547 023673 xustar00gregstaff000000 000000 30 mtime=1719373671.497910548 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Attean/API/RepeatableIterator.pod000644 000765 000024 00000002521 14636707547 021723 0ustar00gregstaff000000 000000 =head1 NAME Attean::API::RepeatableIterator - Role representing iterators that may be reset and iterated again =head1 VERSION This document describes Attean::API::RepeatableIterator version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a Moo role that are consumed by iterators that can be reset and iterated again. =head1 ROLES This role consumes the L role. =head1 REQUIRED METHODS Classes consuming this role must provide the following methods: =over 4 =item C<< reset >> Resets the state of the iterator, allowing iteration from the start of the underlying data. =back =head1 METHODS This role provides default implementations of the following methods: =over 4 =item C<< elements >> Returns a list of all elements in the iterator, leaving the iterator state untouched. =item C<< peek >> Returns the first element of the iterator, leaving the iterator state untouched. =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Serializer/000755 000765 000024 00000000000 14636711137 017257 5ustar00gregstaff000000 000000 Attean-0.034/lib/AtteanX/SPARQL/000755 000765 000024 00000000000 14636711137 016150 5ustar00gregstaff000000 000000 Attean-0.034/lib/AtteanX/Parser/000755 000765 000024 00000000000 14636711137 016402 5ustar00gregstaff000000 000000 Attean-0.034/lib/AtteanX/API/000755 000765 000024 00000000000 14636711137 015557 5ustar00gregstaff000000 000000 Attean-0.034/lib/AtteanX/Functions/000755 000765 000024 00000000000 14636711137 017116 5ustar00gregstaff000000 000000 Attean-0.034/lib/AtteanX/Store/000755 000765 000024 00000000000 14636711137 016242 5ustar00gregstaff000000 000000 Attean-0.034/lib/AtteanX/Store/PaxHeader/Memory.pm000644 000765 000024 00000000225 14636707550 022024 xustar00gregstaff000000 000000 30 mtime=1719373672.790868178 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Store/Memory.pm000644 000765 000024 00000030404 14636707550 020055 0ustar00gregstaff000000 000000 =head1 NAME AtteanX::Store::Memory - Simple in-memory RDF store =head1 VERSION This document describes AtteanX::Store::Memory version 0.034 =head1 SYNOPSIS use AtteanX::Store::Memory; =head1 DESCRIPTION AtteanX::Store::Memory provides an in-memory quad-store. =cut use v5.14; use warnings; package AtteanX::Store::Memory 0.034 { use Moo; use Type::Tiny::Role; use Types::Standard qw(Int ArrayRef HashRef ConsumerOf InstanceOf); use Encode; use Set::Scalar; use Digest::SHA; use Data::Dumper; use List::Util qw(first); use Scalar::Util qw(refaddr reftype blessed); use Math::Cartesian::Product; use namespace::clean; with 'Attean::API::RDFStarStore'; with 'Attean::API::MutableQuadStore'; with 'Attean::API::QuadStore'; with 'Attean::API::ETagCacheableQuadStore'; with 'Attean::API::TimeCacheableQuadStore'; with 'Attean::API::CostPlanner'; my @pos_names = Attean::API::Quad->variables; =head1 ATTRIBUTES =over 4 =item C<< subject >> =item C<< predicate >> =item C<< object >> =item C<< graph >> =back =head1 METHODS Beyond the methods documented below, this class inherits methods from the L class. =over 4 =item C<< new () >> Returns a new memory-backed storage object. =cut has _size => (is => 'rw', isa => Int, init_arg => undef, default => 0); has statements => (is => 'rw', isa => ArrayRef[ConsumerOf['Attean::API::Quad']], init_arg => undef, default => sub { [] }); has subject => (is => 'ro', isa => HashRef[InstanceOf['Set::Scalar']], init_arg => undef, default => sub { +{} }); has predicate => (is => 'ro', isa => HashRef[InstanceOf['Set::Scalar']], init_arg => undef, default => sub { +{} }); has object => (is => 'ro', isa => HashRef[InstanceOf['Set::Scalar']], init_arg => undef, default => sub { +{} }); has graph => (is => 'ro', isa => HashRef[InstanceOf['Set::Scalar']], init_arg => undef, default => sub { +{} }); has graph_nodes => (is => 'rw', isa => HashRef[ConsumerOf['Attean::API::IRI']], init_arg => undef, default => sub { +{} }); has hash => (is => 'rw', isa => InstanceOf['Digest::SHA'], default => sub { Digest::SHA->new }); has mtime => (is => 'rw', isa => Int, default => sub { return time() }); =item C<< size >> Returns the number of quads in the store. =cut sub size { shift->_size() } =item C<< get_quads ( $subject, $predicate, $object, $graph ) >> Returns a stream object of all statements matching the specified subject, predicate and objects. Any of the arguments may be undef to match any value. =cut sub get_quads { my $self = shift; my @nodes = map { ref($_) eq 'ARRAY' ? $_ : [$_] } @_; my @iters; cartesian { push(@iters, $self->_get_quads(@_)) } @nodes; return Attean::IteratorSequence->new( iterators => \@iters, item_type => 'Attean::API::Quad' ); } sub _get_quads { my $self = shift; my @nodes = @_; my @pos_names = Attean::QuadPattern->variables; my %pattern_bound; foreach my $pos (0 .. 3) { my $n = $nodes[ $pos ]; $pattern_bound{ $pos_names[$pos] } = $n; } # create a quadpattern that includes any embedded triple patterns (RDF-star) my $pattern = Attean::QuadPattern->new(%pattern_bound); my %bound; my $bound = 0; my %embedded_triple_vars; my $seen_embedded_triple = 0; foreach my $pos (0 .. 3) { my $n = $nodes[ $pos ]; if (blessed($n) and $n->does('Attean::API::TriplePattern')) { # replace embedded triple patterns with variables. # the quads that match with the new variables will be filtered # in post-processing below to ensure that they also match the # embedded triple patterns. $seen_embedded_triple = 1; my $v = Attean::Variable->new(); $embedded_triple_vars{$v->value} = $n; $nodes[$pos] = $v; $n = $v; } if (blessed($n) and $n->does('Attean::API::Variable')) { $n = undef; $nodes[$pos] = undef; } if (blessed($n)) { $bound++; $bound{ $pos } = $n; } } if ($bound == 0) { my $i = 0; my $sub = sub { return unless ($i <= $#{ $self->statements }); my $st = $self->statements->[ $i ]; while (not(blessed($st)) and ($i <= $#{ $self->statements })) { $i++; $st = $self->statements->[ $i ]; } $i++; return $st; }; return Attean::CodeIterator->new( generator => $sub, item_type => 'Attean::API::Quad' )->matching_pattern($pattern); } my $match_set; if ($bound == 1) { my ($pos) = keys %bound; my $name = $pos_names[ $pos ]; my $node = $bound{ $pos }; my $string = $node->as_string; $match_set = $self->$name()->{ $string }; unless (blessed($match_set)) { return Attean::ListIterator->new( values => [], item_type => 'Attean::API::Quad' ); } } else { my @pos = keys %bound; my @names = @pos_names[ @pos ]; my @sets; foreach my $i (0 .. $#pos) { my $pos = $pos[ $i ]; my $node = $bound{ $pos }; Carp::confess unless ($node->can('as_string')); my $string = $node->as_string; my $name = $names[$i]; my $hash = $self->$name(); my $set = $hash->{ $string }; push(@sets, $set); } foreach my $s (@sets) { unless (blessed($s)) { return Attean::ListIterator->new( values => [], item_type => 'Attean::API::Quad' ); } } my $i = shift(@sets); while (@sets) { my $s = shift(@sets); $i = $i->intersection($s); } $match_set = $i; } my @e = $match_set->elements; my $sub = sub { return unless (scalar(@e)); my $e = shift(@e); my $st = $self->statements->[ $e ]; return $st; }; return Attean::CodeIterator->new( generator => $sub, item_type => 'Attean::API::Quad' )->matching_pattern($pattern); } =item C<< get_graphs >> Returns an iterator over the Attean::API::Term objects comprising the set of graphs of the stored quads. =cut sub get_graphs { my $self = shift; my @ctx = values %{ $self->graph_nodes() }; return Attean::ListIterator->new( values => \@ctx, item_type => 'Attean::API::Term' ); } =item C<< add_quad ( $quad ) >> Adds the specified C<$quad> to the underlying model. =cut sub add_quad { my $self = shift; my $st = shift; my $count = $self->count_quads( $st->values ); if ($count == 0) { $self->_size($self->_size + 1); my $id = scalar(@{ $self->statements }); $self->hash->add('+' . encode_utf8($st->as_string)); $self->mtime(time()); push( @{ $self->statements }, $st ); foreach my $pos (0 .. $#pos_names) { my $name = $pos_names[ $pos ]; my $node = $st->$name(); my $string = $node->as_string; my $set = $self->$name()->{ $string }; unless (blessed($set)) { $set = Set::Scalar->new(); $self->$name()->{ $string } = $set; } $set->insert( $id ); } my $ctx = $st->graph; my $str = $ctx->as_string; unless (exists $self->graph_nodes->{ $str }) { $self->graph_nodes->{ $str } = $ctx; } } return; } =item C<< remove_quad ( $statement ) >> Removes the specified C<$statement> from the underlying model. =cut sub remove_quad { my $self = shift; my $st = shift; my @nodes = $st->values; my $count = $self->count_quads( @nodes[ 0..3 ] ); if ($count > 0) { $self->_size( $self->_size - 1 ); my $id = $self->_statement_id( $st->values ); $self->hash->add('-' . encode_utf8($st->as_string)); $self->mtime(time()); $self->statements->[ $id ] = undef; foreach my $pos (0 .. 3) { my $name = $pos_names[ $pos ]; my $node = $st->$name(); my $str = $node->as_string; my $set = $self->$name()->{ $str }; $set->delete( $id ); if ($set->size == 0) { if ($pos == 3) { delete $self->graph_nodes->{ $str }; } delete $self->$name()->{ $str }; } } } return; } =item C<< remove_quads ( $subject, $predicate, $object, $graph ) >> Removes the specified C<$statement> from the underlying model. =cut sub remove_quads { my $self = shift; my @nodes = map { ref($_) eq 'ARRAY' ? $_ : [$_] } @_; my @iters; cartesian { $self->_remove_quads(@_) } @nodes; } sub _remove_quads { my $self = shift; my $subj = shift; my $pred = shift; my $obj = shift; my $graph = shift; my $iter = $self->get_quads( $subj, $pred, $obj, $graph ); while (my $st = $iter->next) { $self->remove_quad( $st ); } } =item C<< create_graph( $graph ) >> This is a no-op function for the memory quad-store. =cut sub create_graph { # no-op on a quad-store } =item C<< drop_graph( $graph ) >> Removes all quads with the given C<< $graph >>. =cut sub drop_graph { my $self = shift; return $self->clear_graph(@_); } =item C<< clear_graph( $graph ) >> Removes all quads with the given C<< $graph >>. =cut sub clear_graph { my $self = shift; my $g = shift; my $string = $g->as_string; my $set = $self->graph()->{ $string }; return unless (blessed($set)); my @quads = @{ $self->statements}[ $set->elements ]; foreach my $q (@quads) { $self->remove_quad($q); } } =item C<< count_quads ( $subject, $predicate, $object, $graph ) >> Returns a count of all the statements matching the specified subject, predicate, object, and graph. Any of the arguments may be undef to match any value. =cut sub count_quads { my $self = shift; my @nodes = map { ref($_) eq 'ARRAY' ? $_ : [$_] } @_; my $count = 0; cartesian { $count += $self->_count_quads(@_) } @nodes; return $count; } sub _count_quads { my $self = shift; my @nodes = @_[0..3]; my $bound = 0; my %bound; foreach my $pos (0 .. 3) { my $n = $nodes[ $pos ]; if (ref($n)) { Carp::confess "Non-Attean node?" unless (ref($n) =~ /Attean/); } if (blessed($n) and not($n->does('Attean::API::Variable'))) { $bound++; $bound{ $pos } = $n; } } if ($bound == 0) { return $self->_size; } elsif ($bound == 1) { my ($pos) = keys %bound; my $name = $pos_names[ $pos ]; my $set = $self->$name()->{ $bound{ $pos }->as_string }; unless (blessed($set)) { return 0; } return $set->size; } else { my @pos = keys %bound; my @names = @pos_names[ @pos ]; my @sets; foreach my $i (0 .. $#names) { my $pos = $pos[ $i ]; my $setname = $names[ $i ]; my $data = $self->$setname(); my $node = $bound{ $pos }; my $str = $node->as_string; my $set = $data->{ $str }; push( @sets, $set ); } foreach my $s (@sets) { unless (blessed($s)) { return 0; } } my $i = shift(@sets); while (@sets) { my $s = shift(@sets); $i = $i->intersection($s); } return $i->size; } } =item C<< etag_value_for_quads >> If the store has the capability and knowledge to support caching, returns a persistent token that will remain consistent as long as the store's data doesn't change. This token is acceptable for use as an HTTP ETag. =cut sub etag_value_for_quads { my $self = shift; return $self->hash->b64digest; } =item C<< mtime_for_quads >> =cut sub mtime_for_quads { my $self = shift; return $self->mtime; } sub _statement_id { my $self = shift; my @nodes = @_; my ($subj, $pred, $obj, $graph) = @nodes; my @pos = (0 .. 3); my @names = @pos_names[ @pos ]; my @sets; foreach my $i (0 .. $#names) { my $pos = $pos[ $i ]; my $setname = $names[ $i ]; my $data = $self->$setname(); my $node = $nodes[ $pos ]; my $str = $node->as_string; my $set = $data->{ $str }; push( @sets, $set ); } foreach my $s (@sets) { unless (blessed($s)) { return -1; } } my $i = shift(@sets); while (@sets) { my $s = shift(@sets); $i = $i->intersection($s); } if ($i->size == 1) { my ($id) = $i->elements; return $id; } else { return -1; } } =item C<< plans_for_algebra >> The store implements a cost-based query planner, but this method is reimplemented to hand the overall control of the planning process to an external planner by returning C. =cut sub plans_for_algebra { my $self = shift; my $algebra = shift; return; } =item C<< cost_for_plan >> This store provides a cost estimate only for retrieving individual quad patterns in this method. It will allow other planners to estimate the cost for any other parts of the plan by returning C for those parts. =cut sub cost_for_plan { my $self = shift; my $plan = shift; if ($plan->isa('Attean::Plan::Quad')) { my @values = $plan->values; my $count = $self->count_quads(@values); return $count; } return; } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Store/PaxHeader/SimpleTripleStore.pm000644 000765 000024 00000000224 14636707550 024201 xustar00gregstaff000000 000000 29 mtime=1719373672.82405706 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Store/SimpleTripleStore.pm000644 000765 000024 00000005503 14636707550 022235 0ustar00gregstaff000000 000000 =head1 NAME AtteanX::Store::SimpleTripleStore - SimpleTripleStore, unindexed, in-memory RDF store =head1 VERSION This document describes AtteanX::Store::SimpleTripleStore version 0.034 =head1 SYNOPSIS use AtteanX::Store::SimpleTripleStore; =head1 DESCRIPTION AtteanX::Store::SimpleTripleStore provides an in-memory triple-store. =cut use v5.14; use warnings; package AtteanX::Store::SimpleTripleStore 0.034 { use Moo; use Type::Tiny::Role; use Types::Standard qw(Int ArrayRef HashRef ConsumerOf InstanceOf); use Encode; use Set::Scalar; use Digest::SHA; use List::Util qw(first); use Scalar::Util qw(refaddr reftype blessed); use namespace::clean; with 'Attean::API::MutableTripleStore'; my @pos_names = Attean::API::Quad->variables; =head1 METHODS Beyond the methods documented below, this class inherits methods from the L class. =over 4 =item C<< new ( triples => \@triples ) >> Returns a new memory-backed storage object. =cut has triples => (is => 'rw', isa => ArrayRef[ConsumerOf['Attean::API::Triple']], default => sub { [] }); =item C<< get_triples ( $subject, $predicate, $object ) >> Returns a stream object of all statements matching the specified subject, predicate and objects. Any of the arguments may be undef to match any value. =cut sub get_triples { my $self = shift; my @nodes = @_; my %bound; foreach my $pos (0 .. 2) { my $n = $nodes[ $pos ]; if (blessed($n) and $n->does('Attean::API::Variable')) { $n = undef; $nodes[$pos] = undef; } if (blessed($n)) { $bound{ $pos_names[$pos] } = $n; } } my $triples = $self->triples; my $iter = Attean::ListIterator->new( values => $triples, item_type => 'Attean::API::Triple' ); return $iter->grep(sub { my $q = shift; foreach my $key (keys %bound) { my $term = $q->$key(); unless ($term->equals( $bound{$key} )) { return 0; } } return 1; }); return $iter; } =item C<< add_triple( $t ) >> =cut sub add_triple { my $self = shift; my $t = shift; push(@{ $self->triples }, $t); } =item C<< remove_triple( $t ) >> =cut sub remove_triple { my $self = shift; my $t = shift; my @remove; my $triples = $self->triples; foreach my $i (0 .. $#{ $triples }) { my $u = $triples->[$i]; if ($u->as_string eq $t->as_string) { push(@remove, $i); } } while (scalar(@remove)) { my $i = pop(@remove); splice(@$triples, $i, 1, ()); } } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Store/PaxHeader/Simple.pm000644 000765 000024 00000000225 14636707550 022005 xustar00gregstaff000000 000000 30 mtime=1719373672.807313439 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Store/Simple.pm000644 000765 000024 00000003467 14636707550 020047 0ustar00gregstaff000000 000000 =head1 NAME AtteanX::Store::Simple - Simple, unindexed, in-memory RDF store =head1 VERSION This document describes AtteanX::Store::Simple version 0.034 =head1 SYNOPSIS use AtteanX::Store::Simple; =head1 DESCRIPTION AtteanX::Store::Simple provides an in-memory quad-store. =cut use v5.14; use warnings; package AtteanX::Store::Simple 0.034 { use Moo; use Type::Tiny::Role; use Types::Standard qw(Int ArrayRef HashRef ConsumerOf InstanceOf); use Encode; use Set::Scalar; use Digest::SHA; use List::Util qw(first); use Scalar::Util qw(refaddr reftype blessed); use namespace::clean; with 'Attean::API::QuadStore', 'Attean::API::RDFStarStore'; =head1 METHODS Beyond the methods documented below, this class inherits methods from the L class. =over 4 =item C<< new ( quads => \@quads ) >> Returns a new memory-backed storage object. =cut has quads => (is => 'rw', isa => ArrayRef[ConsumerOf['Attean::API::Quad']], default => sub { [] }); =item C<< get_quads ( $subject, $predicate, $object, $graph ) >> Returns a stream object of all statements matching the specified subject, predicate and objects. Any of the arguments may be undef to match any value. =cut sub get_quads { my $self = shift; my @nodes = @_; my $quads = $self->quads; my $iter = Attean::ListIterator->new( values => $quads, item_type => 'Attean::API::Quad' ); return $iter->matching_pattern(@nodes); } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Functions/CompositeMaps.pm000644 000765 000024 00000050052 14632645554 022246 0ustar00gregstaff000000 000000 use v5.14; use warnings; use utf8; =head1 NAME AtteanX::Functions::CompositeMaps - Functions and aggregates to work with composite maps =head1 VERSION This document describes AtteanX::Functions::CompositeMaps version 0.032 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a utility package that defines functions and aggregates to work with composite map datatypes. =over 4 =cut package AtteanX::Functions::CompositeMaps::TurtleLexerWithNull { use Moo; use AtteanX::Serializer::TurtleTokens; use AtteanX::Parser::Turtle; use AtteanX::SPARQL::Constants; extends 'AtteanX::Parser::Turtle::Lexer'; sub get_token { my $self = shift; while (1) { $self->fill_buffer unless (length($self->buffer)); my $start_column = $self->column; my $start_line = $self->line; if ($self->buffer =~ /^[ \r\n\t]+/o) { my $ws = $self->read_length($+[0]); # we're ignoring whitespace tokens, but we could return them here instead of falling through to the 'next': unless ($self->ignore_whitespace) { return $self->new_token(WS, $start_line, $start_column, $ws); } next; } my $c = $self->peek_char(); return unless (defined($c)); if ($c eq ':') { $self->read_length(1); return AtteanX::Parser::Turtle::Token->fast_constructor(PREFIXNAME, -1, -1, -1, -1, [':']); } if ($self->buffer =~ /^null\b/) { $self->read_length($+[0]); return 1; } elsif ($self->buffer =~ /^(true|false)\b/) { my $bool = $self->read_length($+[0]); return $self->new_token(BOOLEAN, $start_line, $start_column, $bool); } return $self->SUPER::get_token(); } } } package AtteanX::Functions::CompositeMaps 0.032 { use Attean; use Attean::RDF; use Encode qw(decode_utf8); use Scalar::Util qw(blessed); use Digest::SHA qw(sha1_hex); use AtteanX::Serializer::TurtleTokens; use AtteanX::Parser::Turtle; use AtteanX::SPARQL::Constants; use AtteanX::Functions::CompositeLists; our $CDT_BASE = 'http://w3id.org/awslabs/neptune/SPARQL-CDTs/'; our $MAP_TYPE_IRI = "${CDT_BASE}Map"; # Assume the opening token of the cdt has already been consumed. # Return either a HASH or ARRAY reference, depending on the closing token. # Does not validate the lexical form with respect to balanced cdt tokens. sub _recursive_lexer_parse_cdt { my $p = shift; my $lexer = shift; my @nodes; my $s = AtteanX::Serializer::TurtleTokens->new( suppress_whitespace => 1 ); while (my $t = $p->_next_nonws($lexer)) { if ($t and not blessed($t)) { # this is the special value returned from our lexer subclass that indicates a null values push(@nodes, undef); } else { next if ($t->type == COMMA); next if ($t->type == PREFIXNAME and $t->value eq ':'); # COLON if ($t->type == LBRACE) { my $hash = _recursive_lexer_parse_cdt($p, $lexer); push(@nodes, AtteanX::Functions::CompositeMaps::map_to_lex(%$hash)); } elsif ($t->type == RBRACE) { my %hash; die "odd number of map elements" unless (scalar(@nodes) % 2 == 0); while (my ($k, $v) = splice(@nodes, 0, 2)) { my @tokens; push(@tokens, $k->sparql_tokens->elements); my $iter = Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::Parser::Turtle::Token' ); my $bytes = $s->serialize_iter_to_bytes($iter); my $key_string = decode_utf8($bytes); $hash{ $key_string } = $v; } return \%hash; } elsif ($t->type == LBRACKET) { my $subnodes = _recursive_lexer_parse_cdt($p, $lexer); push(@nodes, AtteanX::Functions::CompositeLists::list_to_lex(@$subnodes)); } elsif ($t->type == RBRACKET) { return \@nodes; } else { my $t = $p->_object($lexer, $t); push(@nodes, $t); } } } die 'unexpected end of map literal lexical form'; } =item C<< lex_to_map($literal) >> Parses $literal as a cdt:Map value and returns a hash of stringified keys and term object values. Use C<< lex_to_maplist >> to get a list of key-value pairs in which the keys are also term objects. =cut sub lex_to_map { my $l = shift; die 'TypeError' unless ($l->does('Attean::API::Literal')); my $dt = $l->datatype; die 'TypeError: not a datatype literal' unless ($dt); die 'TypeError: Expecting a Map but found ' . $dt->value unless ($dt->value eq $MAP_TYPE_IRI); my $lex = $l->value; $lex =~ s/^\s*//g; $lex =~ s/\s*$//g; unless ($lex =~ m<^\{(.*)\}$>) { die 'TypeError: Invalid lexical form for cdt:Map literal: ' . $dt->value; } open(my $fh, '<:encoding(UTF-8)', \$lex); my $p = AtteanX::Parser::Turtle->new(); local($p->{enable_cdt_rewriting}) = 0; # $p->_map->{''} = Attean::IRI->new($MAP_TYPE_IRI); my $lexer = AtteanX::Functions::CompositeMaps::TurtleLexerWithNull->new(file => $fh); my @nodes; my $t = $p->_next_nonws($lexer); if ($t->type == LBRACE) { my $hash = _recursive_lexer_parse_cdt($p, $lexer); push(@nodes, %$hash); } return @nodes; } =item C<< map_to_lex(@terms) >> =cut sub map_to_lex { my @terms = @_; my $s = AtteanX::Serializer::TurtleTokens->new( suppress_whitespace => 1 ); my $bytes = ''; open(my $io, '>', \$bytes); my $first = 1; my $p = AtteanX::Parser::Turtle->new(); local($p->{enable_cdt_rewriting}) = 0; while (my ($key_string, $value) = splice(@terms, 0, 2)) { unless ($first) { my @tokens; push(@tokens, AtteanX::Parser::Turtle::Token->fast_constructor(COMMA, -1, -1, -1, -1, [','])); push(@tokens, AtteanX::Parser::Turtle::Token->fast_constructor(WS, -1, -1, -1, -1, [' '])); my $iter = Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::Parser::Turtle::Token' ); $s->serialize_iter_to_io($io, $iter); } $first = 0; my @tokens; my $key = $p->parse_node($key_string); push(@tokens, $key->sparql_tokens->elements); push(@tokens, AtteanX::Parser::Turtle::Token->fast_constructor(WS, -1, -1, -1, -1, [' '])); push(@tokens, AtteanX::Parser::Turtle::Token->fast_constructor(PREFIXNAME, -1, -1, -1, -1, [':'])); if (blessed($value)) { push(@tokens, $value->sparql_tokens->elements); my $iter = Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::Parser::Turtle::Token' ); $s->serialize_iter_to_io($io, $iter); } else { my $iter = Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::Parser::Turtle::Token' ); $s->serialize_iter_to_io($io, $iter); print {$io} "null"; } } close($io); my $str = decode_utf8($bytes); chomp($str); return dtliteral("{${str}}", $MAP_TYPE_IRI); } =item C<< mapCreate(@list) >> =cut sub mapCreate { my $model = shift; my $active_graph = shift; my @map; my $s = AtteanX::Serializer::TurtleTokens->new( suppress_whitespace => 1 ); while (my ($key, $value) = splice(@_, 0, 2)) { next unless (is_valid_map_key($key)); my @tokens = $key->sparql_tokens->elements; my $iter = Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::Parser::Turtle::Token' ); my $bytes = $s->serialize_iter_to_bytes($iter); my $key_string = decode_utf8($bytes); push(@map, $key_string, $value); # $map{$key_string} = $value; } my $literal = eval { map_to_lex(@map) }; warn "cdt:Map constructor error: $@" if $@; return $literal; } =item C<< is_valid_map_key( $value ) >> Returns true if $value is a valid map key (is an IRI or a literal), false otherwise. =cut sub is_valid_map_key { my $key = shift; return 0 unless (blessed($key)); return 1 if ($key->does('Attean::API::IRI')); return 1 if ($key->does('Attean::API::Literal')); return 0; } sub _map_key_string { my $key = shift; my $s = AtteanX::Serializer::TurtleTokens->new( suppress_whitespace => 1 ); my @tokens = $key->sparql_tokens->elements; my $iter = Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::Parser::Turtle::Token' ); my $bytes = $s->serialize_iter_to_bytes($iter); my $key_string = decode_utf8($bytes); return $key_string; } =item C<< mapGet($list, $key) >> =cut sub mapGet { my $model = shift; my $active_graph = shift; my $l = shift; my $key = shift; die 'TypeError' unless ($l->does('Attean::API::Literal')); my $dt = $l->datatype; die 'TypeError' unless ($dt->value eq $MAP_TYPE_IRI); my %nodes = lex_to_map($l); my $key_string = _map_key_string($key); my $value = $nodes{$key_string}; return $value; } =item C<< mapKeys($map) >> =cut sub mapKeys { my $model = shift; my $active_graph = shift; my $map = shift; die 'TypeError' unless ($map->does('Attean::API::Literal')); my $dt = $map->datatype; die 'TypeError' unless ($dt->value eq $MAP_TYPE_IRI); my %nodes = lex_to_map($map); my @key_strings = keys %nodes; my $p = AtteanX::Parser::Turtle->new(); local($p->{enable_cdt_rewriting}) = 0; # $p->_map->{''} = Attean::IRI->new($MAP_TYPE_IRI); my @nodes = map { open(my $fh, '<:encoding(UTF-8)', \$_); my $lexer = AtteanX::Functions::CompositeMaps::TurtleLexerWithNull->new(file => $fh); my $token = $p->_next_nonws($lexer); $p->_object($lexer, $token); } @key_strings; AtteanX::Functions::CompositeLists::list_to_lex(@nodes); } =item C<< map_key_to_term( @keys ) >> Converts each argument from the stringified version of map keys used as hash keys to a list of term objects. =cut sub map_key_to_term { my @keys = @_; my $p = AtteanX::Parser::Turtle->new(); local($p->{enable_cdt_rewriting}) = 0; my @terms = map { open(my $fh, '<:encoding(UTF-8)', \$_); my $lexer = AtteanX::Functions::CompositeMaps::TurtleLexerWithNull->new(file => $fh); my $token = $p->_next_nonws($lexer); $p->_object($lexer, $token); } @keys; return wantarray ? @terms : $terms[0]; } =item C<< lex_to_maplist() >> Parses $literal as a cdt:Map value and returns a (flattened) list of key-value pairs of term values. =cut sub lex_to_maplist { my %map = lex_to_map(@_); my @key_strings = keys %map; my @values = values %map; my $p = AtteanX::Parser::Turtle->new(); local($p->{enable_cdt_rewriting}) = 0; my @keys = map { open(my $fh, '<:encoding(UTF-8)', \$_); my $lexer = AtteanX::Functions::CompositeMaps::TurtleLexerWithNull->new(file => $fh); my $token = $p->_next_nonws($lexer); $p->_object($lexer, $token); } @key_strings; my @list; foreach my $i (0 .. $#keys) { push(@list, $keys[$i]); push(@list, $values[$i]); } return @list; } =item C<< mapPut($map, $key, $value) >> =cut sub mapPut { my $model = shift; my $active_graph = shift; my $map = shift; my $key = shift; die 'TypeError' unless (is_valid_map_key($key)); my $value = shift; die 'TypeError' unless (blessed($map) and $map->does('Attean::API::Literal')); my $dt = $map->datatype; die 'TypeError' unless ($dt->value eq $MAP_TYPE_IRI); my %nodes = lex_to_map($map); my @key_strings = keys %nodes; my $key_string = _map_key_string($key); $nodes{ $key_string } = $value; return map_to_lex(%nodes); } =item C<< mapRemove($map, $key) >> =cut sub mapRemove { my $model = shift; my $active_graph = shift; my $map = shift; my $key = shift; die 'TypeError' unless (blessed($map) and $map->does('Attean::API::Literal')); my $dt = $map->datatype; die 'TypeError' unless ($dt->value eq $MAP_TYPE_IRI); my %nodes = lex_to_map($map); my @key_strings = keys %nodes; unless (is_valid_map_key($key)) { return $map; } my $key_string = _map_key_string($key); delete $nodes{ $key_string }; return map_to_lex(%nodes); } =item C<< mapSize($list) >> =cut sub mapSize { my $model = shift; my $active_graph = shift; my $l = shift; die 'TypeError' unless (blessed($l) and $l->does('Attean::API::Literal')); my $dt = $l->datatype; die 'TypeError' unless ($dt->value eq $MAP_TYPE_IRI); my %nodes = lex_to_map($l); my @keys = keys(%nodes); return Attean::Literal->integer(scalar(@keys)); } =item C<< mapContains($map, $term) >> =cut sub mapContains { my $model = shift; my $active_graph = shift; my $l = shift; my $term = shift; die 'TypeError: Not a literal' unless (blessed($l) and $l->does('Attean::API::Literal')); my $dt = $l->datatype; die 'TypeError: Not a cdt:List' unless ($dt->value eq $MAP_TYPE_IRI); my %nodes = lex_to_map($l); my $s = AtteanX::Serializer::TurtleTokens->new( suppress_whitespace => 1 ); my @tokens = $term->sparql_tokens->elements; my $iter = Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::Parser::Turtle::Token' ); my $bytes = $s->serialize_iter_to_bytes($iter); my $key_string = decode_utf8($bytes); return (exists $nodes{ $key_string }) ? Attean::Literal->true : Attean::Literal->false; } =item C<< mapMerge($map1, $map2) >> =cut sub mapMerge { my $model = shift; my $active_graph = shift; my $map1 = shift; my $map2 = shift; my %nodes1 = lex_to_map($map1); my %nodes2 = lex_to_map($map2); my %merged = (%nodes2, %nodes1); my $merged = map_to_lex(%merged); return $merged; } =item C<< mapCreate_agg_start() >> =cut sub mapCreate_agg_start { my $model = shift; my $active_graph = shift; return { values => {} }; } =item C<< mapCreate_agg_process($thunk, $key, $value) >> =cut sub mapCreate_agg_process { my $thunk = shift; my ($key) = shift; my $value = shift; $thunk->{'values'}{$key->value} = $value; } =item C<< mapCreate_agg_finalize($thunk) >> =cut sub mapCreate_agg_finalize { my $thunk = shift; my %terms = @{ $thunk->{'values' }}; return map_to_lex(%terms); } =item C<< register() >> =cut sub register { Attean->register_datatype_role( $MAP_TYPE_IRI => 'AtteanX::Functions::CompositeMaps::MapLiteral' ); Attean->register_global_functional_form( "${CDT_BASE}Map" => \&mapCreate, "${CDT_BASE}mapCreate" => \&mapCreate, "${CDT_BASE}put" => \&mapPut, ); Attean->register_global_function( "${CDT_BASE}mapGet" => \&mapGet, "${CDT_BASE}mapSize" => \&mapSize, "${CDT_BASE}keys" => \&mapKeys, "${CDT_BASE}remove" => \&mapRemove, "${CDT_BASE}containsKey" => \&mapContains, "${CDT_BASE}merge" => \&mapMerge, ); Attean->register_global_aggregate( "${CDT_BASE}mapAgg" => { start => \&mapCreate_agg_start, process => \&mapCreate_agg_process, finalize => \&mapCreate_agg_finalize, }, ); } } package AtteanX::Functions::CompositeMaps::MapLiteral { use Scalar::Util qw(blessed looks_like_number); use List::Util qw(min); use Moo::Role; sub equals { my $lhs = shift; my $rhs = shift; # warn "MAP EQUALS?"; # warn "- " . $lhs->as_string . "\n"; # warn "- " . $rhs->as_string . "\n"; return 0 unless ($rhs->does('Attean::API::Literal') and $rhs->datatype->value eq $AtteanX::Functions::CompositeMaps::MAP_TYPE_IRI); my $lhs_size = eval { AtteanX::Functions::CompositeMaps::mapSize(undef, undef, $lhs)->value }; return 0 if ($@); my $rhs_size = eval { AtteanX::Functions::CompositeMaps::mapSize(undef, undef, $rhs)->value }; return 0 if ($@); return 0 unless ($lhs_size == $rhs_size); my %lhs_map = AtteanX::Functions::CompositeMaps::lex_to_map($lhs); my %rhs_map = AtteanX::Functions::CompositeMaps::lex_to_map($rhs); my @lhs_keys = sort(keys %lhs_map); my @rhs_keys = sort(keys %rhs_map); # TODO: handle differing lexical forms for map keys here: my $seen_error = 0; foreach my $i (0 .. $lhs_size-1) { return 0 unless ($lhs_keys[$i] eq $rhs_keys[$i]); my $key = $lhs_keys[$i]; my $lv = $lhs_map{$key}; my $rv = $rhs_map{$key}; if (not blessed($lv) and not blessed($rv)) { # both null next; } elsif (not blessed($lv) or not blessed($rv)) { return 0; } if ($lv->does('Attean::API::Blank') and $rv->does('Attean::API::Blank')) { if ($lv->value eq $rv->value) { next; } else { $seen_error++; next; } } return 0 unless ($lv->equals($rv)); } if ($seen_error) { die 'TypeError'; } return 1; } sub order { my $self = shift; return _compare('order', $self, @_); } sub compare { my $self = shift; return _compare('compare', $self, @_); } sub _compare { my $cmp_method = shift; my $lhs = shift; my $rhs = shift; # warn "MAP-LESS-THAN?"; # warn "- " . $lhs->as_string . "\n"; # warn "- " . $rhs->as_string . "\n"; die 'TypeError' unless (blessed($rhs) and $rhs->does('Attean::API::Literal') and $rhs->datatype->value eq $AtteanX::Functions::CompositeMaps::MAP_TYPE_IRI); my %lhs = AtteanX::Functions::CompositeMaps::lex_to_map($lhs); my %rhs = AtteanX::Functions::CompositeMaps::lex_to_map($rhs); my $lhs_size = scalar(%lhs); my $rhs_size = scalar(%rhs); if (not($lhs_size) and not($rhs_size)) { return 0; # empty maps are trivially eq } if (scalar(%lhs) == 0 and scalar(%rhs) == 0) { return 0; } my @lhs_keys = sort_map_keys(keys %lhs); my @rhs_keys = sort_map_keys(keys %rhs); my $length = min($lhs_size, $rhs_size); foreach my $i (0 .. $length-1) { my $k1 = AtteanX::Functions::CompositeMaps::map_key_to_term($lhs_keys[$i]); my $k2 = AtteanX::Functions::CompositeMaps::map_key_to_term($rhs_keys[$i]); my $same = sameterm($k1, $k2); if (not($same)) { # the keys are not the same my @sorted = sort_map_keys($lhs_keys[$i], $rhs_keys[$i]); if ($sorted[0] eq $lhs_keys[$i]) { # k1 is ordered before k2 according tot he map key sorting return -1; # less than } else { return 1; # greater than } } my $v1 = $lhs{$lhs_keys[$i]}; my $v2 = $rhs{$rhs_keys[$i]}; if (not blessed($v1) and not blessed($v2)) { # both null next; } elsif (not blessed($v1)) { if ($cmp_method eq 'order') { return -1; } else { die 'TypeError'; } } elsif (not blessed($v2)) { if ($cmp_method eq 'order') { return 1; } else { die 'TypeError'; } } if ($cmp_method eq 'compare') { foreach my $v ($v1, $v2) { if ($v->does('Attean::API::IRI')) { die 'TypeError'; # IRIs as map values cannot be compared } } } my $v_cmp = $v1->$cmp_method($v2); # may throw an error if ($v_cmp) { return $v_cmp; } } return ($lhs_size - $rhs_size); # sort smaller maps ahead of larger maps } sub sameterm { # shared code with SAMETERM handling in SimpleQueryEvaluator. Consider refactoring. my $a = shift; my $b = shift; my $cmp = eval { $a->compare($b) }; if (not($@) and $cmp) { return 0; } if ($a->does('Attean::API::Binding')) { my $ok = ($a->sameTerms($b)); return $ok; } else { my $ok = ($a->value eq $b->value); return $ok; } } sub sort_map_keys { my @keys = @_; my @terms = AtteanX::Functions::CompositeMaps::map_key_to_term(@keys); my @iri_i; my @other_i; foreach my $i (0 .. $#terms) { if ($terms[$i]->does('Attean::API::IRI')) { push(@iri_i, $i); } else { push(@other_i, $i); } } @iri_i = sort { my $at = $terms[$a]; my $bt = $terms[$b]; $at->compare($bt) } @iri_i; @other_i = sort { my $at = $terms[$a]; my $bt = $terms[$b]; my $a_value = $at->value; my $a_dt = $at->datatype->value; my $a_lang = $at->language // ''; my $b_value = $bt->value; my $b_dt = $bt->datatype->value; my $b_lang = $bt->language // ''; if (my $cdt = ($a_dt cmp $b_dt)) { return $cdt; } if (my $cval = ($a_value cmp $b_value)) { return $cval; } return $a_lang cmp $b_lang; } @other_i; return map { $keys[$_] } (@iri_i, @other_i); } sub canonicalized_term { my $self = shift; return $self->canonicalized_term_strict(); } sub canonicalized_term_strict { my $self = shift; my %values = AtteanX::Functions::CompositeMaps::lex_to_map($self); my @keys = sort keys %values; my @values = map { $_ => $values{$_} } @keys; return AtteanX::Functions::CompositeMaps::map_to_lex(@values); } with 'Attean::API::Literal'; with 'Attean::API::CanonicalizingLiteral'; } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Functions/PaxHeader/CompositeLists.pm000644 000765 000024 00000000225 14636707550 024411 xustar00gregstaff000000 000000 30 mtime=1719373672.225673077 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Functions/CompositeLists.pm000644 000765 000024 00000050703 14636707550 022446 0ustar00gregstaff000000 000000 use v5.14; use warnings; use utf8; =head1 NAME AtteanX::Functions::CompositeLists - Functions and aggregates to work with composite lists =head1 VERSION This document describes AtteanX::Functions::CompositeLists version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION This is a utility package that defines functions and aggregates to work with composite list datatypes. =over 4 =cut package AtteanX::Functions::CompositeLists::TurtleLexerWithNull { use Moo; use AtteanX::Parser::Turtle; use AtteanX::SPARQL::Constants; extends 'AtteanX::Parser::Turtle::Lexer'; sub get_token { my $self = shift; while (1) { $self->fill_buffer unless (length($self->buffer)); if ($self->buffer =~ /^[ \r\n\t]+/o) { my $start_column = $self->column; my $start_line = $self->line; my $ws = $self->read_length($+[0]); # we're ignoring whitespace tokens, but we could return them here instead of falling through to the 'next': unless ($self->ignore_whitespace) { return $self->new_token(WS, $start_line, $start_column, $ws); } next; } my $c = $self->peek_char(); return unless (defined($c)); if ($c eq ':') { $self->read_length(1); return AtteanX::Parser::Turtle::Token->fast_constructor(PREFIXNAME, -1, -1, -1, -1, [':']); } if ($self->buffer =~ /^null\b/) { $self->read_length($+[0]); return 1; } return $self->SUPER::get_token(); } } } package AtteanX::Functions::CompositeLists 0.034 { use Attean; use Attean::RDF; use Encode qw(decode_utf8); use Scalar::Util qw(blessed); use Digest::SHA qw(sha1_hex); use AtteanX::Serializer::TurtleTokens; use AtteanX::Parser::Turtle; use AtteanX::SPARQL::Constants; use AtteanX::Functions::CompositeMaps; our $CDT_BASE = 'http://w3id.org/awslabs/neptune/SPARQL-CDTs/'; our $LIST_TYPE_IRI = "${CDT_BASE}List"; =item C<< lex_to_list($literal) >> =cut sub lex_to_list { my $l = shift; die 'TypeError: Cannot parse non-literal to cdt:List' unless ($l->does('Attean::API::Literal')); my $dt = $l->datatype; die 'TypeError: not a datatype literal' unless ($dt); die 'TypeError: Expecting a List but found ' . $dt->value unless ($dt->value eq $LIST_TYPE_IRI); my $lex = $l->value; $lex =~ s/^\s*//g; $lex =~ s/\s*$//g; unless ($lex =~ m<^\[(.*)\]$>s) { die 'TypeError: Invalid lexical form for cdt:List literal: ' . $dt->value; } open(my $fh, '<:encoding(UTF-8)', \$lex); my $p = AtteanX::Parser::Turtle->new(); local($p->{enable_cdt_rewriting}) = 0; my $lexer = AtteanX::Functions::CompositeLists::TurtleLexerWithNull->new(file => $fh); my @nodes; eval { my $t = $p->_next_nonws($lexer); if ($t->type == LBRACKET) { push(@nodes, @{AtteanX::Functions::CompositeMaps::_recursive_lexer_parse_cdt($p, $lexer)}); } # while (my $t = $p->_next_nonws($lexer)) { # # # warn "TOKEN: $t\n"; # if ($t and not blessed($t)) { # # this is the special value returned from our lexer subclass that indicates a null values # push(@nodes, undef); # } else { # next if ($t->type == COMMA); # push(@nodes, $p->_object($lexer, $t)); # } # } }; return @nodes; # this would create fresh bnodes on each access: # my $mapper = Attean::TermMap->uuid_blank_map; # return map { blessed($_) ? $mapper->map($_) : $_ } @nodes; } =item C<< list_to_lex(@terms) >> =cut sub list_to_lex { my @terms = @_; my $s = AtteanX::Serializer::TurtleTokens->new( suppress_whitespace => 1 ); my $bytes = ''; open(my $io, '>', \$bytes); my $first = 1; foreach my $t (@terms) { my @tokens; unless ($first) { push(@tokens, AtteanX::Parser::Turtle::Token->fast_constructor(COMMA, -1, -1, -1, -1, [','])); } $first = 0; if (blessed($t)) { push(@tokens, $t->sparql_tokens->elements); my $iter = Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::Parser::Turtle::Token' ); $s->serialize_iter_to_io($io, $iter); } else { my $iter = Attean::ListIterator->new( values => \@tokens, item_type => 'AtteanX::Parser::Turtle::Token' ); $s->serialize_iter_to_io($io, $iter); print {$io} "null"; } } close($io); my $str = decode_utf8($bytes); chomp($str); return dtliteral("[${str}]", $LIST_TYPE_IRI); } =item C<< stringSplit($string, $pattern) >> =cut sub stringSplit { my $model = shift; my $active_graph = shift; my $string = shift; my $pattern = shift; my @parts = map { literal($_) } split(quotemeta($pattern->value), $string->value); return list_to_lex(@parts); } =item C<< listCreate(@list) >> =cut sub listCreate { my $model = shift; my $active_graph = shift; my $literal = eval { list_to_lex(@_) }; warn "cdt:List constructor error: $@" if $@; return $literal; } =item C<< ctGet($ct, $key) >> =cut sub ctGet { my $model = shift; my $active_graph = shift; my $ct = shift; my $pos = shift; die 'TypeError: Cannot interpret non-literal as CDT type' unless ($ct->does('Attean::API::Literal')); my $dt = $ct->datatype; if ($dt->value eq $LIST_TYPE_IRI) { return listGet($model, $active_graph, $ct, $pos); } elsif ($dt->value eq $AtteanX::Functions::CompositeMaps::MAP_TYPE_IRI) { return AtteanX::Functions::CompositeMaps::mapGet($model, $active_graph, $ct, $pos); } else { die 'TypeError: Unexpected non-CDT type: ' . $dt->value; } } =item C<< listGet($list, $pos) >> =cut sub listGet { my $model = shift; my $active_graph = shift; my $l = shift; my $pos = shift; die 'TypeError: Cannot interpret non-literal as cdt:List' unless ($l->does('Attean::API::Literal')); my $dt = $l->datatype; die 'TypeError: Unexpected non-List type: ' . $dt->value unless ($dt->value eq $LIST_TYPE_IRI); my @nodes = lex_to_list($l); die 'TypeError' unless ($pos->does('Attean::API::NumericLiteral') and $pos->datatype->value eq 'http://www.w3.org/2001/XMLSchema#integer'); my $i = int($pos->value) - 1; # cdt:get is 1-based, while the array index below is 0-based die 'Unexpected non-positive get index' unless ($i >= 0); return $nodes[$i]; } =item C<< listSubseq($list, $pos, $len) >> =cut sub listSubseq { my $model = shift; my $active_graph = shift; my $l = shift; foreach my $term (@_) { die 'TypeError' unless ($term->does('Attean::API::NumericLiteral') and $term->datatype->value eq 'http://www.w3.org/2001/XMLSchema#integer'); } my $pos = shift; my @len = @_; die 'TypeError' unless ($l->does('Attean::API::Literal')); my $dt = $l->datatype; die 'TypeError' unless ($dt->value eq $LIST_TYPE_IRI); my @nodes = lex_to_list($l); my $start = int($pos->value); die 'Unexpected non-positive subseq start argument' unless ($start > 0); my @length = map { int($_->value) } @len; if ($start == (1+scalar(@nodes))) { die 'Unexpected subseq start argument at end of list with non-zero length' unless ((scalar(@length) and $length[0] == 0) or not(scalar(@length))) } else { die 'Unexpected subseq start argument past end of list' unless ($start < (1+scalar(@nodes))); } if (scalar(@length)) { my $end = $start + $length[0]; die 'Subseq start+length is beyond the end of the array' if ($end > (1+scalar(@nodes))); } my @orig = @nodes; my $from = $start-1; my $to = scalar(@length) ? ($from + $length[0] - 1) : $#nodes; my @seq = @nodes[$from .. $to]; return list_to_lex(@seq); } =item C<< listConcat(@lists) >> =cut sub listConcat { my $model = shift; my $active_graph = shift; my @lists = @_; my @nodes; foreach my $l (@lists) { die 'TypeError' unless ($l->does('Attean::API::Literal')); my $dt = $l->datatype; die 'TypeError' unless ($dt->value eq $LIST_TYPE_IRI); push(@nodes, lex_to_list($l)); } return list_to_lex(@nodes); } =item C<< listReverse($list, $pos) >> =cut sub listReverse { my $model = shift; my $active_graph = shift; my $l = shift; die 'TypeError' unless ($l->does('Attean::API::Literal')); my $dt = $l->datatype; die 'TypeError' unless ($dt->value eq $LIST_TYPE_IRI); my @nodes = lex_to_list($l); return list_to_lex(reverse @nodes); } =item C<< listHead($list, $pos) >> =cut sub listHead { my $model = shift; my $active_graph = shift; my $l = shift; die 'TypeError' unless ($l->does('Attean::API::Literal')); my $dt = $l->datatype; die 'TypeError' unless ($dt->value eq $LIST_TYPE_IRI); my @nodes = lex_to_list($l); return shift(@nodes); } =item C<< listTail($list, $pos) >> =cut sub listTail { my $model = shift; my $active_graph = shift; my $l = shift; die 'TypeError' unless ($l->does('Attean::API::Literal')); my $dt = $l->datatype; die 'TypeError' unless ($dt->value eq $LIST_TYPE_IRI); my @nodes = lex_to_list($l); unless (scalar(@nodes)) { die 'cdt:tail called on an empty list'; } shift(@nodes); return list_to_lex(@nodes); } =item C<< listContains($list, $term) >> =cut sub listContains { my $model = shift; my $active_graph = shift; my $l = shift; my $term = shift; die 'TypeError: Not a literal' unless ($l->does('Attean::API::Literal')); my $dt = $l->datatype; die 'TypeError: Not a cdt:List' unless ($dt->value eq $LIST_TYPE_IRI); my @nodes = lex_to_list($l); foreach my $n (@nodes) { next unless (defined($n)); # null list elements cannot be tested for with CONTAINS my $equals = eval { $n->equals($term) }; # warn $@ if ($@); return Attean::Literal->true if ($equals); } return Attean::Literal->false; } =item C<< listContainsTerm($list, $term) >> =cut sub listContainsTerm { my $model = shift; my $active_graph = shift; my $l = shift; my $term = shift; die 'TypeError' unless ($l->does('Attean::API::Literal')); my $dt = $l->datatype; die 'TypeError' unless ($dt->value eq $LIST_TYPE_IRI); my @nodes = lex_to_list($l); foreach my $n (@nodes) { next unless (defined($n)); # null list elements cannot be tested for with CONTAINSTERM if ($n->compare($term)) { next; } if ($n->does('Attean::API::Binding')) { return Attean::Literal->true if ($n->sameTerms($term)); } else { return Attean::Literal->true if ($n->value eq $term->value); } } return Attean::Literal->false; } =item C<< ctSize($ct) >> =cut sub ctSize { my $model = shift; my $active_graph = shift; my $ct = shift; my $pos = shift; die 'TypeError' unless ($ct->does('Attean::API::Literal')); my $dt = $ct->datatype; if ($dt->value eq $LIST_TYPE_IRI) { return listSize($model, $active_graph, $ct, $pos); } elsif ($dt->value eq $AtteanX::Functions::CompositeMaps::MAP_TYPE_IRI) { return AtteanX::Functions::CompositeMaps::mapSize($model, $active_graph, $ct, $pos); } else { die 'TypeError'; } } =item C<< listSize($list) >> =cut sub listSize { my $model = shift; my $active_graph = shift; my $l = shift; die 'TypeError' unless ($l->does('Attean::API::Literal')); my $dt = $l->datatype; die 'TypeError' unless ($dt->value eq $LIST_TYPE_IRI); my @nodes = lex_to_list($l); return Attean::Literal->integer(scalar(@nodes)); } =item C<< sequence($start, $end) >> =cut sub sequence { my $model = shift; my $active_graph = shift; my $start = 1; my $end = 1; if (scalar(@_) == 2) { $start = shift->numeric_value; $end = shift->numeric_value; } else { $end = shift->numeric_value; } my @values = ($start .. $end); return list_to_lex(map { Attean::Literal->integer($_) } @values); } =item C<< zip($list, $list) >> =cut sub zip { my $model = shift; my $active_graph = shift; my $lhs = shift; my $rhs = shift; my @lhs_nodes = lex_to_list($lhs); my @rhs_nodes = lex_to_list($rhs); die 'zip operands are not the same length' unless (scalar(@lhs_nodes) == scalar(@rhs_nodes)); my @elements; while (scalar(@lhs_nodes)) { my @list = (shift(@lhs_nodes), shift(@rhs_nodes)); my $l = list_to_lex(@list); push(@elements, $l); } return list_to_lex(@elements); } =item C<< listCreate_agg_start() >> =cut sub listCreate_agg_start { my $model = shift; my $active_graph = shift; return { values => [] }; } =item C<< listCreate_agg_process($thunk, $term) >> =cut sub listCreate_agg_process { my $thunk = shift; my ($term) = @_; push(@{ $thunk->{'values' }}, $term); } =item C<< listCreate_agg_finalize($thunk) >> =cut sub listCreate_agg_finalize { my $thunk = shift; my @terms = @{ $thunk->{'values' }}; return list_to_lex(@terms); } =item C<< list_from_head($head) >> =cut sub list_from_head { my $model = shift; my $active_graph = shift; my $head = shift; my $list = $model->get_list($active_graph, $head); return list_to_lex($list->elements); } =item C<< rewrite_lexical( $literal, \%bnode_map, $parse_id ) >> =cut # lexer-based rewrite that will preserve the lexical representation of the literal for everything but the blank nodes sub rewrite_lexical { my $term = shift; my $bnode_map = shift; my $parse_id = shift; my %bnode_map = %{ $bnode_map }; my $rewrite_tokens = sub { my $l = shift; my $t = shift; return $t unless (blessed($t)); if ($t->type == BNODE) { my $v = $t->value; if (my $b = $bnode_map{$v}) { return $l->new_token(BNODE, $t->start_line, $t->start_column, $b->value); } else { my $value = 'b' . sha1_hex($parse_id . $v); my $b = Attean::Blank->new(value => $value); $bnode_map{$value} = $b; return $l->new_token(BNODE, $t->start_line, $t->start_column, $b->value); } } else { return $t; } }; my $r = eval { my %seen_hathat; my %seen_cdt_iri; my %seen_cdt_list_iri; my %seen_cdt_map_iri; my $lex = $term->value; open(my $fh, '<:encoding(UTF-8)', \$lex); my $lexer = AtteanX::Functions::CompositeLists::TurtleLexerWithNull->new(file => $fh, ignore_whitespace => 0); my $p = AtteanX::Parser::Turtle->new(); my @rewritten_tokens; my $i = 0; while (my $t = $rewrite_tokens->($lexer, $lexer->get_token())) { if (blessed($t)) { if ($t->type == HATHAT) { $seen_hathat{$i-1}++; } elsif ($t->type == IRI) { if ($t->value eq 'http://w3id.org/awslabs/neptune/SPARQL-CDTs/Map') { $seen_cdt_map_iri{$i-2}++; $seen_cdt_iri{$i-2}++; } elsif ($t->value eq 'http://w3id.org/awslabs/neptune/SPARQL-CDTs/List') { $seen_cdt_list_iri{$i-2}++; $seen_cdt_iri{$i-2}++; } } } push(@rewritten_tokens, $t); $i++; } my @rewritten; my $j = 0; my $s = AtteanX::Serializer::SPARQL->new(); foreach my $t (@rewritten_tokens) { if (blessed($t) and $t->is_string and $seen_hathat{$j} and $seen_cdt_iri{$j}) { my $ct_type = $seen_cdt_list_iri{$j} ? 'http://w3id.org/awslabs/neptune/SPARQL-CDTs/List' : 'http://w3id.org/awslabs/neptune/SPARQL-CDTs/Map'; my $literal = Attean::Literal->new(value => $t->value, datatype => $ct_type); my $rewritten = AtteanX::Functions::CompositeLists::rewrite_lexical($literal, $bnode_map, $parse_id); my ($t) = $rewritten->sparql_tokens->elements; my $i = Attean::ListIterator->new( values => [$t], item_type => 'AtteanX::SPARQL::Token' ); my $str = decode_utf8($s->serialize_iter_to_bytes($i)); chomp($str); push(@rewritten, $str); $j++; next; } push(@rewritten, blessed($t) ? $t->token_as_string() : "null"); $j++; } my $rewritten = join('', @rewritten); Attean::Literal->new(value => $rewritten, datatype => $term->datatype); }; warn $@ if ($@); return $r || $term; } =item C<< register() >> =cut sub register { Attean->register_datatype_role( "${CDT_BASE}List" => 'AtteanX::Functions::CompositeLists::ListLiteral' ); Attean->register_global_functional_form( "${CDT_BASE}List" => \&listCreate, "${CDT_BASE}listCreate" => \&listCreate, ); Attean->register_global_function( "${CDT_BASE}get" => \&ctGet, "${CDT_BASE}listGet" => \&listGet, "${CDT_BASE}subseq" => \&listSubseq, "${CDT_BASE}size" => \&ctSize, "${CDT_BASE}listSize" => \&listSize, "${CDT_BASE}reverse" => \&listReverse, "${CDT_BASE}head" => \&listHead, "${CDT_BASE}tail" => \&listTail, "${CDT_BASE}contains" => \&listContains, "${CDT_BASE}concat" => \&listConcat, "${CDT_BASE}containsTerm" => \&listContainsTerm, "${CDT_BASE}sequence" => \&sequence, "${CDT_BASE}zip" => \&zip, "${CDT_BASE}split" => \&stringSplit, "${CDT_BASE}list_from_head" => \&list_from_head, ); Attean->register_global_aggregate( "${CDT_BASE}listAgg" => { start => \&listCreate_agg_start, process => \&listCreate_agg_process, finalize => \&listCreate_agg_finalize, }, ); } } package AtteanX::Functions::CompositeLists::ListLiteral { use Scalar::Util qw(blessed looks_like_number); use Moo::Role; use List::Util qw(min); sub equals { my $lhs = shift; my $rhs = shift; # warn "LIST EQUALS?"; # warn "- " . $lhs->as_string . "\n"; # warn "- " . $rhs->as_string . "\n"; return 0 unless ($rhs->does('Attean::API::Literal') and $rhs->datatype->value eq $AtteanX::Functions::CompositeLists::LIST_TYPE_IRI); my $lhs_size = eval { AtteanX::Functions::CompositeLists::listSize(undef, undef, $lhs)->value }; return 0 if ($@); my $rhs_size = eval { AtteanX::Functions::CompositeLists::listSize(undef, undef, $rhs)->value }; return 0 if ($@); return 0 unless ($lhs_size == $rhs_size); my $seen_error = 0; foreach my $i (0 .. $lhs_size-1) { my $li = AtteanX::Functions::CompositeLists::listGet(undef, undef, $lhs, Attean::Literal->integer($i+1)); my $ri = AtteanX::Functions::CompositeLists::listGet(undef, undef, $rhs, Attean::Literal->integer($i+1)); if (not blessed($li) and not blessed($ri)) { # both null next; } elsif (not blessed($li) or not blessed($ri)) { return 0; } if ($li->does('Attean::API::Blank') and $ri->does('Attean::API::Blank')) { if ($li->value eq $ri->value) { next; } else { $seen_error++; next; } } return 0 unless ($li->equals($ri)); } if ($seen_error) { die 'TypeError: Cannot compare cdt:List values with blank nodes'; } return 1; } sub order { my $self = shift; return _compare('order', $self, @_); } sub compare { my $self = shift; return _compare('compare', $self, @_); } sub _compare { my $cmp_method = shift; my $lhs = shift; my $rhs = shift; # warn "LIST-LESS-THAN?"; # warn "- " . $lhs->as_string . "\n"; # warn "- " . $rhs->as_string . "\n"; die 'TypeError' unless (blessed($rhs) and $rhs->does('Attean::API::Literal') and $rhs->datatype->value eq $AtteanX::Functions::CompositeLists::LIST_TYPE_IRI); my @lhs = AtteanX::Functions::CompositeLists::lex_to_list($lhs); my @rhs = AtteanX::Functions::CompositeLists::lex_to_list($rhs); my $lhs_size = scalar(@lhs); my $rhs_size = scalar(@rhs); my $seen_error = 0; my $length = min($lhs_size, $rhs_size); foreach my $i (0 .. $length-1) { my $li = AtteanX::Functions::CompositeLists::listGet(undef, undef, $lhs, Attean::Literal->integer($i+1)); my $ri = AtteanX::Functions::CompositeLists::listGet(undef, undef, $rhs, Attean::Literal->integer($i+1)); if (not blessed($li) and not blessed($ri)) { # both null next; } elsif (not blessed($li)) { if ($cmp_method eq 'order') { return -1; } else { die 'TypeError'; $seen_error++; next; } } elsif (not blessed($ri)) { if ($cmp_method eq 'order') { return 1; } else { die 'TypeError'; $seen_error++; next; } } if ($li->does('Attean::API::Blank') and $ri->does('Attean::API::Blank')) { die 'TypeError'; $seen_error++; next; } my $icmp = $li->$cmp_method($ri); next if ($icmp == 0); return $icmp; } if ($seen_error) { die 'TypeError'; } if ($lhs_size == $rhs_size) { return 0; } else { return ($lhs_size > $rhs_size) ? 1 : -1; } } sub canonicalized_term { my $self = shift; return $self->canonicalized_term_strict(); } sub canonicalized_term_strict { my $self = shift; my @values = AtteanX::Functions::CompositeLists::lex_to_list($self); return AtteanX::Functions::CompositeLists::list_to_lex(@values); } with 'Attean::API::Literal'; with 'Attean::API::CanonicalizingLiteral'; } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/API/PaxHeader/Lexer.pm000644 000765 000024 00000000225 14636707550 021150 xustar00gregstaff000000 000000 30 mtime=1719373672.207378417 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/API/Lexer.pm000644 000765 000024 00000011064 14636707550 017202 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME AtteanX::API::Lexer - Role defining common functionality for lexers. =head1 VERSION This document describes AtteanX::API::Lexer version 0.034 =head1 DESCRIPTION The AtteanX::API::Lexer role provides a common interface and implementation for lexer implementations, allowing line-based buffer filling, and consuming of characters, constant strings, and fixed-length buffers. =head1 ATTRIBUTES =over 4 =item C<< file >> =item C<< linebuffer >> =item C<< line >> =item C<< column >> =item C<< buffer >> =item C<< start_column >> =item C<< start_line >> =back =head1 METHODS =over 4 =cut package AtteanX::API::Lexer 0.034 { use strict; use Types::Standard qw(FileHandle Ref Str Int ArrayRef HashRef ConsumerOf InstanceOf); use Moo::Role; has file => ( is => 'ro', isa => FileHandle, required => 1, ); has linebuffer => ( is => 'rw', isa => Str, default => '', ); has line => ( is => 'rw', isa => Int, default => 1, ); has column => ( is => 'rw', isa => Int, default => 1, ); has buffer => ( is => 'rw', isa => Str, default => '', ); has start_column => ( is => 'rw', isa => Int, default => -1, ); has start_line => ( is => 'rw', isa => Int, default => -1, ); around 'BUILDARGS' => sub { my $orig = shift; my $class = shift; return { file => shift } if (scalar(@_) == 1); return $orig->( $class, @_ ); }; =item C<< fill_buffer >> Fills the buffer with a new line from the underlying filehandle. =cut sub fill_buffer { my $self = shift; unless (length($self->buffer)) { my $line = $self->file->getline; $self->{buffer} .= $line if (defined($line)); } } =item C<< check_for_bom >> Remove a BOM character if one appears at the start of the buffer. =cut sub check_for_bom { my $self = shift; my $c = $self->peek_char(); $self->get_char if (defined($c) and $c eq "\x{FEFF}"); } =item C<< get_char_safe( $char ) >> Consume the single character C<< $char >> from the buffer. Throw an error if C<< $char >> is not at the start of the buffer. =cut sub get_char_safe { my $self = shift; my $char = shift; my $c = $self->get_char; $self->_throw_error("Expected '$char' but got '$c'") if ($c ne $char); return $c; } =item C<< get_char( $char ) >> Consume and return a single character from the buffer. =cut sub get_char { my $self = shift; my $c = substr($self->{buffer}, 0, 1, ''); if ($c eq "\n") { # $self->{linebuffer} = ''; $self->{line} = 1+$self->{line}; $self->{column} = 1; } else { # $self->{linebuffer} .= $c; $self->{column} = 1+$self->{column}; } return $c; } =item C<< peek_char( $char ) >> Return a single character from the start of the buffer. =cut sub peek_char { my $self = shift; if (length($self->{buffer}) == 0) { $self->fill_buffer; return if (length($self->{buffer}) == 0); } return substr($self->{buffer}, 0, 1); } =item C<< read_word( $word ) >> Consume the string C<< $word >> from the start of the buffer. Throw an error if C<< $word >> is not at the start of the buffer. =cut sub read_word { my $self = shift; my $word = shift; $self->fill_buffer while (length($self->{buffer}) < length($word)); $self->_throw_error("Expected '$word'") if (substr($self->{buffer}, 0, length($word)) ne $word); my $lines = ($word =~ tr/\n//); my $lastnl = rindex($word, "\n"); my $cols = length($word) - $lastnl - 1; $self->{lines} += $lines; if ($lines) { $self->{column} = $cols; } else { $self->{column} += $cols; } substr($self->{buffer}, 0, length($word), ''); } =item C<< read_length( $length ) >> Consume and return C<< $length >> characters from the start of the buffer. =cut sub read_length { my $self = shift; my $len = shift; while (length($self->{buffer}) < $len) { my $curlen = length($self->{buffer}); $self->fill_buffer; last if (length($self->{buffer}) == $curlen); } my $word = substr($self->{buffer}, 0, $len, ''); my $lines = ($word =~ tr/\n//); my $lastnl = rindex($word, "\n"); my $cols = length($word) - $lastnl - 1; $self->{lines} += $lines; if ($lines) { $self->{column} = $cols; } else { $self->{column} += $cols; } return $word; } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/API/PaxHeader/JoinRotatingPlanner.pm000644 000765 000024 00000000225 14636707550 024020 xustar00gregstaff000000 000000 30 mtime=1719373672.191192641 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/API/JoinRotatingPlanner.pm000644 000765 000024 00000006142 14636707550 022053 0ustar00gregstaff000000 000000 use v5.14; use warnings; =encoding utf8 =head1 NAME AtteanX::API::JoinRotatingPlanner - Query planning role to produce alternative join plans =head1 VERSION This document describes AtteanX::API::JoinRotatingPlanner version 0.034 =head1 DESCRIPTION The AtteanX::API::JoinRotatingPlanner role, when used with L, produces alternatives for join query plans. Specifically, joins of the form (A⋈B)⋈C are rotated to A⋈(B⋈C), with the ability to coalesce B⋈C (e.g. for adjacent BGPs). =head1 REQUIRED METHODS =over 4 =item C<< allow_join_rotation( $join_plan ) >> Returns true if join rotation should be attempted on the given join plan. =item C<< coalesce_rotated_join( $join_plan ) >> Given a L plan C<< $join_plan >>, returns a list of equivalent plans. This is useful when the join can be reduced to a more fundamental plan type, such as merging two adjacent BGP plans into a single plan. =cut package AtteanX::API::JoinRotatingPlanner 0.034 { # Rotate joins like (A⋈B)⋈C to A⋈(B⋈C), with the ability to coalesce B⋈C (e.g. for adjacent BGPs) use Attean; use Attean::RDF; use Moo::Role; requires 'coalesce_rotated_join'; requires 'allow_join_rotation'; sub allow_join_rotation { return 1; } sub coalesce_rotated_join { my $self = shift; my $plan = shift; return $plan; } around 'join_plans' => sub { my $orig = shift; my $self = shift; my $model = shift; my $active_graphs = shift; my $default_graphs = shift; my $lplans = shift; my $rplans = shift; my $type = shift; my @plans = $orig->($self, $model, $active_graphs, $default_graphs, $lplans, $rplans, $type, @_); if ($type eq 'inner') { my @rotated; foreach my $p (@plans) { if ($self->allow_join_rotation($p)) { my ($lhs, $rhs) = @{ $p->children }; if ($lhs->does('Attean::API::Plan::Join')) { my ($a, $b) = @{ $lhs->children }; my $c = $rhs; # (A⋈B)⋈C -> A⋈(B⋈C) foreach my $q ($orig->($self, $model, $active_graphs, $default_graphs, [$b], [$c], $type, @_)) { push(@rotated, $orig->($self, $model, $active_graphs, $default_graphs, [$a], [$self->coalesce_rotated_join($q)], $type, @_)) } } elsif ($rhs->does('Attean::API::Plan::Join')) { my $a = $lhs; my ($b, $c) = @{ $rhs->children }; # A⋈(B⋈C) -> (A⋈B)⋈C foreach my $q ($orig->($self, $model, $active_graphs, $default_graphs, [$a], [$b], $type, @_)) { push(@rotated, $orig->($self, $model, $active_graphs, $default_graphs, [$self->coalesce_rotated_join($q)], [$c], $type, @_)); } } } push(@rotated, $p); } return @rotated; } else { return @plans; } }; } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Parser/PaxHeader/SPARQL.pm000644 000765 000024 00000000225 14636707626 021722 xustar00gregstaff000000 000000 30 mtime=1719373718.087443855 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Parser/SPARQL.pm000644 000765 000024 00000330551 14636707626 017761 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME AtteanX::Parser::SPARQL - SPARQL 1.1 Parser. =head1 VERSION This document describes AtteanX::Parser::SPARQL version 0.034. =head1 SYNOPSIS use AtteanX::Parser::SPARQL; my $algbrea = AtteanX::Parser::SPARQL->parse($sparql); # or: my $parser = AtteanX::Parser::SPARQL->new(); my ($algebra) = $parser->parse_list_from_bytes($sparql); # or to allow parsing of SPARQL 1.1 Updates: my $algbrea = AtteanX::Parser::SPARQL->parse_update($sparql); # or: my $parser = AtteanX::Parser::SPARQL->new(update => 1); my ($algebra) = $parser->parse_list_from_bytes($sparql); =head1 DESCRIPTION This module implements a recursive-descent parser for SPARQL 1.1 using the L tokenizer. Successful parsing results in an object whose type is one of: L, L, or L. =head1 ROLES This class consumes L, L, and L. =head1 ATTRIBUTES =over 4 =item C<< canonical_media_type >> =item C<< media_types >> =item C<< file_extensions >> =item C<< handled_type >> =item C<< lexer >> =item C<< args >> =item C<< build >> =item C<< update >> =item C<< namespaces >> =item C<< baseURI >> =item C<< filters >> =back =head1 METHODS =over 4 =cut package AtteanX::Parser::SPARQL 0.034; use strict; use warnings; no warnings 'redefine'; use Carp qw(cluck confess croak); use Attean; use Data::Dumper; use URI::NamespaceMap; use List::MoreUtils qw(zip); use AtteanX::Parser::SPARQLLex; use AtteanX::SPARQL::Constants; use Types::Standard qw(ConsumerOf InstanceOf HashRef ArrayRef Bool Str Int); use Scalar::Util qw(blessed looks_like_number reftype refaddr); ###################################################################### use Moo; has 'lexer' => (is => 'rw', isa => InstanceOf['AtteanX::Parser::SPARQLLex::Iterator']); has 'args' => (is => 'ro', isa => HashRef); has 'build' => (is => 'rw', isa => HashRef); has 'update' => (is => 'rw', isa => Bool); has 'baseURI' => (is => 'rw'); has '_stack' => (is => 'rw', isa => ArrayRef); has 'filters' => (is => 'rw', isa => ArrayRef); has 'counter' => (is => 'rw', isa => Int, default => 0); has '_pattern_container_stack' => (is => 'rw', isa => ArrayRef); has 'blank_nodes' => (is => 'ro', isa => HashRef[ConsumerOf['Attean::API::Blank']], predicate => 'has_blank_nodes_map', default => sub { +{} }); sub file_extensions { return [qw(rq ru)] } sub canonical_media_type { return "application/sparql-query" } sub media_types { return [qw(application/sparql-query application/sparql-update)]; } sub handled_type { state $ITEM_TYPE = Type::Tiny::Role->new(role => 'Attean::API::Algebra'); return $ITEM_TYPE; } with 'Attean::API::AtOnceParser', 'Attean::API::Parser', 'Attean::API::AbbreviatingParser'; with 'Attean::API::CDTBlankNodeMappingParser'; with 'MooX::Log::Any'; sub BUILDARGS { my $class = shift; my %args = @_; my $ns = delete $args{namespaces} // URI::NamespaceMap->new(); my %a = (args => \%args, namespaces => $ns); if (my $handler = delete $args{handler}) { $a{handler} = $handler; } return \%a; } ################################################################################ sub _configure_lexer { my $self = shift; my $l = shift; $l->add_regex_rule( qr/RANK/, KEYWORD, sub { return uc(shift) } ); return $l; } =item C<< parse ( $sparql ) >> Parse the C<< $sparql >> query string and return the resulting L object. =cut sub parse { my $self = shift; my $parser = ref($self) ? $self : $self->new(); my ($algebra) = $parser->parse_list_from_bytes(@_); return $algebra; } =item C<< parse_update ( $sparql ) >> Parse the C<< $sparql >> update string and return the resulting L object. =cut sub parse_update { my $self = shift; my $parser = ref($self) ? $self : $self->new(); $parser->update(1); my ($algebra) = $parser->parse_list_from_bytes(@_); return $algebra; } =item C<< parse_list_from_io( $fh ) >> =cut sub parse_list_from_io { my $self = shift; my $p = AtteanX::Parser::SPARQLLex->new(); my $l = $self->_configure_lexer( $p->parse_iter_from_io(@_) ); $self->lexer($l); $self->baseURI($self->{args}{base}); my $q = $self->_parse(); return unless (ref($q)); my $a = $q->{triples}[0]; return unless (ref($a)); return $a; } =item C<< parse_list_from_bytes( $bytes ) >> =cut sub parse_list_from_bytes { my $self = shift; my $p = AtteanX::Parser::SPARQLLex->new(); my $l = $self->_configure_lexer( $p->parse_iter_from_bytes(@_) ); $self->lexer($l); $self->baseURI($self->{args}{base}); my $q = $self->_parse(); return unless (ref($q)); my $a = $q->{triples}[0]; return unless (ref($a)); return $a; } =item C<< parse_nodes ( $string ) >> Returns a list of L or L objects, parsed in SPARQL syntax from the supplied C<< $string >>. Parsing is ended either upon seeing a DOT, or reaching the end of the string. =cut sub parse_nodes { my $self = shift; my $p = AtteanX::Parser::SPARQLLex->new(); my $bytes = shift; my %args = @_; my $commas = $args{'commas'} || 0; my $l = $self->_configure_lexer( $p->parse_iter_from_bytes($bytes) ); $self->lexer($l); $self->baseURI($self->{args}{base}); $self->build({base => $self->baseURI}); my @nodes; while ($self->_peek_token) { if ($self->_Verb_test) { $self->_Verb; } else { $self->_GraphNode; } if ($commas) { $self->_optional_token(COMMA); } push(@nodes, splice(@{ $self->{_stack} })); if ($self->_test_token(DOT)) { $self->log->notice('DOT seen in string, stopping here'); last; } } return @nodes; } sub _parse { my $self = shift; unless ($self->update) { my $t = $self->lexer->peek; unless (defined($t)) { confess "No query string found to parse"; } } $self->_stack([]); $self->filters([]); $self->_pattern_container_stack([]); my $triples = $self->_push_pattern_container(); my $build = { sources => [], triples => $triples }; $self->build($build); if ($self->baseURI) { $build->{base} = $self->baseURI; } $self->_RW_Query(); delete $build->{star}; my $data = $build; return $data; } ################################################################################ # [1] Query ::= Prologue ( SelectQuery | ConstructQuery | DescribeQuery | AskQuery | LoadUpdate ) sub _RW_Query { my $self = shift; $self->_Prologue; my $read_query = 0; my $update = 0; while (1) { if ($self->_optional_token(KEYWORD, 'SELECT')) { $self->_SelectQuery(); $read_query++; } elsif ($self->_optional_token(KEYWORD, 'CONSTRUCT')) { $self->_ConstructQuery(); $read_query++; } elsif ($self->_optional_token(KEYWORD, 'DESCRIBE')) { $self->_DescribeQuery(); $read_query++; } elsif ($self->_optional_token(KEYWORD, 'ASK')) { $self->_AskQuery(); $read_query++; } elsif ($self->_test_token(KEYWORD, 'CREATE')) { unless ($self->update) { croak "CREATE GRAPH update forbidden in read-only queries"; } $update++; $self->_CreateGraph(); } elsif ($self->_test_token(KEYWORD, 'DROP')) { unless ($self->update) { croak "DROP GRAPH update forbidden in read-only queries"; } $update++; $self->_DropGraph(); } elsif ($self->_test_token(KEYWORD, 'LOAD')) { unless ($self->update) { croak "LOAD update forbidden in read-only queries" } $update++; $self->_LoadUpdate(); } elsif ($self->_test_token(KEYWORD, 'CLEAR')) { unless ($self->update) { croak "CLEAR GRAPH update forbidden in read-only queries"; } $update++; $self->_ClearGraphUpdate(); } elsif ($self->_test_token(KEYWORD, qr/^(WITH|INSERT|DELETE)/)) { unless ($self->update) { croak "INSERT/DELETE update forbidden in read-only queries"; } $update++; my ($graph); if ($self->_optional_token(KEYWORD, 'WITH')) { $self->{build}{custom_update_dataset} = 1; $self->_IRIref; ($graph) = splice( @{ $self->{_stack} } ); } if ($self->_optional_token(KEYWORD, 'INSERT')) { if ($self->_optional_token(KEYWORD, 'DATA')) { unless ($self->update) { croak "INSERT DATA update forbidden in read-only queries"; } $self->_InsertDataUpdate(); } else { $self->_InsertUpdate($graph); } } elsif ($self->_optional_token(KEYWORD, 'DELETE')) { if ($self->_optional_token(KEYWORD, 'DATA')) { unless ($self->update) { croak "DELETE DATA update forbidden in read-only queries"; } $self->_DeleteDataUpdate(); } else { $self->_DeleteUpdate($graph); } } } elsif ($self->_test_token(KEYWORD, 'COPY')) { $update++; $self->_AddCopyMoveUpdate('COPY'); } elsif ($self->_test_token(KEYWORD, 'MOVE')) { $update++; $self->_AddCopyMoveUpdate('MOVE'); } elsif ($self->_test_token(KEYWORD, 'ADD')) { $update++; $self->_AddCopyMoveUpdate('ADD'); } elsif ($self->_test_token(SEMICOLON)) { $self->_expected_token(SEMICOLON); next if ($self->_Query_test); last; } else { if ($self->update and not $self->_peek_token) { last; } my $t = $self->_peek_token; return $self->_token_error($t, 'Expected query type'); } last if ($read_query); if ($self->_optional_token(SEMICOLON)) { if ($self->_Query_test) { next; } } last; } my $count = scalar(@{ $self->{build}{triples} }); my $t = $self->_peek_token; if ($t) { my $type = AtteanX::SPARQL::Constants::decrypt_constant($t->type); croak "Syntax error: Remaining input after query: $type " . Dumper($t->args); } if ($count == 0 or $count > 1) { my @patterns = splice(@{ $self->{build}{triples} }); my %seen; foreach my $p (@patterns) { my @blanks = $p->blank_nodes; foreach my $b (@blanks) { if ($seen{$b->value}++) { croak "Cannot re-use a blank node label in multiple update operations in a single request"; } } } my $pattern = Attean::Algebra::Sequence->new( children => \@patterns ); $self->_check_duplicate_blanks($pattern); $self->{build}{triples} = [ $pattern ]; } my %dataset; foreach my $s (@{ $self->{build}{sources} }) { my ($iri, $group) = @$s; if ($group eq 'NAMED') { push(@{ $dataset{named} }, $iri ); } else { push(@{ $dataset{default} }, $iri ); } } my $algebra = $self->{build}{triples}[0]; if ($update) { $self->{build}{triples}[0] = Attean::Algebra::Update->new( children => [$algebra] ); } else { $self->{build}{triples}[0] = Attean::Algebra::Query->new( children => [$algebra], dataset => \%dataset ); } } sub _Query_test { my $self = shift; return ($self->_test_token(KEYWORD, qr/^(SELECT|CONSTRUCT|DESCRIBE|ASK|LOAD|CLEAR|DROP|ADD|MOVE|COPY|CREATE|INSERT|DELETE|WITH)/i)); } # [2] Prologue ::= BaseDecl? PrefixDecl* # [3] BaseDecl ::= 'BASE' IRI_REF # [4] PrefixDecl ::= 'PREFIX' PNAME_NS IRI_REF sub _Prologue { my $self = shift; my $base; my @base; if ($self->_optional_token(KEYWORD, 'BASE')) { my $iriref = $self->_expected_token(IRI); my $iri = $iriref->value; $base = $self->new_iri( value => $iri ); @base = $base; $self->{base} = $base; } my %namespaces; while ($self->_optional_token(KEYWORD, 'PREFIX')) { my $prefix = $self->_expected_token(PREFIXNAME); my @args = @{ $prefix->args }; if (scalar(@args) > 1) { croak "Syntax error: PREFIX namespace used a full PNAME_LN, not a PNAME_NS"; } my $ns = substr($prefix->value, 0, length($prefix->value) - 1); my $iriref = $self->_expected_token(IRI); my $iri = $iriref->value; if (@base) { my $r = $self->new_iri( value => $iri, base => shift(@base) ); $iri = $r->value; } $namespaces{ $ns } = $iri; $self->namespaces->add_mapping($ns, $iri); } $self->{build}{namespaces} = \%namespaces; $self->{build}{base} = $base if (defined($base)); # push(@data, (base => $base)) if (defined($base)); # return @data; } sub _InsertDataUpdate { my $self = shift; $self->_expected_token(LBRACE); local($self->{__data_pattern}) = 1; my @triples = $self->_ModifyTemplate(); $self->_expected_token(RBRACE); my $insert = Attean::Algebra::Modify->new(insert => \@triples); $self->_add_patterns( $insert ); $self->{build}{method} = 'UPDATE'; } sub _DeleteDataUpdate { my $self = shift; $self->_expected_token(LBRACE); local($self->{__data_pattern}) = 1; local($self->{__no_bnodes}) = "DELETE DATA block"; my @triples = $self->_ModifyTemplate(); $self->_expected_token(RBRACE); my $delete = Attean::Algebra::Modify->new(delete => \@triples); $self->_add_patterns( $delete ); $self->{build}{method} = 'UPDATE'; } sub _InsertUpdate { my $self = shift; my $graph = shift; $self->_expected_token(LBRACE); my @triples = $self->_ModifyTemplate(); $self->_expected_token(RBRACE); if ($graph) { @triples = map { $_->as_quad_pattern($graph) } @triples; } my %dataset; while ($self->_optional_token(KEYWORD, 'USING')) { $self->{build}{custom_update_dataset} = 1; my $named = 0; if ($self->_optional_token(KEYWORD, 'NAMED')) { $named = 1; } $self->_IRIref; my ($iri) = splice( @{ $self->{_stack} } ); if ($named) { $dataset{named}{$iri->value} = $iri; } else { push(@{ $dataset{default} }, $iri ); } } $self->_expected_token(KEYWORD, 'WHERE'); if ($graph) { $self->_GroupGraphPattern; my $ggp = $self->_remove_pattern; $ggp = Attean::Algebra::Graph->new( children => [$ggp], graph => $graph ); $self->_add_patterns( $ggp ); } else { $self->_GroupGraphPattern; } my $ggp = $self->_remove_pattern; my @triples_with_fresh_bnodes = $self->_statements_with_fresh_bnodes(@triples); my $insert = Attean::Algebra::Modify->new( children => [$ggp], insert => \@triples_with_fresh_bnodes, dataset => \%dataset ); $self->_add_patterns( $insert ); $self->{build}{method} = 'UPDATE'; } sub _statements_with_fresh_bnodes { my $self = shift; my @triples = @_; my %fresh_blank_map; my @triples_with_fresh_bnodes; foreach my $t (@triples) { my @pos = ref($t)->variables; if ($t->has_blanks) { my @terms; foreach my $term ($t->values) { if ($term->does('Attean::API::Blank')) { if (my $b = $fresh_blank_map{$term->value}) { push(@terms, $b); } else { my $id = $self->counter; $self->counter($id+1); my $name = ".b-$id"; my $b = Attean::Blank->new($name); push(@terms, $b); $fresh_blank_map{$term->value} = $b; } } else { push(@terms, $term); } } push(@triples_with_fresh_bnodes, ref($t)->new(zip @pos, @terms)); } else { push(@triples_with_fresh_bnodes, $t); } } return @triples_with_fresh_bnodes; } sub _DeleteUpdate { my $self = shift; my $graph = shift; my %dataset; if ($self->_optional_token(KEYWORD, 'WHERE')) { if ($graph) { croak "Syntax error: WITH clause cannot be used with DELETE WHERE operations"; } $self->_expected_token(LBRACE); my @st = $self->_ModifyTemplate(); $self->_expected_token(RBRACE); my @patterns; my @triples; my @quads; my @blanks = grep { $_->does('Attean::API::Blank') } map { $_->values } @st; if (scalar(@blanks) > 0) { croak "Cannot use blank nodes in a DELETE pattern"; } foreach my $s (@st) { if ($s->does('Attean::API::QuadPattern')) { push(@quads, $s); my $tp = $s->as_triple_pattern; my $bgp = Attean::Algebra::BGP->new( triples => [$tp] ); push(@patterns, Attean::Algebra::Graph->new( graph => $s->graph, children => [$bgp] )); } else { push(@triples, $s); } } push(@patterns, Attean::Algebra::BGP->new( triples => \@triples )); my $ggp = Attean::Algebra::Join->new( children => \@patterns ); my $update = Attean::Algebra::Modify->new( children => [$ggp], delete => [@st]); $self->_add_patterns( $update ); $self->{build}{method} = 'UPDATE'; return; } else { my @delete_triples; { local($self->{__no_bnodes}) = "DELETE block"; $self->_expected_token(LBRACE); @delete_triples = $self->_ModifyTemplate( $graph ); $self->_expected_token(RBRACE); } my @insert_triples; if ($self->_optional_token(KEYWORD, 'INSERT')) { $self->_expected_token(LBRACE); @insert_triples = $self->_ModifyTemplate( $graph ); @insert_triples = $self->_statements_with_fresh_bnodes(@insert_triples); $self->_expected_token(RBRACE); } if ($graph) { @insert_triples = map { $_->does('Attean::API::QuadPattern') ? $_ : $_->as_quad_pattern($graph) } @insert_triples; @delete_triples = map { $_->does('Attean::API::QuadPattern') ? $_ : $_->as_quad_pattern($graph) } @delete_triples; } while ($self->_optional_token(KEYWORD, 'USING')) { $self->{build}{custom_update_dataset} = 1; my $named = 0; if ($self->_optional_token(KEYWORD, 'NAMED')) { $named = 1; } $self->_IRIref; my ($iri) = splice( @{ $self->{_stack} } ); if ($named) { $dataset{named}{$iri->value} = $iri; } else { push(@{ $dataset{default} }, $iri ); } } $self->_expected_token(KEYWORD, 'WHERE'); if ($graph) { $self->_GroupGraphPattern; delete $self->{__no_bnodes}; my $ggp = $self->_remove_pattern; $ggp = Attean::Algebra::Graph->new( children => [$ggp], graph => $graph ); $self->_add_patterns( $ggp ); } else { $self->_GroupGraphPattern; delete $self->{__no_bnodes}; } my $ggp = $self->_remove_pattern; my %args = (children => [$ggp], dataset => \%dataset); if (scalar(@insert_triples)) { $args{insert} = \@insert_triples; } if (scalar(@delete_triples)) { $args{delete} = \@delete_triples; my @blanks = grep { $_->does('Attean::API::Blank') } map { $_->values } @delete_triples; if (scalar(@blanks) > 0) { croak "Cannot use blank nodes in a DELETE pattern"; } } my $update = Attean::Algebra::Modify->new( %args ); $self->_add_patterns( $update ); $self->{build}{method} = 'UPDATE'; } } sub _ModifyTemplate_test { my $self = shift; return 1 if ($self->_TriplesBlock_test); return 1 if ($self->_test_token(KEYWORD, 'GRAPH')); return 0; } sub _ModifyTemplate { my $self = shift; my $graph = shift; my @triples; while ($self->_ModifyTemplate_test) { push(@triples, $self->__ModifyTemplate( $graph )); } return @triples; } sub __ModifyTemplate { my $self = shift; my $graph = shift; local($self->{_modify_template}) = 1; if ($self->_TriplesBlock_test) { $self->_push_pattern_container; $self->_TriplesBlock; (my $cont, undef) = $self->_pop_pattern_container; # ignore hints in a modify template my ($bgp) = @{ $cont }; my @triples = @{ $bgp->triples }; if ($graph) { @triples = map { $_->as_quad_pattern($graph) } @triples; } return @triples; } else { $self->_GraphGraphPattern; { my (@d) = splice(@{ $self->{_stack} }); $self->__handle_GraphPatternNotTriples( @d ); } my $data = $self->_remove_pattern; my $graph = $data->graph; my @bgps = $data->subpatterns_of_type('Attean::Algebra::BGP'); my @triples = map { $_->as_quad_pattern($graph) } map { @{ $_->triples } } @bgps; return @triples; } } sub _LoadUpdate { my $self = shift; $self->_expected_token(KEYWORD, 'LOAD'); my $silent = $self->_optional_token(KEYWORD, 'SILENT') ? 1 : 0; $self->_IRIref; my ($iri) = splice( @{ $self->{_stack} } ); if ($self->_optional_token(KEYWORD, 'INTO')) { $self->_expected_token(KEYWORD, 'GRAPH'); $self->_IRIref; my ($graph) = splice( @{ $self->{_stack} } ); my $pat = Attean::Algebra::Load->new( silent => $silent, url => $iri, graph => $graph ); $self->_add_patterns( $pat ); } else { my $pat = Attean::Algebra::Load->new( silent => $silent, url => $iri ); $self->_add_patterns( $pat ); } $self->{build}{method} = 'LOAD'; } sub _CreateGraph { my $self = shift; $self->_expected_token(KEYWORD, 'CREATE'); my $silent = $self->_optional_token(KEYWORD, 'SILENT') ? 1 : 0; $self->_expected_token(KEYWORD, 'GRAPH'); $self->_IRIref; my ($graph) = splice( @{ $self->{_stack} } ); my $pat = Attean::Algebra::Create->new( silent => $silent, graph => $graph ); $self->_add_patterns( $pat ); $self->{build}{method} = 'CREATE'; } sub _ClearGraphUpdate { my $self = shift; $self->_expected_token(KEYWORD, 'CLEAR'); my $silent = $self->_optional_token(KEYWORD, 'SILENT') ? 1 : 0; if ($self->_optional_token(KEYWORD, 'GRAPH')) { $self->_IRIref; my ($graph) = splice( @{ $self->{_stack} } ); my $pat = Attean::Algebra::Clear->new(silent => $silent, target => 'GRAPH', graph => $graph); $self->_add_patterns( $pat ); } elsif ($self->_optional_token(KEYWORD, 'DEFAULT')) { my $pat = Attean::Algebra::Clear->new(silent => $silent, target => 'DEFAULT'); $self->_add_patterns( $pat ); } elsif ($self->_optional_token(KEYWORD, 'NAMED')) { my $pat = Attean::Algebra::Clear->new(silent => $silent, target => 'NAMED'); $self->_add_patterns( $pat ); } elsif ($self->_optional_token(KEYWORD, 'ALL')) { my $pat = Attean::Algebra::Clear->new(silent => $silent, target => 'ALL'); $self->_add_patterns( $pat ); } $self->{build}{method} = 'CLEAR'; } sub _DropGraph { my $self = shift; $self->_expected_token(KEYWORD, 'DROP'); my $silent = $self->_optional_token(KEYWORD, 'SILENT') ? 1 : 0; if ($self->_optional_token(KEYWORD, 'GRAPH')) { $self->_IRIref; my ($graph) = splice( @{ $self->{_stack} } ); my $pat = Attean::Algebra::Clear->new(drop => 1, silent => $silent, target => 'GRAPH', graph => $graph); $self->_add_patterns( $pat ); } elsif ($self->_optional_token(KEYWORD, 'DEFAULT')) { my $pat = Attean::Algebra::Clear->new(drop => 1, silent => $silent, target => 'DEFAULT'); $self->_add_patterns( $pat ); } elsif ($self->_optional_token(KEYWORD, 'NAMED')) { my $pat = Attean::Algebra::Clear->new(drop => 1, silent => $silent, target => 'NAMED'); $self->_add_patterns( $pat ); } elsif ($self->_optional_token(KEYWORD, 'ALL')) { my $pat = Attean::Algebra::Clear->new(drop => 1, silent => $silent, target => 'ALL'); $self->_add_patterns( $pat ); } $self->{build}{method} = 'CLEAR'; } sub __graph { my $self = shift; if ($self->_optional_token(KEYWORD, 'DEFAULT')) { return; } else { $self->_optional_token(KEYWORD, 'GRAPH'); $self->_IRIref; my ($g) = splice( @{ $self->{_stack} } ); return $g; } } sub _AddCopyMoveUpdate { my $self = shift; my $op = shift; $self->_expected_token(KEYWORD, $op); my $silent = $self->_optional_token(KEYWORD, 'SILENT') ? 1 : 0; my %args = (silent => $silent); if ($op eq 'COPY') { $args{drop_destination} =1; } elsif ($op eq 'MOVE') { $args{drop_destination} = 1; $args{drop_source} = 1; } if (my $from = $self->__graph()) { $args{source} = $from; } $self->_expected_token(KEYWORD, 'TO'); if (my $to = $self->__graph()) { $args{destination} = $to; } my $pattern = Attean::Algebra::Add->new( %args ); $self->_add_patterns( $pattern ); $self->{build}{method} = 'UPDATE'; } # [5] SelectQuery ::= 'SELECT' ( 'DISTINCT' | 'REDUCED' )? ( Var+ | '*' ) DatasetClause* WhereClause SolutionModifier sub _SelectQuery { my $self = shift; if ($self->_optional_token(KEYWORD, qr/^(DISTINCT)/)) { $self->{build}{options}{distinct} = 1; } elsif ($self->_optional_token(KEYWORD, qr/^(REDUCED)/)) { $self->{build}{options}{distinct} = 2; } my ($star, $exprs, $vars) = $self->__SelectVars; my @exprs = @$exprs; $self->_DatasetClause(); $self->_WhereClause; $self->_SolutionModifier($vars); if ($self->_optional_token(KEYWORD, 'VALUES')) { my @vars; # $self->_Var; # push( @vars, splice(@{ $self->{_stack} })); my $parens = 0; if ($self->_optional_token(NIL)) { $parens = 1; } else { if ($self->_optional_token(LPAREN)) { $parens = 1; } while ($self->_test_token(VAR)) { $self->_Var; push( @vars, splice(@{ $self->{_stack} })); } if ($parens) { $self->_expected_token(RPAREN); } } my $count = scalar(@vars); if (not($parens) and $count == 0) { croak "Syntax error: Expected VAR in inline data declaration"; } elsif (not($parens) and $count > 1) { croak "Syntax error: Inline data declaration can only have one variable when parens are omitted"; } my $short = (not($parens) and $count == 1); $self->_expected_token(LBRACE); if ($self->_optional_token(NIL)) { } else { if (not($short) or ($short and $self->_test_token(LPAREN))) { while ($self->_test_token(LPAREN)) { my $terms = $self->_Binding($count); push( @{ $self->{build}{bindings}{terms} }, $terms ); } } else { while ($self->_BindingValue_test) { $self->_BindingValue; my ($term) = splice(@{ $self->{_stack} }); push( @{ $self->{build}{bindings}{terms} }, [$term] ); } } } $self->_expected_token(RBRACE); my $bindings = delete $self->{build}{bindings}; my @rows = @{ $bindings->{terms} || [] }; my @vbs; foreach my $r (@rows) { my %d; foreach my $i (0 .. $#{ $r }) { if (blessed($r->[$i])) { $d{ $vars[$i]->value } = $r->[$i]; } } my $r = Attean::Result->new(bindings => \%d); push(@vbs, $r); } my $table = Attean::Algebra::Table->new( variables => \@vars, rows => \@vbs ); my $pattern = pop(@{ $self->{build}{triples} }); push(@{ $self->{build}{triples} }, $self->_new_join($pattern, $table)); } my %projected = map { $_ => 1 } $self->__solution_modifiers( $star, @exprs ); delete $self->{build}{options}; $self->{build}{method} = 'SELECT'; } sub __SelectVars { my $self = shift; my $star = 0; my @vars; my $count = 0; my @exprs; while ($self->_test_token(STAR) or $self->__SelectVar_test) { if ($self->_test_token(STAR)) { $self->{build}{star}++; $self->_expected_token(STAR); $star = 1; $count++; last; } else { my @s = $self->__SelectVar; if (scalar(@s) > 1) { my ($var, $expr) = @s; push(@exprs, $var->value, $expr); } else { my $var = $s[0]; push(@exprs, $var->value, $var); } push(@vars, shift(@s)); $count++; } } my %seen; foreach my $v (@vars) { if ($v->does('Attean::API::Variable')) { my $name = $v->value; if ($seen{ $name }++) { croak "Syntax error: Repeated variable ($name) used in projection list"; } } } $self->{build}{variables} = \@vars; if ($count == 0) { croak "Syntax error: No select variable or expression specified"; } return $star, \@exprs, \@vars; } sub _BrackettedAliasExpression { my $self = shift; my $allow_multiple_vars = shift || 0; $self->_expected_token(LPAREN); $self->_Expression; my ($expr) = splice(@{ $self->{_stack} }); $self->_expected_token(KEYWORD, 'AS'); $self->_Var; my ($var) = splice(@{ $self->{_stack} }); if ($allow_multiple_vars) { my @vars = ($var); while ($self->_optional_token(COMMA)) { $self->_Var; push( @vars, splice(@{ $self->{_stack} })); } $self->_expected_token(RPAREN); return (\@vars, $expr); } else { $self->_expected_token(RPAREN); return ($var, $expr); } } sub __SelectVar_test { my $self = shift; local($self->{__aggregate_call_ok}) = 1; # return 1 if $self->_BuiltInCall_test; return 1 if $self->_test_token(LPAREN); return $self->_test_token(VAR); } sub __SelectVar { my $self = shift; local($self->{__aggregate_call_ok}) = 1; if ($self->_test_token(LPAREN)) { my ($var, $expr) = $self->_BrackettedAliasExpression; return ($var, $expr); } else { $self->_Var; my ($var) = splice(@{ $self->{_stack} }); return $var; } } # [6] ConstructQuery ::= 'CONSTRUCT' ConstructTemplate DatasetClause* WhereClause SolutionModifier sub _ConstructQuery { my $self = shift; my $shortcut = 1; if ($self->_test_token(LBRACE)) { $shortcut = 0; $self->_ConstructTemplate; } $self->_DatasetClause(); if ($shortcut) { $self->_TriplesWhereClause; } else { $self->_WhereClause; } $self->_SolutionModifier(); my $pattern = $self->{build}{triples}[0]; my $triples = delete $self->{build}{construct_triples}; if (blessed($triples) and $triples->isa('Attean::Algebra::BGP')) { $triples = $triples->triples; } # my @triples; # warn $triples; # foreach my $t (@{ $triples // [] }) { # if ($t->isa('Attean::Algebra::BGP')) { # push(@triples, @{ $t->triples }); # } else { # push(@triples, $t); # } # } my $construct = Attean::Algebra::Construct->new( children => [$pattern], triples => $triples ); $self->{build}{triples}[0] = $construct; $self->{build}{method} = 'CONSTRUCT'; } # [7] DescribeQuery ::= 'DESCRIBE' ( VarOrIRIref+ | '*' ) DatasetClause* WhereClause? SolutionModifier sub _DescribeQuery { my $self = shift; my $star = 0; if ($self->_optional_token(STAR)) { $star = 1; $self->{build}{variables} = ['*']; } else { $self->_VarOrIRIref; while ($self->_VarOrIRIref_test) { $self->_VarOrIRIref; } $self->{build}{variables} = [ splice(@{ $self->{_stack} }) ]; } $self->_DatasetClause(); if ($self->_WhereClause_test) { $self->_WhereClause; } else { my $pattern = Attean::Algebra::BGP->new(); $self->_add_patterns( $pattern ); } $self->_SolutionModifier(); $self->{build}{method} = 'DESCRIBE'; my $pattern = $self->{build}{triples}[0]; my $terms = $star ? [map { Attean::Variable->new($_) } $pattern->in_scope_variables] : $self->{build}{variables}; $self->{build}{triples}[0] = Attean::Algebra::Describe->new( terms => $terms, children => [$pattern] ); } # [8] AskQuery ::= 'ASK' DatasetClause* WhereClause sub _AskQuery { my $self = shift; $self->_DatasetClause(); $self->_WhereClause; $self->{build}{variables} = []; $self->{build}{method} = 'ASK'; my $pattern = $self->{build}{triples}[0]; $self->{build}{triples}[0] = Attean::Algebra::Ask->new( children => [$pattern] ); } # sub _DatasetClause_test { # my $self = shift; # return $self->_test_token(KEYWORD, 'FROM'); # } # [9] DatasetClause ::= 'FROM' ( DefaultGraphClause | NamedGraphClause ) sub _DatasetClause { my $self = shift; # my @dataset; $self->{build}{sources} = []; while ($self->_optional_token(KEYWORD, 'FROM')) { if ($self->_test_token(KEYWORD, 'NAMED')) { $self->_NamedGraphClause; } else { $self->_DefaultGraphClause; } } } # [10] DefaultGraphClause ::= SourceSelector sub _DefaultGraphClause { my $self = shift; $self->_SourceSelector; my ($source) = splice(@{ $self->{_stack} }); push( @{ $self->{build}{sources} }, [$source, 'DEFAULT'] ); } # [11] NamedGraphClause ::= 'NAMED' SourceSelector sub _NamedGraphClause { my $self = shift; $self->_expected_token(KEYWORD, 'NAMED'); $self->_SourceSelector; my ($source) = splice(@{ $self->{_stack} }); push( @{ $self->{build}{sources} }, [$source, 'NAMED'] ); } # [12] SourceSelector ::= IRIref sub _SourceSelector { my $self = shift; $self->_IRIref; } # [13] WhereClause ::= 'WHERE'? GroupGraphPattern sub _WhereClause_test { my $self = shift; return 1 if ($self->_test_token(KEYWORD, 'WHERE')); return 1 if ($self->_test_token(LBRACE)); return 0; } sub _WhereClause { my $self = shift; $self->_optional_token(KEYWORD, 'WHERE'); $self->_GroupGraphPattern; my $ggp = $self->_peek_pattern; $self->_check_duplicate_blanks($ggp); } sub _check_duplicate_blanks { my $self = shift; my $p = shift; # warn 'TODO: $ggp->_check_duplicate_blanks'; # XXXXXXXX # my @children = @{ $ggp->children }; # my %seen; # foreach my $c (@{ $ggp->children }) { # my @blanks = $c->blank_nodes; # foreach my $b (@blanks) { # my $id = $b->value; # if ($seen{ $id }++) { # warn $ggp->as_string; # croak "Same blank node identifier ($id) used in more than one BasicGraphPattern."; # } # } # } return 1; } sub _TriplesWhereClause { my $self = shift; $self->_push_pattern_container; $self->_expected_token(KEYWORD, 'WHERE'); $self->_expected_token(LBRACE); if ($self->_TriplesBlock_test) { $self->_TriplesBlock; } $self->_expected_token(RBRACE); my ($cont, $hints) = $self->_pop_pattern_container; $self->{build}{construct_triples} = $cont->[0]; my $pattern = $self->_new_join(@$cont); $pattern->hints($hints); $self->_add_patterns( $pattern ); } # sub _Binding_test { # my $self = shift; # return $self->_test_token(LPAREN); # } sub _Binding { my $self = shift; my $count = shift; $self->_expected_token(LPAREN); my @terms; foreach my $i (1..$count) { unless ($self->_BindingValue_test) { my $found = $i-1; croak "Syntax error: Expected $count BindingValues but only found $found"; } $self->_BindingValue; push( @terms, splice(@{ $self->{_stack} })); } $self->_expected_token(RPAREN); return \@terms; } sub _BindingValue_test { my $self = shift; return 1 if ($self->_IRIref_test); return 1 if ($self->_test_token(KEYWORD, 'UNDEF')); return 1 if ($self->_test_literal_token); return 1 if ($self->_IRIref_test); return 1 if ($self->_test_token(BNODE)); return 1 if ($self->_test_token(NIL)); return 1 if ($self->_test_token(LTLT)); return 0; } sub _BindingValue { my $self = shift; if ($self->_optional_token(KEYWORD, 'UNDEF')) { push(@{ $self->{_stack} }, undef); } elsif ($self->_test_token(LTLT)) { $self->_QuotedTriple(); } else { $self->_GraphTerm; } } # [20] GroupCondition ::= ( BuiltInCall | FunctionCall | '(' Expression ( 'AS' Var )? ')' | Var ) sub __GroupByVar_test { my $self = shift; return 1 if ($self->_BuiltInCall_test); return 1 if ($self->_IRIref_test); return 1 if ($self->_test_token(LPAREN)); return 1 if ($self->_test_token(VAR)); return 0; } sub __GroupByVar { my $self = shift; if ($self->_optional_token(LPAREN)) { $self->_Expression; my ($expr) = splice(@{ $self->{_stack} }); if ($self->_optional_token(KEYWORD, 'AS')) { $self->_Var; my ($var) = splice(@{ $self->{_stack} }); push(@{ $self->{build}{__group_vars} }, [$var, $expr]); my $vexpr = Attean::ValueExpression->new( value => $var ); $self->_add_stack( $vexpr ); } else { $self->_add_stack( $expr ); } $self->_expected_token(RPAREN); } elsif ($self->_IRIref_test) { $self->_FunctionCall; } elsif ($self->_BuiltInCall_test) { $self->_BuiltInCall; } else { $self->_Var; my $var = pop(@{ $self->{_stack} }); my $expr = Attean::ValueExpression->new(value => $var); $self->_add_stack($expr); } } # [14] SolutionModifier ::= OrderClause? LimitOffsetClauses? sub _SolutionModifier { my $self = shift; my $vars = shift // []; if ($self->_test_token(KEYWORD, 'GROUP')) { $self->_GroupClause($vars); } if ($self->_test_token(KEYWORD, 'RANK')) { $self->_RankClause; } if ($self->_test_token(KEYWORD, 'HAVING')) { $self->_HavingClause; } if ($self->_OrderClause_test) { $self->_OrderClause; } if ($self->_LimitOffsetClauses_test) { $self->_LimitOffsetClauses; } } sub _GroupClause { my $self = shift; my $vars = shift; $self->_expected_token(KEYWORD, 'GROUP'); $self->_expected_token(KEYWORD, 'BY'); if ($self->{build}{star}) { croak "Syntax error: SELECT * cannot be used with aggregate grouping"; } $self->{build}{__aggregate} ||= {}; my @vars; $self->__GroupByVar; my ($v) = splice(@{ $self->{_stack} }); push( @vars, $v ); while ($self->__GroupByVar_test) { $self->__GroupByVar; my ($v) = splice(@{ $self->{_stack} }); push( @vars, $v ); } my %seen; foreach my $v (@vars) { my $var = $v->value; if ($var->does('Attean::API::Variable')) { my $name = $var->value; $seen{ $name }++; } } # warn 'TODO: verify that projection only includes aggregates and grouping variables'; # XXXXX # foreach my $v (@$vars) { # if ($v->does('Attean::API::Variable')) { # my $name = $v->value; # unless ($seen{ $name }) { # croak "Syntax error: Variable used in projection but not present in aggregate grouping ($name)"; # # throw ::Error::ParseError -text => "Syntax error: Variable used in projection but not present in aggregate grouping ($name)"; # } # } # } $self->{build}{__group_by} = \@vars; } sub _RankClause { my $self = shift; $self->_expected_token(KEYWORD, 'RANK'); $self->_expected_token(LPAREN); $self->_OrderCondition; my @order; push(@order, splice(@{ $self->{_stack} })); while ($self->_OrderCondition_test) { $self->_OrderCondition; push(@order, splice(@{ $self->{_stack} })); } $self->_expected_token(RPAREN); $self->_expected_token(KEYWORD, 'AS'); $self->_Var; my ($var) = splice(@{ $self->{_stack} }); my @exprs; my %ascending; foreach my $o (@order) { my ($dir, $expr) = @$o; push(@exprs, $expr); $ascending{ $expr->value->value } = ($dir eq 'ASC') ? 1 : 0; # TODO: support ranking by complex expressions, not just variables } my $r = Attean::AggregateExpression->new( distinct => 0, operator => 'RANK', children => \@exprs, scalar_vars => { ascending => \%ascending, }, variable => $var, ); $self->{build}{__aggregate}{ $var->value } = [ $var, $r ]; } sub _HavingClause { my $self = shift; $self->_expected_token(KEYWORD, 'HAVING'); $self->{build}{__aggregate} ||= {}; local($self->{__aggregate_call_ok}) = 1; $self->_Constraint; my ($expr) = splice(@{ $self->{_stack} }); $self->{build}{__having} = $expr; } # [15] LimitOffsetClauses ::= ( LimitClause OffsetClause? | OffsetClause LimitClause? ) sub _LimitOffsetClauses_test { my $self = shift; return 1 if ($self->_test_token(KEYWORD, 'LIMIT')); return 1 if ($self->_test_token(KEYWORD, 'OFFSET')); return 0; } sub _LimitOffsetClauses { my $self = shift; if ($self->_LimitClause_test) { $self->_LimitClause; if ($self->_OffsetClause_test) { $self->_OffsetClause; } } else { $self->_OffsetClause; if ($self->_LimitClause_test) { $self->_LimitClause; } } } # [16] OrderClause ::= 'ORDER' 'BY' OrderCondition+ sub _OrderClause_test { my $self = shift; return 1 if ($self->_test_token(KEYWORD, 'ORDER')); return 0; } sub _OrderClause { my $self = shift; $self->_expected_token(KEYWORD, 'ORDER'); $self->_expected_token(KEYWORD, 'BY'); my @order; $self->{build}{__aggregate} ||= {}; local($self->{__aggregate_call_ok}) = 1; $self->_OrderCondition; push(@order, splice(@{ $self->{_stack} })); while ($self->_OrderCondition_test) { $self->_OrderCondition; push(@order, splice(@{ $self->{_stack} })); } $self->{build}{options}{orderby} = \@order; } # [17] OrderCondition ::= ( ( 'ASC' | 'DESC' ) BrackettedExpression ) | ( Constraint | Var ) sub _OrderCondition_test { my $self = shift; return 1 if ($self->_test_token(KEYWORD, 'ASC')); return 1 if ($self->_test_token(KEYWORD, 'DESC')); return 1 if ($self->_test_token(VAR)); return 1 if $self->_Constraint_test; return 0; } sub _OrderCondition { my $self = shift; my $dir = 'ASC'; if (my $t = $self->_optional_token(KEYWORD, qr/^(ASC|DESC)/)) { $dir = $t->value; $self->_BrackettedExpression; } elsif ($self->_test_token(VAR)) { $self->_Var; my $var = pop(@{ $self->{_stack} }); my $expr = Attean::ValueExpression->new(value => $var); $self->_add_stack($expr); } else { $self->_Constraint; } my ($expr) = splice(@{ $self->{_stack} }); $self->_add_stack( [ $dir, $expr ] ); } # [18] LimitClause ::= 'LIMIT' INTEGER sub _LimitClause_test { my $self = shift; return ($self->_test_token(KEYWORD, 'LIMIT')); } sub _LimitClause { my $self = shift; $self->_expected_token(KEYWORD, 'LIMIT'); my $t = $self->_expected_token(INTEGER); $self->{build}{options}{limit} = $t->value; } # [19] OffsetClause ::= 'OFFSET' INTEGER sub _OffsetClause_test { my $self = shift; return ($self->_test_token(KEYWORD, 'OFFSET')); } sub _OffsetClause { my $self = shift; $self->_expected_token(KEYWORD, 'OFFSET'); my $t = $self->_expected_token(INTEGER); $self->{build}{options}{offset} = $t->value; } # [20] GroupGraphPattern ::= '{' TriplesBlock? ( ( GraphPatternNotTriples | Filter ) '.'? TriplesBlock? )* '}' sub _GroupGraphPattern { my $self = shift; $self->_expected_token(LBRACE); if ($self->_SubSelect_test) { $self->_SubSelect; } else { $self->_GroupGraphPatternSub; } $self->_expected_token(RBRACE); } sub _GroupGraphPatternSub { my $self = shift; $self->_push_pattern_container; my $got_pattern = 0; my $need_dot = 0; if ($self->_TriplesBlock_test) { $need_dot = 1; $got_pattern++; $self->_TriplesBlock; } while (not $self->_test_token(RBRACE)) { my $cur = $self->_peek_token; if ($self->_GraphPatternNotTriples_test) { $need_dot = 0; $got_pattern++; $self->_GraphPatternNotTriples; my (@data) = splice(@{ $self->{_stack} }); $self->__handle_GraphPatternNotTriples( @data ); } elsif ($self->_test_token(KEYWORD, 'FILTER')) { $got_pattern++; $need_dot = 0; $self->_Filter; } if ($need_dot or $self->_test_token(DOT)) { $self->_expected_token(DOT); if ($got_pattern) { $need_dot = 0; $got_pattern = 0; } else { croak "Syntax error: Extra dot found without preceding pattern"; } } if ($self->_TriplesBlock_test) { my $peek = $self->_peek_pattern; if (blessed($peek) and $peek->isa('Attean::Algebra::BGP')) { $self->_TriplesBlock; my $rhs = $self->_remove_pattern; my $lhs = $self->_remove_pattern; if ($rhs->isa('Attean::Algebra::BGP')) { my $merged = $self->__new_bgp( map { @{ $_->triples } } ($lhs, $rhs) ); $self->_add_patterns( $merged ); } else { my $merged = $self->_new_join($lhs, $rhs); $self->_add_patterns( $merged ); } } else { $self->_TriplesBlock; } } my $t = $self->_peek_token; last if (refaddr($t) == refaddr($cur)); } my ($cont, $hints) = $self->_pop_pattern_container; my @filters = splice(@{ $self->{filters} }); my @patterns; my $pattern = $self->_new_join(@$cont); $pattern->hints($hints); if (@filters) { while (my $f = shift @filters) { $pattern = Attean::Algebra::Filter->new( children => [$pattern], expression => $f ); } } $self->_add_patterns( $pattern ); } sub __handle_GraphPatternNotTriples { my $self = shift; my $data = shift; return unless ($data); my ($class, @args) = @$data; if ($class =~ /^Attean::Algebra::(LeftJoin|Minus)$/) { my ($cont, $hints) = $self->_pop_pattern_container; my $ggp = $self->_new_join(@$cont); $ggp->hints($hints); $self->_push_pattern_container; # my $ggp = $self->_remove_pattern(); unless ($ggp) { $ggp = Attean::Algebra::BGP->new(); } my $opt = $class->new( children => [$ggp, @args] ); $self->_add_patterns( $opt ); } elsif ($class eq 'Attean::Algebra::Table') { my ($table) = @args; $self->_add_patterns( $table ); } elsif ($class =~ /^Attean::Algebra::Unfold$/) { my ($cont, $hints) = $self->_pop_pattern_container; my $ggp = $self->_new_join(@$cont); $ggp->hints($hints); $self->_push_pattern_container; # my $ggp = $self->_remove_pattern(); unless ($ggp) { $ggp = Attean::Algebra::BGP->new(); } my @vars = @{ $args[0] }; my $expr = $args[1]; foreach my $var (@vars) { my %in_scope = map { $_ => 1 } $ggp->in_scope_variables; if (exists $in_scope{ $var->value }) { croak "Syntax error: BIND used with variable already in scope"; } } my $bind = $class->new( children => [$ggp], variables => \@vars, expression => $expr ); $self->_add_patterns( $bind ); } elsif ($class =~ /^Attean::Algebra::Extend$/) { my ($cont, $hints) = $self->_pop_pattern_container; my $ggp = $self->_new_join(@$cont); $ggp->hints($hints); $self->_push_pattern_container; # my $ggp = $self->_remove_pattern(); unless ($ggp) { $ggp = Attean::Algebra::BGP->new(); } my ($var, $expr) = @args; my %in_scope = map { $_ => 1 } $ggp->in_scope_variables; if (exists $in_scope{ $var->value }) { croak "Syntax error: BIND used with variable already in scope"; } my $bind = $class->new( children => [$ggp], variable => $var, expression => $expr ); $self->_add_patterns( $bind ); } elsif ($class eq 'Attean::Algebra::Service') { my ($endpoint, $pattern, $silent) = @args; if ($endpoint->does('Attean::API::Variable')) { # SERVICE ?var croak "SERVICE ?var not implemented"; } else { # SERVICE # no-op my $service = Attean::Algebra::Service->new( children => [$pattern], endpoint => $endpoint, silent => $silent ); $self->_add_patterns( $service ); } } elsif ($class =~ /Attean::Algebra::(Union|Graph|Join)$/) { # no-op } else { croak 'Unrecognized GraphPattern: ' . $class; } } sub _SubSelect_test { my $self = shift; return $self->_test_token(KEYWORD, 'SELECT'); } sub _SubSelect { my $self = shift; my $pattern; { local($self->{namespaces}) = $self->{namespaces}; local($self->{_stack}) = []; local($self->{filters}) = []; local($self->{_pattern_container_stack}) = []; my $triples = $self->_push_pattern_container(); local($self->{build}) = { triples => $triples}; if ($self->{baseURI}) { $self->{build}{base} = $self->{baseURI}; } $self->_expected_token(KEYWORD, 'SELECT'); if (my $t = $self->_optional_token(KEYWORD, qr/^(DISTINCT|REDUCED)/)) { my $mod = $t->value; $self->{build}{options}{lc($mod)} = 1; } my ($star, $exprs, $vars) = $self->__SelectVars; my @exprs = @$exprs; $self->_WhereClause; $self->_SolutionModifier($vars); if ($self->{build}{options}{orderby}) { my $order = delete $self->{build}{options}{orderby}; my $pattern = pop(@{ $self->{build}{triples} }); my @order = @$order; my @cmps; foreach my $o (@order) { my ($dir, $expr) = @$o; my $asc = ($dir eq 'ASC'); push(@cmps, Attean::Algebra::Comparator->new(ascending => $asc, expression => $expr)); } my $sort = Attean::Algebra::OrderBy->new( children => [$pattern], comparators => \@cmps ); push(@{ $self->{build}{triples} }, $sort); } if ($self->_optional_token(KEYWORD, 'VALUES')) { my @vars; my $parens = 0; if ($self->_optional_token(LPAREN)) { $parens = 1; } while ($self->_test_token(VAR)) { $self->_Var; push( @vars, splice(@{ $self->{_stack} })); } if ($parens) { $self->_expected_token(RPAREN); } my $count = scalar(@vars); if (not($parens) and $count == 0) { croak "Syntax error: Expected VAR in inline data declaration"; } elsif (not($parens) and $count > 1) { croak "Syntax error: Inline data declaration can only have one variable when parens are omitted"; } my $short = (not($parens) and $count == 1); $self->_expected_token(LBRACE); if (not($short) or ($short and $self->_test_token(LPAREN))) { while ($self->_test_token(LPAREN)) { my $terms = $self->_Binding($count); push( @{ $self->{build}{bindings}{terms} }, $terms ); } } else { while ($self->_BindingValue_test) { $self->_BindingValue; my ($term) = splice(@{ $self->{_stack} }); push( @{ $self->{build}{bindings}{terms} }, [$term] ); } } $self->_expected_token(RBRACE); $self->{build}{bindings}{vars} = \@vars; my $bindings = delete $self->{build}{bindings}; my @rows = @{ $bindings->{terms} }; my @vbs; foreach my $r (@rows) { my %d; foreach my $i (0 .. $#{ $r }) { if (blessed($r->[$i])) { $d{ $vars[$i]->value } = $r->[$i]; } } my $r = Attean::Result->new(bindings => \%d); push(@vbs, $r); } my $table = Attean::Algebra::Table->new( variables => \@vars, rows => \@vbs ); my $pattern = pop(@{ $self->{build}{triples} }); push(@{ $self->{build}{triples} }, $self->_new_join($pattern, $table)); } $self->__solution_modifiers( $star, @exprs ); delete $self->{build}{options}; my $data = delete $self->{build}; $pattern = $data->{triples}[0]; $pattern = Attean::Algebra::Query->new( children => [$pattern], subquery => 1 ); } $self->_add_patterns( $pattern ); } # [21] TriplesBlock ::= TriplesSameSubject ( '.' TriplesBlock? )? sub _TriplesBlock_test { my $self = shift; # VarOrTerm | TriplesNode -> (Var | GraphTerm) | (Collection | BlankNodePropertyList) -> Var | IRIref | RDFLiteral | NumericLiteral | BooleanLiteral | BlankNode | NIL | Collection | BlankNodePropertyList # but since a triple can't start with a literal, this is reduced to: # Var | IRIref | BlankNode | NIL return 1 if ($self->_test_token(VAR)); return 1 if ($self->_test_token(NIL)); return 1 if ($self->_test_token(ANON)); return 1 if ($self->_test_token(BNODE)); return 1 if ($self->_test_token(LPAREN)); return 1 if ($self->_test_token(LBRACKET)); return 1 if ($self->_test_token(LTLT)); return 1 if ($self->_IRIref_test); return 1 if ($self->_test_literal_token); return 0; } sub _test_literal_token { my $self = shift; return 1 if ($self->_test_token(STRING1D)); return 1 if ($self->_test_token(STRING3D)); return 1 if ($self->_test_token(STRING1S)); return 1 if ($self->_test_token(STRING3S)); return 1 if ($self->_test_token(DECIMAL)); return 1 if ($self->_test_token(DOUBLE)); return 1 if ($self->_test_token(INTEGER)); return 1 if ($self->_test_token(BOOLEAN)); return 0; } sub _TriplesBlock { my $self = shift; $self->_push_pattern_container; $self->__TriplesBlock; my ($triples, $hints) = $self->_pop_pattern_container; my $bgp = $self->__new_bgp( @$triples ); $bgp->hints($hints); $self->_add_patterns( $bgp ); } ## this one (with two underscores) doesn't pop patterns off the stack and make a BGP. ## instead, things are left on the stack so we can recurse without doing the wrong thing. ## the one with one underscore (_TriplesBlock) will pop everything off and make the BGP. sub __TriplesBlock { my $self = shift; my $got_dot = 0; TRIPLESBLOCKLOOP: $self->_TriplesSameSubjectPath; while ($self->_test_token(DOT)) { if ($got_dot) { croak "Syntax error: found extra DOT after TriplesBlock"; } $self->_expected_token(DOT); $got_dot++; if ($self->_TriplesBlock_test) { $got_dot = 0; goto TRIPLESBLOCKLOOP; } } } # [22] GraphPatternNotTriples ::= OptionalGraphPattern | GroupOrUnionGraphPattern | GraphGraphPattern sub _GraphPatternNotTriples_test { my $self = shift; return 1 if ($self->_test_token(LBRACE)); my $t = $self->_peek_token; return unless ($t); return 0 unless ($t->type == KEYWORD); return ($t->value =~ qr/^(VALUES|BIND|UNFOLD|SERVICE|MINUS|OPTIONAL|GRAPH|HINT)$/i); } sub _GraphPatternNotTriples { my $self = shift; if ($self->_test_token(KEYWORD, 'VALUES')) { $self->_InlineDataClause; } elsif ($self->_test_token(KEYWORD, 'SERVICE')) { $self->_ServiceGraphPattern; } elsif ($self->_test_token(KEYWORD, 'MINUS')) { $self->_MinusGraphPattern; } elsif ($self->_test_token(KEYWORD, 'BIND')) { $self->_Bind; } elsif ($self->_test_token(KEYWORD, 'UNFOLD')) { $self->_Unfold; } elsif ($self->_test_token(KEYWORD, 'HINT')) { $self->_Hint; } elsif ($self->_test_token(KEYWORD, 'OPTIONAL')) { $self->_OptionalGraphPattern; } elsif ($self->_test_token(LBRACE)) { $self->_GroupOrUnionGraphPattern; } else { $self->_GraphGraphPattern; } } sub _InlineDataClause { my $self = shift; $self->_expected_token(KEYWORD, 'VALUES'); my @vars; my $parens = 0; if ($self->_optional_token(LPAREN)) { $parens = 1; } while ($self->_test_token(VAR)) { $self->_Var; push( @vars, splice(@{ $self->{_stack} })); } if ($parens) { $self->_expected_token(RPAREN); } my $count = scalar(@vars); if (not($parens) and $count == 0) { croak "Syntax error: Expected VAR in inline data declaration"; } elsif (not($parens) and $count > 1) { croak "Syntax error: Inline data declaration can only have one variable when parens are omitted"; } my $short = (not($parens) and $count == 1); $self->_expected_token(LBRACE); my @rows; if (not($short) or ($short and $self->_test_token(LPAREN))) { # { (term) (term) } while ($self->_test_token(LPAREN)) { my $terms = $self->_Binding($count); push( @rows, $terms ); } } else { # { term term } while ($self->_BindingValue_test) { $self->_BindingValue; my ($term) = splice(@{ $self->{_stack} }); push( @rows, [$term] ); } } $self->_expected_token(RBRACE); my @vbs; foreach my $row (@rows) { my %d; # Turn triple patterns into ground triples. @d{ map { $_->value } @vars } = map { (blessed($_) and $_->does('Attean::API::TriplePattern')) ? $_->as_triple : $_ } @$row; foreach my $k (keys %d) { unless (blessed($d{$k})) { delete $d{$k}; } } my $result = Attean::Result->new(bindings => \%d); push(@vbs, $result); } my $table = Attean::Algebra::Table->new( variables => \@vars, rows => \@vbs ); $self->_add_stack( ['Attean::Algebra::Table', $table] ); } sub _Bind { my $self = shift; $self->_expected_token(KEYWORD, 'BIND'); my ($var, $expr) = $self->_BrackettedAliasExpression; $self->_add_stack( ['Attean::Algebra::Extend', $var, $expr] ); } sub _Unfold { my $self = shift; $self->_expected_token(KEYWORD, 'UNFOLD'); my ($var, $expr) = $self->_BrackettedAliasExpression(1); $self->_add_stack( ['Attean::Algebra::Unfold', $var, $expr] ); } sub _Hint { my $self = shift; $self->_expected_token(KEYWORD, 'HINT'); my $terms = $self->_HintTerms(); $self->_add_hint($terms); } sub _HintTerms { my $self = shift; $self->_expected_token(LPAREN); my @terms; while ($self->_BindingValue_test) { $self->_BindingValue; push(@terms, splice(@{ $self->{_stack} })); } $self->_expected_token(RPAREN); return \@terms; } sub _ServiceGraphPattern { my $self = shift; $self->_expected_token(KEYWORD, 'SERVICE'); my $silent = $self->_optional_token(KEYWORD, 'SILENT') ? 1 : 0; $self->__close_bgp_with_filters; if ($self->_test_token(VAR)) { $self->_Var; } else { $self->_IRIref; } my ($endpoint) = splice( @{ $self->{_stack} } ); $self->_GroupGraphPattern; my $ggp = $self->_remove_pattern; my $opt = ['Attean::Algebra::Service', $endpoint, $ggp, ($silent ? 1 : 0)]; $self->_add_stack( $opt ); } # [23] OptionalGraphPattern ::= 'OPTIONAL' GroupGraphPattern # sub _OptionalGraphPattern_test { # my $self = shift; # return $self->_test_token(KEYWORD, 'OPTIONAL'); # } sub __close_bgp_with_filters { my $self = shift; my @filters = splice(@{ $self->{filters} }); if (@filters) { my ($cont, $hints) = $self->_pop_pattern_container; my $ggp = $self->_new_join(@$cont); $ggp->hints($hints); $self->_push_pattern_container; # my $ggp = $self->_remove_pattern(); unless ($ggp) { $ggp = Attean::Algebra::BGP->new(); } while (my $f = shift @filters) { $ggp = Attean::Algebra::Filter->new( children => [$ggp], expression => $f ); } $self->_add_patterns($ggp); } } sub _OptionalGraphPattern { my $self = shift; $self->_expected_token(KEYWORD, 'OPTIONAL'); $self->__close_bgp_with_filters; $self->_GroupGraphPattern; my $ggp = $self->_remove_pattern; my $opt = ['Attean::Algebra::LeftJoin', $ggp]; $self->_add_stack( $opt ); } sub _MinusGraphPattern { my $self = shift; $self->_expected_token(KEYWORD, 'MINUS'); $self->__close_bgp_with_filters; $self->_GroupGraphPattern; my $ggp = $self->_remove_pattern; my $opt = ['Attean::Algebra::Minus', $ggp]; $self->_add_stack( $opt ); } # [24] GraphGraphPattern ::= 'GRAPH' VarOrIRIref GroupGraphPattern sub _GraphGraphPattern { my $self = shift; if ($self->{__data_pattern}) { if ($self->{__graph_nesting_level}++) { croak "Syntax error: Nested named GRAPH blocks not allowed in data template."; } } $self->_expected_token(KEYWORD, 'GRAPH'); $self->_VarOrIRIref; my ($graph) = splice(@{ $self->{_stack} }); if ($graph->does('Attean::API::IRI')) { $self->_GroupGraphPattern; } else { $self->_GroupGraphPattern; } if ($self->{__data_pattern}) { $self->{__graph_nesting_level}--; } my $ggp = $self->_remove_pattern; my $pattern = Attean::Algebra::Graph->new( children => [$ggp], graph => $graph ); $self->_add_patterns( $pattern ); $self->_add_stack( [ 'Attean::Algebra::Graph' ] ); } # [25] GroupOrUnionGraphPattern ::= GroupGraphPattern ( 'UNION' GroupGraphPattern )* # sub _GroupOrUnionGraphPattern_test { # my $self = shift; # return $self->_test_token(LBRACE); # } sub _GroupOrUnionGraphPattern { my $self = shift; $self->_GroupGraphPattern; my $ggp = $self->_remove_pattern; if ($self->_test_token(KEYWORD, 'UNION')) { while ($self->_optional_token(KEYWORD, 'UNION')) { $self->_GroupGraphPattern; my $rhs = $self->_remove_pattern; $ggp = Attean::Algebra::Union->new( children => [$ggp, $rhs] ); } $self->_add_patterns( $ggp ); $self->_add_stack( [ 'Attean::Algebra::Union' ] ); } else { $self->_add_patterns( $ggp ); $self->_add_stack( [ 'Attean::Algebra::Join' ] ); } } # [26] Filter ::= 'FILTER' Constraint sub _Filter { my $self = shift; $self->_expected_token(KEYWORD, 'FILTER'); $self->_Constraint; my ($expr) = splice(@{ $self->{_stack} }); $self->_add_filter( $expr ); } # [27] Constraint ::= BrackettedExpression | BuiltInCall | FunctionCall sub _Constraint_test { my $self = shift; return 1 if ($self->_test_token(LPAREN)); return 1 if $self->_BuiltInCall_test; return 1 if $self->_IRIref_test; return 0; } sub _Constraint { my $self = shift; if ($self->_test_token(LPAREN)) { $self->_BrackettedExpression(); } elsif ($self->_BuiltInCall_test) { $self->_BuiltInCall(); } else { $self->_FunctionCall(); } } # [28] FunctionCall ::= IRIref ArgList # sub _FunctionCall_test { # my $self = shift; # return $self->_IRIref_test; # } sub _FunctionCall { my $self = shift; $self->_IRIref; my ($iri) = splice(@{ $self->{_stack} }); if (my $func = Attean->get_global_aggregate($iri)) { } my @args = $self->_ArgList; if ($iri->value =~ m<^http://www[.]w3[.]org/2001/XMLSchema#(?:integer|decimal|float|double|boolean|string|dateTime)$>) { my $expr = Attean::CastExpression->new( children => \@args, datatype => $iri ); $self->_add_stack( $expr ); } else { my $func = Attean::ValueExpression->new( value => $iri ); my $expr = $self->new_function_expression( 'INVOKE', $func, @args ); $self->_add_stack( $expr ); } } # [29] ArgList ::= ( NIL | '(' Expression ( ',' Expression )* ')' ) sub _ArgList_test { my $self = shift; return 1 if $self->_test_token(NIL); return $self->_test_token(LPAREN); } sub _ArgList { my $self = shift; if ($self->_optional_token(NIL)) { return; } else { $self->_expected_token(LPAREN); my @args; unless ($self->_test_token(RPAREN)) { $self->_Expression; push( @args, splice(@{ $self->{_stack} }) ); while ($self->_optional_token(COMMA)) { $self->_Expression; push( @args, splice(@{ $self->{_stack} }) ); } } $self->_expected_token(RPAREN); return @args; } } # [30] ConstructTemplate ::= '{' ConstructTriples? '}' sub _ConstructTemplate { my $self = shift; $self->_push_pattern_container; $self->_expected_token(LBRACE); if ($self->_ConstructTriples_test) { $self->_ConstructTriples; } $self->_expected_token(RBRACE); (my $cont, undef) = $self->_pop_pattern_container; # ignore hints in a construct template $self->{build}{construct_triples} = $cont; } # [31] ConstructTriples ::= TriplesSameSubject ( '.' ConstructTriples? )? sub _ConstructTriples_test { my $self = shift; return $self->_TriplesBlock_test; } sub _ConstructTriples { my $self = shift; $self->_TriplesSameSubject; while ($self->_optional_token(DOT)) { if ($self->_ConstructTriples_test) { $self->_TriplesSameSubject; } } } # [32] TriplesSameSubject ::= VarOrTerm PropertyListNotEmpty | TriplesNode PropertyList sub _TriplesSameSubject { my $self = shift; my @triples; if ($self->_TriplesNode_test) { $self->_TriplesNode; my ($s) = splice(@{ $self->{_stack} }); $self->_PropertyList; my @list = splice(@{ $self->{_stack} }); foreach my $data (@list) { push(@triples, $self->__new_statement( $s, @$data )); } } else { $self->_VarOrTermOrQuotedTP; my ($s) = splice(@{ $self->{_stack} }); $self->_PropertyListNotEmpty; my (@list) = splice(@{ $self->{_stack} }); foreach my $data (@list) { push(@triples, $self->__new_statement( $s, @$data )); } } $self->_add_patterns( @triples ); # return @triples; } # TriplesSameSubjectPath ::= VarOrTerm PropertyListNotEmptyPath | TriplesNode PropertyListPath sub _TriplesSameSubjectPath { my $self = shift; my @triples; if ($self->_TriplesNode_test) { $self->_TriplesNode; my ($s) = splice(@{ $self->{_stack} }); $self->_PropertyListPath; my @list = splice(@{ $self->{_stack} }); foreach my $data (@list) { push(@triples, $self->__new_statement( $s, @$data )); } } else { $self->_VarOrTermOrQuotedTP; my ($s) = splice(@{ $self->{_stack} }); $self->_PropertyListNotEmptyPath; my (@list) = splice(@{ $self->{_stack} }); foreach my $data (@list) { push(@triples, $self->__new_statement( $s, @$data )); } } $self->_add_patterns( @triples ); # return @triples; } # [33] PropertyListNotEmpty ::= Verb ObjectList ( ';' ( Verb ObjectList )? )* sub _PropertyListNotEmpty { my $self = shift; $self->_Verb; my ($v) = splice(@{ $self->{_stack} }); $self->_ObjectList; my @l = splice(@{ $self->{_stack} }); my @props = map { [$v, $_] } @l; while ($self->_optional_token(SEMICOLON)) { if ($self->_Verb_test) { $self->_Verb; my ($v) = splice(@{ $self->{_stack} }); $self->_ObjectList; my @l = splice(@{ $self->{_stack} }); push(@props, map { [$v, $_] } @l); } } $self->_add_stack( @props ); } # [34] PropertyList ::= PropertyListNotEmpty? sub _PropertyList { my $self = shift; if ($self->_Verb_test) { $self->_PropertyListNotEmpty; } } # [33] PropertyListNotEmptyPath ::= (VerbPath | VerbSimple) ObjectList ( ';' ( (VerbPath | VerbSimple) ObjectList )? )* sub _PropertyListNotEmptyPath { my $self = shift; if ($self->_VerbPath_test) { $self->_VerbPath; } else { $self->_VerbSimple; } my ($v) = splice(@{ $self->{_stack} }); $self->_ObjectList; my @l = splice(@{ $self->{_stack} }); my @props = map { [$v, $_] } @l; while ($self->_optional_token(SEMICOLON)) { if ($self->_VerbPath_test or $self->_test_token(VAR)) { if ($self->_VerbPath_test) { $self->_VerbPath; } else { $self->_VerbSimple; } my ($v) = splice(@{ $self->{_stack} }); $self->_ObjectList; my @l = splice(@{ $self->{_stack} }); push(@props, map { [$v, $_] } @l); } } $self->_add_stack( @props ); } # [34] PropertyListPath ::= PropertyListNotEmptyPath? sub _PropertyListPath { my $self = shift; if ($self->_Verb_test) { $self->_PropertyListNotEmptyPath; } } # [35] ObjectList ::= Object ( ',' Object )* sub _ObjectList { my $self = shift; my @list; $self->_Object; push(@list, splice(@{ $self->{_stack} })); while ($self->_optional_token(COMMA)) { $self->_Object; push(@list, splice(@{ $self->{_stack} })); } $self->_add_stack( @list ); } # [36] Object ::= GraphNode sub _Object { my $self = shift; $self->_GraphNode; if ($self->_optional_token(LANNOT)) { ######################## TODO: SPARQL-star annotation syntax my ($s) = splice(@{ $self->{_stack} }); $self->_PropertyListNotEmptyPath; my (@list) = splice(@{ $self->{_stack} }); my $obj = AtteanX::Parser::SPARQL::ObjectWrapper->new( value => $s, annotations => \@list); $self->_add_stack($obj); ######################## $self->_expected_token(RANNOT) } } # [37] Verb ::= VarOrIRIref | 'a' sub _Verb_test { my $self = shift; return 1 if ($self->_test_token(A)); return 1 if ($self->_test_token(VAR)); return 1 if ($self->_IRIref_test); return 0; } sub _Verb { my $self = shift; if ($self->_optional_token(A)) { my $type = Attean::IRI->new(value => 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type', lazy => 1); $self->_add_stack( $type ); } else { $self->_VarOrIRIref; } } # VerbSimple ::= Var # sub _VerbSimple_test { # my $self = shift; # return ($self->_test_token(VAR)); # } sub _VerbSimple { my $self = shift; $self->_Var; } # VerbPath ::= Path sub _VerbPath_test { my $self = shift; return 1 if ($self->_IRIref_test); return 1 if ($self->_test_token(HAT)); return 1 if ($self->_test_token(OR)); return 1 if ($self->_test_token(BANG)); return 1 if ($self->_test_token(LPAREN)); return 1 if ($self->_test_token(A)); return 0; } sub _VerbPath { my $self = shift; $self->_Path } # [74] Path ::= PathAlternative sub _Path { my $self = shift; $self->_PathAlternative; } ################################################################################ # [75] PathAlternative ::= PathSequence ( '|' PathSequence )* sub _PathAlternative { my $self = shift; $self->_PathSequence; while ($self->_optional_token(OR)) { my ($lhs) = splice(@{ $self->{_stack} }); # $self->_PathOneInPropertyClass; $self->_PathSequence; my ($rhs) = splice(@{ $self->{_stack} }); $self->_add_stack( ['PATH', '|', $lhs, $rhs] ); } } # [76] PathSequence ::= PathEltOrInverse ( '/' PathEltOrInverse | '^' PathElt )* sub _PathSequence { my $self = shift; $self->_PathEltOrInverse; while ($self->_test_token(SLASH) or $self->_test_token(HAT)) { my $op; my ($lhs) = splice(@{ $self->{_stack} }); if ($self->_optional_token(SLASH)) { $op = '/'; $self->_PathEltOrInverse; } else { $op = '^'; $self->_expected_token(HAT); $self->_PathElt; } my ($rhs) = splice(@{ $self->{_stack} }); $self->_add_stack( ['PATH', $op, $lhs, $rhs] ); } } # [77] PathElt ::= PathPrimary PathMod? sub _PathElt { my $self = shift; $self->_PathPrimary; # $self->__consume_ws_opt; if ($self->_PathMod_test) { my @path = splice(@{ $self->{_stack} }); $self->_PathMod; my ($mod) = splice(@{ $self->{_stack} }); if (defined($mod)) { $self->_add_stack( ['PATH', $mod, @path] ); } else { # this might happen if we descend into _PathMod by mistaking a + as # a path modifier, but _PathMod figures out it's actually part of a # signed numeric object that follows the path $self->_add_stack( @path ); } } } # [78] PathEltOrInverse ::= PathElt | '^' PathElt sub _PathEltOrInverse { my $self = shift; if ($self->_optional_token(HAT)) { $self->_PathElt; my @props = splice(@{ $self->{_stack} }); $self->_add_stack( [ 'PATH', '^', @props ] ); } else { $self->_PathElt; } } # [79] PathMod ::= ( '*' | '?' | '+' | '{' ( Integer ( ',' ( '}' | Integer '}' ) | '}' ) ) ) sub _PathMod_test { my $self = shift; return 1 if ($self->_test_token(STAR)); return 1 if ($self->_test_token(QUESTION)); return 1 if ($self->_test_token(PLUS)); return 1 if ($self->_test_token(LBRACE)); return 0; } sub _PathMod { my $self = shift; if ($self->_test_token(STAR) or $self->_test_token(QUESTION) or $self->_test_token(PLUS)) { my $t = $self->_next_token; my $op; if ($t->type == STAR) { $op = '*'; } elsif ($t->type == QUESTION) { $op = '?'; } else { $op = '+'; } $self->_add_stack($op); ### path repetition range syntax :path{n,m}; removed from 1.1 Query 2LC # } else { # $self->_eat(qr/{/); # $self->__consume_ws_opt; # my $value = 0; # if ($self->_test(qr/}/)) { # throw ::Error::ParseError -text => "Syntax error: Empty Path Modifier"; # } # if ($self->_test($r_INTEGER)) { # $value = $self->_eat( $r_INTEGER ); # $self->__consume_ws_opt; # } # if ($self->_test(qr/,/)) { # $self->_eat(qr/,/); # $self->__consume_ws_opt; # if ($self->_test(qr/}/)) { # $self->_eat(qr/}/); # $self->_add_stack( "$value-" ); # } else { # my $end = $self->_eat( $r_INTEGER ); # $self->__consume_ws_opt; # $self->_eat(qr/}/); # $self->_add_stack( "$value-$end" ); # } # } else { # $self->_eat(qr/}/); # $self->_add_stack( "$value" ); # } } } # [80] PathPrimary ::= ( IRIref | 'a' | '!' PathNegatedPropertyClass | '(' Path ')' ) sub _PathPrimary { my $self = shift; if ($self->_IRIref_test) { $self->_IRIref; } elsif ($self->_optional_token(A)) { my $type = Attean::IRI->new(value => 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type', lazy => 1); $self->_add_stack( $type ); } elsif ($self->_optional_token(BANG)) { $self->_PathNegatedPropertyClass; my (@path) = splice(@{ $self->{_stack} }); $self->_add_stack( ['PATH', '!', @path] ); } else { $self->_expected_token(LPAREN); $self->_Path; $self->_expected_token(RPAREN); } } # [81] PathNegatedPropertyClass ::= ( PathOneInPropertyClass | '(' ( PathOneInPropertyClass ( '|' PathOneInPropertyClass )* )? ')' ) sub _PathNegatedPropertyClass { my $self = shift; if ($self->_optional_token(LPAREN)) { my @nodes; if ($self->_PathOneInPropertyClass_test) { $self->_PathOneInPropertyClass; push(@nodes, splice(@{ $self->{_stack} })); while ($self->_optional_token(OR)) { $self->_PathOneInPropertyClass; push(@nodes, splice(@{ $self->{_stack} })); # $self->_add_stack( ['PATH', '|', $lhs, $rhs] ); } } $self->_expected_token(RPAREN); $self->_add_stack( @nodes ); } else { $self->_PathOneInPropertyClass; } } # [82] PathOneInPropertyClass ::= IRIref | 'a' sub _PathOneInPropertyClass_test { my $self = shift; return 1 if $self->_IRIref_test; return 1 if ($self->_test_token(A)); return 1 if ($self->_test_token(HAT)); return 0; } sub _PathOneInPropertyClass { my $self = shift; my $rev = 0; if ($self->_optional_token(HAT)) { $rev = 1; } if ($self->_optional_token(A)) { my $type = Attean::IRI->new(value => 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type', lazy => 1); if ($rev) { $self->_add_stack( [ 'PATH', '^', $type ] ); } else { $self->_add_stack( $type ); } } else { $self->_IRIref; if ($rev) { my ($path) = splice(@{ $self->{_stack} }); $self->_add_stack( [ 'PATH', '^', $path ] ); } } } ################################################################################ # [38] TriplesNode ::= Collection | BlankNodePropertyList sub _TriplesNode_test { my $self = shift; return 1 if $self->_test_token(LPAREN); return 1 if $self->_test_token(LBRACKET); return 0; } sub _TriplesNode { my $self = shift; if ($self->_test_token(LPAREN)) { $self->_Collection; } else { $self->_BlankNodePropertyList; } } # [39] BlankNodePropertyList ::= '[' PropertyListNotEmpty ']' sub _BlankNodePropertyList { my $self = shift; if (my $where = $self->{__no_bnodes}) { croak "Syntax error: Blank nodes not allowed in $where"; } $self->_expected_token(LBRACKET); # $self->_PropertyListNotEmpty; $self->_PropertyListNotEmptyPath; $self->_expected_token(RBRACKET); my @props = splice(@{ $self->{_stack} }); my $subj = Attean::Blank->new(); my @triples = map { $self->__new_statement( $subj, @$_ ) } @props; $self->_add_patterns( @triples ); $self->_add_stack( $subj ); } # [40] Collection ::= '(' GraphNode+ ')' sub _Collection { my $self = shift; $self->_expected_token(LPAREN); $self->_GraphNode; my @nodes; push(@nodes, splice(@{ $self->{_stack} })); while ($self->_GraphNode_test) { $self->_GraphNode; push(@nodes, splice(@{ $self->{_stack} })); } $self->_expected_token(RPAREN); my $subj = Attean::Blank->new(); my $cur = $subj; my $last; my $first = Attean::IRI->new(value => 'http://www.w3.org/1999/02/22-rdf-syntax-ns#first', lazy => 1); my $rest = Attean::IRI->new(value => 'http://www.w3.org/1999/02/22-rdf-syntax-ns#rest', lazy => 1); my $nil = Attean::IRI->new(value => 'http://www.w3.org/1999/02/22-rdf-syntax-ns#nil', lazy => 1); my @triples; foreach my $node (@nodes) { push(@triples, $self->__new_statement( $cur, $first, $node ) ); my $new = Attean::Blank->new(); push(@triples, $self->__new_statement( $cur, $rest, $new ) ); $last = $cur; $cur = $new; } pop(@triples); push(@triples, $self->__new_statement( $last, $rest, $nil )); $self->_add_patterns( @triples ); $self->_add_stack( $subj ); } # [41] GraphNode ::= VarOrTerm | TriplesNode sub _GraphNode_test { my $self = shift; # VarOrTerm | TriplesNode -> (Var | GraphTerm) | (Collection | BlankNodePropertyList) -> Var | IRIref | RDFLiteral | NumericLiteral | BooleanLiteral | BlankNode | NIL | Collection | BlankNodePropertyList # but since a triple can't start with a literal, this is reduced to: # Var | IRIref | BlankNode | NIL return 1 if ($self->_test_token(VAR)); return 1 if ($self->_IRIref_test); return 1 if ($self->_test_token(BNODE)); return 1 if ($self->_test_token(LBRACKET)); return 1 if ($self->_test_token(LPAREN)); return 1 if ($self->_test_token(ANON)); return 1 if ($self->_test_token(NIL)); return 1 if ($self->_test_token(LTLT)); return 0; } sub _GraphNode { my $self = shift; if ($self->_TriplesNode_test) { $self->_TriplesNode; } else { $self->_VarOrTermOrQuotedTP; } } # [42] VarOrTerm ::= Var | GraphTerm # sub _VarOrTerm_test { # my $self = shift; # return 1 if ($self->_peek_token(VAR)); # return 1 if ($self->_IRIref_test); # return 1 if ($self->_peek_token(BOOLEAN)); # return 1 if ($self->_test_literal_token); # return 1 if ($self->_peek_token(BNODE)); # return 1 if ($self->_peek_token(NIL)); # return 0; # } sub _VarOrTermOrQuotedTP { my $self = shift; if ($self->_test_token(VAR)) { $self->_Var(); } elsif ($self->_test_token(LTLT)) { $self->_QuotedTP(); } else { $self->_GraphTerm; } } sub _VarOrTerm { my $self = shift; if ($self->_test_token(VAR)) { $self->_Var; } else { $self->_GraphTerm; } } # [43] VarOrIRIref ::= Var | IRIref sub _VarOrIRIref_test { my $self = shift; return 1 if ($self->_IRIref_test); return 1 if ($self->_test_token(VAR)); return 0; } sub _VarOrIRIref { my $self = shift; if ($self->_test_token(VAR)) { $self->_Var; } else { $self->_IRIref; } } # [44] Var ::= VAR1 | VAR2 sub _Var { my $self = shift; if ($self->{__data_pattern}) { croak "Syntax error: Variable found where Term expected"; } my $var = $self->_expected_token(VAR); $self->_add_stack( Attean::Variable->new( $var->value ) ); } # [45] GraphTerm ::= IRIref | RDFLiteral | NumericLiteral | BooleanLiteral | BlankNode | NIL sub _GraphTerm { my $self = shift; if ($self->_test_token(BOOLEAN)) { my $b = $self->_BooleanLiteral; $self->_add_stack( $b ); } elsif ($self->_test_token(NIL)) { my $n = $self->_NIL; $self->_add_stack( $n ); } elsif ($self->_test_token(ANON) or $self->_test_token(BNODE)) { my $b = $self->_BlankNode; $self->_add_stack( $b ); } elsif ($self->_test_token(INTEGER) or $self->_test_token(DECIMAL) or $self->_test_token(DOUBLE) or $self->_test_token(MINUS) or $self->_test_token(PLUS)) { my $l = $self->_NumericLiteral; $self->_add_stack( $l ); } elsif ($self->_test_literal_token) { my $l = $self->_RDFLiteral; $self->_add_stack( $l ); } else { $self->_IRIref; } } # [46] Expression ::= ConditionalOrExpression sub _Expression { my $self = shift; $self->_ConditionalOrExpression; } # [47] ConditionalOrExpression ::= ConditionalAndExpression ( '||' ConditionalAndExpression )* sub _ConditionalOrExpression { my $self = shift; my @list; $self->_ConditionalAndExpression; push(@list, splice(@{ $self->{_stack} })); while ($self->_test_token(OROR)) { $self->_expected_token(OROR); $self->_ConditionalAndExpression; push(@list, splice(@{ $self->{_stack} })); } if (scalar(@list) > 1) { my $algebra = Attean::BinaryExpression->new( operator => '||', children => [splice(@list, 0, 2)] ); while (scalar(@list)) { $algebra = Attean::BinaryExpression->new( operator => '||', children => [$algebra, shift(@list)] ); } $self->_add_stack($algebra); } else { $self->_add_stack( @list ); } if (scalar(@{ $self->{_stack} }) == 0) { my $t = $self->_peek_token; $self->_token_error($t, "Missing conditional expression"); } } # [48] ConditionalAndExpression ::= ValueLogical ( '&&' ValueLogical )* sub _ConditionalAndExpression { my $self = shift; $self->_ValueLogical; my @list = splice(@{ $self->{_stack} }); while ($self->_test_token(ANDAND)) { $self->_expected_token(ANDAND); $self->_ValueLogical; push(@list, splice(@{ $self->{_stack} })); } if (scalar(@list) > 1) { my $algebra = Attean::BinaryExpression->new( operator => '&&', children => [splice(@list, 0, 2)] ); while (scalar(@list)) { $algebra = Attean::BinaryExpression->new( operator => '&&', children => [$algebra, shift(@list)] ); } $self->_add_stack($algebra); } else { $self->_add_stack( @list ); } } # [49] ValueLogical ::= RelationalExpression sub _ValueLogical { my $self = shift; $self->_RelationalExpression; } # [50] RelationalExpression ::= NumericExpression ( '=' NumericExpression | '!=' NumericExpression | '<' NumericExpression | '>' NumericExpression | '<=' NumericExpression | '>=' NumericExpression )? sub _RelationalExpression { my $self = shift; $self->_NumericExpression; my $t = $self->_peek_token; my $type = $t->type; if ($type == EQUALS or $type == NOTEQUALS or $type == LE or $type == GE or $type == LT or $type == GT) { $self->_next_token; my @list = splice(@{ $self->{_stack} }); my $op = $t->value; $self->_NumericExpression; push(@list, splice(@{ $self->{_stack} })); $self->_add_stack( $self->new_binary_expression( $op, @list ) ); } elsif ($self->_test_token(KEYWORD, qr/^(NOT|IN)/)) { my @list = splice(@{ $self->{_stack} }); my $not = $self->_optional_token(KEYWORD, 'NOT'); $self->_expected_token(KEYWORD, 'IN'); my $op = $not ? 'NOTIN' : 'IN'; $self->_ExpressionList(); push(@list, splice(@{ $self->{_stack} })); my $p = $self->new_function_expression( $op, @list ); $self->_add_stack($p); } } sub _ExpressionList { my $self = shift; if ($self->_optional_token(NIL)) { return; } else { $self->_expected_token(LPAREN); my @args; unless ($self->_test_token(RPAREN)) { $self->_Expression; push( @args, splice(@{ $self->{_stack} }) ); while ($self->_optional_token(COMMA)) { $self->_Expression; push( @args, splice(@{ $self->{_stack} }) ); } } $self->_expected_token(RPAREN); $self->_add_stack( @args ); } } # [51] NumericExpression ::= AdditiveExpression sub _NumericExpression { my $self = shift; $self->_AdditiveExpression; } # [52] AdditiveExpression ::= MultiplicativeExpression ( '+' MultiplicativeExpression | '-' MultiplicativeExpression | NumericLiteralPositive | NumericLiteralNegative )* sub _AdditiveExpression { my $self = shift; $self->_MultiplicativeExpression; my ($expr) = splice(@{ $self->{_stack} }); while ($self->_test_token(MINUS) or $self->_test_token(PLUS)) { my $t = $self->_next_token; my $op = ($t->type == MINUS) ? '-' : '+'; $self->_MultiplicativeExpression; my ($rhs) = splice(@{ $self->{_stack} }); $expr = $self->new_binary_expression( $op, $expr, $rhs ); } $self->_add_stack( $expr ); } # [53] MultiplicativeExpression ::= UnaryExpression ( '*' UnaryExpression | '/' UnaryExpression )* sub _MultiplicativeExpression { my $self = shift; $self->_UnaryExpression; my ($expr) = splice(@{ $self->{_stack} }); while ($self->_test_token(STAR) or $self->_test_token(SLASH)) { my $t = $self->_next_token; my $op = ($t->type == STAR) ? '*' : '/'; $self->_UnaryExpression; my ($rhs) = splice(@{ $self->{_stack} }); $expr = $self->new_binary_expression( $op, $expr, $rhs ); } $self->_add_stack( $expr ); } # [54] UnaryExpression ::= '!' PrimaryExpression | '+' PrimaryExpression | '-' PrimaryExpression | PrimaryExpression sub _UnaryExpression { my $self = shift; if ($self->_optional_token(BANG)) { $self->_PrimaryExpression; my ($expr) = splice(@{ $self->{_stack} }); my $not = Attean::UnaryExpression->new( operator => '!', children => [$expr] ); $self->_add_stack( $not ); } elsif ($self->_optional_token(PLUS)) { $self->_PrimaryExpression; my ($expr) = splice(@{ $self->{_stack} }); ### if it's just a literal, force the positive down into the literal if (blessed($expr) and $expr->isa('Attean::ValueExpression') and $expr->value->does('Attean::API::NumericLiteral')) { my $value = '+' . $expr->value->value; my $l = $self->new_literal( value => $value, datatype => $expr->value->datatype ); my $lexpr = Attean::ValueExpression->new( value => $l ); $self->_add_stack( $lexpr ); } else { my $lexpr = Attean::ValueExpression->new( value => $expr ); $self->_add_stack( $lexpr ); } } elsif ($self->_optional_token(MINUS)) { $self->_PrimaryExpression; my ($expr) = splice(@{ $self->{_stack} }); ### if it's just a literal, force the negative down into the literal instead of make an unnecessary multiplication. if (blessed($expr) and $expr->isa('Attean::ValueExpression') and $expr->value->does('Attean::API::NumericLiteral')) { my $value = -1 * $expr->value->value; my $l = $self->new_literal( value => $value, datatype => $expr->value->datatype ); my $lexpr = Attean::ValueExpression->new( value => $l ); $self->_add_stack( $lexpr ); } else { my $int = 'http://www.w3.org/2001/XMLSchema#integer'; my $l = $self->new_literal( value => '-1', datatype => $int ); my $neg = $self->new_binary_expression( '*', Attean::ValueExpression->new( value => $l ), $expr ); my $lexpr = Attean::ValueExpression->new( value => $neg ); $self->_add_stack( $lexpr ); } } else { $self->_PrimaryExpression; } } # [55] PrimaryExpression ::= BrackettedExpression | BuiltInCall | IRIrefOrFunction | RDFLiteral | NumericLiteral | BooleanLiteral | Var sub _PrimaryExpression { my $self = shift; my $t = $self->_peek_token; if ($self->_test_token(LPAREN)) { $self->_BrackettedExpression; } elsif ($self->_BuiltInCall_test) { $self->_BuiltInCall; } elsif ($self->_IRIref_test) { $self->_IRIrefOrFunction; my $v = pop(@{ $self->{_stack} }); if ($v->does('Attean::API::IRI')) { $v = Attean::ValueExpression->new(value => $v); } $self->_add_stack($v); } elsif ($self->_test_token(VAR)) { $self->_Var; my $var = pop(@{ $self->{_stack} }); my $expr = Attean::ValueExpression->new(value => $var); $self->_add_stack($expr); } elsif ($self->_test_token(BOOLEAN)) { my $b = $self->_BooleanLiteral; my $expr = Attean::ValueExpression->new(value => $b); $self->_add_stack($expr); } elsif ($self->_test_token(INTEGER) or $self->_test_token(DECIMAL) or $self->_test_token(DOUBLE) or $self->_test_token(PLUS) or $self->_test_token(MINUS)) { my $l = $self->_NumericLiteral; my $expr = Attean::ValueExpression->new(value => $l); $self->_add_stack($expr); } elsif ($self->_test_token(LTLT)) { $self->_ExprQuotedTP(); my $tp = pop(@{ $self->{_stack} }); my $expr = Attean::ValueExpression->new(value => $tp); $self->_add_stack($expr); } else { my $value = $self->_RDFLiteral; my $expr = Attean::ValueExpression->new(value => $value); $self->_add_stack($expr); } } sub _ExprQuotedTP { my $self = shift; # '<<' ExprVarOrTerm Verb ExprVarOrTerm '>>' $self->_expected_token(LTLT); $self->_ExprVarOrTerm(); $self->_Verb(); $self->_ExprVarOrTerm(); $self->_expected_token(GTGT); my ($s, $p, $o) = splice(@{ $self->{_stack} }, -3); $self->_add_stack( $self->__new_statement( $s, $p, $o ) ); } sub _ExprVarOrTerm { my $self = shift; if ($self->_test_token(VAR)) { $self->_Var(); } elsif ($self->_test_token(LTLT)) { $self->_ExprQuotedTP(); } else { # TODO: this should prevent use of bnodes $self->_GraphTerm; my $term = ${ $self->{_stack} }[-1]; if ($term->does('Attean::API::Blank')) { croak "Expecting (non-blank) RDF term but found blank"; } } } # [56] BrackettedExpression ::= '(' Expression ')' # sub _BrackettedExpression_test { # my $self = shift; # return $self->_test_token(LPAREN); # } sub _BrackettedExpression { my $self = shift; $self->_expected_token(LPAREN); $self->_Expression; $self->_expected_token(RPAREN); } sub _Aggregate { my $self = shift; my $op; my $custom_agg_iri; if (scalar(@_)) { $custom_agg_iri = shift->value; $op = 'CUSTOM'; } else { my $t = $self->_expected_token(KEYWORD); $op = $t->value; } $self->_expected_token(LPAREN); my $distinct = 0; if ($self->_optional_token(KEYWORD, 'DISTINCT')) { $distinct = 1; } my $star = 0; my (@expr, %scalar_args, %options); if ($self->_optional_token(STAR)) { $star = 1; } else { $self->_Expression; push(@expr, splice(@{ $self->{_stack} })); if ($op =~ /^(GROUP_CONCAT|FOLD)$/) { # aggs that can take multiple arguments while ($self->_optional_token(COMMA)) { $self->_Expression; push(@expr, splice(@{ $self->{_stack} })); } } if ($self->_OrderClause_test()) { local($self->{build}{__aggregate}); local($self->{__aggregate_call_ok}); local($self->{build}{options}{orderby}); $self->_OrderClause(); $options{ order } = $self->{build}{options}{orderby}; } if ($self->_optional_token(SEMICOLON)) { if ($self->_optional_token(KEYWORD, 'SEPARATOR')) { $self->_expected_token(EQUALS); my $sep = $self->_String; $scalar_args{ seperator } = $sep; } } } $self->_expected_token(RPAREN); my $arg = join(',', map { blessed($_) ? $_->as_string : $_ } @expr); if ($distinct) { $arg = 'DISTINCT ' . $arg; } my $name = sprintf('%s(%s)', $op, $arg); my $var = Attean::Variable->new( value => ".$name"); my $agg = Attean::AggregateExpression->new( distinct => $distinct, operator => $op, children => [@expr], scalar_vars => \%scalar_args, variable => $var, custom_iri => $custom_agg_iri, %options ); $self->{build}{__aggregate}{ $name } = [ $var, $agg ]; my $expr = Attean::ValueExpression->new(value => $var); $self->_add_stack($expr); } # [57] BuiltInCall ::= 'STR' '(' Expression ')' | 'LANG' '(' Expression ')' | 'LANGMATCHES' '(' Expression ',' Expression ')' | 'DATATYPE' '(' Expression ')' | 'BOUND' '(' Var ')' | 'sameTerm' '(' Expression ',' Expression ')' | 'isIRI' '(' Expression ')' | 'isURI' '(' Expression ')' | 'isBLANK' '(' Expression ')' | 'isLITERAL' '(' Expression ')' | RegexExpression sub _BuiltInCall_test { my $self = shift; my $t = $self->_peek_token; return unless ($t); if ($self->{__aggregate_call_ok}) { return 1 if ($self->_test_token(KEYWORD, qr/^(MIN|MAX|COUNT|AVG|SUM|SAMPLE|GROUP_CONCAT|FOLD)$/io)); } return 1 if ($self->_test_token(KEYWORD, 'NOT')); return 1 if ($self->_test_token(KEYWORD, 'EXISTS')); return 1 if ($self->_test_token(KEYWORD, qr/^(ABS|CEIL|FLOOR|ROUND|CONCAT|SUBSTR|STRLEN|UCASE|LCASE|ENCODE_FOR_URI|CONTAINS|STRSTARTS|STRENDS|RAND|MD5|SHA1|SHA224|SHA256|SHA384|SHA512|HOURS|MINUTES|SECONDS|DAY|MONTH|YEAR|TIMEZONE|TZ|NOW)$/i)); return 1 if ($self->_test_token(KEYWORD, qr/^(TRIPLE|ISTRIPLE|SUBJECT|PREDICATE|OBJECT)$/i)); return ($self->_test_token(KEYWORD, qr/^(COALESCE|UUID|STRUUID|STR|STRDT|STRLANG|STRBEFORE|STRAFTER|REPLACE|BNODE|IRI|URI|LANG|LANGMATCHES|DATATYPE|BOUND|sameTerm|isIRI|isURI|isBLANK|isLITERAL|REGEX|IF|isNumeric)$/i)); } sub _BuiltInCall { my $self = shift; my $t = $self->_peek_token; if ($self->{__aggregate_call_ok} and $self->_test_token(KEYWORD, qr/^(MIN|MAX|COUNT|AVG|SUM|SAMPLE|GROUP_CONCAT|FOLD)\b/io)) { $self->_Aggregate; } elsif ($self->_test_token(KEYWORD, qr/^(NOT|EXISTS)/)) { my $not = $self->_optional_token(KEYWORD, 'NOT'); $self->_expected_token(KEYWORD, 'EXISTS'); local($self->{filters}) = []; $self->_GroupGraphPattern; my $cont = $self->_remove_pattern; my $p = Attean::ExistsExpression->new( pattern => $cont ); if ($not) { $p = Attean::UnaryExpression->new( operator => '!', children => [$p] ); } $self->_add_stack($p); } elsif ($self->_test_token(KEYWORD, qr/^(COALESCE|BNODE|CONCAT|SUBSTR|RAND|NOW)/i)) { # n-arg functions that take expressions my $t = $self->_next_token; my $op = $t->value; my @args = $self->_ArgList; my $func = $self->new_function_expression( $op, @args ); $self->_add_stack( $func ); } elsif ($self->_test_token(KEYWORD, 'REGEX')) { $self->_RegexExpression; } else { my $t = $self->_next_token; my $op = $t->value; if ($op =~ /^(STR)?UUID$/i) { # no-arg functions $self->_expected_token(NIL); $self->_add_stack( $self->new_function_expression($op) ); } elsif ($op =~ /^(STR|URI|IRI|LANG|DATATYPE|isIRI|isURI|isBLANK|isLITERAL|isNumeric|ABS|CEIL|FLOOR|ROUND|STRLEN|UCASE|LCASE|ENCODE_FOR_URI|MD5|SHA1|SHA224|SHA256|SHA384|SHA512|HOURS|MINUTES|SECONDS|DAY|MONTH|YEAR|TIMEZONE|TZ|ISTRIPLE|SUBJECT|PREDICATE|OBJECT)$/i) { ### one-arg functions that take an expression $self->_expected_token(LPAREN); $self->_Expression; my ($expr) = splice(@{ $self->{_stack} }); $self->_add_stack( $self->new_function_expression($op, $expr) ); $self->_expected_token(RPAREN); } elsif ($op =~ /^(STRDT|STRLANG|LANGMATCHES|sameTerm|CONTAINS|STRSTARTS|STRENDS|STRBEFORE|STRAFTER)$/i) { ### two-arg functions that take expressions $self->_expected_token(LPAREN); $self->_Expression; my ($arg1) = splice(@{ $self->{_stack} }); $self->_expected_token(COMMA); $self->_Expression; my ($arg2) = splice(@{ $self->{_stack} }); $self->_add_stack( $self->new_function_expression($op, $arg1, $arg2) ); $self->_expected_token(RPAREN); } elsif ($op =~ /^(IF|REPLACE|TRIPLE)$/i) { ### three-arg functions that take expressions $self->_expected_token(LPAREN); $self->_Expression; my ($arg1) = splice(@{ $self->{_stack} }); $self->_expected_token(COMMA); $self->_Expression; my ($arg2) = splice(@{ $self->{_stack} }); $self->_expected_token(COMMA); $self->_Expression; my ($arg3) = splice(@{ $self->{_stack} }); $self->_add_stack( $self->new_function_expression($op, $arg1, $arg2, $arg3) ); $self->_expected_token(RPAREN); } else { ### BOUND(Var) $self->_expected_token(LPAREN); $self->_Var; my $var = pop(@{ $self->{_stack} }); my $expr = Attean::ValueExpression->new(value => $var); $self->_add_stack( $self->new_function_expression($op, $expr) ); $self->_expected_token(RPAREN); } } } # [58] RegexExpression ::= 'REGEX' '(' Expression ',' Expression ( ',' Expression )? ')' # sub _RegexExpression_test { # my $self = shift; # return $self->_test_token(KEYWORD, 'REGEX'); # } sub _RegexExpression { my $self = shift; $self->_expected_token(KEYWORD, 'REGEX'); $self->_expected_token(LPAREN); $self->_Expression; my $string = splice(@{ $self->{_stack} }); $self->_expected_token(COMMA); $self->_Expression; my $pattern = splice(@{ $self->{_stack} }); my @args = ($string, $pattern); if ($self->_optional_token(COMMA)) { $self->_Expression; push(@args, splice(@{ $self->{_stack} })); } $self->_expected_token(RPAREN); $self->_add_stack( $self->new_function_expression( 'REGEX', @args ) ); } # [59] IRIrefOrFunction ::= IRIref ArgList? # sub _IRIrefOrFunction_test { # my $self = shift; # $self->_IRIref_test; # } sub _IRIrefOrFunction { my $self = shift; $self->_IRIref; if ($self->_ArgList_test) { my ($iri) = splice(@{ $self->{_stack} }); if (my $func = Attean->get_global_aggregate($iri->value)) { # special-case: treat this as an aggregate invocation instead of a scalar function call, since there is a custom aggregate registered return $self->_Aggregate($iri); } my @args = $self->_ArgList; if ($iri->value =~ m<^http://www[.]w3[.]org/2001/XMLSchema#(?:integer|decimal|float|double|boolean|string|dateTime)$>) { my $expr = Attean::CastExpression->new( children => \@args, datatype => $iri ); $self->_add_stack( $expr ); } else { my $func = Attean::ValueExpression->new( value => $iri ); my $expr = $self->new_function_expression( 'INVOKE', $func, @args ); $self->_add_stack( $expr ); } } } # [60] RDFLiteral ::= String ( LANGTAG | ( '^^' IRIref ) )? sub _RDFLiteral { my $self = shift; my $value = $self->_String; my $obj; if ($self->_test_token(LANG)) { my $t = $self->_expected_token(LANG); my $lang = $t->value; $obj = $self->new_literal( value => $value, language => $lang ); } elsif ($self->_test_token(HATHAT)) { $self->_expected_token(HATHAT); $self->_IRIref; my ($iri) = splice(@{ $self->{_stack} }); $obj = $self->new_literal( value => $value, datatype => $iri ); } else { $obj = $self->new_literal( value => $value ); } return $obj; } # [61] NumericLiteral ::= NumericLiteralUnsigned | NumericLiteralPositive | NumericLiteralNegative # [62] NumericLiteralUnsigned ::= INTEGER | DECIMAL | DOUBLE # [63] NumericLiteralPositive ::= INTEGER_POSITIVE | DECIMAL_POSITIVE | DOUBLE_POSITIVE # [64] NumericLiteralNegative ::= INTEGER_NEGATIVE | DECIMAL_NEGATIVE | DOUBLE_NEGATIVE sub _NumericLiteral { my $self = shift; my $sign = 0; if ($self->_optional_token(PLUS)) { $sign = '+'; } elsif ($self->_optional_token(MINUS)) { $sign = '-'; } my $value; my $type; if (my $db = $self->_optional_token(DOUBLE)) { $value = $db->value; $type = Attean::IRI->new(value => 'http://www.w3.org/2001/XMLSchema#double', lazy => 1); } elsif (my $dc = $self->_optional_token(DECIMAL)) { $value = $dc->value; $type = Attean::IRI->new(value => 'http://www.w3.org/2001/XMLSchema#decimal', lazy => 1); } else { my $i = $self->_expected_token(INTEGER); $value = $i->value; $type = Attean::IRI->new(value => 'http://www.w3.org/2001/XMLSchema#integer', lazy => 1); } if ($sign) { $value = $sign . $value; } my $obj = $self->new_literal( value => $value, datatype => $type ); # if ($self->{args}{canonicalize} and blessed($obj) and $obj->isa('RDF::Trine::Node::Literal')) { # $obj = $obj->canonicalize; # } return $obj; } # [65] BooleanLiteral ::= 'true' | 'false' sub _BooleanLiteral { my $self = shift; my $t = $self->_expected_token(BOOLEAN); my $bool = $t->value; my $obj = $self->new_literal( value => $bool, datatype => 'http://www.w3.org/2001/XMLSchema#boolean' ); # if ($self->{args}{canonicalize} and blessed($obj) and $obj->isa('RDF::Trine::Node::Literal')) { # $obj = $obj->canonicalize; # } return $obj; } # [66] String ::= STRING_LITERAL1 | STRING_LITERAL2 | STRING_LITERAL_LONG1 | STRING_LITERAL_LONG2 sub _String { my $self = shift; my $value; my $string; my $t = $self->_peek_token; if ($string = $self->_optional_token(STRING1D)) { $value = $string->value; } elsif ($string = $self->_optional_token(STRING1S)) { $value = $string->value; } elsif ($string = $self->_optional_token(STRING3S)) { $value = $string->value; } elsif ($string = $self->_optional_token(STRING3D)) { $value = $string->value; } else { my $got = AtteanX::SPARQL::Constants::decrypt_constant($t->type); my $value = $t->value; croak "Expecting string literal but found $got '$value'"; } $value =~ s/\\t/\t/g; $value =~ s/\\b/\n/g; $value =~ s/\\n/\n/g; $value =~ s/\\r/\x08/g; $value =~ s/\\"/"/g; $value =~ s/\\'/'/g; $value =~ s/\\\\/\\/g; # backslash must come last, so it doesn't accidentally create a new escape return $value; } # [67] IRIref ::= IRI_REF | PrefixedName sub _IRIref_test { my $self = shift; return 1 if ($self->_test_token(IRI)); return 1 if ($self->_test_token(PREFIXNAME)); return 0; } sub _IRIref { my $self = shift; if (my $t = $self->_optional_token(IRI)) { my $iri = $t->value; my $base = $self->__base; my $node = $self->new_iri( value => $iri, $base ? (base => $base) : () ); $self->_add_stack( $node ); } else { my $p = $self->_PrefixedName; $self->_add_stack( $p ); } } # [68] PrefixedName ::= PNAME_LN | PNAME_NS sub _PrefixedName { my $self = shift; my $t = $self->_expected_token(PREFIXNAME); my ($ns, $local) = @{ $t->args }; chop($ns); # $local =~ s{\\([-~.!&'()*+,;=:/?#@%_\$])}{$1}g; unless ($self->namespaces->namespace_uri($ns)) { croak "Syntax error: Use of undefined namespace '$ns'"; } my $iri = $self->namespaces->namespace_uri($ns)->iri($local); my $base = $self->__base; my $p = $self->new_iri( value => $iri->value, $base ? (base => $base) : () ); return $p; } sub _qtSubjectOrObject { my $self = shift; # Var | BlankNode | iri | RDFLiteral | NumericLiteral | BooleanLiteral | QuotedTP if ($self->_test_token(LTLT)) { $self->_QuotedTP(); } else { $self->_VarOrTerm; } } sub _QuotedTP { my $self = shift; #'<<' qtSubjectOrObject Verb qtSubjectOrObject '>>' $self->_expected_token(LTLT); $self->_qtSubjectOrObject(); $self->_Verb(); $self->_qtSubjectOrObject(); $self->_expected_token(GTGT); my ($s, $p, $o) = splice(@{ $self->{_stack} }, -3); if ($self->{__data_pattern}) { foreach my $term ($s, $o) { if ($term->does('Attean::API::Blank')) { croak "Expecting (non-blank) RDF term in quoted triple, but found blank"; } } } $self->_add_stack( $self->__new_statement( $s, $p, $o ) ); } sub _QuotedTriple { my $self = shift; #'<<' DataValueTerm Verb DataValueTerm '>>' local($self->{__data_pattern}) = 1; $self->_QuotedTP(); } # [69] BlankNode ::= BLANK_NODE_LABEL | ANON sub _BlankNode { my $self = shift; if (my $where = $self->{__no_bnodes}) { croak "Syntax error: Blank nodes not allowed in $where"; } if (my $b = $self->_optional_token(BNODE)) { my $label = $b->value; my $b = Attean::Blank->new($label); $self->blank_nodes->{$label} = $b; return $b; } else { $self->_expected_token(ANON); return Attean::Blank->new(); } } sub _NIL { my $self = shift; $self->_expected_token(NIL); return Attean::IRI->new(value => 'http://www.w3.org/1999/02/22-rdf-syntax-ns#nil', lazy => 1); } sub __solution_modifiers { my $self = shift; my $star = shift; my @exprs = @_; if (my $computed_group_vars = delete( $self->{build}{__group_vars} )) { my $pattern = $self->{build}{triples}[0]; foreach my $data (@$computed_group_vars) { my ($var, $expr) = @$data; $pattern = Attean::Algebra::Extend->new( children => [$pattern], variable => $var, expression => $expr ); } $self->{build}{triples}[0] = $pattern; } my $has_aggregation = 0; my $having_expr; my $aggdata = delete( $self->{build}{__aggregate} ); my $groupby = delete( $self->{build}{__group_by} ) || []; my @aggkeys = keys %{ $aggdata || {} }; if (scalar(@aggkeys) or scalar(@$groupby)) { $has_aggregation++; my @aggs; foreach my $k (@aggkeys) { my ($var, $expr) = @{ $aggdata->{$k} }; push(@aggs, $expr); } my $pattern = $self->{build}{triples}; my $ggp = shift(@$pattern); if (my $having = delete( $self->{build}{__having} )) { $having_expr = $having; } my $agg = Attean::Algebra::Group->new( children => [$ggp], groupby => $groupby, aggregates => \@aggs ); push(@{ $self->{build}{triples} }, $agg); } my %group_vars; my %agg_vars; if ($has_aggregation) { foreach my $agg_var (map { $_->[0] } values %$aggdata) { $agg_vars{ $agg_var->value }++; } foreach my $g (@$groupby) { if ($g->isa('Attean::ValueExpression') and $g->value->does('Attean::API::Variable')) { $group_vars{ $g->value->value }++; } else { $self->log->trace("Remaining GROUP BY clauses:\n" . Dumper($g)); croak 'Unrecognized GROUP BY clauses, see trace log for details.'; } } } my @project; my @vars; my @extend; if ($star) { my $pattern = ${ $self->{build}{triples} }[-1]; push(@project, $pattern->in_scope_variables); if ($has_aggregation) { croak "Cannot SELECT * in an aggregate query"; } } else { for (my $i = 0; $i < $#exprs; $i += 2) { my $k = $exprs[$i]; my $v = $exprs[$i+1]; if ($has_aggregation) { my @vars = $v->does('Attean::API::Variable') ? $v : $v->unaggregated_variables; foreach my $var (@vars) { my $name = $var->value; unless (exists $agg_vars{$name} or exists $group_vars{$name}) { croak "Cannot project variable ?$name that is not aggregated or used in grouping"; } } } push(@project, $k); if ($v->does('Attean::API::Variable')) { push(@vars, $v); } else { push(@extend, $k, $v); } } } { my $pattern = pop(@{ $self->{build}{triples} }); my %in_scope = map { $_ => 1 } $pattern->in_scope_variables; while (my($name, $expr) = splice(@extend, 0, 2)) { if (exists $in_scope{$name}) { croak "Syntax error: Already-bound variable ($name) used in project expression"; } my $var = Attean::Variable->new( value => $name ); $pattern = Attean::Algebra::Extend->new(children => [$pattern], variable => $var, expression => $expr); } push(@{ $self->{build}{triples} }, $pattern); } if ($having_expr) { my $pattern = pop(@{ $self->{build}{triples} }); my $filter = Attean::Algebra::Filter->new( children => [$pattern], expression => $having_expr ); push(@{ $self->{build}{triples} }, $filter); } if ($self->{build}{options}{orderby}) { my $order = delete $self->{build}{options}{orderby}; my $pattern = pop(@{ $self->{build}{triples} }); my @order = @$order; my @cmps; foreach my $o (@order) { my ($dir, $expr) = @$o; my $asc = ($dir eq 'ASC'); push(@cmps, Attean::Algebra::Comparator->new(ascending => $asc, expression => $expr)); } my $sort = Attean::Algebra::OrderBy->new( children => [$pattern], comparators => \@cmps ); push(@{ $self->{build}{triples} }, $sort); } { my $pattern = pop(@{ $self->{build}{triples} }); my $vars = [map { Attean::Variable->new(value => $_) } @project]; if (scalar(@$vars)) { $pattern = Attean::Algebra::Project->new( children => [$pattern], variables => $vars); } push(@{ $self->{build}{triples} }, $pattern); } if (my $level = $self->{build}{options}{distinct}) { delete $self->{build}{options}{distinct}; my $pattern = pop(@{ $self->{build}{triples} }); my $sort = ($level == 1) ? Attean::Algebra::Distinct->new( children => [$pattern] ) : Attean::Algebra::Reduced->new( children => [$pattern] ); push(@{ $self->{build}{triples} }, $sort); } if (exists $self->{build}{options}{offset} and exists $self->{build}{options}{limit}) { my $limit = delete $self->{build}{options}{limit}; my $offset = delete $self->{build}{options}{offset}; my $pattern = pop(@{ $self->{build}{triples} }); my $sliced = Attean::Algebra::Slice->new( children => [$pattern], limit => $limit, offset => $offset ); push(@{ $self->{build}{triples} }, $sliced); } elsif (exists $self->{build}{options}{offset}) { my $offset = delete $self->{build}{options}{offset}; my $pattern = pop(@{ $self->{build}{triples} }); my $sliced = Attean::Algebra::Slice->new( children => [$pattern], offset => $offset ); push(@{ $self->{build}{triples} }, $sliced); } elsif (exists $self->{build}{options}{limit}) { my $limit = delete $self->{build}{options}{limit}; my $pattern = pop(@{ $self->{build}{triples} }); my $sliced = Attean::Algebra::Slice->new( children => [$pattern], limit => $limit ); push(@{ $self->{build}{triples} }, $sliced); } return @project; } ################################################################################ =item C<< error >> Returns the error encountered during the last parse. =cut sub _add_patterns { my $self = shift; my @triples = @_; my $container = $self->{ _pattern_container_stack }[0]; push( @{ $container }, @triples ); } sub _remove_pattern { my $self = shift; my $container = $self->{ _pattern_container_stack }[0]; my $pattern = pop( @{ $container } ); return $pattern; } sub _peek_pattern { my $self = shift; my $container = $self->{ _pattern_container_stack }[0]; my $pattern = $container->[-1]; return $pattern; } sub _add_hint { my $self = shift; my $hints = shift; push( @{ $self->{ _pattern_container_hints_stack }[0] }, $hints ); } sub _push_pattern_container { my $self = shift; my $cont = []; unshift( @{ $self->{ _pattern_container_stack } }, $cont ); unshift( @{ $self->{ _pattern_container_hints_stack } }, [] ); return $cont; } sub _pop_pattern_container { my $self = shift; my $hints = shift( @{ $self->{ _pattern_container_hints_stack } } ); my $cont = shift( @{ $self->{ _pattern_container_stack } } ); return ($cont, $hints); } sub _add_stack { my $self = shift; my @items = @_; push( @{ $self->{_stack} }, @items ); } sub _add_filter { my $self = shift; my @filters = shift; push( @{ $self->{filters} }, @filters ); } sub __base { my $self = shift; my $build = $self->{build}; if (blessed($build->{base})) { return $build->{base}; } elsif (defined($build->{base})) { return $self->new_iri($build->{base}); } else { return; } } sub __new_statement { my $self = shift; my $s = shift; my $p = shift; my $o = shift; my $annot; if ($o->isa('AtteanX::Parser::SPARQL::ObjectWrapper')) { if (reftype($p) eq 'ARRAY' and $p->[0] eq 'PATH') { # this is actually a property path, for which annotations (stored in the ObjectWrapper) are forbidden croak "Syntax error: Cannot use SPARQL-star annotation syntax on a property path"; } $annot = $o->annotations; $o = $o->value; } my $t = Attean::TriplePattern->new($s, $p, $o); my @st = ($t); if ($annot) { $s = $t; foreach my $pair (@$annot) { my ($p, $o) = @$pair; push(@st, $self->__new_statement($s, $p, $o)); } } return @st; } sub __new_path { my $self = shift; my $start = shift; my $pdata = shift; my $end = shift; (undef, my $op, my @nodes) = @$pdata; my $path = $self->__new_path_pred($op, @nodes); return Attean::Algebra::Path->new( subject => $start, path => $path, object => $end ); } sub __new_path_pred { my $self = shift; my $op = shift; my @nodes = @_; if ($op eq '!') { my @preds; my @reversed; foreach my $p (@nodes) { if (blessed($p)) { push(@preds, $p); } elsif (reftype($p) eq 'ARRAY' and $p->[1] eq '^' and blessed($p->[2])) { push(@reversed, $p->[2]); } else { die "Unexpected NPS element: " . Dumper($p); } } return Attean::Algebra::NegatedPropertySet->new( predicates => \@preds, reversed => \@reversed ); } foreach my $i (0 .. $#nodes) { if (ref($nodes[$i]) eq 'ARRAY') { (undef, my @data) = @{ $nodes[$i] }; $nodes[$i] = $self->__new_path_pred(@data); } elsif ($nodes[$i]->does('Attean::API::IRI')) { $nodes[$i] = Attean::Algebra::PredicatePath->new( predicate => $nodes[$i] ); } } if ($op eq '*') { return Attean::Algebra::ZeroOrMorePath->new( children => [@nodes] ); } elsif ($op eq '+') { return Attean::Algebra::OneOrMorePath->new( children => [@nodes] ); } elsif ($op eq '?') { return Attean::Algebra::ZeroOrOnePath->new( children => [@nodes] ); } elsif ($op eq '^') { return Attean::Algebra::InversePath->new( children => [@nodes] ); } elsif ($op eq '/') { return Attean::Algebra::SequencePath->new( children => [@nodes] ); } elsif ($op eq '|') { return Attean::Algebra::AlternativePath->new( children => [@nodes] ); } else { $self->log->debug("Path $op:\n". Dumper(\@nodes)); confess "Error in path $op. See debug log for details." } } sub __new_bgp { # fix up BGPs that might actually have property paths in them. split those # out as their own path algebra objects, and join them with the bgp with a # ggp if necessary my $self = shift; my @patterns = @_; my @paths = grep { reftype($_->predicate) eq 'ARRAY' and $_->predicate->[0] eq 'PATH' } @patterns; my @triples = grep { blessed($_->predicate) } @patterns; if ($self->log->is_trace && (scalar(@patterns) > scalar(@paths) + scalar(@triples))) { $self->log->warn('More than just triples and paths passed to __new_bgp'); $self->log->trace("Arguments to __new_bgp:\n" .Dumper(\@patterns)); } my $bgp = Attean::Algebra::BGP->new( triples => \@triples ); if (@paths) { my @p; foreach my $p (@paths) { my $start = $p->subject; my $end = $p->object; my $pdata = $p->predicate; push(@p, $self->__new_path( $start, $pdata, $end )); } if (scalar(@triples)) { return $self->_new_join($bgp, @p); } else { return $self->_new_join(@p); } } else { return $bgp; } } =item C Returns a new binary expression structure. =cut sub new_binary_expression { my $self = shift; my $op = shift; my @operands = @_[0,1]; return Attean::BinaryExpression->new( operator => $op, children => \@operands ); } =item C Returns a new function expression structure. =cut sub new_function_expression { my $self = shift; my $function = shift; my @operands = @_; my $base = $self->__base; return Attean::FunctionExpression->new( operator => $function, children => \@operands, $base ? (base => $base) : () ); } sub _new_join { my $self = shift; my @parts = @_; if (0 == scalar(@parts)) { return Attean::Algebra::BGP->new(); } elsif (1 == scalar(@parts)) { return shift(@parts); } else { return Attean::Algebra::Join->new( children => \@parts ); } } sub _peek_token { my $self = shift; my $l = $self->lexer; my $t = $l->peek; return unless ($t); while ($t == COMMENT) { $t = $l->peek; return unless ($t); } return $t; } sub _test_token { my $self = shift; my $type = shift; my $t = $self->_peek_token; return unless ($t); return if ($t->type != $type); if (@_) { my $value = shift; if (ref($value) eq 'Regexp') { return unless ($t->value =~ $value); } else { return unless ($t->value eq $value); } } return 1; } sub _optional_token { my $self = shift; if ($self->_test_token(@_)) { return $self->_next_token; } return; } sub _next_token { my $self = shift; my $l = $self->lexer; my $t = $l->next; while ($t->type == COMMENT) { $t = $l->peek; return unless ($t); } return $t; } sub _expected_token { my $self = shift; my $type = shift; if ($self->_test_token($type, @_)) { return $self->_next_token; } else { my $t = $self->_peek_token; my $expecting = AtteanX::SPARQL::Constants::decrypt_constant($type); my $got = blessed($t) ? AtteanX::SPARQL::Constants::decrypt_constant($t->type) : '(undef)'; if (@_) { my $value = shift; if ($t) { my $value2 = $t->value; confess "Expecting $expecting '$value' but got $got '$value2' before " . $self->lexer->buffer; } else { confess "Expecting $expecting '$value' but found EOF"; } } else { confess "Expecting $expecting but found $got before " . $self->lexer->buffer; } } } sub _token_error { my $self = shift; my $t = shift; my $note = shift; my $got = blessed($t) ? AtteanX::SPARQL::Constants::decrypt_constant($t->type) : '(undef)'; my $message = "$note but got $got"; if ($t and $t->start_line > 0) { my $l = $t->start_line; my $c = $t->start_column; $message .= " at $l:$c"; } else { my $n = $self->lexer->buffer; $n =~ s/\s+/ /g; $n =~ s/\s*$//; if ($n) { $message .= " near '$n'"; } } croak $message; } package AtteanX::Parser::SPARQL::ObjectWrapper 0.034; use strict; use warnings; no warnings 'redefine'; use Types::Standard qw(InstanceOf HashRef ArrayRef Bool Str Int); use Moo; has 'value' => (is => 'rw'); has 'annotations' => (is => 'rw', isa => ArrayRef); 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Parser/SPARQLXML/000755 000765 000024 00000000000 14636711137 017765 5ustar00gregstaff000000 000000 Attean-0.034/lib/AtteanX/Parser/PaxHeader/Trig.pm000644 000765 000024 00000000225 14636707550 021621 xustar00gregstaff000000 000000 30 mtime=1719373672.423283867 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Parser/Trig.pm000644 000765 000024 00000014133 14636707550 017653 0ustar00gregstaff000000 000000 use v5.14; use warnings; # AtteanX::Parser::Trig # ----------------------------------------------------------------------------- =head1 NAME AtteanX::Parser::Trig - Trig RDF Parser =head1 VERSION This document describes AtteanX::Parser::Trig version 0.034 =head1 SYNOPSIS use Attean; my $parser = AtteanX::Parser::Trig->new( handler => sub {...}, base => $base_iri ); # Parse data from a file-handle and handle triples in the 'handler' callback $parser->parse_cb_from_io( $fh ); # Parse the given byte-string, and return an iterator of triples my $iter = $parser->parse_iter_from_bytes('

1, 2, 3 .'); while (my $triple = $iter->next) { print $triple->as_string; } =head1 DESCRIPTION This module implements a parser for the Trig RDF format. =head1 ROLES This class consumes L, L, , and . =head1 ATTRIBUTES =over 4 =item C<< canonical_media_type >> =item C<< media_types >> =item C<< file_extensions >> =item C<< canonicalize >> A boolean indicating whether term values should be canonicalized during parsing. =back =head1 METHODS =over 4 =cut package AtteanX::Parser::Trig 0.034 { use Moo; use Types::Standard qw(Bool ArrayRef HashRef Str Maybe InstanceOf); use Types::Namespace qw( NamespaceMap ); use utf8; use Carp qw(carp); use Encode qw(encode); use Scalar::Util qw(blessed); use Attean::API::Parser; use AtteanX::Parser::Turtle; use AtteanX::Parser::Turtle::Constants; use namespace::clean; my $RDF = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'; my $XSD = 'http://www.w3.org/2001/XMLSchema#'; extends 'AtteanX::Parser::Turtle'; sub canonical_media_type { return "text/trig" } sub media_types { return [qw(text/trig)]; } sub file_extensions { return [qw(trig)] } has 'canonicalize' => (is => 'rw', isa => Bool, default => 0); has '_map' => (is => 'ro', isa => HashRef[Str], default => sub { +{} }); with 'Attean::API::MixedStatementParser'; ################################################################################ # this is the entry point where we change the rules from Turtle to Trig sub _parse { my $self = shift; my $l = shift; $l->check_for_bom; while (my $t = $self->_next_nonws($l)) { $self->_trigDoc($l, $t); } } sub _trigDoc { my $self = shift; my $l = shift; my $t = shift; my $type = $t->type; if ($type == TURTLEPREFIX or $type == PREFIX) { $t = $self->_get_token_type($l, PREFIXNAME); use Data::Dumper; unless (defined($t->value)) { my $tname = AtteanX::Parser::Turtle::Constants::decrypt_constant($t->type); Carp::confess "undefined $tname token value: " . Dumper($t); } my $name = $t->value; chop($name) if (substr($name, -1) eq ':'); # $name =~ s/:$//; $t = $self->_get_token_type($l, IRI); my %args = (value => $t->value); if ($self->has_base) { $args{base} = $self->base; } my $r = $self->new_iri(%args); my $iri = $r->as_string; if ($type == TURTLEPREFIX) { $t = $self->_get_token_type($l, DOT); # $t = $self->_next_nonws($l); # if ($t and $t->type != DOT) { # $self->_unget_token($t); # } } $self->_map->{$name} = $iri; if ($self->has_namespaces) { my $ns = $self->namespaces; unless ($ns->namespace_uri($name)) { $ns->add_mapping($name, $iri); } } } elsif ($type == TURTLEBASE or $type == BASE) { $t = $self->_get_token_type($l, IRI); my %args = (value => $t->value); if ($self->has_base) { $args{base} = $self->base; } my $r = $self->new_iri(%args); my $iri = $r->as_string; if ($type == TURTLEBASE) { $t = $self->_get_token_type($l, DOT); # $t = $self->_next_nonws($l); # if ($t and $t->type != DOT) { # $self->_unget_token($t); # } } $self->base($iri); } else { $self->_block( $l, $t ); } # } } sub _block { my $self = shift; my $l = shift; my $t = shift; my $type = $t->type; if ($type == GRAPH) { # "GRAPH" labelOrSubject wrappedGraph my $graph = $self->_labelOrSubject($l); local($self->{graph}) = $graph; $t = $self->_get_token_type($l, LBRACE); $self->_block($l, $t); } elsif ($type == LBRACE) { $t = $self->_next_nonws($l); $type = $t->type; while ($type != RBRACE) { $self->_triple($l, $t); $t = $self->_next_nonws($l); $type = $t->type; unless ($type == RBRACE or $type == DOT) { carp "Expected DOT or closing brace"; } if ($type == DOT) { $t = $self->_next_nonws($l); $type = $t->type; } } } else { $self->_triple($l, $t); $t = $self->_get_token_type($l, DOT); } } sub _labelOrSubject { my $self = shift; my $l = shift; my $t = $self->_next_nonws($l); if ($t->type == IRI or $t->type == PREFIXNAME or $t->type == BNODE) { return $self->_token_to_node($t); } else { $self->_throw_error(sprintf("Expecting graph name but got %s", decrypt_constant($t->type)), $t, $l); } } sub _assert_triple { my $self = shift; my $subj = shift; my $pred = shift; my $obj = shift; if ($self->canonicalize and blessed($obj) and $obj->does('Attean::API::Literal')) { $obj = $obj->canonicalize; } my $graph = $self->{graph}; my $t = (defined($graph)) ? Attean::Quad->new($subj, $pred, $obj, $graph) : Attean::Triple->new($subj, $pred, $obj); $self->handler->($t); return $t; } sub _throw_error { my $self = shift; my $message = shift; my $t = shift; my $l = shift; my $line = $t->start_line; my $col = $t->start_column; # Carp::cluck "$message at $line:$col"; my $text = "$message at $line:$col"; if (defined($t->value)) { $text .= " (near '" . $t->value . "')"; } Carp::cluck "TriG parser error"; die $text; } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Parser/Turtle/000755 000765 000024 00000000000 14636711137 017661 5ustar00gregstaff000000 000000 Attean-0.034/lib/AtteanX/Parser/PaxHeader/NTriples.pm000644 000765 000024 00000000225 14636707550 022454 xustar00gregstaff000000 000000 30 mtime=1719373672.263995676 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Parser/NTriples.pm000644 000765 000024 00000005031 14636707550 020503 0ustar00gregstaff000000 000000 =head1 NAME AtteanX::Parser::NTriples - N-Triples Parser =head1 VERSION This document describes AtteanX::Parser::NTriples version 0.034 =head1 SYNOPSIS use Attean; my $parser = Attean->get_parser('NTriples')->new(); # Parse data from a file-handle and handle triples in the 'handler' callback $parser->parse_cb_from_io( $fh ); # Parse the given byte-string, and return an iterator of triples my $iter = $parser->parse_iter_from_bytes(' "object" .'); while (my $triple = $iter->next) { print $triple->as_string; } =head1 DESCRIPTION This module implements a parser for the N-Triples format. =head1 ROLES This class consumes L, L and . =head1 METHODS =over 4 =item C<< parse_iter_from_io( $fh ) >> Returns an L that result from parsing the data read from the L object C<< $fh >>. =item C<< parse_iter_from_bytes( $data ) >> Returns an L that result from parsing the data read from the UTF-8 encoded byte string C<< $data >>. =cut use v5.14; use warnings; package AtteanX::Parser::NTriples 0.034 { use utf8; use Attean; use Moo; extends 'AtteanX::Parser::NTuples'; =item C<< canonical_media_type >> Returns the canonical media type for N-Triples: application/n-triples. =cut sub canonical_media_type { return "application/n-triples" } =item C<< media_types >> Returns a list of media types that may be parsed with the N-Triples parser: application/n-triples. =cut sub media_types { return [qw(application/n-triples)]; } =item C<< file_extensions >> Returns a list of file extensions that may be parsed with the parser. =cut sub file_extensions { return [qw(nt)] } with 'Attean::API::TripleParser'; with 'Attean::API::PullParser'; with 'Attean::API::Parser'; with 'Attean::API::CDTBlankNodeMappingParser'; sub _binding { my $self = shift; my $nodes = shift; my $lineno = shift; if (scalar(@$nodes) == 3) { return Attean::Triple->new(@$nodes); } else { die qq[Not valid N-Triples data at line $lineno]; } } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Parser/PaxHeader/SPARQLJSON.pm000644 000765 000024 00000000225 14636707550 022410 xustar00gregstaff000000 000000 30 mtime=1719373672.337278559 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Parser/SPARQLJSON.pm000644 000765 000024 00000006720 14636707550 020445 0ustar00gregstaff000000 000000 =head1 NAME AtteanX::Parser::SPARQLJSON - SPARQL JSON Parser =head1 VERSION This document describes AtteanX::Parser::SPARQLJSON version 0.034 =head1 SYNOPSIS use Attean; my $parser = Attean->get_parser('SPARQLJSON')->new(); $parser->parse_list_from_io( $fh ); =head1 DESCRIPTION ... =head1 ATTRIBUTES =over 4 =item C<< canonical_media_type >> =item C<< media_types >> =item C<< file_extensions >> =back =head1 METHODS =over 4 =cut use v5.14; use warnings; package AtteanX::Parser::SPARQLJSON 0.034 { use Attean; use Moo; use JSON; use Encode qw(decode); sub canonical_media_type { return "application/sparql-results+json" } sub media_types { return [qw(application/sparql-results+json)]; } sub file_extensions { return [qw(srj)] } with 'Attean::API::ResultOrTermParser'; with 'Attean::API::Parser'; with 'Attean::API::AtOnceParser'; =item C<< parse_list_from_io( $fh ) >> =cut sub parse_list_from_io { my $self = shift; my $io = shift; my $data = do { local($/) = undef; <$io> }; return $self->parse_list_from_bytes($data); } =item C<< parse_list_from_bytes( $bytes ) >> =cut sub parse_list_from_bytes { my $self = shift; my $octets = shift; my $json = decode('UTF-8', $octets, Encode::FB_CROAK); my $data = from_json($json, {utf8 => 1}); my $head = $data->{head}; my $vars = $head->{vars}; my $res = $data->{results}; if (defined(my $bool = $data->{boolean})) { return ($bool) ? Attean::Literal->true : Attean::Literal->false; } elsif (my $binds = $res->{bindings}) { my @results; foreach my $b (@$binds) { my %data; foreach my $v (@$vars) { if (defined(my $value = $b->{ $v })) { $data{ $v } = $self->decode_node($value); } } push(@results, Attean::Result->new( bindings => \%data )); } return @results; } } =item C<< decode_node( \%value ) >> =cut sub decode_node { my $self = shift; my $value = shift; my $type = $value->{type}; if ($type eq 'uri') { my $data = $value->{value}; return $self->new_iri( value => $data ); } elsif ($type eq 'bnode') { my $data = $value->{value}; return Attean::Blank->new( $data ); } elsif ($type eq 'literal') { my $data = $value->{value}; if (my $lang = $value->{'xml:lang'}) { return Attean::Literal->new( value => $data, language => $lang ); } elsif (my $dt = $value->{'datatype'}) { my $iri = $self->new_iri(value => $dt); return Attean::Literal->new( value => $data, datatype => $iri ); } else { return Attean::Literal->new( $data ); } } elsif ($type eq 'typed-literal') { my $data = $value->{value}; my $dt = $value->{datatype}; my $iri = $self->new_iri(value => $dt); return Attean::Literal->new( value => $data, datatype => $iri ); } elsif ($type eq 'triple') { my $s = $self->decode_node($value->{value}{subject}); my $p = $self->decode_node($value->{value}{predicate}); my $o = $self->decode_node($value->{value}{object}); return Attean::Triple->new( $s, $p, $o ); } else { die "Unknown node type $type during parsing of SPARQL JSON Results"; } } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Parser/PaxHeader/NTuples.pm000644 000765 000024 00000000225 14636707550 022306 xustar00gregstaff000000 000000 30 mtime=1719373672.281010489 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Parser/NTuples.pm000644 000765 000024 00000016415 14636707550 020345 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME AtteanX::Parser::NTuples - Shared functionality for N-Triples and N-Quads parsers =head1 VERSION This document describes AtteanX::Parser::NTuples version 0.034 =head1 SYNOPSIS use Attean; =head1 DESCRIPTION This module provides a base class for RDF formats N-Triples and N-Quads. =head1 METHODS =over 4 =cut package AtteanX::Parser::NTuples 0.034 { use utf8; use Moo; use Attean; use Carp qw(carp); use Encode qw(decode); use Types::Standard qw(Bool HashRef ArrayRef HashRef Str Maybe InstanceOf ConsumerOf); use namespace::clean; has 'blank_nodes' => (is => 'ro', isa => HashRef[ConsumerOf['Attean::API::Blank']], predicate => 'has_blank_nodes_map', default => sub { +{} }); =item C<< parse_term_from_bytes( $bytes ) >> Parses the given C<< $bytes >> and returns a corresponding L object. =cut sub parse_term_from_bytes { my $self = shift; unless (ref($self)) { $self = $self->new(); } my $string = shift; my $n = $self->_eat_node( 0, $string ); return $n; } =item C<< parse_iter_from_bytes( $data ) >> Returns an iterator of L objects that result from parsing the data read from the UTF-8 encoded byte string C<< $data >>. =cut sub parse_iter_from_bytes { my $self = shift; my $data = shift; $data = Encode::encode("utf-8", $data); open(my $fh, '<:encoding(UTF-8)', \$data); return $self->parse_iter_from_io($fh); } =item C<< parse_iter_from_io( $fh ) >> Returns an iterator of L objects that result from parsing the data read from the L object C<< $fh >>. =cut sub parse_iter_from_io { my $self = shift; my $fh = shift; my $lineno = 0; my $line; my $gen = sub { while (defined($line = <$fh>)) { ($line, my @extra) = split(/\r\n|\r|\n/, $line, 2); $lineno++; next unless (defined($line) and length($line)); next unless ($line =~ /\S/); chomp($line); $line =~ s/^\s*//; $line =~ s/\s*$//; next if ($line =~ /^#/); my @nodes = (); while (my $n = $self->_eat_node( $lineno, $line )) { push(@nodes, $n); $line =~ s/^\s*//; } $line =~ s/^\s//g; unless ($line eq '.') { die "Missing expected '.' at line $lineno"; } my $binding = $self->_binding( \@nodes, $lineno ); if (@extra and $extra[0] ne '') { $line = shift(@extra); goto LINE; } return $binding; } return; }; return Attean::CodeIterator->new( generator => $gen, item_type => $self->handled_type->role, ); } sub _eat_node { my $self = shift; my $lineno = shift; $_[0] =~ s/^\s*//; return unless length($_[0]); my $char = substr($_[0], 0, 1); return if ($char eq '.'); if ($char eq '<') { my ($uri) = $_[0] =~ m/^<([^>]*)>/; substr($_[0], 0, length($uri)+2) = ''; state %cache; if (my $i = $cache{$uri}) { return $i; } else { if (rand() < 0.02) { # clear out the cache roughly every 50 IRIs %cache = (); } my $iri = $self->new_iri( value => _unescape($uri, $lineno) ); $cache{$uri} = $iri; return $iri; } } elsif ($char eq '_') { my ($name) = $_[0] =~ m/^_:([A-Za-z][A-Za-z0-9]*)/; substr($_[0], 0, length($name)+2) = ''; my $b = Attean::Blank->new($name); $self->blank_nodes->{$name} = $b; return $b; } elsif ($char eq '"') { substr($_[0], 0, 1) = ''; my $value = decode('utf8', ''); while (length($_[0]) and substr($_[0], 0, 1) ne '"') { while ($_[0] =~ m/^([^"\\]+)/) { $value .= $1; substr($_[0],0,length($1)) = ''; } if (substr($_[0],0,1) eq '\\') { while ($_[0] =~ m/^\\(.)/) { if ($1 eq 't') { $value .= "\t"; substr($_[0],0,2) = ''; } elsif ($1 eq 'r') { $value .= "\r"; substr($_[0],0,2) = ''; } elsif ($1 eq 'n') { $value .= "\n"; substr($_[0],0,2) = ''; } elsif ($1 eq '"') { $value .= '"'; substr($_[0],0,2) = ''; } elsif ($1 eq '\\') { $value .= "\\"; substr($_[0],0,2) = ''; } elsif ($1 eq 'u') { $_[0] =~ m/^\\u([0-9A-Fa-f]{4})/ or die qq[Bad N-Triples \\u escape at line $lineno, near "$_[0]"]; $value .= chr(oct('0x' . $1)); substr($_[0],0,6) = ''; } elsif ($1 eq 'U') { $_[0] =~ m/^\\U([0-9A-Fa-f]{8})/ or die qq[Bad N-Triples \\U escape at line $lineno, near "$_[0]"]; $value .= chr(oct('0x' . $1)); substr($_[0],0,10) = ''; } else { die qq[Not valid N-Triples escape character '\\$1' at line $lineno, near "$_[0]"]; } } } } if (substr($_[0],0,1) eq '"') { substr($_[0],0,1) = ''; } else { die qq[Ending double quote not found at line $lineno]; } if ($_[0] =~ m/^@([a-z]+(-[a-zA-Z0-9]+)*)/) { my $lang = $1; substr($_[0],0,1+length($lang)) = ''; return Attean::Literal->new( value => $value, language => $lang ); } elsif (substr($_[0],0,3) eq '^^<') { substr($_[0],0,3) = ''; my ($uri) = $_[0] =~ m/^([^>]*)>/; substr($_[0], 0, length($uri)+1) = ''; my $dt = $self->new_iri(value => $uri); return Attean::Literal->new( value => $value, datatype => $dt); } else { return Attean::Literal->new($value); } } else { Carp::cluck; die qq[Not valid N-Triples node start character '$char' at line $lineno, near "$_[0]"]; } } sub _unescape { my $string = shift; my $lineno = shift; my $value = ''; while (length($string)) { while ($string =~ m/^([^\\]+)/) { $value .= $1; substr($string,0,length($1)) = ''; } if (length($string)) { if ($string eq '\\') { die qq[Backslash in N-Triples node without escaped character at line $lineno]; } if ($string =~ m/^\\([tbnrf"'uU])/) { while ($string =~ m/^\\([tbnrf"'uU])/) { if ($1 eq 't') { $value .= "\t"; substr($string,0,2) = ''; } elsif ($1 eq 'b') { $value .= "\b"; substr($string,0,2) = ''; } elsif ($1 eq 'n') { $value .= "\n"; substr($string,0,2) = ''; } elsif ($1 eq 'r') { $value .= "\r"; substr($string,0,2) = ''; } elsif ($1 eq 'f') { $value .= "\f"; substr($string,0,2) = ''; } elsif ($1 eq '"') { $value .= '"'; substr($string,0,2) = ''; } elsif ($1 eq '\\') { $value .= "\\"; substr($string,0,2) = ''; } elsif ($1 eq 'u') { $string =~ m/^\\u([0-9A-F]{4})/ or die qq[Bad N-Triples \\u escape at line $lineno, near "$string"]; $value .= chr(oct('0x' . $1)); substr($string,0,6) = ''; } elsif ($1 eq 'U') { $string =~ m/^\\U([0-9A-F]{8})/ or die qq[Bad N-Triples \\U escape at line $lineno, near "$string"]; $value .= chr(oct('0x' . $1)); substr($string,0,10) = ''; } } } else { my $esc = substr($string, 0, 2); die qq[Not a valid N-Triples escape sequence '$esc' at line $lineno, near "$string"]; } } } return $value; } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Parser/PaxHeader/SPARQLXML.pm000644 000765 000024 00000000225 14636707550 022277 xustar00gregstaff000000 000000 30 mtime=1719373672.407030887 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Parser/SPARQLXML.pm000644 000765 000024 00000005631 14636707550 020334 0ustar00gregstaff000000 000000 # AtteanX::Parser::SPARQLXML # ----------------------------------------------------------------------------- =head1 NAME AtteanX::Parser::SPARQLXML - SPARQL XML Parser =head1 VERSION This document describes AtteanX::Parser::SPARQLXML version 0.034 =head1 SYNOPSIS use Attean; my $parser = Attean->get_parser('SPARQLXML')->new(); $parser->parse_cb_from_io( $fh ); =head1 DESCRIPTION ... =head1 METHODS =over 4 =cut use v5.14; use warnings; package AtteanX::Parser::SPARQLXML 0.034 { use XML::SAX::ParserFactory; use Attean; use Moo; use Encode qw(encode); use PerlIO::Layers qw(query_handle); use AtteanX::Parser::SPARQLXML::SAXHandler; =item C<< canonical_media_type >> Returns the canonical media type for SPARQL XML: application/sparql-results+xml. =cut sub canonical_media_type { return "application/sparql-results+xml" } =item C<< media_types >> Returns a list of media types that may be parsed with the SPARQL XML parser: application/sparql-results+xml. =cut sub media_types { return [qw(application/sparql-results+xml)]; } =item C<< file_extensions >> Returns a list of file extensions that may be parsed with the parser. =cut sub file_extensions { return [qw(srx)] } with 'Attean::API::ResultOrTermParser'; with 'Attean::API::PushParser'; =item C<< parse_cb_from_io( $fh ) >> Calls the C<< $parser->handler >> function once for each L object that result from parsing the data read from the L object C<< $fh >>. =cut sub parse_cb_from_io { my $self = shift; my $fh = shift; my $handler = AtteanX::Parser::SPARQLXML::SAXHandler->new($self->handler); my $p = XML::SAX::ParserFactory->parser(Handler => $handler); if (query_handle($fh, 'utf8')) { # the filehandle already has utf-8 decoding applied, but the XML # parser is expecting utf-8 *encoded* bytes, so we need to # re-encode the data before parsing. my $string = do { local($/); <$fh> }; my $data = encode('UTF-8', $string, Encode::FB_CROAK); $p->parse_string($data); } else { $p->parse_file( $fh ); } } =item C<< parse_cb_from_bytes( $data ) >> Calls the C<< $parser->handler >> function once for each L object that result from parsing the data read from the UTF-8 encoded byte string C<< $data >>. =cut sub parse_cb_from_bytes { my $self = shift; my $data = shift; my $handler = AtteanX::Parser::SPARQLXML::SAXHandler->new($self->handler); my $p = XML::SAX::ParserFactory->parser(Handler => $handler); $p->parse_string( $data ); } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Parser/PaxHeader/SPARQLTSV.pm000644 000765 000024 00000000225 14636707550 022313 xustar00gregstaff000000 000000 30 mtime=1719373672.371978608 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Parser/SPARQLTSV.pm000644 000765 000024 00000005477 14636707550 020360 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME AtteanX::Parser::SPARQLTSV - SPARQL Results TSV Parser =head1 VERSION This document describes AtteanX::Parser::SPARQLTSV version 0.034 =head1 SYNOPSIS use Attean; =head1 DESCRIPTION ... =head1 ATTRIBUTES =over 4 =item C<< canonical_media_type >> =item C<< media_types >> =item C<< file_extensions >> =back =head1 METHODS =over 4 =cut package AtteanX::Parser::SPARQLTSV 0.034 { use utf8; use Moo; use Attean; use Encode; use Encode qw(decode); use List::MoreUtils qw(zip); use namespace::clean; sub canonical_media_type { return "text/tab-separated-values" } sub media_types { return [qw(text/tab-separated-values)]; } sub file_extensions { return [qw(tsv)] } with 'Attean::API::ResultParser', 'Attean::API::PullParser', 'Attean::API::Parser'; =item C<< parse_iter_from_bytes( $data ) >> Returns an iterator of L objects that result from parsing the data read from the UTF-8 encoded byte string C<< $data >>. =cut sub parse_iter_from_bytes { my $self = shift; my $data = shift; open(my $fh, '<:encoding(UTF-8)', \$data); return $self->parse_iter_from_io($fh); } =item C<< parse_iter_from_io( $fh ) >> Returns an iterator of L objects that result from parsing the data read from the L object C<< $fh >>. =cut sub parse_iter_from_io { my $self = shift; my $fh = shift; my $parser = Attean->get_parser('Turtle')->new(lazy_iris => $self->lazy_iris); my $line = <$fh>; unless (defined($line)) { die "undefined header line in SPARQL/TSV parser"; } chomp($line); my @vars; foreach my $v (split("\t", $line)) { unless (substr($v, 0, 1) eq '?') { Carp::confess "Bad variable syntax in SPARQL TSV data: '$v'"; } push(@vars, substr($v, 1)); } my $gen = sub { my $line = <$fh>; return unless defined($line); chomp($line); my @strings = split("\t", $line); my %binding; foreach my $i (0 .. $#vars) { my $string = $strings[$i]; if (length($string)) { my $var = $vars[$i]; my $bytes = encode('UTF-8', $string, Encode::FB_CROAK); my $term = $parser->parse_term_from_bytes($bytes); if ($term) { $binding{ $var } = $term; } } } return Attean::Result->new( bindings => \%binding ); }; return Attean::CodeIterator->new( generator => $gen, item_type => $self->handled_type->role, variables => \@vars, ); } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Parser/PaxHeader/Turtle.pm000644 000765 000024 00000000225 14636707550 022173 xustar00gregstaff000000 000000 30 mtime=1719373672.497151344 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Parser/Turtle.pm000644 000765 000024 00000043542 14636707550 020233 0ustar00gregstaff000000 000000 use v5.14; use warnings; # AtteanX::Parser::Turtle # ----------------------------------------------------------------------------- =head1 NAME AtteanX::Parser::Turtle - Turtle RDF Parser =head1 VERSION This document describes AtteanX::Parser::Turtle version 0.034 =head1 SYNOPSIS use Attean; my $parser = AtteanX::Parser::Turtle->new( handler => sub {...}, base => $base_iri ); # Parse data from a file-handle and handle triples in the 'handler' callback $parser->parse_cb_from_io( $fh ); # Parse the given byte-string, and return an iterator of triples my $iter = $parser->parse_iter_from_bytes('

1, 2, 3 .'); while (my $triple = $iter->next) { print $triple->as_string; } =head1 DESCRIPTION This module implements a parser for the Turtle RDF format. =head1 ROLES This class consumes L, L, , and . =head1 ATTRIBUTES =over 4 =item C<< canonical_media_type >> =item C<< media_types >> =item C<< file_extensions >> =item C<< canonicalize >> A boolean indicating whether term values should be canonicalized during parsing. =back =head1 METHODS =over 4 =cut package AtteanX::Parser::Turtle 0.034 { use Moo; use Types::Standard qw(Bool HashRef ArrayRef HashRef Str Maybe InstanceOf ConsumerOf); use Types::Namespace qw( NamespaceMap ); use utf8; use Carp qw(carp); use Encode qw(encode); use Scalar::Util qw(blessed); use AtteanX::Parser::Turtle::Constants; use AtteanX::Parser::Turtle::Lexer; use AtteanX::Parser::Turtle::Token; use Attean::API::Parser; use namespace::clean; sub canonical_media_type { return "text/turtle" } sub media_types { return [qw(application/x-turtle application/turtle text/turtle)]; } sub file_extensions { return [qw(ttl)] } has 'canonicalize' => (is => 'rw', isa => Bool, default => 0); has '_map' => (is => 'ro', isa => HashRef[Str], default => sub { +{} }); =item C<< has_namespaces >> Returns true if the parser has a namespace map, false otherwise. =cut has 'namespaces' => (is => 'rw', isa => Maybe[NamespaceMap], predicate => 'has_namespaces'); has 'blank_nodes' => (is => 'ro', isa => HashRef[ConsumerOf['Attean::API::Blank']], predicate => 'has_blank_nodes_map', default => sub { +{} }); has '_stack' => ( is => 'ro', isa => ArrayRef, default => sub { [] }, init_arg => undef, ); with 'Attean::API::TripleParser'; with 'Attean::API::AbbreviatingParser'; with 'Attean::API::PushParser'; with 'Attean::API::CDTBlankNodeMappingParser'; my $RDF = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'; my $XSD = 'http://www.w3.org/2001/XMLSchema#'; =item C<< parse_cb_from_io( $fh ) >> Calls the C<< $parser->handler >> function once for each L object that result from parsing the data read from the L object C<< $fh >>. =cut sub parse_cb_from_io { my $self = shift; my $fh = shift; unless (ref($fh)) { my $filename = $fh; undef $fh; open( $fh, '<', $filename ) or die $!; } my $l = AtteanX::Parser::Turtle::Lexer->new($fh); $self->_parse($l); } =item C<< parse_cb_from_bytes( $data ) >> Calls the C<< $parser->handler >> function once for each L object that result from parsing the data read from the UTF-8 encoded byte string C<< $data >>. =cut sub parse_cb_from_bytes { my $self = shift; my $data = shift; open(my $fh, '<:encoding(UTF-8)', \$data); my $l = AtteanX::Parser::Turtle::Lexer->new($fh); $self->_parse($l); } =item C<< parse_term_from_bytes ( $bytes ) >> =item C<< parse_node ( $bytes ) >> Returns the Attean::API::Term object corresponding to the node whose N-Triples serialization is found at the beginning of C<< $bytes >>. =cut sub parse_term_from_bytes { my $self = shift; unless (ref($self)) { $self = $self->new(); } return $self->parse_node(@_); } sub parse_node { my $self = shift; my $string = shift; my %args = @_; open(my $fh, '<:encoding(UTF-8)', \$string); my $l = AtteanX::Parser::Turtle::Lexer->new(file => $fh, %args); my $t = $self->_next_nonws($l); my $node = $self->_object($l, $t); return $node; } sub _parse { my $self = shift; my $l = shift; $l->check_for_bom; while (my $t = $self->_next_nonws($l)) { $self->_statement($l, $t); } } ################################################################################ sub _unget_token { my $self = shift; my $t = shift; push(@{ $self->_stack }, $t); # push(@{ $self->{ stack } }, $t); } sub _next_nonws { my $self = shift; if (scalar(@{ $self->_stack })) { return pop(@{ $self->_stack }); } my $l = shift; while (1) { my $t = $l->get_token; return unless ($t); # my $type = $t->type; # next if ($type == WS or $type == COMMENT); # warn decrypt_constant($type) . "\n"; return $t; } } sub _get_token_type { my $self = shift; my $l = shift; my $type = shift; my $t = $self->_next_nonws($l); unless ($t) { $l->_throw_error(sprintf("Expecting %s but got EOF", decrypt_constant($type))); return; } unless ($t->type eq $type) { $self->_throw_error(sprintf("Expecting %s but got %s", decrypt_constant($type), decrypt_constant($t->type)), $t, $l); } return $t; } sub _statement { my $self = shift; my $l = shift; my $t = shift; my $type = $t->type; # when (WS) {} if ($type == TURTLEPREFIX or $type == PREFIX) { $t = $self->_get_token_type($l, PREFIXNAME); use Data::Dumper; unless (defined($t->value)) { my $tname = AtteanX::Parser::Turtle::Constants::decrypt_constant($t->type); Carp::confess "undefined $tname token value: " . Dumper($t); } my $name = $t->value; chop($name) if (substr($name, -1) eq ':'); # $name =~ s/:$//; $t = $self->_get_token_type($l, IRI); my %args = (value => $t->value); if ($self->has_base) { $args{base} = $self->base; } my $r = $self->new_iri(%args); my $iri = $r->as_string; if ($type == TURTLEPREFIX) { $t = $self->_get_token_type($l, DOT); # $t = $self->_next_nonws($l); # if ($t and $t->type != DOT) { # $self->_unget_token($t); # } } $self->_map->{$name} = $iri; if ($self->has_namespaces) { my $ns = $self->namespaces; unless ($ns->namespace_uri($name)) { $ns->add_mapping($name, $iri); } } } elsif ($type == TURTLEBASE or $type == BASE) { $t = $self->_get_token_type($l, IRI); my %args = (value => $t->value); if ($self->has_base) { $args{base} = $self->base; } my $r = $self->new_iri(%args); my $iri = $r->as_string; if ($type == TURTLEBASE) { $t = $self->_get_token_type($l, DOT); # $t = $self->_next_nonws($l); # if ($t and $t->type != DOT) { # $self->_unget_token($t); # } } $self->base($iri); } else { $self->_triple( $l, $t ); $t = $self->_get_token_type($l, DOT); } # } } sub _triple { my $self = shift; my $l = shift; my $t = shift; my $type = $t->type; # subject my $subj; my $bnode_plist = 0; if ($type == LTLT) { $subj = $self->_quotedTriple($l); } elsif ($type == LBRACKET) { $bnode_plist = 1; $subj = Attean::Blank->new(); my $t = $self->_next_nonws($l); if ($t->type != RBRACKET) { $self->_unget_token($t); $self->_predicateObjectList( $l, $subj ); $t = $self->_get_token_type($l, RBRACKET); } } elsif ($type == LPAREN) { my $t = $self->_next_nonws($l); if ($t->type == RPAREN) { $subj = Attean::IRI->new(value => "http://www.w3.org/1999/02/22-rdf-syntax-ns#nil", lazy => 1); } else { $subj = Attean::Blank->new(); my @objects = $self->_object($l, $t); while (1) { my $t = $self->_next_nonws($l); if ($t->type == RPAREN) { last; } else { push(@objects, $self->_object($l, $t)); } } $self->_assert_list($subj, @objects); } } elsif (not($type==IRI or $type==PREFIXNAME or $type==BNODE)) { $self->_throw_error("Expecting resource or bnode but got " . decrypt_constant($type), $t, $l); } else { $subj = $self->_token_to_node($t); } # warn "Subject: $subj\n"; # XXX if ($bnode_plist) { #predicateObjectList? $t = $self->_next_nonws($l); $self->_unget_token($t); if ($t->type != DOT) { $self->_predicateObjectList($l, $subj); } } else { #predicateObjectList $self->_predicateObjectList($l, $subj); } } sub _quotedTriple { my $self = shift; my $l = shift; my $subj = $self->_qtSubject($l); my $t = $self->_next_nonws($l); my $type = $t->type; unless ($type==IRI or $type==PREFIXNAME or $type==A) { $self->_throw_error("Expecting verb but got " . decrypt_constant($type), $t, $l); } my $pred = $self->_token_to_node($t); my $obj = $self->_qtObject($l, $self->_next_nonws($l)); $self->_get_token_type($l, GTGT); my $triple = Attean::Triple->new($subj, $pred, $obj); return $triple; } sub _qtSubject { my $self = shift; my $l = shift; my $t = $self->_next_nonws($l); my $type = $t->type; my $subj; if ($type == LTLT) { $subj = $self->_quotedTriple($l); } elsif ($type == LBRACKET) { $self->_get_token_type($l, RBRACKET); return Attean::Blank->new(); } elsif (not($type==IRI or $type==PREFIXNAME or $type==BNODE)) { $self->_throw_error("Expecting resource or bnode but got " . decrypt_constant($type), $t, $l); } else { $subj = $self->_token_to_node($t); } return $subj; } sub _qtObject { my $self = shift; my $l = shift; my $t = shift; my $tcopy = $t; my $obj; my $type = $t->type; if ($type == LTLT) { $obj = $self->_quotedTriple($l); } elsif ($type == LBRACKET) { $self->_get_token_type($l, RBRACKET); return Attean::Blank->new(); } elsif (not($type==IRI or $type==PREFIXNAME or $type==STRING1D or $type==STRING3D or $type==STRING1S or $type==STRING3S or $type==BNODE or $type==INTEGER or $type==DECIMAL or $type==DOUBLE or $type==BOOLEAN)) { $self->_throw_error("Expecting object but got " . decrypt_constant($type), $t, $l); } else { if ($type==STRING1D or $type==STRING3D or $type==STRING1S or $type==STRING3S) { my $value = $t->value; my $t = $self->_next_nonws($l); my $dt; my $lang; if ($t) { if ($t->type == HATHAT) { my $t = $self->_next_nonws($l); if ($t->type == IRI or $t->type == PREFIXNAME) { $dt = $self->_token_to_node($t); } } elsif ($t->type == LANG) { $lang = $t->value; } else { $self->_unget_token($t); } } my %args = (value => $value); $args{language} = $lang if (defined($lang)); $args{datatype} = $dt if (defined($dt)); $obj = $self->new_literal(%args); } else { $obj = $self->_token_to_node($t, $type); } } return $obj; } sub _assert_list { my $self = shift; my $subj = shift; my @objects = @_; my $head = $subj; while (@objects) { my $obj = shift(@objects); $self->_assert_triple($head, Attean::IRI->new(value => "${RDF}first", lazy => 1), $obj); my $next = scalar(@objects) ? Attean::Blank->new() : Attean::IRI->new(value => "${RDF}nil", lazy => 1); $self->_assert_triple($head, Attean::IRI->new(value => "${RDF}rest", lazy => 1), $next); $head = $next; } } sub _predicateObjectList { my $self = shift; my $l = shift; my $subj = shift; my $t = $self->_next_nonws($l); while (1) { my $type = $t->type; unless ($type==IRI or $type==PREFIXNAME or $type==A) { $self->_throw_error("Expecting verb but got " . decrypt_constant($type), $t, $l); } my $pred = $self->_token_to_node($t); $self->_objectList($l, $subj, $pred); $t = $self->_next_nonws($l); last unless ($t); if ($t->type == SEMICOLON) { my $sc = $t; SEMICOLON_REPEAT: $t = $self->_next_nonws($l); unless ($t) { $l->_throw_error("Expecting token after semicolon, but got EOF"); } goto SEMICOLON_REPEAT if ($t->type == SEMICOLON); if ($t->type == IRI or $t->type == PREFIXNAME or $t->type == A) { next; } else { $self->_unget_token($t); return; } } else { $self->_unget_token($t); return; } } } sub _objectList { my $self = shift; my $l = shift; my $subj = shift; my $pred = shift; while (1) { my $t = $self->_next_nonws($l); last unless ($t); my $obj = $self->_object($l, $t); $self->_assert_triple_with_optional_annotation($l, $subj, $pred, $obj); $t = $self->_next_nonws($l); if ($t and $t->type == COMMA) { next; } else { $self->_unget_token($t); return; } } } sub _assert_triple_with_optional_annotation { my $self = shift; my $l = shift; my $subj = shift; my $pred = shift; my $obj = shift; my $qt = $self->_assert_triple($subj, $pred, $obj); my $t = $self->_next_nonws($l); if ($t->type != LANNOT) { $self->_unget_token($t); return; } $self->_predicateObjectList( $l, $qt ); $self->_get_token_type($l, RANNOT); } sub _assert_triple { my $self = shift; my $subj = shift; my $pred = shift; my $obj = shift; if ($self->canonicalize and blessed($obj) and $obj->does('Attean::API::Literal')) { $obj = $obj->canonicalize; } my $t = Attean::Triple->new($subj, $pred, $obj); $self->handler->($t); return $t; } sub _object { my $self = shift; my $l = shift; my $t = shift; my $tcopy = $t; my $obj; my $type = $t->type; if ($type==LTLT) { return $self->_quotedTriple($l); } elsif ($type==LBRACKET) { $obj = Attean::Blank->new(); my $t = $self->_next_nonws($l); unless ($t) { $self->_throw_error("Expecting object but got only opening bracket", $tcopy, $l); } if ($t->type != RBRACKET) { $self->_unget_token($t); $self->_predicateObjectList( $l, $obj ); $t = $self->_get_token_type($l, RBRACKET); } } elsif ($type == LPAREN) { my $t = $self->_next_nonws($l); unless ($t) { $self->_throw_error("Expecting object but got only opening paren", $tcopy, $l); } if ($t->type == RPAREN) { $obj = Attean::IRI->new(value => "http://www.w3.org/1999/02/22-rdf-syntax-ns#nil", lazy => 1); } else { $obj = Attean::Blank->new(); my @objects = $self->_object($l, $t); while (1) { my $t = $self->_next_nonws($l); if ($t->type == RPAREN) { last; } else { push(@objects, $self->_object($l, $t)); } } $self->_assert_list($obj, @objects); } } elsif (not($type==IRI or $type==PREFIXNAME or $type==STRING1D or $type==STRING3D or $type==STRING1S or $type==STRING3S or $type==BNODE or $type==INTEGER or $type==DECIMAL or $type==DOUBLE or $type==BOOLEAN)) { $self->_throw_error("Expecting object but got " . decrypt_constant($type), $t, $l); } else { if ($type==STRING1D or $type==STRING3D or $type==STRING1S or $type==STRING3S) { my $value = $t->value; my $t = $self->_next_nonws($l); my $dt; my $lang; if ($t) { if ($t->type == HATHAT) { my $t = $self->_next_nonws($l); if ($t->type == IRI or $t->type == PREFIXNAME) { $dt = $self->_token_to_node($t); } } elsif ($t->type == LANG) { $lang = $t->value; } else { $self->_unget_token($t); } } my %args = (value => $value); $args{language} = $lang if (defined($lang)); $args{datatype} = $dt if (defined($dt)); $obj = $self->new_literal(%args); } else { $obj = $self->_token_to_node($t, $type); } } return $obj; } sub _token_to_node { my $self = shift; my $t = shift; my $type = shift || $t->type; if ($type eq A) { state $rdftype = Attean::IRI->new(value => "${RDF}type", lazy => 1); return $rdftype; } elsif ($type eq IRI) { my $value = $t->value; my %args = (value => $value); my $iri; if ($self->has_base) { $args{base} = $self->base; my $iri = $self->new_iri(%args); return $iri; } state %cache; if (my $n = $cache{$value}) { return $n; } else { my $iri = $self->new_iri(%args); if (rand() < 0.02) { # clear out the cache roughly every 50 IRIs %cache = (); } $cache{$value} = $iri; return $iri; } } elsif ($type eq INTEGER) { return $self->new_literal(value => $t->value, datatype => Attean::IRI->new(value => "${XSD}integer", lazy => 1)); } elsif ($type eq DECIMAL) { return $self->new_literal(value => $t->value, datatype => Attean::IRI->new(value => "${XSD}decimal", lazy => 1)); } elsif ($type eq DOUBLE) { return $self->new_literal(value => $t->value, datatype => Attean::IRI->new(value => "${XSD}double", lazy => 1)); } elsif ($type eq BOOLEAN) { return $self->new_literal(value => $t->value, datatype => Attean::IRI->new(value => "${XSD}boolean", lazy => 1)); } elsif ($type eq PREFIXNAME) { my ($ns, $local) = @{ $t->args }; $ns =~ s/:$//; unless (exists $self->_map->{$ns}) { $self->_throw_error("Use of undeclared prefix '$ns'", $t); } my $prefix = $self->_map->{$ns}; no warnings 'uninitialized'; my $iri = $self->new_iri("${prefix}${local}"); return $iri; } elsif ($type eq BNODE) { my $b = Attean::Blank->new($t->value); $self->blank_nodes->{$t->value} = $b; return $b; } elsif ($type eq STRING1D) { return $self->new_literal($t->value); } elsif ($type eq STRING1S) { return $self->new_literal($t->value); } else { $self->_throw_error("Converting $type to node not implemented", $t); } } sub _throw_error { my $self = shift; my $message = shift; my $t = shift; my $l = shift; my $line = $t->start_line; my $col = $t->start_column; # Carp::cluck "$message at $line:$col"; my $text = "$message at $line:$col"; if (defined($t->value)) { $text .= " (near '" . $t->value . "')"; } die $text; } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Parser/PaxHeader/NQuads.pm000644 000765 000024 00000000225 14636707550 022107 xustar00gregstaff000000 000000 30 mtime=1719373672.248199795 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Parser/NQuads.pm000644 000765 000024 00000005120 14636707550 020135 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME AtteanX::Parser::NQuads - N-Quads Parser =head1 VERSION This document describes AtteanX::Parser::NQuads version 0.034 =head1 SYNOPSIS use Attean; my $parser = Attean->get_parser('NQuads')->new(); # Parse data from a file-handle and handle quads in the 'handler' callback $parser->parse_cb_from_io( $fh ); # Parse the given byte-string, and return an iterator of quads my $iter = $parser->parse_iter_from_bytes(' "object" .'); while (my $quad = $iter->next) { print $quad->as_string; } =head1 DESCRIPTION This module implements a parser for the N-Quads format. =head1 ROLES This class consumes L, L and . =head1 METHODS =over 4 =item C<< parse_iter_from_io( $fh ) >> Returns an L that result from parsing the data read from the L object C<< $fh >>. =item C<< parse_iter_from_bytes( $data ) >> Returns an L that result from parsing the data read from the UTF-8 encoded byte string C<< $data >>. =cut package AtteanX::Parser::NQuads 0.034 { use utf8; use Attean; use Moo; extends 'AtteanX::Parser::NTuples'; =item C<< canonical_media_type >> Returns the canonical media type for N-Quads: application/n-quads. =cut sub canonical_media_type { return "application/n-quads" } =item C<< media_types >> Returns a list of media types that may be parsed with the N-Triples parser: application/n-quads. =cut sub media_types { return [qw(application/n-quads)]; } =item C<< file_extensions >> Returns a list of file extensions that may be parsed with the parser. =cut sub file_extensions { return [qw(nq)] } with 'Attean::API::MixedStatementParser'; with 'Attean::API::PullParser'; with 'Attean::API::CDTBlankNodeMappingParser'; sub _binding { my $self = shift; my $nodes = shift; my $lineno = shift; if (scalar(@$nodes) == 3) { return Attean::Triple->new(@$nodes); } elsif (scalar(@$nodes) == 4) { return Attean::Quad->new(@$nodes); } else { die qq[Not valid N-Quads data at line $lineno]; } } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Parser/PaxHeader/RDFXML.pm000644 000765 000024 00000000225 14636707550 021710 xustar00gregstaff000000 000000 30 mtime=1719373672.298038469 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Parser/RDFXML.pm000644 000765 000024 00000051351 14636707550 017745 0ustar00gregstaff000000 000000 =head1 NAME AtteanX::Parser::RDFXML - RDF/XML Parser =head1 VERSION This document describes AtteanX::Parser::RDFXML version 0.034 =head1 SYNOPSIS use Attean; my $parser = Attean->get_parser('RDFXML')->new(base => $base_iri); use AtteanX::Parser::Turtle; my $parser = AtteanX::Parser::Turtle->new( handler => sub {...}, base => $base_iri ); # Parse data from a file-handle and handle triples in the 'handler' callback $parser->parse_cb_from_io( $fh ); # Parse the given byte-string, and return an iterator of triples my $iter = $parser->parse_iter_from_bytes('...'); while (my $triple = $iter->next) { print $triple->as_string; } =head1 DESCRIPTION This module implements a parser for the RDF/XML format. =head1 ROLES This class consumes L, L, , and . =head1 ATTRIBUTES =over 4 =item C<< canonical_media_type >> =item C<< media_types >> =item C<< file_extensions >> =item C<< bnode_prefix >> A string prefix for identifiers generated for blank nodes. =back =head1 METHODS =over 4 =cut use v5.14; use warnings; package AtteanX::Parser::RDFXML 0.034 { use Moo; use Types::Standard qw(Str Object); use Attean; use Attean::RDF; use Carp; use Encode; use XML::SAX; use Data::Dumper; use Scalar::Util qw(blessed); use Module::Load::Conditional qw[can_load]; =item C<< canonical_media_type >> Returns the canonical media type for SPARQL XML: application/sparql-results+json. =cut sub canonical_media_type { return "application/rdf+xml" } =item C<< media_types >> Returns a list of media types that may be parsed with the SPARQL XML parser: application/sparql-results+json. =cut sub media_types { return [qw(application/rdf+xml application/octet-stream)]; } =item C<< file_extensions >> Returns a list of file extensions that may be parsed with the parser. =cut sub file_extensions { return [qw(rdf xrdf)] } with 'Attean::API::TripleParser', 'Attean::API::AbbreviatingParser', 'Attean::API::Parser'; with 'Attean::API::PushParser'; has 'bnode_prefix' => (is => 'ro', isa => Str, default => ''); =item C<< parse_cb_from_io( $fh ) >> Calls the C<< $parser->handler >> function once for each L object that result from parsing the data read from the L object C<< $fh >>. =cut sub parse_cb_from_io { my $self = shift; $self->_parse(@_); } =item C<< parse_cb_from_bytes( $data ) >> Calls the C<< $parser->handler >> function once for each L object that result from parsing the data read from the UTF-8 encoded byte string C<< $data >>. =cut sub parse_cb_from_bytes { my $self = shift; $self->_parse(@_); } sub _parse { my $self = shift; my $data = shift; my @args; if (my $map = $self->namespaces) { push(@args, namespaces => $map); } if ($self->has_base) { push(@args, base => $self->base); } my $new_iri = sub { $self->new_iri(@_) }; my $saxhandler = AtteanX::Parser::RDFXML::SAXHandler->new( bnode_prefix => $self->bnode_prefix, handler => $self->handler, new_iri => $new_iri, @args ); my $p = XML::SAX::ParserFactory->parser(Handler => $saxhandler); $saxhandler->push_base( $self->base ) if ($self->has_base); eval { if (ref($data)) { $p->parse_file($data); } else { if (length($data) > 0) { $p->parse_string($data); } } }; if ($@) { if ($@ =~ /no element found at line 1, column 0, byte/) { # silence XML::Parser output on empty input } else { die $@; } } my $nodes = $saxhandler->{nodes}; if ($nodes and scalar(@$nodes)) { die "RDFXML parser node stack isn't empty after parse: " . Dumper($nodes); } my $expect = $saxhandler->{expect}; if ($expect and scalar(@$expect) > 2) { die "RDFXML parser expect stack isn't empty after parse:" . Dumper($expect); } } } package AtteanX::Parser::RDFXML::SAXHandler; use v5.14; use warnings; use base qw(XML::SAX::Base); use List::Util qw(first); use Module::Load::Conditional qw[can_load]; use Attean::RDF; use Data::Dumper; use Scalar::Util qw(blessed); use constant NIL => 0x00; use constant SUBJECT => 0x01; use constant PREDICATE => 0x02; use constant OBJECT => 0x04; use constant LITERAL => 0x08; use constant COLLECTION => 0x16; my $HAS_XML_LIBXML = can_load( modules => { 'XML::LibXML' => 1.70, } ); sub new { my $class = shift; my %args = @_; my $prefix = $args{ bnode_prefix } // ''; my $self = bless( { expect => [ SUBJECT, NIL ], base => [], depth => 0, characters => '', prefix => $prefix, counter => 0, nodes => [], chars_ok => 0, sthandler => $args{handler}, new_iri => $args{new_iri}, named_bnodes => {}, }, $class ); if (my $ns = $args{ namespaces }) { $self->{namespaces} = $ns; } if (my $base = $args{ base }) { $self->push_base( $base ); } return $self; } sub new_expect { my $self = shift; unshift( @{ $self->{expect} }, shift ); } sub old_expect { shift( @{ shift->{expect} } ); } sub expect { return shift->{expect}[0]; } sub peek_expect { return shift->{expect}[1]; } sub start_element { my $self = shift; my $el = shift; $self->{depth}++; $self->handle_scoped_values( $el ) unless ($self->expect == LITERAL); if ($self->{depth} == 1 and $el->{NamespaceURI} eq 'http://www.w3.org/1999/02/22-rdf-syntax-ns#' and $el->{LocalName} eq 'RDF') { # ignore the wrapping rdf:RDF element } else { my $prefix = $el->{Prefix}; my $expect = $self->expect; $self->new_expect( $expect = SUBJECT ) if ($expect == NIL); if ($expect == SUBJECT or $expect == OBJECT) { my $ns = $self->get_namespace( $prefix ); my $local = $el->{LocalName}; my $uri = join('', $ns, $local); my $node = $self->new_resource( $uri ); if ($self->expect == OBJECT) { if (defined($self->{characters}) and length(my $string = $self->{characters})) { die "character data found before object element" if ($string =~ /\S/); } delete($self->{characters}); # get rid of any whitespace we saw before the element } my $node_id = $self->node_id( $el ); if ($self->peek_expect == COLLECTION) { my $list = $self->new_bnode; if (my $last = $self->{ collection_last }[0]) { my $st = Attean::Triple->new( $last, iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#rest"), $list ); $self->assert( $st ); } $self->{ collection_last }[0] = $list; my $st = Attean::Triple->new( $list, iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#first"), $node_id ); $self->assert( $st ); $self->{ collection_head }[0] ||= $list; } elsif ($self->expect == OBJECT) { my $nodes = $self->{nodes}; my $st = Attean::Triple->new( @{ $nodes }[ $#{$nodes} - 1, $#{$nodes} ], $node_id ); $self->assert( $st ); } if ($uri ne 'http://www.w3.org/1999/02/22-rdf-syntax-ns#Description') { my $type = $node; $self->assert( Attean::Triple->new( $node_id, iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#type"), $node ) ); } push( @{ $self->{nodes} }, $node_id ); $self->parse_literal_property_attributes( $el, $node_id ); $self->new_expect( PREDICATE ); unshift(@{ $self->{seqs} }, 0); } elsif ($self->expect == COLLECTION) { } elsif ($self->expect == PREDICATE) { my $ns = $self->get_namespace( $prefix ); my $local = $el->{LocalName}; my $uri = join('', $ns, $local); my $node = $self->new_resource( $uri ); if ($node->value eq 'http://www.w3.org/1999/02/22-rdf-syntax-ns#li') { my $id = ++(${ $self }{seqs}[0]); $node = $self->new_resource( 'http://www.w3.org/1999/02/22-rdf-syntax-ns#_' . $id ); } push( @{ $self->{nodes} }, $node ); if (my $data = $el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}datatype'}) { $self->{datatype} = $data->{Value}; } if (my $data = $el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}ID'}) { my $id = $data->{Value}; unshift(@{ $self->{reify_id} }, $id); } else { unshift(@{ $self->{reify_id} }, undef); } if (my $pt = $el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}parseType'}) { if ($pt->{Value} eq 'Resource') { # fake an enclosing object scope my $node = $self->new_bnode; my $nodes = $self->{nodes}; push( @$nodes, $node ); $self->assert( Attean::Triple->new( @{ $nodes }[ $#{$nodes} - 2 .. $#{$nodes} ] ) ); $self->new_expect( PREDICATE ); } elsif ($pt->{Value} eq 'Literal') { $self->{datatype} = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#XMLLiteral'; my $depth = $self->{depth}; $self->{literal_depth} = $depth - 1; $self->new_expect( LITERAL ); } elsif ($pt->{Value} eq 'Collection') { my $depth = $self->{depth}; unshift( @{ $self->{ collection_head } }, undef ); unshift( @{ $self->{ collection_last } }, undef ); $self->new_expect( COLLECTION ); $self->new_expect( OBJECT ); } } elsif (my $data = $el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}resource'}) { # stash the uri away so that we can use it when we get the end_element call for this predicate my $uri = $self->new_resource( $data->{Value} ); $self->parse_literal_property_attributes( $el, $uri ); $self->{'rdf:resource'} = $uri; $self->new_expect( OBJECT ); $self->{chars_ok} = 1; } elsif (my $ndata = $el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}nodeID'}) { my $node_name = $ndata->{Value}; # stash the bnode away so that we can use it when we get the end_element call for this predicate my $bnode = $self->get_named_bnode( $node_name ); $self->parse_literal_property_attributes( $el, $uri ); $self->{'rdf:resource'} = $bnode; # the key 'rdf:resource' is a bit misused here, but both rdf:resource and rdf:nodeID use it for the same purpose, so... $self->new_expect( OBJECT ); $self->{chars_ok} = 1; } elsif (my $node = $self->parse_literal_property_attributes( $el )) { # fake an enclosing object scope my $nodes = $self->{nodes}; push( @$nodes, $node ); $self->assert( Attean::Triple->new( @{ $nodes }[ $#{$nodes} - 2 .. $#{$nodes} ] ) ); $self->new_expect( PREDICATE ); } else { $self->new_expect( OBJECT ); $self->{chars_ok} = 1; } } elsif ($self->expect == LITERAL) { my $tag; if ($el->{Prefix}) { $tag = join(':', @{ $el }{qw(Prefix LocalName)}); } else { $tag = $el->{LocalName}; } $self->{characters} .= '<' . $tag; my $attr = $el->{Attributes}; if (my $ns = $el->{NamespaceURI}) { my $abbr = $el->{Prefix}; unless ($self->{defined_literal_namespaces}{$abbr}{$ns}) { $self->{characters} .= ' xmlns'; if (length($abbr)) { $self->{characters} .= ':' . $abbr; } $self->{characters} .= '="' . $ns . '"'; $self->{defined_literal_namespaces}{$abbr}{$ns}++; } } if (%$attr) { foreach my $k (keys %$attr) { $self->{characters} .= ' '; my $el = $attr->{ $k }; my $prop; if ($el->{Prefix}) { $prop = join(':', @{ $el }{qw(Prefix LocalName)}); } else { $prop = $el->{LocalName}; } $self->{characters} .= $prop . '="' . $el->{Value} . '"'; } } $self->{characters} .= '>'; } else { die "not sure what type of token is expected"; } } } sub end_element { my $self = shift; my $el = shift; $self->{depth}--; my $cleanup = 0; my $expect = $self->expect; if ($expect == SUBJECT) { $self->old_expect; $cleanup = 1; $self->{chars_ok} = 0; shift(@{ $self->{reify_id} }); } elsif ($expect == PREDICATE) { $self->old_expect; if ($self->expect == PREDICATE) { # we're closing a parseType=Resource block, so take off the extra implicit node. pop( @{ $self->{nodes} } ); } else { shift(@{ $self->{seqs} }); } $cleanup = 1; $self->{chars_ok} = 0; } elsif ($expect == OBJECT or ($expect == LITERAL and $self->{literal_depth} == $self->{depth})) { if (exists $self->{'rdf:resource'}) { my $uri = delete $self->{'rdf:resource'}; my $nodes = $self->{nodes}; delete $self->{characters}; $self->assert( Attean::Triple->new( @{ $nodes }[ $#{$nodes} - 1, $#{$nodes} ], $uri ) ); } $self->old_expect; if (defined($self->{characters})) { my $string = $self->{characters}; my $literal = $self->new_literal( $string ); my $nodes = $self->{nodes}; $self->assert( Attean::Triple->new( @{ $nodes }[ $#{$nodes} - 1, $#{$nodes} ], $literal ) ); delete($self->{characters}); delete $self->{datatype}; delete $self->{defined_literal_namespaces}; } if ($self->expect == COLLECTION) { # We were expecting an object, but got an end_element instead. # after poping the OBJECT expectation, we see we were expecting objects in a COLLECTION. # so we're ending the COLLECTION here: $self->old_expect; my $nodes = $self->{nodes}; my $head = $self->{ collection_head }[0] || iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#nil"); my @nodes = (@{ $nodes }[ $#{$nodes} - 1, $#{$nodes} ], $head); my $st = Attean::Triple->new( @nodes ); $self->assert( $st ); if (my $last = $self->{ collection_last }[0]) { my @nodes = ( $last, iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#rest"), iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#nil") ); my $st = Attean::Triple->new( @nodes ); $self->assert( $st ); } shift( @{ $self->{ collection_last } } ); shift( @{ $self->{ collection_head } } ); } $cleanup = 1; $self->{chars_ok} = 0; shift(@{ $self->{reify_id} }); } elsif ($expect == COLLECTION) { shift( @{ $self->{collections} } ); $self->old_expect; } elsif ($expect == LITERAL) { my $tag; if ($el->{Prefix}) { $tag = join(':', @{ $el }{qw(Prefix LocalName)}); } else { $tag = $el->{LocalName}; } $self->{characters} .= ''; $cleanup = 0; } else { die "how did we get here?"; } if ($cleanup) { pop( @{ $self->{nodes} } ); $self->pop_namespace_pad(); $self->pop_language(); $self->pop_base(); } } sub characters { my $self = shift; my $data = shift; my $expect = $self->expect; if ($expect == LITERAL or ($expect == OBJECT and $self->{chars_ok})) { my $chars = $data->{Data}; $self->{characters} .= $chars; } } sub parse_literal_property_attributes { my $self = shift; my $el = shift; my $node_id = shift || $self->new_bnode; my @keys = grep { not(m<[{][}](xmlns|about)>) } grep { not(m<[{]http://www.w3.org/1999/02/22-rdf-syntax-ns#[}](resource|about|ID|datatype|nodeID)>) } grep { not(m<[{]http://www.w3.org/XML/1998/namespace[}](base|lang)>) } keys %{ $el->{Attributes} }; my $asserted = 0; unshift(@{ $self->{reify_id} }, undef); # don't reify any of these triples foreach my $k (@keys) { my $data = $el->{Attributes}{ $k }; my $ns = $data->{NamespaceURI}; unless ($ns) { my $prefix = $data->{Prefix}; next unless (length($ns)); $ns = $self->get_namespace( $prefix ); } next if ($ns eq 'http://www.w3.org/XML/1998/namespace'); next if ($ns eq 'http://www.w3.org/2000/xmlns/'); my $local = $data->{LocalName}; my $uri = join('', $ns, $local); my $value = $data->{Value}; my $pred = $self->new_resource( $uri ); my $term = ($uri eq 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type') ? $self->new_resource( $value ) : $self->new_literal( $value ); $self->assert( Attean::Triple->new( $node_id, $pred, $term ) ); $asserted++; } shift(@{ $self->{reify_id} }); return ($asserted ? $node_id : 0); } sub assert { my $self = shift; my $st = shift; if ($self->{sthandler}) { $self->{sthandler}->( $st ); if (defined(my $id = $self->{reify_id}[0])) { my $stid = $self->new_resource( "#$id" ); my $tst = Attean::Triple->new( $stid, iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#type"), iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#Statement") ); my $sst = Attean::Triple->new( $stid, iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#subject"), $st->subject ); my $pst = Attean::Triple->new( $stid, iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#predicate"), $st->predicate ); my $ost = Attean::Triple->new( $stid, iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#object"), $st->object ); foreach ($tst, $sst, $pst, $ost) { $self->{sthandler}->( $_ ); } $self->{reify_id}[0] = undef; # now that we've used this reify ID, get rid of it (because we don't want it used again) } } } sub node_id { my $self = shift; my $el = shift; if ($el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}about'}) { my $uri = $el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}about'}{Value}; return $self->new_resource( $uri ); } elsif ($el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}ID'}) { my $uri = $el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}ID'}{Value}; return $self->new_resource( '#' . $uri ); } elsif ($el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}nodeID'}) { my $name = $el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}nodeID'}{Value}; return $self->get_named_bnode( $name ); } else { return $self->new_bnode; } } sub handle_scoped_values { my $self = shift; my $el = shift; my %new; { # xml:base my $base = ''; if (exists($el->{Attributes}{'{http://www.w3.org/XML/1998/namespace}base'})) { my $uri = $el->{Attributes}{'{http://www.w3.org/XML/1998/namespace}base'}{Value}; $base = $self->new_resource( $uri ); } $self->push_base( $base ); } { # language my $lang = ''; if (exists($el->{Attributes}{'{http://www.w3.org/XML/1998/namespace}lang'})) { $lang = $el->{Attributes}{'{http://www.w3.org/XML/1998/namespace}lang'}{Value}; } $self->push_language( $lang ); } { # namespaces my @ns = grep { m<^[{]http://www.w3.org/2000/xmlns/[}]> } (keys %{ $el->{Attributes} }); foreach my $n (@ns) { my ($prefix) = substr($n, 31); my $value = $el->{Attributes}{$n}{Value}; $new{ $prefix } = $value; if (blessed(my $ns = $self->{namespaces})) { unless ($ns->namespace_uri($prefix)) { $ns->add_mapping( $prefix => $value ); } } } if (exists($el->{Attributes}{'{}xmlns'})) { my $value = $el->{Attributes}{'{}xmlns'}{Value}; $new{ '' } = $value; } $self->push_namespace_pad( \%new ); } } sub push_base { my $self = shift; my $base = shift; if ($base) { my $uri = (blessed($base) and $base->isa('URI')) ? $base : URI->new($base->value ); $uri->fragment( undef ); $base = iri( "$uri" ); } unshift( @{ $self->{base} }, $base ); } sub pop_base { my $self = shift; shift( @{ $self->{base} } ); } sub get_base { my $self = shift; return first { length($_) } @{ $self->{base} }; } sub push_language { my $self = shift; my $lang = shift; unshift( @{ $self->{language} }, $lang ); } sub pop_language { my $self = shift; shift( @{ $self->{language} } ); } sub get_language { my $self = shift; my $lang = first { length($_) } @{ $self->{language} }; return $lang // ''; } sub push_namespace_pad { my $self = shift; my $pad = shift; unshift( @{ $self->{_namespaces} }, $pad ); } sub pop_namespace_pad { my $self = shift; shift( @{ $self->{_namespaces} } ); } sub get_namespace { my $self = shift; my $prefix = shift; foreach my $level (0 .. $#{ $self->{_namespaces} }) { my $pad = $self->{_namespaces}[ $level ]; if (exists($pad->{ $prefix })) { my $uri = $pad->{ $prefix }; return $uri; } } die "Unknown namespace: $prefix"; } sub new_bnode { my $self = shift; if (my $prefix = $self->{prefix}) { my $id = $prefix . ++$self->{counter}; return Attean::Blank->new( $id ); } else { return Attean::Blank->new(); } } sub new_literal { my $self = shift; my $string = shift; my %args; if (my $dt = $self->{datatype}) { # datatype $args{datatype} = $dt; if ($dt eq 'http://www.w3.org/1999/02/22-rdf-syntax-ns#XMLLiteral') { if ($HAS_XML_LIBXML) { eval { if ($string =~ m/^load_xml(string => $string); my $canon = $doc->toStringEC14N(1); $string = $canon; } }; if ($@) { warn "Cannot canonicalize XMLLiteral: $@" . Dumper($string); } } } } elsif (my $lang = $self->get_language) { $args{language} = $lang; } my $literal = Attean::Literal->new( value => $string, %args ); } sub new_resource { my $self = shift; my $uri = shift; my ($base) = $self->get_base; return $self->{new_iri}->( value => $uri, $base ? (base => $base) : () ); } sub get_named_bnode { my $self = shift; my $name = shift; return ($self->{named_bnodes}{ $name } ||= $self->new_bnode); } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Parser/PaxHeader/SPARQLLex.pm000644 000765 000024 00000000225 14636707550 022367 xustar00gregstaff000000 000000 30 mtime=1719373672.355777541 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Parser/SPARQLLex.pm000644 000765 000024 00000055123 14636707550 020425 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME AtteanX::Parser::SPARQLLex - SPARQL Lexer =head1 VERSION This document describes AtteanX::Parser::SPARQLLex version 0.034 =head1 SYNOPSIS use Attean; =head1 DESCRIPTION ... =head1 ATTRIBUTES =over 4 =item C<< canonical_media_type >> =item C<< media_types >> =item C<< file_extensions >> =item C<< handled_type >> =item C<< extend >> =back =head1 METHODS =over 4 =cut package AtteanX::Parser::SPARQLLex 0.034 { use utf8; use Moo; use Attean; use Encode; use Encode qw(decode); use List::MoreUtils qw(zip); use Types::Standard qw(ArrayRef); use namespace::clean; sub canonical_media_type { return "application/x-sparql-query-tokens" } # these pass through to the lexer iterator has extend => ( is => 'ro', isa => ArrayRef, default => sub { [] } ); sub media_types { return [qw(application/x-sparql-query-tokens)]; } sub handled_type { state $ITEM_TYPE = Type::Tiny::Role->new(role => 'AtteanX::SPARQL::Token'); return $ITEM_TYPE; } =item C<< file_extensions >> Returns a list of file extensions that may be parsed with the parser. =cut sub file_extensions { return [qw(rq)] } with 'Attean::API::PullParser', 'Attean::API::Parser'; =item C<< parse_iter_from_bytes( $data ) >> Returns an iterator of SPARQL tokens that result from parsing the SPARQL query/update read from the UTF-8 encoded byte string C<< $data >>. =cut sub parse_iter_from_bytes { my $self = shift; my $data = shift; open(my $fh, '<:encoding(UTF-8)', \$data); return $self->parse_iter_from_io($fh); } =item C<< parse_iter_from_io( $fh ) >> Returns an iterator of SPARQL tokens that result from parsing the SPARQL query/update read from the L object C<< $fh >>. =cut sub parse_iter_from_io { my $self = shift; my $fh = shift; return AtteanX::Parser::SPARQLLex::Iterator->new( extend => $self->extend, file => $fh, ); } } package AtteanX::Parser::SPARQLLex::Iterator 0.034 { use utf8; use Moo; use Attean; use Encode; use Encode qw(decode); use List::MoreUtils qw(zip); use AtteanX::SPARQL::Token; use AtteanX::SPARQL::Constants; use Types::Standard qw(FileHandle Ref Str Int ArrayRef HashRef ConsumerOf InstanceOf); use namespace::clean; has lookahead_methods => ( is => 'ro', isa => HashRef, default => sub { +{} } ); has lookahead_tokens => ( is => 'ro', isa => HashRef, default => sub { +{} } ); has extend => ( is => 'ro', isa => ArrayRef, default => sub { [] } ); has token_buffer => ( is => 'ro', isa => ArrayRef, default => sub { [] } ); with 'AtteanX::API::Lexer'; my $r_ECHAR = qr/\\([tbnrf\\"'])/o; my $r_STRING_LITERAL1 = qr/'(([^\x{27}\x{5C}\x{0A}\x{0D}])|${r_ECHAR})*'/o; my $r_STRING_LITERAL2 = qr/"(([^\x{22}\x{5C}\x{0A}\x{0D}])|${r_ECHAR})*"/o; my $r_STRING_LITERAL_LONG1 = qr/'''(('|'')?([^'\\]|${r_ECHAR}))*'''/o; my $r_STRING_LITERAL_LONG2 = qr/"""(("|"")?([^"\\]|${r_ECHAR}))*"""/o; my $r_LANGTAG = qr/@[a-zA-Z]+(-[a-zA-Z0-9]+)*/o; my $r_IRI_REF = qr/<([^<>"{}|^`\\\x{00}-\x{20}])*>/o; my $r_PN_CHARS_BASE = qr/([A-Z]|[a-z]|[\x{00C0}-\x{00D6}]|[\x{00D8}-\x{00F6}]|[\x{00F8}-\x{02FF}]|[\x{0370}-\x{037D}]|[\x{037F}-\x{1FFF}]|[\x{200C}-\x{200D}]|[\x{2070}-\x{218F}]|[\x{2C00}-\x{2FEF}]|[\x{3001}-\x{D7FF}]|[\x{F900}-\x{FDCF}]|[\x{FDF0}-\x{FFFD}]|[\x{10000}-\x{EFFFF}])/o; my $r_PN_CHARS_U = qr/([_]|${r_PN_CHARS_BASE})/o; my $r_VARNAME = qr/((${r_PN_CHARS_U}|[0-9])(${r_PN_CHARS_U}|[0-9]|\x{00B7}|[\x{0300}-\x{036F}]|[\x{203F}-\x{2040}])*)/o; my $r_VAR1 = qr/[?]${r_VARNAME}/o; my $r_VAR2 = qr/[\$]${r_VARNAME}/o; my $r_PN_CHARS = qr/${r_PN_CHARS_U}|-|[0-9]|\x{00B7}|[\x{0300}-\x{036F}]|[\x{203F}-\x{2040}]/o; my $r_PN_PREFIX = qr/(${r_PN_CHARS_BASE}((${r_PN_CHARS}|[.])*${r_PN_CHARS})?)/o; my $r_PN_LOCAL_ESCAPED = qr{(\\([-~.!&'()*+,;=/?#@%_\$]))|%[0-9A-Fa-f]{2}}o; my $r_PN_LOCAL = qr/((${r_PN_CHARS_U}|[:0-9]|${r_PN_LOCAL_ESCAPED})((${r_PN_CHARS}|${r_PN_LOCAL_ESCAPED}|[:.])*(${r_PN_CHARS}|[:]|${r_PN_LOCAL_ESCAPED}))?)/o; my $r_PN_LOCAL_BNODE = qr/((${r_PN_CHARS_U}|[0-9])((${r_PN_CHARS}|[.])*${r_PN_CHARS})?)/o; my $r_PNAME_NS = qr/((${r_PN_PREFIX})?:)/o; my $r_PNAME_LN = qr/(${r_PNAME_NS}${r_PN_LOCAL})/o; my $r_EXPONENT = qr/[eE][-+]?\d+/o; my $r_DOUBLE = qr/\d+[.]\d*${r_EXPONENT}|[.]\d+${r_EXPONENT}|\d+${r_EXPONENT}/o; my $r_DECIMAL = qr/(\d+[.]\d*)|([.]\d+)/o; my $r_INTEGER = qr/\d+/o; my $r_BLANK_NODE_LABEL = qr/_:${r_PN_LOCAL_BNODE}/o; my $r_ANON = qr/\[[\t\r\n ]*\]/o; my $r_NIL = qr/\([\n\r\t ]*\)/o; my $r_KEYWORDS = qr/(ABS|ADD|ALL|ASC|ASK|AS|AVG|BASE|BIND|BNODE|BOUND|BY|CEIL|CLEAR|COALESCE|CONCAT|CONSTRUCT|CONTAINS|COPY|COUNT|CREATE|DATATYPE|DAY|DEFAULT|DELETE|DELETE WHERE|DESCRIBE|DESC|DISTINCT|DISTINCT|DROP|ENCODE_FOR_URI|EXISTS|FILTER|FLOOR|FROM|GRAPH|GROUP_CONCAT|GROUP|HAVING|HOURS|IF|INSERT|INSERT|DATA|INTO|IN|IRI|ISBLANK|ISIRI|ISLITERAL|ISNUMERIC|ISURI|LANGMATCHES|LANG|LCASE|LIMIT|LOAD|MAX|MD5|MINUS|MINUTES|MIN|MONTH|MOVE|NAMED|NOT|NOW|OFFSET|OPTIONAL|ORDER|PREFIX|RAND|REDUCED|REGEX|REPLACE|ROUND|SAMETERM|SAMPLE|SECONDS|SELECT|SEPARATOR|SERVICE|SHA1|SHA256|SHA384|SHA512|SILENT|STRAFTER|STRBEFORE|STRDT|STRENDS|STRLANG|STRLEN|STRSTARTS|STRUUID|STR|SUBSTR|SUM|TIMEZONE|TO|TZ|UCASE|UNDEF|UNION|URI|USING|UUID|VALUES|WHERE|WITH|YEAR|TRIPLE|ISTRIPLE|SUBJECT|PREDICATE|OBJECT|HINT|UNFOLD|FOLD)(?!:)\b/io; sub BUILD { my $self = shift; my %METHOD_TOKEN = ( # q[#] => '_get_comment', q[@] => '_get_lang', q[<] => '_get_iriref_or_relational', q[{] => '_get_brace_or_annotation_or_or', q[}] => '_get_brace_or_annotation_or_or', q[|] => '_get_brace_or_annotation_or_or', q[_] => '_get_bnode', q['] => '_get_single_literal', q["] => '_get_double_literal', q[:] => '_get_pname', q[?] => '_get_variable', q[$] => '_get_variable', q[!] => '_get_bang', q[>] => '_get_iriref_or_relational', q([) => '_get_lbracket_or_anon', q[(] => '_get_lparen_or_nil', (map {$_ => '_get_number'} (0 .. 9, '-', '+')) ); while (my ($k,$v) = each(%METHOD_TOKEN)) { if (length($k) != 1) { die "Cannot set a lookahead token handler method with lookahead > 1 char"; } $self->lookahead_methods->{$k} //= $v; } my %CHAR_TOKEN = ( ',' => COMMA, '.' => DOT, '=' => EQUALS, ']' => RBRACKET, ')' => RPAREN, '-' => MINUS, '+' => PLUS, ';' => SEMICOLON, '/' => SLASH, '*' => STAR, ); while (my ($k,$v) = each(%CHAR_TOKEN)) { if (length($k) != 1) { die "Cannot set a lookahead token with lookahead > 1 char"; } $self->lookahead_tokens->{$k} //= $v; } $self->add_regex_rule( $r_KEYWORDS, KEYWORD, sub { return uc(shift) } ); } sub peek { my $self = shift; my $b = $self->token_buffer; my $t = $self->next; return unless ($t); push(@$b, $t); return $t; } sub next { my $self = shift; my $b = $self->token_buffer; if (scalar(@$b)) { return shift(@$b); } else { return $self->get_token(); } } sub fill_buffer { my $self = shift; unless (length($self->buffer)) { my $line = $self->file->getline; if (defined($line)) { no warnings 'uninitialized'; $line =~ s{\\(?:(?:u([0-9A-Fa-f]{4}))|(?:U([0-9A-Fa-f]{8})))}{ my $h = $1 . $2; my $codepoint = hex($h); if ($codepoint >= 0xD800 and $codepoint <= 0xDFFF) { die "Unicode surrogate U+$h is illegal in UTF-8"; } chr($codepoint); }ge; # $line =~ s/\\u([0-9A-Fa-f]{4})/chr(hex($1))/ge; # $line =~ s/\\U([0-9A-Fa-f]{8})/chr(hex($1))/ge; $self->{buffer} .= $line; } } } sub new_token { my $self = shift; my $type = shift; my $start_line = shift; my $start_col = shift; my $line = $self->line; my $col = $self->column; return AtteanX::SPARQL::Token->fast_constructor( $type, $start_line, $start_col, $line, $col, \@_ ); } sub add_regex_rule { my $self = shift; my $r = shift; my $ttype = shift; my $convert = shift; my $extend = $self->extend; push(@$extend, sub { my $l = shift; if ($l->buffer =~ /^$r\b/) { my $value = $self->read_length($+[0]); my $c = $convert ? $convert->($value) : $value; return $l->new_token($ttype, $l->start_line, $l->start_column, $c); } }); } sub get_token { my $self = shift; while (1) { $self->fill_buffer unless (length($self->buffer)); if ($self->buffer =~ /^[ \r\n\t]+/o) { $self->read_length($+[0]); # we're ignoring whitespace tokens, but we could return them here instead of falling through to the 'next': # return $self->new_token(WS); next; } my $c = $self->peek_char(); return unless (defined($c)); if ($c eq '#') { # we're ignoring comment tokens, but we could return them here instead of falling through to the 'next': $self->_get_comment(); next; } my $start_column = $self->column; my $start_line = $self->line; $self->start_column( $start_column ); $self->start_line( $start_line ); foreach my $e (@{ $self->extend }) { if (my $t = $e->( $self )) { return $t; } } if ($c eq '.' and $self->buffer =~ /^$r_DECIMAL/) { return $self->_get_number(); } if (defined(my $name = $self->lookahead_tokens->{$c})) { $self->get_char; return $self->new_token($name, $start_line, $start_column, $c); } elsif (defined(my $method = $self->lookahead_methods->{$c})) { return $self->$method() } elsif ($c =~ /[A-Za-z\x{00C0}-\x{00D6}\x{00D8}-\x{00F6}\x{00F8}-\x{02FF}\x{0370}-\x{037D}\x{037F}-\x{1FFF}\x{200C}-\x{200D}\x{2070}-\x{218F}\x{2C00}-\x{2FEF}\x{3001}-\x{D7FF}\x{F900}-\x{FDCF}\x{FDF0}-\x{FFFD}\x{10000}-\x{EFFFF}]/o) { if ($self->buffer =~ /^a(?!:)\s/o) { $self->get_char; return $self->new_token(A, $start_line, $start_column, 'a'); } elsif ($self->buffer =~ /^(?:true|false)(?!:)\b/o) { my $bool = $self->read_length($+[0]); return $self->new_token(BOOLEAN, $start_line, $start_column, $bool); # } elsif ($self->buffer =~ /^$r_KEYWORDS/) { # my $bool = $self->read_length($+[0]); # return $self->new_token(KEYWORD, $start_line, $start_column, $bool); } elsif ($self->buffer =~ /^BASE(?!:)\b/oi) { $self->read_length(4); return $self->new_token(BASE, $start_line, $start_column, 'BASE'); } elsif ($self->buffer =~ /^PREFIX(?!:)\b/io) { $self->read_length(6); return $self->new_token(PREFIX, $start_line, $start_column, 'PREFIX'); } else { return $self->_get_pname; } } elsif ($c eq '^') { if ($self->buffer =~ /^\^\^/) { $self->read_word('^^'); return $self->new_token(HATHAT, $start_line, $start_column, '^^'); } else { $self->read_word('^'); return $self->new_token(HAT, $start_line, $start_column, '^'); } } elsif ($c eq '&') { $self->read_word('&&'); return $self->new_token(ANDAND, $start_line, $start_column, '&&'); } else { # Carp::cluck sprintf("Unexpected byte '$c' (0x%02x)", ord($c)); return $self->_throw_error(sprintf("Unexpected byte '%s' (0x%02x)", $c, ord($c))); } warn sprintf('byte: 0x%x', ord($c)); } } sub _get_pname { my $self = shift; my $prefix = ''; if ($self->buffer =~ /^$r_PNAME_LN/o) { my $ln = $self->read_length($+[0]); my ($ns, $local) = ($ln =~ /^([^:]*:)(.*)$/); no warnings 'uninitialized'; $local =~ s{\\([-~.!&'()*+,;=:/?#@%_\$])}{$1}g; return $self->new_token(PREFIXNAME, $self->start_line, $self->start_column, $ns, $local); } elsif ($self->buffer =~ $r_PNAME_NS) { my $ns = $self->read_length($+[0]); return $self->new_token(PREFIXNAME, $self->start_line, $self->start_column, $ns); } else { $self->_throw_error("Expected PNAME"); } } sub _get_variable { my $self = shift; if (substr($self->buffer, 0, 1) eq '$') { $self->get_char_safe('$'); if ($self->buffer =~ /^$r_VARNAME/) { my $name = $self->read_length($+[0]); return $self->new_token(VAR, $self->start_line, $self->start_column, $name); } else { $self->_throw_error("Invalid variable name"); } } else { $self->get_char_safe('?'); if ($self->buffer =~ /^$r_VARNAME/) { my $name = $self->read_length($+[0]); return $self->new_token(VAR, $self->start_line, $self->start_column, $name); } else { return $self->new_token(QUESTION, $self->start_line, $self->start_column, '?'); } } } sub _get_iriref_or_relational { my $self = shift; my $buffer = $self->buffer; if ($buffer =~ m/^<([^<>"{}|^`\x00-\x20])*>/) { $self->get_char_safe(q[<]); if ($self->buffer =~ m/^[\x23-\x3d\x3f-\x5a\x5d-\x7e]*>/o) { my $iri .= $self->read_length($+[0]); chop($iri); return $self->new_token(IRI, $self->start_line, $self->start_column, $iri); } my $iri = ''; while (1) { if (length($self->buffer) == 0) { my $c = $self->peek_char; last unless defined($c); } if (substr($self->buffer, 0, 1) eq '\\') { $self->get_char_safe('\\'); my $esc = $self->get_char; if ($esc eq '\\') { $iri .= "\\"; } elsif ($esc eq 'U') { my $codepoint = $self->read_length(8); $self->_throw_error("Bad unicode escape codepoint '$codepoint'") unless ($codepoint =~ /^[0-9A-Fa-f]+$/o); $iri .= chr(hex($codepoint)); } elsif ($esc eq 'u') { my $codepoint = $self->read_length(4); $self->_throw_error("Bad unicode escape codepoint '$codepoint'") unless ($codepoint =~ /^[0-9A-Fa-f]+$/o); my $char = chr(hex($codepoint)); if ($char =~ /[<>" {}|\\^`]/o) { $self->_throw_error(sprintf("Bad IRI character: '%s' (0x%x)", $char, ord($char))); } $iri .= $char; } else { $self->_throw_error("Unrecognized iri escape '$esc'"); } } elsif ($self->buffer =~ /^[^<>\x00-\x20\\"{}|^`]+/o) { $iri .= $self->read_length($+[0]); } elsif (substr($self->buffer, 0, 1) eq '>') { last; } else { my $c = $self->peek_char; $self->_throw_error("Got '$c' while expecting IRI character"); } } $self->get_char_safe(q[>]); return $self->new_token(IRI, $self->start_line, $self->start_column, $iri); } elsif (substr($buffer, 0, 2) eq '<=') { $self->read_length(2); return $self->new_token(LE, $self->start_line, $self->start_column, '<='); } elsif (substr($buffer, 0, 2) eq '>=') { $self->read_length(2); return $self->new_token(GE, $self->start_line, $self->start_column, '>='); } elsif (substr($buffer, 0, 2) eq '<<') { $self->read_length(2); return $self->new_token(LTLT, $self->start_line, $self->start_column, '<<'); } elsif (substr($buffer, 0, 2) eq '>>') { $self->read_length(2); return $self->new_token(GTGT, $self->start_line, $self->start_column, '>>'); } elsif (substr($buffer, 0, 1) eq '>') { $self->get_char; return $self->new_token(GT, $self->start_line, $self->start_column, '>'); } elsif (substr($buffer, 0, 1) eq '<') { $self->get_char; return $self->new_token(LT, $self->start_line, $self->start_column, '<'); } else { die "Unrecognized relational op near '$buffer'"; } } sub _get_bang { my $self = shift; if ($self->buffer =~ /^!=/) { $self->read_length(2); return $self->new_token(NOTEQUALS, $self->start_line, $self->start_column, '!='); } else { $self->get_char; return $self->new_token(BANG, $self->start_line, $self->start_column, '!'); } } sub _get_bnode { my $self = shift; unless ($self->buffer =~ /^$r_BLANK_NODE_LABEL/o) { $self->_throw_error("Expected: name"); } my $ln = $self->read_length($+[0]); my $name = substr($ln, 2); return $self->new_token(BNODE, $self->start_line, $self->start_column, $name); } sub _get_number { my $self = shift; if ($self->buffer =~ /^${r_DOUBLE}/o) { return $self->new_token(DOUBLE, $self->start_line, $self->start_column, $self->read_length($+[0])); } elsif ($self->buffer =~ /^${r_DECIMAL}/o) { return $self->new_token(DECIMAL, $self->start_line, $self->start_column, $self->read_length($+[0])); } elsif ($self->buffer =~ /^${r_INTEGER}/o) { return $self->new_token(INTEGER, $self->start_line, $self->start_column, $self->read_length($+[0])); } $self->_throw_error("Expected number"); } sub _get_lparen_or_nil { my $self = shift; if ($self->buffer =~ /^$r_NIL/) { $self->read_length($+[0]); return $self->new_token(NIL, $self->start_line, $self->start_column, '()'); } else { $self->get_char_safe('('); return $self->new_token(LPAREN, $self->start_line, $self->start_column, '('); } } sub _get_brace_or_annotation_or_or { my $self = shift; if (substr($self->buffer, 0, 2) eq '{|') { $self->read_length(2); return $self->new_token(LANNOT, $self->start_line, $self->start_column, '{|'); } elsif (substr($self->buffer, 0, 2) eq '|}') { $self->read_length(2); return $self->new_token(RANNOT, $self->start_line, $self->start_column, '|}'); } elsif (substr($self->buffer, 0, 2) eq '||') { $self->read_length(2); return $self->new_token(OROR, $self->start_line, $self->start_column, '||'); } elsif (substr($self->buffer, 0, 1) eq '{') { $self->get_char_safe('{'); return $self->new_token(LBRACE, $self->start_line, $self->start_column, '{'); } elsif (substr($self->buffer, 0, 1) eq '}') { $self->get_char_safe('}'); return $self->new_token(RBRACE, $self->start_line, $self->start_column, '}'); } else { $self->get_char_safe('|'); return $self->new_token(OR, $self->start_line, $self->start_column, '|'); } } sub _get_lbracket_or_anon { my $self = shift; if ($self->buffer =~ /^$r_ANON/) { $self->read_length($+[0]); return $self->new_token(ANON, $self->start_line, $self->start_column, '[]'); } else { $self->get_char_safe('['); return $self->new_token(LBRACKET, $self->start_line, $self->start_column, '['); } } sub _get_comment { my $self = shift; $self->get_char_safe('#'); my $comment = ''; my $c = $self->peek_char; while (length($c) and $c !~ /[\r\n]/o) { $comment .= $self->get_char; $c = $self->peek_char; } if (length($c) and $c =~ /[\r\n]/o) { $self->get_char; } return $self->new_token(COMMENT, $self->start_line, $self->start_column, $comment); } sub _get_lang { my $self = shift; $self->get_char_safe('@'); if ($self->buffer =~ /^[a-zA-Z]+(-[a-zA-Z0-9]+)*\b/o) { my $lang = $self->read_length($+[0]); return $self->new_token(LANG, $self->start_line, $self->start_column, $lang); } $self->_throw_error("Expected keyword or language tag"); } sub _get_double_literal { my $self = shift; # my $c = $self->peek_char(); $self->get_char_safe(q["]); if (substr($self->buffer, 0, 2) eq q[""]) { # #x22 #x22 #x22 lcharacter* #x22 #x22 #x22 $self->read_word(q[""]); my $quote_count = 0; my $string = ''; while (1) { if (length($self->buffer) == 0) { $self->fill_buffer; $self->_throw_error("Found EOF in string literal") if (length($self->buffer) == 0); } if (substr($self->buffer, 0, 1) eq '"') { my $c = $self->get_char; $quote_count++; last if ($quote_count == 3); } else { if ($quote_count) { $string .= '"' foreach (1..$quote_count); $quote_count = 0; } if (substr($self->buffer, 0, 1) eq '\\') { $string .= $self->_get_escaped_char(); } else { $self->buffer =~ /^[^"\\]+/; $string .= $self->read_length($+[0]); } } } return $self->new_token(STRING3D, $self->start_line, $self->start_column, $string); } else { ### #x22 scharacter* #x22 my $string = ''; while (1) { if (substr($self->buffer, 0, 1) eq '\\') { $string .= $self->_get_escaped_char(); } elsif ($self->buffer =~ /^[^"\\]+/o) { $string .= $self->read_length($+[0]); } elsif (substr($self->buffer, 0, 1) eq '"') { last; } else { my $c = $self->peek_char; $self->_throw_error("Got '$c' while expecting string character"); } } $self->get_char_safe(q["]); return $self->new_token(STRING1D, $self->start_line, $self->start_column, $string); } } sub _get_single_literal { my $self = shift; $self->get_char_safe("'"); if (substr($self->buffer, 0, 2) eq q['']) { # #x22 #x22 #x22 lcharacter* #x22 #x22 #x22 $self->read_word(q['']); my $quote_count = 0; my $string = ''; while (1) { if (length($self->buffer) == 0) { $self->fill_buffer; $self->_throw_error("Found EOF in string literal") if (length($self->buffer) == 0); } if (substr($self->buffer, 0, 1) eq "'") { my $c = $self->get_char; $quote_count++; last if ($quote_count == 3); } else { if ($quote_count) { $string .= "'" foreach (1..$quote_count); $quote_count = 0; } if (substr($self->buffer, 0, 1) eq '\\') { $string .= $self->_get_escaped_char(); } else { $self->buffer =~ /^[^'\\]+/; $string .= $self->read_length($+[0]); } } } return $self->new_token(STRING3S, $self->start_line, $self->start_column, $string); } else { ### #x22 scharacter* #x22 my $string = ''; while (1) { if (substr($self->buffer, 0, 1) eq '\\') { $string .= $self->_get_escaped_char(); } elsif ($self->buffer =~ /^[^'\\]+/o) { $string .= $self->read_length($+[0]); } elsif (substr($self->buffer, 0, 1) eq "'") { last; } else { my $c = $self->peek_char(); $self->_throw_error("Got '$c' while expecting string character"); } } $self->get_char_safe(q[']); return $self->new_token(STRING1S, $self->start_line, $self->start_column, $string); } } sub _get_escaped_char { my $self = shift; my $c = $self->peek_char; $self->get_char_safe('\\'); my $esc = $self->get_char; if ($esc eq '\\') { return "\\" } elsif ($esc =~ /^['">]$/) { return $esc } elsif ($esc eq 'r') { return "\r" } elsif ($esc eq 't') { return "\t" } elsif ($esc eq 'n') { return "\n" } elsif ($esc eq 'b') { return "\b" } elsif ($esc eq 'f') { return "\f" } elsif ($esc eq 'U') { my $codepoint = $self->read_length(8); $self->_throw_error("Bad unicode escape codepoint '$codepoint'") unless ($codepoint =~ /^[0-9A-Fa-f]+$/o); return chr(hex($codepoint)); } elsif ($esc eq 'u'){ my $codepoint = $self->read_length(4); $self->_throw_error("Bad unicode escape codepoint '$codepoint'") unless ($codepoint =~ /^[0-9A-Fa-f]+$/o); return chr(hex($codepoint)); } $self->_throw_error("Unrecognized string escape '$esc'"); } sub _throw_error { my $self = shift; my $error = shift; my $line = $self->line; my $col = $self->column; use Data::Dumper; Carp::confess "$error at $line:$col with buffer: " . Dumper($self->buffer); } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Parser/Turtle/PaxHeader/Token.pm000644 000765 000024 00000000225 14636707617 023257 xustar00gregstaff000000 000000 30 mtime=1719373711.316189072 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Parser/Turtle/Token.pm000644 000765 000024 00000011233 14636707617 021307 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME AtteanX::Parser::Turtle::Token - Token objects used for parsing of Turtle =head1 VERSION This document describes AtteanX::Parser::Turtle::Token version 0.034 =head1 SYNOPSIS use v5.14; use Attean; my $term = Attean::Blank->new('b1'); $term->ntriples_string; # _:b1 =head1 DESCRIPTION The AtteanX::Parser::Turtle::Token class represents tokens produced and used during parsing of Turtle. =head1 ATTRIBUTES =over 4 =item C<< type >> An integer indicating the token type, defined in L =item C<< start_line >> The line number in the source text that this token begins on. =item C<< start_column >> The column number in the source text that this token begins on. =item C<< line >> The line number in the source text that this token ends on. =item C<< column >> The column number in the source text that this token ends on. =item C<< args >> An array of values associated with the token (e.g. the integer value of an INT token). =back =head1 METHODS =over 4 =cut package AtteanX::Parser::Turtle::Token; use Moo; use Types::Standard qw(ArrayRef Str); use List::MoreUtils qw(zip); use Sub::Util qw(set_subname); use AtteanX::Parser::Turtle::Constants; use Sub::Install; use namespace::clean; our $VERSION = 0.034; has type => ( is => 'ro', ); has start_line => ( is => 'ro', ); has start_column => ( is => 'ro', ); has line => ( is => 'ro', ); has column => ( is => 'ro', ); has args => ( is => 'ro', isa => ArrayRef[Str]); =item C<< value >> Returns the token value. =cut sub value { my $self = shift; my $args = $self->args; return $args->[0]; } =item C<< fast_constructor ( $type, $start_line, $start_col, $line, $col, \@args ) >> Returns a new token object. =cut my @KEYS = qw(type start_line start_column line column args); sub fast_constructor { my $class = shift; return $class->new( zip @KEYS, @_ ); } my %token_strings; { my %tokens = ( a => [A, 'a'], prefix => [PREFIX, '@prefix'], base => [BASE, '@base'], lparen => [LPAREN, '('], rparen => [RPAREN, ')'], lbracket => [LBRACKET, '['], rbracket => [RBRACKET, ']'], dot => [DOT, '.'], comma => [COMMA, ','], semicolon => [SEMICOLON, ';'], hathat => [HATHAT, '^^'], ); for my $name (keys %tokens) { my ($type, $value) = @{ $tokens{ $name } }; my $code = sub { my $class = shift; my $sl = shift // -1; my $sc = shift // -1; my $l = shift // $sl; my $c = shift // $sc; if ($sl > $l) { die '$start_line cannot be greater than $line in AtteanX::Parser::Turtle::Token constructor' } if ($sc > $c) { die '$start_line cannot be greater than $line in AtteanX::Parser::Turtle::Token constructor' } return $class->fast_constructor($type, $sl, $sc, $l, $c, [$value]); }; Sub::Install::install_sub({ code => set_subname($name, $code), as => $name }); $token_strings{$type} = $value; } } =item C<< token_as_string() >> Returns a string version of the token (without escaping). =cut sub token_as_string { my $self = shift; my $type = $self->type; my @args = @{ $self->args }; my $value = $args[0]; if (defined(my $v = $token_strings{$type})) { return $v; } elsif ($type == STRING1D) { return qq["$value"]; } elsif ($type == STRING1S) { return qq["$value"]; } elsif ($type == STRING3D) { return qq["""$value"""]; } elsif ($type == STRING3S) { return qq['''$value''']; } elsif ($type == IRI) { return qq[<$value>]; } elsif ($type == BNODE) { return qq[_:$value] } elsif ($type == LANG) { return qq[\@$value] } else { join(', ', @args); } } =item C<< is_string() >> Returns true if the token is one of the quoted string types (STRING1D, STRING3D, STRING1S, or STRING3S), false otherwise. =cut sub is_string { my $self = shift; my $type = $self->type; return 1 if ($type == STRING1D); return 1 if ($type == STRING1S); return 1 if ($type == STRING3D); return 1 if ($type == STRING3S); } =item C<< as_string >> Returns a string description of the token including the token type and any associated values. =cut sub as_string { my $self = shift; my $type = decrypt_constant($self->type); my @args = @{ $self->args }; if (scalar(@args)) { return "$type(" . join(', ', @args) . ")"; } else { return $type; } } __PACKAGE__->meta->make_immutable; 1; =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Parser/Turtle/PaxHeader/Constants.pm000644 000765 000024 00000000225 14636707550 024147 xustar00gregstaff000000 000000 30 mtime=1719373672.439279404 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Parser/Turtle/Constants.pm000644 000765 000024 00000003320 14636707550 022175 0ustar00gregstaff000000 000000 # AtteanX::Parser::Turtle::Constants # ----------------------------------------------------------------------------- =head1 NAME AtteanX::Parser::Turtle::Constants - Constant definitions for use in parsing Turtle, TriG, and N-Triples =head1 VERSION This document describes AtteanX::Parser::Turtle::Constants version 0.034 =head1 SYNOPSIS use AtteanX::Parser::Turtle::Constants; =head1 METHODS =over 4 =cut package AtteanX::Parser::Turtle::Constants 0.034 { use v5.14; use warnings; our @EXPORT; BEGIN { @EXPORT = qw( A BASE BNODE BOOLEAN COMMA COMMENT DECIMAL DOT DOUBLE EQUALS HATHAT INTEGER IRI LANG LBRACE LBRACKET LPAREN GRAPH PREFIX PREFIXNAME RBRACE RBRACKET RPAREN SEMICOLON STRING1D STRING1S STRING3D STRING3S TURTLEBASE TURTLEPREFIX GTGT LTLT LANNOT RANNOT WS decrypt_constant ) }; use base 'Exporter'; { my %mapping; my %reverse; BEGIN { my $cx = 0; foreach my $name (grep { $_ ne 'decrypt_constant' } @EXPORT) { my $value = ++$cx; $reverse{ $value } = $name; $mapping{ $name } = $value; } } use constant +{ %mapping }; =item C<< decrypt_constant ( $type ) >> Returns the token name for the given token type. =cut sub decrypt_constant { my $num = +shift; $reverse{$num} } } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Toby Inkster C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Toby Inkster. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Parser/Turtle/PaxHeader/Lexer.pm000644 000765 000024 00000000225 14636707550 023252 xustar00gregstaff000000 000000 30 mtime=1719373672.460127131 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Parser/Turtle/Lexer.pm000644 000765 000024 00000037572 14636707550 021320 0ustar00gregstaff000000 000000 # AtteanX::Parser::Turtle::Lexer # ----------------------------------------------------------------------------- =head1 NAME AtteanX::Parser::Turtle::Lexer - Tokenizer for parsing Turtle, TriG, and N-Triples =head1 VERSION This document describes AtteanX::Parser::Turtle::Lexer version 0.034 =head1 SYNOPSIS use AtteanX::Parser::Turtle::Lexer; my $l = AtteanX::Parser::Turtle::Lexer->new( file => $fh ); while (my $t = $l->get_token) { ... } =head1 METHODS =over 4 =cut package AtteanX::Parser::Turtle::Lexer 0.034 { use AtteanX::Parser::Turtle::Constants; use v5.14; use strict; use warnings; use Data::Dumper; use Moo; use Types::Standard qw(FileHandle Ref Str Int Bool ArrayRef HashRef ConsumerOf InstanceOf); use namespace::clean; my $r_nameChar_extra = qr'[-0-9\x{B7}\x{0300}-\x{036F}\x{203F}-\x{2040}]'o; my $r_nameStartChar_minus_underscore = qr'[A-Za-z\x{00C0}-\x{00D6}\x{00D8}-\x{00F6}\x{00F8}-\x{02FF}\x{0370}-\x{037D}\x{037F}-\x{1FFF}\x{200C}-\x{200D}\x{2070}-\x{218F}\x{2C00}-\x{2FEF}\x{3001}-\x{D7FF}\x{F900}-\x{FDCF}\x{FDF0}-\x{FFFD}\x{00010000}-\x{000EFFFF}]'o; my $r_nameStartChar = qr/[A-Za-z_\x{00C0}-\x{00D6}\x{00D8}-\x{00F6}\x{00F8}-\x{02FF}\x{0370}-\x{037D}\x{037F}-\x{1FFF}\x{200C}-\x{200D}\x{2070}-\x{218F}\x{2C00}-\x{2FEF}\x{3001}-\x{D7FF}\x{F900}-\x{FDCF}\x{FDF0}-\x{FFFD}\x{10000}-\x{EFFFF}]/o; my $r_nameChar = qr/${r_nameStartChar}|[-0-9\x{b7}\x{0300}-\x{036f}\x{203F}-\x{2040}]/o; my $r_prefixName = qr/(?:(?!_)${r_nameStartChar})(?:$r_nameChar)*/o; my $r_nameChar_test = qr"(?:$r_nameStartChar|$r_nameChar_extra)"o; my $r_double = qr'[+-]?([0-9]+\.[0-9]*[eE][+-]?[0-9]+|\.[0-9]+[eE][+-]?[0-9]+|[0-9]+[eE][+-]?[0-9]+)'o; my $r_decimal = qr'[+-]?(([0-9]+\.[0-9]+)|\.([0-9])+)'o; my $r_integer = qr'[+-]?[0-9]+'o; my $r_PN_CHARS_U = qr/[_A-Za-z_\x{00C0}-\x{00D6}\x{00D8}-\x{00F6}\x{00F8}-\x{02FF}\x{0370}-\x{037D}\x{037F}-\x{1FFF}\x{200C}-\x{200D}\x{2070}-\x{218F}\x{2C00}-\x{2FEF}\x{3001}-\x{D7FF}\x{F900}-\x{FDCF}\x{FDF0}-\x{FFFD}\x{10000}-\x{EFFFF}]/o; my $r_PN_CHARS = qr"${r_PN_CHARS_U}|[-0-9\x{00B7}\x{0300}-\x{036F}\x{203F}-\x{2040}]"o; my $r_bnode_id = qr"(?:${r_PN_CHARS_U}|[0-9])((${r_PN_CHARS}|[.])*${r_PN_CHARS})?"o; my $r_PN_CHARS_BASE = qr/([A-Z]|[a-z]|[\x{00C0}-\x{00D6}]|[\x{00D8}-\x{00F6}]|[\x{00F8}-\x{02FF}]|[\x{0370}-\x{037D}]|[\x{037F}-\x{1FFF}]|[\x{200C}-\x{200D}]|[\x{2070}-\x{218F}]|[\x{2C00}-\x{2FEF}]|[\x{3001}-\x{D7FF}]|[\x{F900}-\x{FDCF}]|[\x{FDF0}-\x{FFFD}]|[\x{10000}-\x{EFFFF}])/o; my $r_PN_PREFIX = qr/(?:${r_PN_CHARS_BASE}(?:(?:${r_PN_CHARS}|[.])*${r_PN_CHARS})?)/o; my $r_PN_LOCAL_ESCAPED = qr{(?:\\(?:[-~.!&'()*+,;=/?#@%_\$]))|%[0-9A-Fa-f]{2}}o; our $r_PN_LOCAL = qr/(?:(?:${r_PN_CHARS_U}|[:0-9]|${r_PN_LOCAL_ESCAPED})(?:(?:${r_PN_CHARS}|${r_PN_LOCAL_ESCAPED}|[:.])*(?:${r_PN_CHARS}|[:]|${r_PN_LOCAL_ESCAPED}))?)/o; my $r_PN_LOCAL_BNODE = qr/(?:(?:${r_PN_CHARS_U}|[0-9])(?:(?:${r_PN_CHARS}|[.])*${r_PN_CHARS})?)/o; our $r_PNAME_NS = qr/(?:(?:${r_PN_PREFIX})?:)/o; our $r_PNAME_LN = qr/(?:${r_PNAME_NS}${r_PN_LOCAL})/o; with 'AtteanX::API::Lexer'; has 'ignore_whitespace' => (is => 'rw', isa => Bool, default => 1); =item C<< new_token ( $type, $start_line, $start_column, @values ) >> Returns a new token with the given type and optional values, capturing the current line and column of the input data. =cut sub new_token { my $self = shift; my $type = shift; my $start_line = shift; my $start_col = shift; my $line = $self->line; my $col = $self->column; return AtteanX::Parser::Turtle::Token->fast_constructor( $type, $start_line, $start_col, $line, $col, \@_ ); } my %CHAR_TOKEN = ( '.' => DOT, ';' => SEMICOLON, '[' => LBRACKET, ']' => RBRACKET, '(' => LPAREN, ')' => RPAREN, '}' => RBRACE, ',' => COMMA, '=' => EQUALS, ); my %METHOD_TOKEN = ( # q[#] => '_get_comment', q[@] => '_get_keyword', q[<] => '_get_iriref_or_ltlt', q[>] => '_get_gtgt', q[|] => '_get_rannot', q[{] => '_get_lbrace_or_lannot', q[_] => '_get_bnode', q['] => '_get_single_literal', q["] => '_get_double_literal', q[:] => '_get_pname', (map {$_ => '_get_number'} (0 .. 9, '-', '+')) ); =item C<< get_token >> Returns the next token present in the input. =cut sub get_token { my $self = shift; while (1) { $self->fill_buffer unless (length($self->buffer)); my $start_column = $self->column; my $start_line = $self->line; if ($self->buffer =~ /^[ \r\n\t]+/o) { my $ws = $self->read_length($+[0]); # we're ignoring whitespace tokens, but we could return them here instead of falling through to the 'next': unless ($self->ignore_whitespace) { return $self->new_token(WS, $start_line, $start_column, $ws); } next; } my $c = $self->peek_char(); return unless (defined($c)); if ($c eq '#') { # we're ignoring comment tokens, but we could return them here instead of falling through to the 'next': $self->_get_comment(); next; } $self->start_column( $start_column ); $self->start_line( $start_line ); if ($c eq '.' and $self->buffer =~ /^$r_decimal/) { return $self->_get_number(); } if (defined(my $name = $CHAR_TOKEN{$c})) { $self->get_char; return $self->new_token($name, $start_line, $start_column, $c); } elsif (defined(my $method = $METHOD_TOKEN{$c})) { return $self->$method() } elsif ($c =~ /[A-Za-z\x{00C0}-\x{00D6}\x{00D8}-\x{00F6}\x{00F8}-\x{02FF}\x{0370}-\x{037D}\x{037F}-\x{1FFF}\x{200C}-\x{200D}\x{2070}-\x{218F}\x{2C00}-\x{2FEF}\x{3001}-\x{D7FF}\x{F900}-\x{FDCF}\x{FDF0}-\x{FFFD}\x{10000}-\x{EFFFF}]/o) { if ($self->buffer =~ /^a(?!:)\s/o) { $self->get_char; return $self->new_token(A, $start_line, $start_column, 'a'); } elsif ($self->buffer =~ /^(?:true|false)(?!:)\b/o) { my $bool = $self->read_length($+[0]); return $self->new_token(BOOLEAN, $start_line, $start_column, $bool); } elsif ($self->buffer =~ /^BASE(?!:)\b/oi) { $self->read_length(4); return $self->new_token(BASE, $start_line, $start_column); } elsif ($self->buffer =~ /^PREFIX(?!:)\b/io) { $self->read_length(6); return $self->new_token(PREFIX, $start_line, $start_column); } elsif ($self->buffer =~ /^GRAPH(?!:)\b/io) { $self->read_length(5); return $self->new_token(GRAPH, $start_line, $start_column); } else { return $self->_get_pname; } } elsif ($c eq '^') { $self->read_word('^^'); return $self->new_token(HATHAT, $start_line, $start_column); } else { # Carp::cluck sprintf("Unexpected byte '$c' (0x%02x)", ord($c)); return $self->_throw_error(sprintf("Unexpected byte '%s' (0x%02x)", $c, ord($c))); } warn sprintf('byte: 0x%x', ord($c)); } } =begin private =cut sub _get_pname { my $self = shift; my $prefix = ''; if ($self->buffer =~ /^$r_PNAME_LN/o) { my $ln = $self->read_length($+[0]); my ($ns, $local) = ($ln =~ /^([^:]*:)(.*)$/); no warnings 'uninitialized'; $local =~ s{\\([-~.!&'()*+,;=:/?#@%_\$])}{$1}g; return $self->new_token(PREFIXNAME, $self->start_line, $self->start_column, $ns, $local); } else { $self->buffer =~ $r_PNAME_NS; my $ns = $self->read_length($+[0]); return $self->new_token(PREFIXNAME, $self->start_line, $self->start_column, $ns); } } sub _get_gtgt { my $self = shift; $self->read_word('>>'); return $self->new_token(GTGT, $self->start_line, $self->start_column, '>>'); } sub _get_lbrace_or_lannot { my $self = shift; $self->get_char_safe(q[{]); if ($self->buffer =~ /^\|/o) { $self->get_char_safe(q[|]); return $self->new_token(LANNOT, $self->start_line, $self->start_column, '{|'); } return $self->new_token(LBRACE, $self->start_line, $self->start_column, '{'); } sub _get_rannot { my $self = shift; $self->read_word('|}'); return $self->new_token(RANNOT, $self->start_line, $self->start_column, '|}'); } sub _get_iriref_or_ltlt { my $self = shift; $self->get_char_safe(q[<]); if ($self->buffer =~ /^get_char_safe(q[<]); return $self->new_token(LTLT, $self->start_line, $self->start_column, '<<'); } if ($self->buffer =~ m/^[\x23-\x3d\x3f-\x5a\x5d-\x7e]*>/o) { my $iri .= $self->read_length($+[0]); chop($iri); return $self->new_token(IRI, $self->start_line, $self->start_column, $iri); } my $iri = ''; while (1) { if (length($self->buffer) == 0) { my $c = $self->peek_char; last unless defined($c); } if (substr($self->buffer, 0, 1) eq '\\') { $self->get_char_safe('\\'); my $esc = $self->get_char; if ($esc eq '\\') { $iri .= "\\"; } elsif ($esc eq 'U') { my $codepoint = $self->read_length(8); $self->_throw_error("Bad unicode escape codepoint '$codepoint'") unless ($codepoint =~ /^[0-9A-Fa-f]+$/o); $iri .= chr(hex($codepoint)); } elsif ($esc eq 'u') { my $codepoint = $self->read_length(4); $self->_throw_error("Bad unicode escape codepoint '$codepoint'") unless ($codepoint =~ /^[0-9A-Fa-f]+$/o); my $char = chr(hex($codepoint)); if ($char =~ /[<>" {}|\\^`]/o) { $self->_throw_error(sprintf("Bad IRI character: '%s' (0x%x)", $char, ord($char))); } $iri .= $char; } else { $self->_throw_error("Unrecognized iri escape '$esc'"); } } elsif ($self->buffer =~ /^[^<>\x00-\x20\\"{}|^`]+/o) { $iri .= $self->read_length($+[0]); } elsif (substr($self->buffer, 0, 1) eq '>') { last; } else { my $c = $self->peek_char; $self->_throw_error("Got '$c' while expecting IRI character"); } } $self->get_char_safe(q[>]); return $self->new_token(IRI, $self->start_line, $self->start_column, $iri); } sub _get_bnode { my $self = shift; $self->read_word('_:'); $self->_throw_error("Expected: name") unless ($self->buffer =~ /^${r_bnode_id}/o); my $name = substr($self->buffer, 0, $+[0]); $self->read_word($name); return $self->new_token(BNODE, $self->start_line, $self->start_column, $name); } sub _get_number { my $self = shift; if ($self->buffer =~ /^${r_double}/o) { return $self->new_token(DOUBLE, $self->start_line, $self->start_column, $self->read_length($+[0])); } elsif ($self->buffer =~ /^${r_decimal}/o) { return $self->new_token(DECIMAL, $self->start_line, $self->start_column, $self->read_length($+[0])); } elsif ($self->buffer =~ /^${r_integer}/o) { return $self->new_token(INTEGER, $self->start_line, $self->start_column, $self->read_length($+[0])); } $self->_throw_error("Expected number"); } sub _get_comment { my $self = shift; $self->get_char_safe('#'); my $comment = ''; my $c = $self->peek_char; while (length($c) and $c !~ /[\r\n]/o) { $comment .= $self->get_char; $c = $self->peek_char; } if (length($c) and $c =~ /[\r\n]/o) { $self->get_char; } return $self->new_token(COMMENT, $self->start_line, $self->start_column, $comment); } sub _get_double_literal { my $self = shift; # my $c = $self->peek_char(); $self->get_char_safe(q["]); if (substr($self->buffer, 0, 2) eq q[""]) { # #x22 #x22 #x22 lcharacter* #x22 #x22 #x22 $self->read_word(q[""]); my $quote_count = 0; my $string = ''; while (1) { if (length($self->buffer) == 0) { $self->fill_buffer; $self->_throw_error("Found EOF in string literal") if (length($self->buffer) == 0); } if (substr($self->buffer, 0, 1) eq '"') { my $c = $self->get_char; $quote_count++; last if ($quote_count == 3); } else { if ($quote_count) { $string .= '"' foreach (1..$quote_count); $quote_count = 0; } if (substr($self->buffer, 0, 1) eq '\\') { $string .= $self->_get_escaped_char(); } else { $self->buffer =~ /^[^"\\]+/; $string .= $self->read_length($+[0]); } } } return $self->new_token(STRING3D, $self->start_line, $self->start_column, $string); } else { ### #x22 scharacter* #x22 my $string = ''; while (1) { if (substr($self->buffer, 0, 1) eq '\\') { my $c = $self->_get_escaped_char(); $string .= $c; } elsif ($self->buffer =~ /^[^"\\]+/o) { my $s = $self->read_length($+[0]); $string .= $s; } elsif (substr($self->buffer, 0, 1) eq '"') { last; } else { my $c = $self->peek_char; $self->_throw_error("Got '$c' while expecting string character"); } } $self->get_char_safe(q["]); return $self->new_token(STRING1D, $self->start_line, $self->start_column, $string); } } sub _get_single_literal { my $self = shift; $self->get_char_safe("'"); if (substr($self->buffer, 0, 2) eq q['']) { # #x22 #x22 #x22 lcharacter* #x22 #x22 #x22 $self->read_word(q['']); my $quote_count = 0; my $string = ''; while (1) { if (length($self->buffer) == 0) { $self->fill_buffer; $self->_throw_error("Found EOF in string literal") if (length($self->buffer) == 0); } if (substr($self->buffer, 0, 1) eq "'") { my $c = $self->get_char; $quote_count++; last if ($quote_count == 3); } else { if ($quote_count) { $string .= "'" foreach (1..$quote_count); $quote_count = 0; } if (substr($self->buffer, 0, 1) eq '\\') { $string .= $self->_get_escaped_char(); } else { $self->buffer =~ /^[^'\\]+/; $string .= $self->read_length($+[0]); } } } return $self->new_token(STRING3S, $self->start_line, $self->start_column, $string); } else { ### #x22 scharacter* #x22 my $string = ''; while (1) { $self->fill_buffer unless (length($self->buffer)); if (substr($self->buffer, 0, 1) eq '\\') { $string .= $self->_get_escaped_char(); } elsif ($self->buffer =~ /^[^'\\]+/o) { $string .= $self->read_length($+[0]); } elsif (substr($self->buffer, 0, 1) eq "'") { last; } else { my $c = $self->peek_char(); $self->_throw_error("Got '$c' while expecting string character"); } } $self->get_char_safe(q[']); return $self->new_token(STRING1S, $self->start_line, $self->start_column, $string); } } sub _get_escaped_char { my $self = shift; my $c = $self->peek_char; $self->get_char_safe('\\'); my $esc = $self->get_char; if ($esc eq '\\') { return "\\" } elsif ($esc =~ /^['">]$/) { return $esc } elsif ($esc eq 'r') { return "\r" } elsif ($esc eq 't') { return "\t" } elsif ($esc eq 'n') { return "\n" } elsif ($esc eq 'b') { return "\b" } elsif ($esc eq 'f') { return "\f" } elsif ($esc eq 'U') { my $codepoint = $self->read_length(8); $self->_throw_error("Bad unicode escape codepoint '$codepoint'") unless ($codepoint =~ /^[0-9A-Fa-f]+$/o); return chr(hex($codepoint)); } elsif ($esc eq 'u'){ my $codepoint = $self->read_length(4); $self->_throw_error("Bad unicode escape codepoint '$codepoint'") unless ($codepoint =~ /^[0-9A-Fa-f]+$/o); return chr(hex($codepoint)); } $self->_throw_error("Unrecognized string escape '$esc'"); } sub _get_keyword { my $self = shift; $self->get_char_safe('@'); if ($self->buffer =~ /^base/o) { $self->read_word('base'); return $self->new_token(TURTLEBASE, $self->start_line, $self->start_column); } elsif ($self->buffer =~ /^prefix/o) { $self->read_word('prefix'); return $self->new_token(TURTLEPREFIX, $self->start_line, $self->start_column); } else { if ($self->buffer =~ /^[a-zA-Z]+(-[a-zA-Z0-9]+)*\b/o) { my $lang = $self->read_length($+[0]); return $self->new_token(LANG, $self->start_line, $self->start_column, $lang); } $self->_throw_error("Expected keyword or language tag"); } } sub _throw_error { my $self = shift; my $error = shift; my $line = $self->line; my $col = $self->column; Carp::confess "$error at $line:$col with buffer: " . Dumper($self->buffer); } } 1; __END__ =end private =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Parser/SPARQLXML/PaxHeader/SAXHandler.pm000644 000765 000024 00000000225 14636707622 024230 xustar00gregstaff000000 000000 30 mtime=1719373714.009840194 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Parser/SPARQLXML/SAXHandler.pm000644 000765 000024 00000012544 14636707622 022266 0ustar00gregstaff000000 000000 # AtteanX::Parser::SPARQLXML::SAXHandler # ----------------------------------------------------------------------------- =head1 NAME AtteanX::Parser::SPARQLXML::SAXHandler - XML parser for SPARQL XML Results format =head1 VERSION This document describes AtteanX::Parser::SPARQLXML::SAXHandler version 0.034 =head1 STATUS This module's API and functionality should be considered unstable. In the future, this module may change in backwards-incompatible ways, or be removed entirely. =head1 SYNOPSIS use AtteanX::Parser::SPARQLXML::SAXHandler; =head1 METHODS =over 4 =cut package AtteanX::Parser::SPARQLXML::SAXHandler 0.034; use v5.14; use warnings; use Attean; use Scalar::Util qw(refaddr); use base qw(XML::SAX::Base); use Attean; use namespace::clean; my %strings; my %tagstack; my %results; my %values; my %bindings; my %booleans; my %variables; my %has_head; my %has_end; my %result_count; my %result_handlers; my %config; my %triples; my %expecting_string = map { $_ => 1 } qw(boolean bnode uri literal); =item C<< new ( [ \&handler ] ) >> Returns a new XML::SAX handler object. If C<< &handler >> is supplied, it will be called with a variable bindings object as each is parsed, bypassing the normal process of collecting the results for retrieval via an iterator object. =cut sub new { my $class = shift; my $self = $class->SUPER::new(); if (@_) { my $addr = refaddr( $self ); my $code = shift; my $args = shift || {}; $result_handlers{ $addr } = $code; $config{ $addr } = { %$args }; } return $self; } =begin private =item C<< start_element >> =cut sub start_element { my $self = shift; my $el = shift; my $tag = $el->{LocalName}; my $addr = refaddr( $self ); unshift( @{ $tagstack{ $addr } }, [$tag, $el] ); if ($expecting_string{ $tag }) { $strings{ $addr } = ''; } if ($tag eq 'triple') { push(@{ $triples{ $addr } }, {}); } } =item C<< end_element >> =cut sub end_element { my $self = shift; my $class = ref($self); my $eel = shift; my $addr = refaddr( $self ); my $string = $strings{ $addr }; my $taginfo = shift( @{ $tagstack{ $addr } } ); my ($tag, $el) = @$taginfo; if ($tag eq 'head') { $has_head{ $addr } = 1; if (my $code = $result_handlers{ $addr }) { if ($config{ $addr }{ variables }) { $code->( $variables{ $addr } ); } } } elsif ($tag eq 'sparql') { $has_end{ $addr } = 1; } elsif ($tag eq 'variable') { push( @{ $variables{ $addr } }, $el->{Attributes}{'{}name'}{Value}); } elsif ($tag eq 'boolean') { $booleans{ $addr } = ($string eq 'true') ? 1 : 0; if ($string =~ /^(?:true|false)$/ and my $code = $result_handlers{ $addr }) { $code->( Attean::Literal->$string() ); } } elsif ($tag eq 'binding') { my $name = $el->{Attributes}{'{}name'}{Value}; my $value = delete( $values{ $addr } ); $bindings{ $addr }{ $name } = $value; } elsif ($tag eq 'result') { my $result = delete( $bindings{ $addr } ) || {}; $result_count{ $addr }++; my $vb = Attean::Result->new( bindings => $result ); if (my $code = $result_handlers{ $addr }) { $code->( $vb ); } else { push( @{ $results{ $addr } }, $vb ); } } elsif ($tag eq 'bnode') { $values{ $addr } = Attean::Blank->new( $string ); } elsif ($tag eq 'uri') { $values{ $addr } = Attean::IRI->new( $string ); } elsif ($tag eq 'literal') { my ($lang, $dt); if (my $dtinf = $el->{Attributes}{'{}datatype'}) { $dt = $dtinf->{Value}; $values{ $addr } = Attean::Literal->new( value => $string, datatype => $dt ); } elsif (my $langinf = $el->{Attributes}{'{http://www.w3.org/XML/1998/namespace}lang'}) { $lang = $langinf->{Value}; $values{ $addr } = Attean::Literal->new( value => $string, language => $lang ); } else { $values{ $addr } = Attean::Literal->new( value => $string ); } } elsif ($tag eq 'subject') { my $value = delete( $values{ $addr } ); $triples{ $addr }[-1]{$tag} = $value; } elsif ($tag eq 'predicate') { my $value = delete( $values{ $addr } ); $triples{ $addr }[-1]{$tag} = $value; } elsif ($tag eq 'object') { my $value = delete( $values{ $addr } ); $triples{ $addr }[-1]{$tag} = $value; } elsif ($tag eq 'triple') { my $data = pop(@{ $triples{ $addr } }); my $t = Attean::Triple->new( %{ $data } ); $values{ $addr } = $t; } } =item C<< characters >> =cut sub characters { my $self = shift; my $data = shift; my $addr = refaddr( $self ); my $tag = $self->_current_tag; if ($expecting_string{ $tag }) { my $chars = $data->{Data}; $strings{ $addr } .= $chars; } } sub _current_tag { my $self = shift; my $addr = refaddr( $self ); return $tagstack{ $addr }[0][0]; } sub DESTROY { my $self = shift; my $addr = refaddr( $self ); delete $strings{ $addr }; delete $results{ $addr }; delete $tagstack{ $addr }; delete $values{ $addr }; delete $bindings{ $addr }; delete $booleans{ $addr }; delete $variables{ $addr }; delete $has_head{ $addr }; delete $has_end{ $addr }; delete $result_count{ $addr }; delete $result_handlers{ $addr }; delete $config{ $addr }; } 1; __END__ =end private =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/SPARQL/PaxHeader/Token.pm000644 000765 000024 00000000225 14636707630 021541 xustar00gregstaff000000 000000 30 mtime=1719373720.089315425 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/SPARQL/Token.pm000644 000765 000024 00000010445 14636707630 017575 0ustar00gregstaff000000 000000 use v5.14; use warnings; =head1 NAME AtteanX::SPARQL::Token - Token objects used for parsing and serializing SPARQL =head1 VERSION This document describes AtteanX::SPARQL::Token version 0.034 =head1 SYNOPSIS use v5.14; use Attean; =head1 DESCRIPTION The AtteanX::SPARQL::Token class represents tokens produced and used during parsing and serializing of SPARQL. =head1 ATTRIBUTES =over 4 =item C<< type >> An integer indicating the token type, defined in L =item C<< start_line >> The line number in the source text that this token begins on. =item C<< start_column >> The column number in the source text that this token begins on. =item C<< line >> The line number in the source text that this token ends on. =item C<< column >> The column number in the source text that this token ends on. =item C<< args >> An array of values associated with the token (e.g. the integer value of an INT token). =back =head1 METHODS =over 4 =cut package AtteanX::SPARQL::Token 0.034; use Moo; use Types::Standard qw(ArrayRef Str); use List::MoreUtils qw(zip); use Sub::Util qw(set_subname); use AtteanX::SPARQL::Constants; use namespace::clean; has type => ( is => 'ro', ); has start_line => ( is => 'ro', ); has start_column => ( is => 'ro', ); has line => ( is => 'ro', ); has column => ( is => 'ro', ); has args => ( is => 'ro', isa => ArrayRef[Str]); extends 'AtteanX::Parser::Turtle::Token'; =item C<< value >> Returns the token value. =cut sub value { my $self = shift; my $args = $self->args; return $args->[0]; } =item C<< fast_constructor ( $type, $start_line, $start_col, $line, $col, \@args ) >> Returns a new token object. =cut my @KEYS = qw(type start_line start_column line column args); sub fast_constructor { my $class = shift; return $class->new( zip @KEYS, @_ ); } { my %tokens = ( a => [A, 'a'], prefix => [PREFIX, '@prefix'], base => [BASE, '@base'], lparen => [LPAREN, '('], rparen => [RPAREN, ')'], lbracket => [LBRACKET, '['], rbracket => [RBRACKET, ']'], dot => [DOT, '.'], comma => [COMMA, ','], semicolon => [SEMICOLON, ';'], hathat => [HATHAT, '^^'], lbrace => [LBRACE, '{'], rbrace => [RBRACE, '}'], op_andand => [ANDAND, '&&'], anon => [ANON, '[]'], op_bang => [BANG, '!'], op_ge => [GE, '>='], op_gt => [GT, '>'], path_hat => [HAT, '^'], op_le => [LE, '<='], op_lt => [LT, '<'], minus => [MINUS, '-'], nil => [NIL, '()'], op_ne => [NOTEQUALS, '!='], path_or => [OR, '|'], op_oror => [OROR, '||'], op_plus => [PLUS, '+'], question => [QUESTION, '?'], slash => [SLASH, '/'], star => [STAR, '*'], ltlt => [LTLT, '<<'], gtgt => [GTGT, '>>'], lannot => [LANNOT, '{|'], rannot => [RANNOT, '|}'], ); for my $name (keys %tokens) { my ($type, $value) = @{ $tokens{ $name } }; my $code = sub { my $class = shift; return $class->fast_constructor($type, -1, -1, -1, -1, [$value]); }; Sub::Install::install_sub({ code => set_subname($name, $code), as => $name }); } } =item C<< keyword( $kw ) >> Returns a new L object with the C type and C<$kw> value. =cut sub keyword { my $class = shift; my $kw = shift; return $class->fast_constructor(KEYWORD, -1, -1, -1, -1, [uc($kw)]); } =item C<< integer( $value ) >> Returns a new L object with the C type and the given C<$value>. =cut sub integer { my $class = shift; my $value = shift; return $class->fast_constructor(INTEGER, -1, -1, -1, -1, [+$value] ); } =item C<< as_string >> Returns a string description of the token including the token type and any associated values. =cut sub as_string { my $self = shift; my $type = decrypt_constant($self->type); my @args = @{ $self->args }; if (scalar(@args)) { return "$type(" . join(', ', @args) . ")"; } else { return $type; } } __PACKAGE__->meta->make_immutable; 1; =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/SPARQL/PaxHeader/Constants.pm000644 000765 000024 00000000225 14636707550 022436 xustar00gregstaff000000 000000 30 mtime=1719373672.755030567 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/SPARQL/Constants.pm000644 000765 000024 00000003643 14636707550 020474 0ustar00gregstaff000000 000000 # AtteanX::SPARQL::Constants # ----------------------------------------------------------------------------- =head1 NAME AtteanX::SPARQL::Constants - Constant definitions for use in parsing and serializing SPARQL =head1 VERSION This document describes AtteanX::SPARQL::Constants version 0.034 =head1 SYNOPSIS use AtteanX::SPARQL::Constants; =head1 METHODS =over 4 =cut package AtteanX::SPARQL::Constants 0.034 { use v5.14; use warnings; use AtteanX::Parser::Turtle::Constants; our @EXPORT; our @LOCAL_TYPES; BEGIN { @LOCAL_TYPES = qw( ANDAND ANON BANG GE GT HAT KEYWORD LE LT MINUS NIL NOTEQUALS OR OROR PLUS QUESTION SLASH STAR VAR decrypt_constant ); # GTGT # LTLT # LANNOT # RANNOT @EXPORT = (@AtteanX::Parser::Turtle::Constants::EXPORT, @LOCAL_TYPES); }; use base 'Exporter'; { my %mapping; my %reverse; BEGIN { my $cx = scalar(@AtteanX::Parser::Turtle::Constants::EXPORT) - 1; foreach my $name (grep { $_ ne 'decrypt_constant' } @LOCAL_TYPES) { my $value = ++$cx; $reverse{ $value } = $name; $mapping{ $name } = $value; } } use constant +{ %mapping }; =item C<< decrypt_constant ( $type ) >> Returns the token name for the given token type. =cut no warnings 'redefine'; sub decrypt_constant { my $num = +shift; if (exists $reverse{$num}) { return $reverse{$num}; } else { return AtteanX::Parser::Turtle::Constants::decrypt_constant($num); } } } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Toby Inkster C<< >> Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Toby Inkster. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Serializer/PaxHeader/CanonicalNTriples.pm000644 000765 000024 00000000424 14636707550 025142 xustar00gregstaff000000 000000 29 mtime=1719373672.51708358 69 LIBARCHIVE.xattr.com.apple.lastuseddate#PS=dEdvZgAAAAAAydQgAAAAAA 59 SCHILY.xattr.com.apple.lastuseddate#PS=tGofÉÔ 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Serializer/CanonicalNTriples.pm000644 000765 000024 00000003406 14636707550 023174 0ustar00gregstaff000000 000000 =head1 NAME AtteanX::Serializer::CanonicalNTriples - Canonical N-Triples Serializer =head1 VERSION This document describes AtteanX::Serializer::CanonicalNTriples version 0.034 =head1 SYNOPSIS use Attean; my $serializer = Attean->get_serializer('NTriples')->new(); $serializer->serialize_iter_to_io( $io, $iter ); =head1 DESCRIPTION ... =head1 METHODS =over 4 =cut use v5.14; use warnings; package AtteanX::Serializer::CanonicalNTriples 0.034 { use Moo; use Encode; extends 'AtteanX::Serializer::NTriples'; use namespace::clean; =item C<< serialize_iter_to_io( $fh, $iterator ) >> Serializes the L objects from C<< $iterator >> to the L object C<< $fh >>. =cut sub serialize_iter_to_io { my $self = shift; my $io = shift; my $iter = shift; $iter = $iter->materialize; my $triples = $iter->canonical_set(); foreach my $t (@$triples) { my $str = $t->tuples_string; $io->print($str . "\n"); } return; } =item C<< serialize_iter_to_bytes( $iterator ) >> Serializes the L objects from C<< $iterator >> and returns the serialization as a UTF-8 encoded byte string. =cut sub serialize_iter_to_bytes { my $self = shift; my $iter = shift; my $data = encode('UTF-8', ''); open(my $fh, '>', \$data); $self->serialize_iter_to_io($fh, $iter); close($fh); return $data; } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Serializer/PaxHeader/SPARQL.pm000644 000765 000024 00000000225 14636707550 022573 xustar00gregstaff000000 000000 30 mtime=1719373672.604595138 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Serializer/SPARQL.pm000644 000765 000024 00000014776 14636707550 020642 0ustar00gregstaff000000 000000 =head1 NAME AtteanX::Serializer::SPARQL - SPARQL Serializer =head1 VERSION This document describes AtteanX::Serializer::SPARQL version 0.034 =head1 SYNOPSIS use Attean; my $serializer = Attean->get_serializer('SPARQL')->new(); $serializer->serialize_iter_to_io( $io, $fh ); =head1 DESCRIPTION ... =head1 ATTRIBUTES =over 4 =item C<< canonical_media_type >> =item C<< media_types >> =item C<< handled_type >> =item C<< file_extensions >> =back =head1 METHODS =over 4 =cut use v5.14; use warnings; package AtteanX::Serializer::SPARQL 0.034 { use Moo; use Data::Dumper; use Encode qw(encode); use Attean::ListIterator; use Scalar::Util qw(blessed); use List::MoreUtils qw(any); use AtteanX::SPARQL::Constants; use namespace::clean; with 'Attean::API::AbbreviatingSerializer'; sub canonical_media_type { return "application/sparql-query" } sub media_types { return [qw(application/sparql-query)]; } =item C<< file_extensions >> Returns a list of file extensions associated with the serialized format. =cut sub file_extensions { return [qw(rq ru)] }; sub handled_type { state $ITEM_TYPE = Type::Tiny::Role->new(role => 'AtteanX::SPARQL::Token'); return $ITEM_TYPE; } =item C<< serialize_iter_to_io( $fh, $iterator ) >> Serializes the SPARQL token objects from C<< $iterator >> to the L object C<< $fh >>. =cut sub serialize_iter_to_io { my $self = shift; my $io = shift; my $iter = shift; my $indent = 0; my $newline = 1; my $semicolon = 0; my $need_space = 0; my $ns = $self->namespaces; my $parser = Attean->get_parser('SPARQLLex')->new(); if ($ns) { NSLOOP: foreach my $p (sort $ns->list_prefixes) { my $prefix = $ns->namespace_uri($p)->as_string; $io->print("PREFIX $p: <$prefix>\n"); } } my $last; while (my $t = $iter->next()) { my $type = $t->type; if ($type == LANG or $type == HATHAT) { $need_space= 0; } unless ($newline) { if ($type == RBRACE) { $io->print("\n"); $newline = 1; } elsif ($type == KEYWORD and $t->value =~ /^(BASE|PREFIX|SELECT|ASK|CONSTRUCT|DESCRIBE|USING|FROM)$/) { $io->print("\n"); $newline = 1; } elsif ($type == KEYWORD and $t->value eq 'WHERE' and blessed($last) and ($last->type == PREFIXNAME or $last->type == IRI)) { # this captures "USING WHERE" and "USING NAMED WHERE", forcing a newline before the "WHERE" $io->print("\n"); $newline = 1; } } if ($type == RBRACE) { $indent--; } if ($semicolon and $type == KEYWORD and $t->value =~ /^(BASE|PREFIX|SELECT|ADD|COPY|MOVE|USING|LOAD|DELETE|INSERT|WITH|CLEAR|DROP|CREATE)$/) { # SPARQL Update use of a semicolon is different from its use in a Query; # In queries, semicolon affects indentation. In updates, it's just a separator. # So back out the indentation if it's being used as a separator here. $semicolon = 0; $indent--; } if ($newline) { $io->print(' ' x $indent); $newline = 0; } elsif ($need_space) { $io->print(' '); $need_space = 0; } if ($type == KEYWORD) { $io->print($t->value); $need_space++; } elsif ($type == IRI) { my $value = $t->value; my $ser = '<' . $value . '>'; if ($ns) { NSLOOP: foreach my $p ($ns->list_prefixes) { my $prefix = $ns->namespace_uri($p)->as_string; if (substr($value, 0, length($prefix)) eq $prefix) { # now verify that the prefixname is valid SPARQL syntax by re-parsing it my $pname = join(':', $p, substr($value, length($prefix))); my $b = $pname; $b = encode('UTF-8', $b, Encode::FB_CROAK); my ($pnt) = eval { $parser->parse_list_from_bytes($b) }; if (blessed($pnt) and $pnt->type == PREFIXNAME) { $ser = $pname; } last NSLOOP; } } } # TODO: escape $io->print($ser); $need_space++; } elsif ($type == PREFIXNAME) { my $args = $t->args; $io->print(join('', @$args)); $need_space++; } elsif ($type == BNODE) { $io->print('_:'); $io->print($t->value); $need_space++; } elsif ($type == LANG) { $io->print('@'); $io->print($t->value); $need_space++; } elsif ($type == STRING1S) { my $value = $t->value; $value =~ s/'/\\'/g; $io->print("'"); $io->print($value); $io->print("'"); $need_space++; } elsif ($type == STRING1D) { my $value = $t->value; $value =~ s/"/\\"/g; $io->print('"'); $io->print($value); $io->print('"'); $need_space++; } elsif ($type == STRING3S) { my $value = $t->value; $value =~ s/'''/''\\'/g; $io->print("'''"); $io->print($value); $io->print("'''"); $need_space++; } elsif ($type == STRING3D) { my $value = $t->value; $value =~ s/"""/""\\"/g; $io->print('"""'); $io->print($value); $io->print('"""'); $need_space++; } elsif ($type == VAR) { $io->print('?'); $io->print($t->value); $need_space++; } elsif ($type == A) { $io->print('a'); $need_space++; } elsif ($type == WS) { } elsif ($type == COMMENT) { $io->print('# '); $io->print($t->value); $io->print("\n"); } elsif ($type == HATHAT) { $io->print($t->value); } else { $io->print($t->value); $need_space++; } if ($type == DOT) { if ($semicolon) { $indent--; $semicolon = 0; } $need_space = 0; $io->print("\n"); $newline = 1; } elsif ($type == LBRACE) { $io->print("\n"); $need_space = 0; $newline = 1; $indent++; } elsif ($type == SEMICOLON) { $io->print("\n"); $need_space = 0; $newline = 1; unless ($semicolon) { $indent++; } $semicolon = 1; } $last = $t; } unless ($newline) { $io->print("\n"); } return; } =item C<< serialize_iter_to_bytes( $iterator ) >> Serializes the SPARQL token objects from C<< $iterator >> and returns the serialization as a UTF-8 encoded byte string. =cut sub serialize_iter_to_bytes { my $self = shift; my $iter = shift; my $data = ''; open(my $fh, '>:utf8', \$data); $self->serialize_iter_to_io($fh, $iter); close($fh); return $data; } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Serializer/PaxHeader/TextTable.pm000644 000765 000024 00000000225 14636707550 023465 xustar00gregstaff000000 000000 30 mtime=1719373672.704060581 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Serializer/TextTable.pm000644 000765 000024 00000007652 14636707550 021527 0ustar00gregstaff000000 000000 =head1 NAME AtteanX::Serializer::TextTable - SPARQL Results TSV Serializer =head1 VERSION This document describes AtteanX::Serializer::TextTable version 0.034 =head1 SYNOPSIS use Attean; my $s = Attean->get_serializer('TextTable')->new(); $s->serialize_iter_to_io( $fh, $iter ); =head1 DESCRIPTION ... =head1 ATTRIBUTES =over 4 =item C<< canonical_media_type >> =item C<< file_extensions >> =back =head1 METHODS =over 4 =cut use v5.14; use warnings; package AtteanX::Serializer::TextTable 0.034 { use Moo; use Types::Standard qw(Str Bool ArrayRef); use Encode qw(encode); use Scalar::Util qw(blessed); use Attean::ListIterator; use List::MoreUtils qw(any); use Text::Table; use namespace::clean; my @rule = qw(- +); has 'canonical_media_type' => (is => 'ro', isa => Str, init_arg => undef, default => 'text/plain'); has 'number_rows' => (is => 'rw', isa => Bool, default => 0); =item C<< media_types >> Returns a list of media types that identify the format produced by this serializer. =cut sub media_types { return [qw(text/plain)]; } =item C<< file_extensions >> Returns a list of file extensions associated with the serialized format. =cut sub file_extensions { return [qw(txt text)] }; =item C<< serialize_iter_to_io( $fh, $iterator ) >> Serializes the L objects from C<< $iterator >> to the L object C<< $fh >>. =cut sub serialize_iter_to_io { my $self = shift; my $io = shift; my $iter = shift; my @vars; if ($iter->does('Attean::API::ResultOrTermIterator')) { @vars = @{ $iter->variables }; } elsif ($iter->does('Attean::API::TripleIterator')) { @vars = qw(subject predicate object); } else { @vars = qw(subject predicate object graph); } my @header_names = @vars; if ($self->number_rows) { unshift(@header_names, '#'); } my @headers = (\q"| "); push(@headers, map { $_ => \q" | " } @header_names); pop @headers; push @headers => (\q" |"); my $table = Text::Table->new(@headers); my @rule = qw(- +); my @rows; my $row = 1; while (my $t = $iter->next()) { my @strings = map { blessed($_) ? $_->as_string : '' } map { eval { $t->value($_) } } @vars; if ($self->number_rows) { unshift(@strings, $row++); } push(@rows, \@strings); } $table->load(@rows); print {$io} join('', $table->rule(@rule), $table->title, $table->rule(@rule), map({ $table->body($_) } 0 .. @rows), $table->rule(@rule) ); } =item C<< serialize_iter_to_bytes( $iterator ) >> Serializes the L objects from C<< $iterator >> and returns the serialization as a UTF-8 encoded byte string. =cut sub serialize_iter_to_bytes { my $self = shift; my $io = shift; my $iter = shift; my @vars = @{ $iter->variables }; my @header_names = @vars; if ($self->number_rows) { unshift(@header_names, '#'); } my @headers = (\q"| "); push(@headers, map { $_ => \q" | " } @header_names); pop @headers; push @headers => (\q" |"); my $table = Text::Table->new(@headers); my @rows; my $row = 1; while (my $t = $iter->next()) { my @strings = map { blessed($_) ? $_->ntriples_string : '' } map { $t->value($_) } @vars; if ($self->number_rows) { unshift(@strings, $row++); } push(@rows, \@strings); } $table->load(@rows); my $data = join('', $table->rule(@rule), $table->title, $table->rule(@rule), map({ $table->body($_) } 0 .. @rows), $table->rule(@rule) ); return encode('UTF-8', $data); } with 'Attean::API::ResultSerializer'; } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Serializer/PaxHeader/NTriples.pm000644 000765 000024 00000000425 14636707550 023333 xustar00gregstaff000000 000000 30 mtime=1719373672.554040004 69 LIBARCHIVE.xattr.com.apple.lastuseddate#PS=s0ZvZgAAAABYXM4JAAAAAA 59 SCHILY.xattr.com.apple.lastuseddate#PS=³FofX\Î 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Serializer/NTriples.pm000644 000765 000024 00000003514 14636707550 021364 0ustar00gregstaff000000 000000 =head1 NAME AtteanX::Serializer::NTriples - N-Triples Serializer =head1 VERSION This document describes AtteanX::Serializer::NTriples version 0.034 =head1 SYNOPSIS use Attean; my $serializer = Attean->get_serializer('NTriples')->new(); $serializer->serialize_iter_to_io( $iter, $fh ); =head1 DESCRIPTION Serializes triples into the RDF 1.1 N-Triples format. =head1 ATTRIBUTES =over 4 =item C<< canonical_media_type >> =item C<< file_extensions >> =back =head1 METHODS =over 4 =item C<< serialize_iter_to_io( $fh, $iterator ) >> =item C<< serialize_iter_to_bytes( $fh ) >> =cut use v5.14; use warnings; package AtteanX::Serializer::NTriples 0.034 { use Moo; use Types::Standard qw(Str ArrayRef); use Encode qw(encode); use Attean::ListIterator; use List::MoreUtils qw(any); use namespace::clean; extends 'AtteanX::Serializer::NTuples'; has 'canonical_media_type' => (is => 'ro', isa => Str, init_arg => undef, default => 'application/n-triples'); =item C<< media_types >> Returns a list of media types that identify the format produced by this serializer. =cut sub media_types { return [qw(application/n-triples text/plain)]; } =item C<< file_extensions >> Returns a list of file extensions associated with the serialized format. =cut sub file_extensions { return [qw(nt)] }; with 'Attean::API::TripleSerializer'; with 'Attean::API::AppendableSerializer'; } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO L =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Serializer/PaxHeader/SPARQLCSV.pm000644 000765 000024 00000000225 14636707550 023147 xustar00gregstaff000000 000000 30 mtime=1719373672.624272847 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Serializer/SPARQLCSV.pm000644 000765 000024 00000006422 14636707550 021203 0ustar00gregstaff000000 000000 =head1 NAME AtteanX::Serializer::SPARQLCSV - SPARQL Results CSV Serializer =head1 VERSION This document describes AtteanX::Serializer::SPARQLCSV version 0.034 =head1 SYNOPSIS use Attean; my $s = Attean->get_serializer('SPARQLCSV')->new(); $s->serialize_iter_to_io( $fh, $iter ); =head1 DESCRIPTION ... =head1 ATTRIBUTES =over 4 =item C<< canonical_media_type >> =item C<< file_extensions >> =back =head1 METHODS =over 4 =cut use v5.14; use warnings; package AtteanX::Serializer::SPARQLCSV 0.034 { use Moo; use Types::Standard qw(Str ArrayRef); use Encode qw(encode); use Scalar::Util qw(blessed); use Attean::ListIterator; use List::MoreUtils qw(any); use Text::CSV; use namespace::clean; has 'canonical_media_type' => (is => 'ro', isa => Str, init_arg => undef, default => 'text/csv'); =item C<< media_types >> Returns a list of media types that identify the format produced by this serializer. =cut sub media_types { return [qw(text/csv)]; } =item C<< file_extensions >> Returns a list of file extensions associated with the serialized format. =cut sub file_extensions { return [qw(csv)] }; =item C<< serialize_iter_to_io( $fh, $iterator ) >> Serializes the L objects from C<< $iterator >> to the L object C<< $fh >>. =cut sub serialize_iter_to_io { my $self = shift; my $io = shift; my $iter = shift; my $csv = Text::CSV->new ( { binary => 1 } ); my @vars = @{ $iter->variables }; $csv->print($io, \@vars); print $io "\n"; while (my $t = $iter->next()) { my @strings; foreach my $var (@vars) { my $term = $t->value($var); if (blessed($term)) { if ($term->does('Attean::API::Blank')) { push(@strings, $term->ntriples_string); } else { push(@strings, $term->value); } } else { push(@strings, ''); } } $csv->print($io, [@strings]); print $io "\n"; } return; } =item C<< serialize_iter_to_bytes( $iterator ) >> Serializes the L objects from C<< $iterator >> and returns the serialization as a UTF-8 encoded byte string. =cut sub serialize_iter_to_bytes { my $self = shift; my $iter = shift; my $data = encode('UTF-8', ''); my $csv = Text::CSV->new ( { binary => 1 } ); my @vars = @{ $iter->variables }; $csv->combine(map { encode('UTF-8', $_) } @vars); $data .= $csv->string . "\n"; while (my $t = $iter->next()) { my @strings; foreach my $var (@vars) { my $term = $t->value($var); if (blessed($term)) { if ($term->does('Attean::API::Blank')) { push(@strings, $term->ntriples_string); } else { push(@strings, $term->value); } } else { push(@strings, ''); } } if ($csv->combine(map { encode('UTF-8', $_) } @strings)) { $data .= $csv->string . "\n"; } } return $data; } with 'Attean::API::ResultSerializer', 'Attean::API::AppendableSerializer'; } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Serializer/PaxHeader/SPARQLJSON.pm000644 000765 000024 00000000225 14636707550 023265 xustar00gregstaff000000 000000 30 mtime=1719373672.656020183 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Serializer/SPARQLJSON.pm000644 000765 000024 00000006162 14636707550 021322 0ustar00gregstaff000000 000000 =head1 NAME AtteanX::Serializer::SPARQLJSON - SPARQL Results JSON Serializer =head1 VERSION This document describes AtteanX::Serializer::SPARQLJSON version 0.034 =head1 SYNOPSIS use Attean; my $s = Attean->get_serializer('SPARQLJSON')->new(); $s->serialize_iter_to_io( $fh, $iter ); =head1 DESCRIPTION ... =head1 ATTRIBUTES =over 4 =item C<< canonical_media_type >> =item C<< file_extensions >> =back =head1 METHODS =over 4 =cut use v5.14; use warnings; package AtteanX::Serializer::SPARQLJSON 0.034 { use Moo; use Types::Standard qw(Str); use Encode qw(encode); use Scalar::Util qw(blessed); use Attean::ListIterator; use JSON; use namespace::clean; has 'canonical_media_type' => (is => 'ro', isa => Str, init_arg => undef, default => 'application/sparql-results+json'); =item C<< media_types >> Returns a list of media types that identify the format produced by this serializer. =cut sub media_types { return [qw(application/sparql-results+json)]; } =item C<< file_extensions >> Returns a list of file extensions associated with the serialized format. =cut sub file_extensions { return [qw(srj json)] }; =item C<< serialize_iter_to_io( $fh, $iterator ) >> Serializes the L objects from C<< $iterator >> to the L object C<< $fh >>. =cut sub serialize_iter_to_io { my $self = shift; my $fh = shift; my $iter = shift; my @vars = sort @{ $iter->variables }; my $data = { head => { vars => \@vars }, results => { bindings => [] }, }; while (my $t = $iter->next()) { my %binding; foreach my $name ($t->variables) { my $term = $t->value($name); if (blessed($term)) { my $type; if ($term->does('Attean::API::IRI')) { $type = 'uri'; } elsif ($term->does('Attean::API::Literal')) { $type = 'literal'; } elsif ($term->does('Attean::API::Blank')) { $type = 'bnode'; } else { die 'Term object has an unrecognized type: ' . ref($term); } $binding{$name} = { type => $type, value => $term->value }; } } push(@{ $data->{results}{bindings} }, { %binding }); } print {$fh} JSON->new->canonical(1)->encode($data); return; } =item C<< serialize_iter_to_bytes( $iterator ) >> Serializes the L objects from C<< $iterator >> and returns the serialization as a UTF-8 encoded byte string. =cut sub serialize_iter_to_bytes { my $self = shift; my $iter = shift; my $data = encode('UTF-8', ''); open(my $fh, '>:encoding(UTF-8)', \$data); $self->serialize_iter_to_io($fh, $iter); close($fh); return $data; } with 'Attean::API::ResultSerializer', 'Attean::API::AppendableSerializer'; } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO L =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Serializer/PaxHeader/NTuples.pm000644 000765 000024 00000000425 14636707550 023165 xustar00gregstaff000000 000000 30 mtime=1719373672.570115453 69 LIBARCHIVE.xattr.com.apple.lastuseddate#PS=t0ZvZgAAAACg2rYeAAAAAA 59 SCHILY.xattr.com.apple.lastuseddate#PS=·Fof Ú¶ 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Serializer/NTuples.pm000644 000765 000024 00000003337 14636707550 021221 0ustar00gregstaff000000 000000 =head1 NAME AtteanX::Serializer::NTuples - Shared functionality for N-Triples and N-Quads serializers =head1 VERSION This document describes AtteanX::Serializer::NTuples version 0.034 =head1 SYNOPSIS use Attean; my $serializer = Attean->get_serializer('NTriples')->new(); $serializer->serialize_iter_to_io( $io, $fh ); =head1 DESCRIPTION ... =head1 METHODS =over 4 =cut use v5.14; use warnings; package AtteanX::Serializer::NTuples 0.034 { use Moo; use Encode qw(encode); use Attean::ListIterator; use List::MoreUtils qw(any); use namespace::clean; =item C<< serialize_iter_to_io( $fh, $iterator ) >> Serializes the L objects from C<< $iterator >> to the L object C<< $fh >>. =cut sub serialize_iter_to_io { my $self = shift; my $io = shift; my $iter = shift; while (my $t = $iter->next()) { my $str = $t->tuples_string . "\n"; $io->print($str); } return; } =item C<< serialize_iter_to_bytes( $iterator ) >> Serializes the L objects from C<< $iterator >> and returns the serialization as a UTF-8 encoded byte string. =cut sub serialize_iter_to_bytes { my $self = shift; my $iter = shift; my $data = ''; while (my $t = $iter->next()) { my $str = $t->tuples_string; $data .= $str . "\n"; } return encode('UTF-8', $data); } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Serializer/PaxHeader/SPARQLXML.pm000644 000765 000024 00000000225 14636707550 023154 xustar00gregstaff000000 000000 30 mtime=1719373672.687927927 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Serializer/SPARQLXML.pm000644 000765 000024 00000010140 14636707550 021200 0ustar00gregstaff000000 000000 =head1 NAME AtteanX::Serializer::SPARQLXML - SPARQL Results XML Serializer =head1 VERSION This document describes AtteanX::Serializer::SPARQLXML version 0.034 =head1 SYNOPSIS use Attean; my $s = Attean->get_serializer('SPARQLXML')->new(); $s->serialize_iter_to_io( $fh, $iter ); =head1 DESCRIPTION ... =head1 ATTRIBUTES =over 4 =item C<< canonical_media_type >> =item C<< file_extensions >> =back =head1 METHODS =over 4 =cut use v5.14; use warnings; package AtteanX::Serializer::SPARQLXML 0.034 { use Moo; use Types::Standard qw(Str ArrayRef); use Encode qw(encode encode_utf8); use Scalar::Util qw(blessed); use Attean::ListIterator; use List::MoreUtils qw(any); use namespace::clean; has 'canonical_media_type' => (is => 'ro', isa => Str, init_arg => undef, default => 'application/sparql-results+xml'); =item C<< media_types >> Returns a list of media types that identify the format produced by this serializer. =cut sub media_types { return [qw(application/sparql-results+xml)]; } =item C<< file_extensions >> Returns a list of file extensions associated with the serialized format. =cut sub file_extensions { return [qw(srx xml)] }; =item C<< serialize_iter_to_io( $fh, $iterator ) >> Serializes the L objects from C<< $iterator >> to the L object C<< $fh >>. =cut sub serialize_iter_to_io { my $self = shift; my $fh = shift; my $iter = shift; print {$fh} <<"END"; END my @vars = @{ $iter->variables }; if ($iter->does('Attean::API::ResultIterator')) { foreach my $v (@vars) { print $fh qq(\t\n); } } print {$fh} <<"END"; END while (my $t = $iter->next()) { print $fh "\t\t\n"; foreach my $name (@vars) { my $term = $t->value($name); if (blessed($term)) { if ($term->does('Attean::API::IRI')) { my $label = $term->value; $label =~ s/&/&/g; $label =~ s/${label}\n); } elsif ($term->does('Attean::API::Literal')) { my $label = $term->value; $label =~ s/&/&/g; $label =~ s/language) { $label = qq(${label}); } elsif (my $dt = $term->datatype) { $label = qq(${label}); } else { $label = qq(${label}); } print $fh qq(\t\t\t${label}\n); } elsif ($term->does('Attean::API::Blank')) { my $label = $term->value; $label =~ s/&/&/g; $label =~ s/${label}\n); } else { die "Term object has an unrecognized type: " . ref($term); } } } print $fh "\t\t\n"; } print {$fh} "\n"; print {$fh} "\n"; return; } =item C<< serialize_iter_to_bytes( $iterator ) >> Serializes the L objects from C<< $iterator >> and returns the serialization as a UTF-8 encoded byte string. =cut sub serialize_iter_to_bytes { my $self = shift; my $iter = shift; my $data = encode('UTF-8', ''); open(my $fh, '>', \$data); $self->serialize_iter_to_io($fh, $iter); close($fh); return $data; } with 'Attean::API::ResultSerializer', 'Attean::API::AppendableSerializer'; } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Serializer/PaxHeader/SPARQLTSV.pm000644 000765 000024 00000000225 14636707550 023170 xustar00gregstaff000000 000000 30 mtime=1719373672.672280996 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Serializer/SPARQLTSV.pm000644 000765 000024 00000005340 14636707550 021222 0ustar00gregstaff000000 000000 =head1 NAME AtteanX::Serializer::SPARQLTSV - SPARQL Results TSV Serializer =head1 VERSION This document describes AtteanX::Serializer::SPARQLTSV version 0.034 =head1 SYNOPSIS use Attean; my $s = Attean->get_serializer('SPARQLTSV')->new(); $s->serialize_iter_to_io( $fh, $iter ); =head1 DESCRIPTION ... =head1 ATTRIBUTES =over 4 =item C<< canonical_media_type >> =item C<< file_extensions >> =back =head1 METHODS =over 4 =cut use v5.14; use warnings; package AtteanX::Serializer::SPARQLTSV 0.034 { use Moo; use Types::Standard qw(Str ArrayRef); use Encode qw(encode); use Scalar::Util qw(blessed); use Attean::ListIterator; use List::MoreUtils qw(any); use namespace::clean; has 'canonical_media_type' => (is => 'ro', isa => Str, init_arg => undef, default => 'text/tab-separated-values'); =item C<< media_types >> Returns a list of media types that identify the format produced by this serializer. =cut sub media_types { return [qw(text/tab-separated-values)]; } =item C<< file_extensions >> Returns a list of file extensions associated with the serialized format. =cut sub file_extensions { return [qw(tsv)] }; =item C<< serialize_iter_to_io( $fh, $iterator ) >> Serializes the L objects from C<< $iterator >> to the L object C<< $fh >>. =cut sub serialize_iter_to_io { my $self = shift; my $io = shift; my $iter = shift; my @vars = @{ $iter->variables }; $io->print(join("\t", map { "?$_" } @vars) . "\n"); while (my $t = $iter->next()) { my @strings = map { blessed($_) ? $_->ntriples_string : '' } map { $t->value($_) } @vars; $io->print(join("\t", @strings) . "\n"); } return; } =item C<< serialize_iter_to_bytes( $iterator ) >> Serializes the L objects from C<< $iterator >> and returns the serialization as a UTF-8 encoded byte string. =cut sub serialize_iter_to_bytes { my $self = shift; my $iter = shift; my $data = ''; my @vars = @{ $iter->variables }; $data .= join("\t", map { "?$_" } @vars) . "\n"; while (my $t = $iter->next()) { my @strings = map { blessed($_) ? $_->ntriples_string : '' } map { $t->value($_) } @vars; my $str = join("\t", @strings); $data .= $str . "\n"; } return encode('UTF-8', $data); } with 'Attean::API::ResultSerializer', 'Attean::API::AppendableSerializer'; } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Serializer/PaxHeader/Turtle.pm000644 000765 000024 00000000224 14636707550 023047 xustar00gregstaff000000 000000 29 mtime=1719373672.72053934 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Serializer/Turtle.pm000644 000765 000024 00000011335 14636707550 021103 0ustar00gregstaff000000 000000 =head1 NAME AtteanX::Serializer::Turtle - Turtle Serializer =head1 VERSION This document describes AtteanX::Serializer::Turtle version 0.034 =head1 SYNOPSIS use Attean; my $serializer = Attean->get_serializer('Turtle')->new(); $serializer->serialize_iter_to_io( $io, $fh ); =head1 DESCRIPTION ... =head1 ATTRIBUTES =over 4 =item C<< canonical_media_type >> =item C<< media_types >> =item C<< handled_type >> =item C<< file_extensions >> =back =head1 METHODS =over 4 =cut use v5.14; use warnings; package AtteanX::Serializer::Turtle 0.034 { use Moo; use Data::Dumper; use Encode qw(encode); use Attean::ListIterator; use List::MoreUtils qw(any); use AtteanX::Parser::Turtle::Constants; use AtteanX::Parser::Turtle::Token; use AtteanX::Serializer::TurtleTokens; use Types::Standard qw(InstanceOf HashRef ArrayRef Bool Str); use namespace::clean; with 'Attean::API::AbbreviatingSerializer'; with 'Attean::API::AppendableSerializer'; with 'Attean::API::TripleSerializer'; sub canonical_media_type { return "text/turtle" } sub media_types { return [qw(text/turtle)]; } sub handled_type { state $ITEM_TYPE = Type::Tiny::Role->new(role => 'Attean::API::Triple'); return $ITEM_TYPE; } =item C<< file_extensions >> Returns a list of file extensions associated with the serialized format. =cut sub file_extensions { return [qw(ttl)] } has 'serializer' => (is => 'rw', isa => InstanceOf['AtteanX::Serializer::TurtleTokens']); sub BUILD { my $self = shift; my $s = $self->serializer; unless ($s) { my @args; if (my $map = $self->namespaces) { push(@args, namespaces => $map); } $s = AtteanX::Serializer::TurtleTokens->new( @args ); $self->serializer($s); } } =item C<< serialize_iter_to_io( $fh, $iterator ) >> Serializes the Turtle token objects from C<< $iterator >> to the L object C<< $fh >>. =cut sub serialize_iter_to_io { my $self = shift; my $io = shift; my $iter = shift; my @buffer; # TODO: look for shared subject-predicate in repeated triples, and emit COMMA syntax # TODO: look for shared subject in repeated triples, and emit SEMICOLON syntax my $dot = AtteanX::Parser::Turtle::Token->dot; my $comma = AtteanX::Parser::Turtle::Token->comma; my $semi = AtteanX::Parser::Turtle::Token->semicolon; if (my $map = $self->namespaces) { my $prefix = AtteanX::Parser::Turtle::Token->prefix; foreach my $ns (sort $map->list_prefixes) { my $uri = Attean::IRI->new( value => $map->namespace_uri($ns)->as_string ); my $name = AtteanX::Parser::Turtle::Token->fast_constructor( PREFIXNAME, -1, -1, -1, -1, ["${ns}:"] ); my $iri = AtteanX::Parser::Turtle::Token->fast_constructor( IRI, -1, -1, -1, -1, [$uri->value] ); push(@buffer, $prefix); push(@buffer, $name); push(@buffer, $iri); push(@buffer, $dot); } } my $last_subj; my $last_pred; my $sub = sub { if (scalar(@buffer)) { return shift(@buffer); } if (my $t = $iter->next) { my ($subj, $pred, $obj) = $t->values; if (defined($last_subj) and $subj->equals($last_subj)) { if (defined($last_pred) and $pred->equals($last_pred)) { push(@buffer, $comma); push(@buffer, $obj->sparql_tokens->elements); } else { push(@buffer, $semi); push(@buffer, $pred->sparql_tokens->elements); push(@buffer, $obj->sparql_tokens->elements); } } else { if (defined($last_pred)) { push(@buffer, $dot); } foreach my $term ($subj, $pred, $obj) { push(@buffer, $term->sparql_tokens->elements); } } $last_subj = $subj; $last_pred = $pred; return shift(@buffer); } if (defined($last_subj)) { push(@buffer, $dot); $last_subj = undef; $last_pred = undef; return shift(@buffer); } return; }; my $titer = Attean::CodeIterator->new( generator => $sub, item_type => 'AtteanX::Parser::Turtle::Token' ); return $self->serializer->serialize_iter_to_io($io, $titer); } =item C<< serialize_iter_to_bytes( $iterator ) >> Serializes the Turtle token objects from C<< $iterator >> and returns the serialization as a UTF-8 encoded byte string. =cut sub serialize_iter_to_bytes { my $self = shift; my $iter = shift; my $data = encode('UTF-8', ''); open(my $fh, '>', \$data); $self->serialize_iter_to_io($fh, $iter); close($fh); return $data; } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Serializer/PaxHeader/NQuads.pm000644 000765 000024 00000000225 14636707550 022764 xustar00gregstaff000000 000000 30 mtime=1719373672.536084492 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Serializer/NQuads.pm000644 000765 000024 00000003503 14636707550 021015 0ustar00gregstaff000000 000000 =head1 NAME AtteanX::Serializer::NQuads - N-Triples Serializer =head1 VERSION This document describes AtteanX::Serializer::NQuads version 0.034 =head1 SYNOPSIS use Attean; my $serializer = Attean->get_serializer('NQuads')->new(); $serializer->serialize_iter_to_io( $iter, $fh ); =head1 DESCRIPTION Serializes triples and quads into the RDF 1.1 N-Quads format. =head1 ATTRIBUTES =over 4 =item C<< canonical_media_type >> =item C<< file_extensions >> =back =head1 METHODS =over 4 =item C<< serialize_iter_to_io( $fh, $iterator ) >> =item C<< serialize_iter_to_bytes( $fh ) >> =cut use v5.14; use warnings; package AtteanX::Serializer::NQuads 0.034 { use Moo; use Types::Standard qw(Str ArrayRef); use Encode qw(encode); use Attean::ListIterator; use List::MoreUtils qw(any); use namespace::clean; extends 'AtteanX::Serializer::NTuples'; has 'canonical_media_type' => (is => 'ro', isa => Str, init_arg => undef, default => 'application/n-quads'); =item C<< media_types >> Returns a list of media types that identify the format produced by this serializer. =cut sub media_types { return [qw(application/n-quads)]; } =item C<< file_extensions >> Returns a list of file extensions associated with the serialized format. =cut sub file_extensions { return [qw(nq)] }; with 'Attean::API::MixedStatementSerializer'; with 'Attean::API::AppendableSerializer'; } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO L =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Serializer/PaxHeader/RDFXML.pm000644 000765 000024 00000000225 14636707550 022565 xustar00gregstaff000000 000000 30 mtime=1719373672.587960512 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Serializer/RDFXML.pm000644 000765 000024 00000016235 14636707550 020624 0ustar00gregstaff000000 000000 =head1 NAME AtteanX::Serializer::RDFXML - RDF/XML Serializer =head1 VERSION This document describes AtteanX::Serializer::RDFXML version 0.034 =head1 SYNOPSIS use Attean; my $s = Attean->get_serializer('RDFXML')->new(); $s->serialize_iter_to_io( $fh, $iter ); =head1 DESCRIPTION ... =head1 ATTRIBUTES =over 4 =item C<< canonical_media_type >> =item C<< scoped_namespaces >> =item C<< file_extensions >> =item C<< file_extensions >> =back =head1 METHODS =over 4 =cut use v5.14; use warnings; package AtteanX::Serializer::RDFXML 0.034 { use Moo; use Types::Standard qw(Str ArrayRef HashRef); use Encode qw(encode); use Scalar::Util qw(blessed); use Attean::ListIterator; use List::MoreUtils qw(any); use namespace::clean; has 'canonical_media_type' => (is => 'ro', isa => Str, init_arg => undef, default => 'application/rdf+xml'); has '_rev' => (is => 'rw', isa => HashRef, init_arg => undef, default => sub { +{} }); has 'scoped_namespaces' => (is => 'rw', init_arg => undef); =item C<< file_extensions >> Returns a list of file extensions associated with the serialized format. =cut sub file_extensions { return [qw(rdf xml)] } =item C<< media_types >> Returns a list of media types that identify the format produced by this serializer. =cut sub media_types { return [qw(application/rdf+xml)]; } =item C<< serialize_iter_to_io( $fh, $iterator ) >> Serializes the L objects from C<< $iterator >> to the L object C<< $fh >> (which SHOULD be open with the UTF-8 encoding). =cut sub serialize_iter_to_io { my $self = shift; my $io = shift; my $iter = shift; my $ns = $self->_top_xmlns(); my $base_uri = ''; if ($self->{base_uri}) { $base_uri = "xml:base=\"$self->{base_uri}\" "; } print {$io} qq[\n\n]; my $st = $iter->next; my @statements; push(@statements, $st) if blessed($st); while (@statements) { my $st = shift(@statements); my @samesubj; push(@samesubj, $st); my $subj = $st->subject; while (my $row = $iter->next) { if ($row->subject->equals( $subj )) { push(@samesubj, $row); } else { push(@statements, $row); last; } } print {$io} $self->_statements_same_subject_as_string( @samesubj ); } print {$io} qq[\n]; return; } =item C<< serialize_iter_to_bytes( $iterator ) >> Serializes the L objects from C<< $iterator >> and returns the serialization as a UTF-8 encoded byte string. =cut sub serialize_iter_to_bytes { my $self = shift; my $iter = shift; my $data = ''; open(my $fh, '>:utf8', \$data); $self->serialize_iter_to_io($fh, $iter); close($fh); return $data; } sub _statements_same_subject_as_string { my $self = shift; my @statements = @_; my $s = $statements[0]->subject; my $id; if ($s->does('Attean::API::Blank')) { my $b = 'b' . $s->value; $id = qq[rdf:nodeID="$b"]; } else { my $i = $s->abs; for ($i) { s/&/&/g; s/_rev }; my $string = ''; foreach my $st (@statements) { my (undef, $p, $o) = $st->values; my %used_namespaces; my ($ns, $ln); eval { ($ns,$ln) = $self->_qname($p); }; if ($@) { my $uri = $p->abs; die "Can't turn predicate $uri into a QName."; } $used_namespaces{ $ns }++; unless (exists $namespaces{ $ns }) { $namespaces{ $ns } = 'ns' . $counter++; } my $prefix = $namespaces{ $ns }; my $nsdecl = ''; if ($self->scoped_namespaces) { $nsdecl = qq[ xmlns:$prefix="$ns"]; } if ($o->does('Attean::API::Literal')) { my $lv = $o->value; for ($lv) { s/&/&/g; s/language; my $dt = $o->datatype->value; my $tag = join(':', $prefix, $ln); if ($lang) { $string .= qq[\t<${tag}${nsdecl} xml:lang="${lang}">${lv}\n]; } elsif ($dt) { if ($dt eq 'http://www.w3.org/2001/XMLSchema#string') { $string .= qq[\t<${tag}${nsdecl}>${lv}\n]; } else { $string .= qq[\t<${tag}${nsdecl} rdf:datatype="${dt}">${lv}\n]; } } else { $string .= qq[\t<${tag}${nsdecl}>${lv}\n]; } } elsif ($o->does('Attean::API::Blank')) { my $b = 'b' . $o->value; for ($b) { s/&/&/g; s/\n]; } else { my $u = $o->abs; for ($u) { s/&/&/g; s/\n]; } } $string .= qq[\n]; # rdf namespace is already defined in the tag, so ignore it here my %seen = %{ $self->_rev }; my @ns; foreach my $uri (sort { $namespaces{$a} cmp $namespaces{$b} } grep { not($seen{$_}) } (keys %namespaces)) { my $ns = $namespaces{$uri}; my $str = ($ns eq '') ? qq[xmlns="$uri"] : qq[xmlns:${ns}="$uri"]; push(@ns, $str); } my $ns = join(' ', @ns); if ($ns) { return qq[\n] . $string; } else { return qq[\n] . $string; } } sub _qname { my $self = shift; my $p = shift; my $uri = $p->abs; state $r_PN_CHARS_BASE = qr/([A-Z]|[a-z]|[\x{00C0}-\x{00D6}]|[\x{00D8}-\x{00F6}]|[\x{00F8}-\x{02FF}]|[\x{0370}-\x{037D}]|[\x{037F}-\x{1FFF}]|[\x{200C}-\x{200D}]|[\x{2070}-\x{218F}]|[\x{2C00}-\x{2FEF}]|[\x{3001}-\x{D7FF}]|[\x{F900}-\x{FDCF}]|[\x{FDF0}-\x{FFFD}]|[\x{10000}-\x{EFFFF}])/o; state $r_PN_CHARS_U = qr/(_|${r_PN_CHARS_BASE})/o; state $r_PN_CHARS = qr/${r_PN_CHARS_U}|-|[0-9]|\x{00B7}|[\x{0300}-\x{036F}]|[\x{203F}-\x{2040}]/o; state $r_PN_LOCAL = qr/((${r_PN_CHARS_U})((${r_PN_CHARS}|[.])*${r_PN_CHARS})?)/o; if ($uri =~ m/${r_PN_LOCAL}$/o) { my $ln = $1; my $ns = substr($uri, 0, length($uri)-length($ln)); return ($ns, $ln); } else { die "Can't turn IRI $uri into a QName."; } } sub _top_xmlns { my $self = shift; my $namespaces = $self->namespaces; return '' if ($self->scoped_namespaces); my @ns; my @prefixes = $namespaces ? $namespaces->list_prefixes : (); foreach my $k (sort { $a cmp $b } @prefixes) { my $v = $namespaces->namespace_uri($k)->as_string; $self->_rev->{$v} = $k; next if ($v eq 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'); my $str = ($k eq '') ? qq[xmlns="$v"] : qq[xmlns:$k="$v"]; push(@ns, $str); } my $ns = join(' ', @ns); if (length($ns)) { $ns = " $ns"; } return $ns; } with 'Attean::API::TripleSerializer'; with 'Attean::API::AbbreviatingSerializer'; } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 SEE ALSO L =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Serializer/PaxHeader/SPARQLHTML.pm000644 000765 000024 00000000225 14636707550 023260 xustar00gregstaff000000 000000 30 mtime=1719373672.639747495 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Serializer/SPARQLHTML.pm000644 000765 000024 00000010176 14636707550 021315 0ustar00gregstaff000000 000000 =head1 NAME AtteanX::Serializer::SPARQLHTML - SPARQL Results HTML Serializer =head1 VERSION This document describes AtteanX::Serializer::SPARQLHTML version 0.034 =head1 SYNOPSIS use Attean; my $s = Attean->get_serializer('SPARQLHTML')->new(); $s->serialize_iter_to_io( $fh, $iter ); =head1 DESCRIPTION ... =head1 ATTRIBUTES =over 4 =item C<< canonical_media_type >> =item C<< file_extensions >> =back =head1 METHODS =over 4 =cut use v5.14; use warnings; package AtteanX::Serializer::SPARQLHTML 0.034 { use Moo; use Types::Standard qw(Str Bool ArrayRef); use Encode qw(encode); use Scalar::Util qw(blessed); use Attean::ListIterator; use List::MoreUtils qw(any); use namespace::clean; has 'full_document' => (is => 'rw', isa => Bool, default => 1); has 'canonical_media_type' => (is => 'ro', isa => Str, init_arg => undef, default => 'text/html'); =item C<< media_types >> Returns a list of media types that identify the format produced by this serializer. =cut sub media_types { return [qw(text/html)]; } =item C<< file_extensions >> Returns a list of file extensions associated with the serialized format. =cut sub file_extensions { return [qw(html)] }; =item C<< serialize_iter_to_io( $fh, $iterator ) >> Serializes the L objects from C<< $iterator >> to the L object C<< $fh >>. =cut sub serialize_iter_to_io { my $self = shift; my $io = shift; my $iter = shift; if ($self->full_document) { $io->print(<<"END"); SPARQL Results

Results

END } my @names; my $count = 0; my $first = 1; while (my $t = $iter->next()) { $count++; if ($first) { $io->print("\n\n"); @names = $t->variables; foreach my $name (@names) { $io->print("\t\n"); } $io->print("\n"); $first = 0; } $io->print("\n"); foreach my $k (@names) { my $term = $t->value($k); my $value = $self->node_as_html($term) // ''; $io->print("\t\n"); } $io->print("\n"); } unless ($first) { my $columns = scalar(@names); $io->print("\n
" . $name . "
$value
Total: $count
\n"); } if ($self->full_document) { $io->print("
\n\n"); } return; } =item C<< serialize_iter_to_bytes( $iterator ) >> Serializes the L objects from C<< $iterator >> and returns the serialization as a UTF-8 encoded byte string. =cut sub serialize_iter_to_bytes { my $self = shift; my $iter = shift; my $data = ''; open(my $fh, '>:utf8', \$data); $self->serialize_iter_to_io($fh, $iter); close($fh); return $data; } =item C<< node_as_html($node) >> Serializes the L object as HTML. =cut sub node_as_html { my $self = shift; my $node = shift; return '' unless (blessed($node)); if ($node->does('Attean::API::IRI')) { my $uri = $node->value; for ($uri) { s/&/&/g; s/$uri]; if (my $map = $self->namespaces) { my $abr = $map->abbreviate($uri); if ($abr) { return qq[$abr]; } else { return $html; } } else { return $html; } # if ($link) { # $html = qq[$html]; # } } elsif ($node->does('Attean::API::Literal')) { my $html = $node->value; for ($html) { s/&/&/g; s/value; for ($html) { s/&/&/g; s/. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/AtteanX/Serializer/PaxHeader/TurtleTokens.pm000644 000765 000024 00000000224 14636707550 024233 xustar00gregstaff000000 000000 29 mtime=1719373672.73825399 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/AtteanX/Serializer/TurtleTokens.pm000644 000765 000024 00000014446 14636707550 022275 0ustar00gregstaff000000 000000 =head1 NAME AtteanX::Serializer::TurtleTokens - Turtle Serializer =head1 VERSION This document describes AtteanX::Serializer::TurtleTokens version 0.034 =head1 SYNOPSIS use Attean; my $serializer = Attean->get_serializer('Turtle')->new(); $serializer->serialize_iter_to_io( $io, $fh ); =head1 DESCRIPTION ... =head1 ATTRIBUTES =over 4 =item C<< canonical_media_type >> =item C<< media_types >> =item C<< handled_type >> =item C<< file_extensions >> =back =head1 METHODS =over 4 =cut use v5.14; use warnings; package AtteanX::Serializer::TurtleTokens 0.034 { use Moo; use Data::Dumper; use Types::Standard qw(Bool ArrayRef HashRef ConsumerOf); use Encode qw(encode); use Attean::ListIterator; use List::MoreUtils qw(any); use AtteanX::Parser::Turtle::Constants; use AtteanX::Parser::Turtle::Lexer; use namespace::clean; with 'Attean::API::AbbreviatingSerializer'; with 'Attean::API::AppendableSerializer'; has suppress_whitespace => (is => 'rw', isa => Bool, default => 0); sub canonical_media_type { return "text/turtle" } sub media_types { return [qw(text/turtle)]; } sub handled_type { state $ITEM_TYPE = Type::Tiny::Role->new(role => 'AtteanX::Parser::Turtle::Token'); return $ITEM_TYPE; } sub file_extensions { return [qw(ttl)] } =item C<< serialize_iter_to_io( $fh, $iterator ) >> Serializes the Turtle token objects from C<< $iterator >> to the L object C<< $fh >>. =cut sub serialize_iter_to_io { my $self = shift; my $io = shift; my $iter = shift; my $indent = 0; my $newline = 1; my $semicolon = 0; my $need_space = 0; my $map = $self->namespaces; my %namespace_map; if ($map) { foreach my $p ($map->list_prefixes) { my $prefix = $map->namespace_uri($p)->as_string; $namespace_map{$prefix} = $p; } } while (my $t = $iter->next()) { my $type = $t->type; if ($map) { if ($type == IRI) { my $value = $t->value; if ($value =~ /^(?.*?)(?$AtteanX::Parser::Turtle::Lexer::r_PN_LOCAL)$/) { if (my $ns = $namespace_map{$+{namespace}}) { $type = PREFIXNAME; $t = AtteanX::SPARQL::Token->fast_constructor( $type, $t->start_line, $t->start_column, $t->line, $t->column, ["${ns}:", $+{local}] ); } } } } if ($type == LANG or $type == HATHAT) { $need_space= 0; } unless ($newline) { if ($type == BASE or $type == PREFIX or $type == TURTLEBASE or $type == TURTLEPREFIX) { $io->print("\n"); $newline = 1; } } unless ($self->suppress_whitespace) { if ($newline) { $io->print(' ' x $indent); $newline = 0; } elsif ($need_space) { $io->print(' '); $need_space = 0; } } if ($type == PREFIX or $type == TURTLEPREFIX) { # If we're serializing a PREFIX, also serialize the PREFIXNAME # and IRI that must follow it so that we don't accidentally # shorten the prefix IRI with its own namespace. For example, # if we didn't serialize the PREFIXNAME and IRI here, we might # end up with this: # # @prefix foaf: foaf: # # instead of: # # @prefix foaf: $io->print($t->value); $io->print(' '); my $pname = $iter->next(); unless ($pname->type == PREFIXNAME) { die "PREFIX namespace not found during Turtle serialization"; } my $args = $pname->args; $io->print(join('', @$args)); $io->print(' '); my $iri = $iter->next(); unless ($iri->type == IRI) { die "PREFIX IRI not found during Turtle serialization"; } $io->print('<'); $io->print($iri->value); $io->print('>'); $need_space++; } elsif ($type == PREFIXNAME) { my $args = $t->args; $io->print(join('', @$args)); $need_space++; } elsif ($type == BNODE) { $io->print('_:'); $io->print($t->value); $need_space++; } elsif ($type == IRI) { # TODO: escape $io->print('<'); $io->print($t->value); $io->print('>'); $need_space++; } elsif ($type == LANG) { $io->print('@'); $io->print($t->value); $need_space++; } elsif ($type == STRING1S) { my $value = $t->value; $value =~ s/'/\\'/g; $io->print("'"); $io->print($value); $io->print("'"); $need_space++; } elsif ($type == STRING1D) { my $value = $t->value; $value =~ s/"/\\"/g; $io->print('"'); $io->print($value); $io->print('"'); $need_space++; } elsif ($type == STRING3S) { my $value = $t->value; $value =~ s/'''/''\\'/g; $io->print("'''"); $io->print($value); $io->print("'''"); $need_space++; } elsif ($type == STRING3D) { my $value = $t->value; $value =~ s/"""/""\\"/g; $io->print('"""'); $io->print($value); $io->print('"""'); $need_space++; } elsif ($type == A) { $io->print('a'); $need_space++; } elsif ($type == WS) { } elsif ($type == COMMENT) { if ($t->value =~ /\n/) { die "Unexpected newline found in Turtle comment token"; } $io->print('# '); $io->print($t->value); $io->print("\n"); } elsif ($type == HATHAT) { $io->print($t->value); } else { $io->print($t->value); $need_space++; } if ($type == DOT) { if ($semicolon) { $indent--; $semicolon = 0; } $need_space = 0; $io->print("\n"); $newline = 1; } elsif ($type == SEMICOLON) { $io->print("\n"); $need_space = 0; $newline = 1; unless ($semicolon) { $indent++; } $semicolon = 1; } } unless ($newline) { $io->print("\n"); } return; } =item C<< serialize_iter_to_bytes( $iterator ) >> Serializes the Turtle token objects from C<< $iterator >> and returns the serialization as a UTF-8 encoded byte string. =cut sub serialize_iter_to_bytes { my $self = shift; my $iter = shift; my $data = ''; open(my $fh, '>:utf8', \$data); $self->serialize_iter_to_io($fh, $iter); close($fh); return $data; } } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2014--2022 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Attean-0.034/lib/Test/Attean/000755 000765 000024 00000000000 14636711137 015735 5ustar00gregstaff000000 000000 Attean-0.034/lib/Test/Attean/ETagCacheableQuadStore.pm000644 000765 000024 00000000744 12703546676 022527 0ustar00gregstaff000000 000000 package Test::Attean::ETagCacheableQuadStore; use v5.14; use warnings; use Test::Roo::Role; use Test::Moose; use Attean; use Attean::RDF; requires 'create_store'; # create_store( quads => \@quads ) with 'Test::Attean::StoreCleanup'; test 'etagcacheablequadstore' => sub { my $self = shift; my $time = time(); my $store = $self->create_store(quads => []); my $etag = $store->etag_value_for_quads(); ok(length($etag)); $self->cleanup_store($store); }; 1; Attean-0.034/lib/Test/Attean/TripleStore.pm000644 000765 000024 00000005236 12705322133 020542 0ustar00gregstaff000000 000000 package Test::Attean::TripleStore; use v5.14; use warnings; use Test::Roo::Role; use Test::Moose; use Attean; use Attean::RDF; requires 'create_store'; # create_store( triples => \@triples ) sub cleanup_store {} # cleanup_store( $store ) test 'get_triples' => sub { my $self = shift; my $t1 = triple(iri('http://example.org/s'), iri('http://example.org/p'), iri('http://example.org/o')); my $t2 = triple(iri('http://example.org/x'), iri('http://example.org/y'), iri('http://example.org/z')); my @triples = ($t1, $t2); my $store = $self->create_store(triples => \@triples); ok $store->does('Attean::API::Store'); ok $store->does('Attean::API::TripleStore'); $self->cleanup_store($store); }; test 'count_triples' => sub { my $self = shift; my @triples; foreach (1 .. 20) { push(@triples, triple(iri('http://example.org/s'), iri('http://example.org/p'), literal($_))); } foreach (1,10,20,50) { push(@triples, triple(iri('http://example.org/z'), iri('http://example.org/p'), literal($_))); } foreach (1 .. 20) { push(@triples, triple(iri('http://example.org/s'), iri('http://example.org/q'), blank("b$_"))); } my $store = $self->create_store(triples => \@triples); is($store->count_triples(iri('http://example.org/UNEXPECTED')), 0, 'unexpected IRI'); is($store->count_triples(iri('http://example.org/s')), 40, 'expected subject'); is($store->count_triples(undef, iri('http://example.org/q')), 20, 'expected predicate'); is($store->count_triples(undef, undef, literal('7')), 1, 'expected object'); is($store->count_triples(undef, undef, literal('10')), 2, 'expected object (2)'); is($store->count_triples(iri('http://example.org/z'), undef, literal('10')), 1, 'expected subject/object'); is($store->count_triples(variable('s'), iri('http://example.org/q')), 20, 'expected predicate with variable'); is($store->count_triples(variable('s'), variable('p'), literal('7')), 1, 'expected object with variable'); is($store->count_triples(variable('s'), variable('p'), literal('10')), 2, 'expected object (2) with variable'); is($store->count_triples(iri('http://example.org/z'), variable('o'), literal('10')), 1, 'expected subject/object with variable'); cmp_ok($store->count_triples_estimate(iri('http://example.org/z')), '>=', 0, 'count_triples_estimate'); $self->cleanup_store($store); }; # test 'count_triples_estimate' => sub {}; test 'size' => sub { my $self = shift; foreach my $size (1, 10, 25, 57) { my @triples; foreach (1 .. $size) { push(@triples, triple(iri('http://example.org/s'), iri('http://example.org/p'), literal($_))); } my $store = $self->create_store(triples => \@triples); is($store->size(), $size); $self->cleanup_store($store); } }; 1; Attean-0.034/lib/Test/Attean/SPARQLStarSuite.pm000644 000765 000024 00000010506 14626405101 021131 0ustar00gregstaff000000 000000 package Test::Attean::SPARQLStarSuite; use v5.14; use warnings; use Test::Roo::Role; use Attean; use Attean::RDF; use AtteanX::Parser::SPARQL; use Attean::SimpleQueryEvaluator; use Test::Attean::W3CManifestTestSuite; use Carp; use HTTP::Request; use HTTP::Response; use HTTP::Message::PSGI; use Data::Dumper; use Encode qw(encode encode_utf8); use Getopt::Long; use Regexp::Common qw /URI/; use Scalar::Util qw(blessed reftype); use List::MoreUtils qw(all); use Test::Modern; use Text::CSV; use Try::Tiny; use URI::file; use File::Spec; use Types::Standard qw(Str Bool ArrayRef HashRef InstanceOf ConsumerOf); require XML::Simple; my $XSD = 'http://www.w3.org/2001/XMLSchema#'; my $RDF = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'; my $RDFS = 'http://www.w3.org/2000/01/rdf-schema#'; my $RS = 'http://www.w3.org/2001/sw/DataAccess/tests/result-set#'; my $MF = 'http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#'; my $UT = 'http://www.w3.org/2009/sparql/tests/test-update#'; my $RQ = 'http://www.w3.org/2001/sw/DataAccess/tests/test-query#'; my $DAWGT = 'http://www.w3.org/2001/sw/DataAccess/tests/test-dawg#'; with 'Test::Attean::W3CManifestTestSuite'; sub manifest_paths { my $self = shift; my $dir = $self->tests_dir; unless (defined($dir)) { plan skip_all => "No manifest directory given"; exit(0); } unless (-d $dir and -r $dir) { plan skip_all => "Manifest directory not readable: $dir"; exit(0); } my $manifest = File::Spec->catfile($dir, 'manifest.ttl'); my $manifestall = File::Spec->catfile($dir, 'manifest-all.ttl'); return grep { -r $_ } ($manifest, $manifestall); } ############################################################################### Test::Roo::top_test 'SPARQL 1.1 tests' => sub { my $self = shift; my $PATTERN = $self->pattern; my @manifests = @{ $self->manifests }; my $model = $self->model; foreach my $m (@manifests) { # warn "Manifest: " . $m->as_string . "\n" if ($self->debug); my ($list) = $model->objects( $m, iri("${MF}entries") )->elements; unless (blessed($list)) { warn "No mf:entries found for manifest " . $m->as_string . "\n" if ($self->debug); } my @tests = $model->get_list( $self->default_graph, $list )->elements; foreach my $test (@tests) { unless ($test->value =~ /$PATTERN/) { next; } # if ($LIST_TESTS) { # say $test->value; # } if ($self->run_query_tests) { { # Evaluation Tests my $et = $model->count_quads($test, iri("${RDF}type"), iri("${MF}QueryEvaluationTest")); my $ct = $model->count_quads($test, iri("${RDF}type"), iri("${MF}CSVResultFormatTest")); if ($et + $ct) { my ($name) = $model->objects( $test, iri("${MF}name") )->elements; warn "### query eval test: " . $test->as_string . " >>> " . $name->value . "\n" if ($self->debug); $self->query_eval_test( $model, $test ); } } { # Syntax Tests my $total = 0; foreach my $type (qw(PositiveSyntaxTest11 NegativeSyntaxTest11)) { $total += $model->count_quads($test, iri("${RDF}type"), iri("${MF}$type")); } if ($total) { my ($name) = $model->objects( $test, iri("${MF}name") )->elements; warn "### query syntax test: " . $test->as_string . " >>> " . $name->value . "\n" if ($self->debug); $self->syntax_test( 'query', $model, $test ); } } } if ($self->run_update_tests) { { # Evaluation Tests if ($model->count_quads($test, iri("${RDF}type"), iri("${UT}UpdateEvaluationTest")) or $model->count_quads($test, iri("${RDF}type"), iri("${MF}UpdateEvaluationTest"))) { my ($name) = $model->objects( $test, iri("${MF}name") )->elements; unless ($test->value =~ /$PATTERN/) { next; } warn "### update eval test: " . $test->as_string . " >>> " . $name->value . "\n" if ($self->debug); $self->update_eval_test( $model, $test, ); } } { # Syntax Tests my $total = 0; foreach my $type (qw(PositiveUpdateSyntaxTest11 NegativeUpdateSyntaxTest11)) { $total += $model->count_quads($test, iri("${RDF}type"), iri("${MF}$type")); } if ($total) { my ($name) = $model->objects( $test, iri("${MF}name") )->elements; warn "### query syntax test: " . $test->as_string . " >>> " . $name->value . "\n" if ($self->debug); $self->syntax_test( 'update', $model, $test ); } } } } } }; 1; Attean-0.034/lib/Test/Attean/StoreCleanup.pm000644 000765 000024 00000000267 12703546265 020705 0ustar00gregstaff000000 000000 package Test::Attean::StoreCleanup; use v5.14; use warnings; use Test::Roo::Role; use Test::Moose; use Attean; use Attean::RDF; sub cleanup_store {} # cleanup_store( $store ) 1; Attean-0.034/lib/Test/Attean/TimeCacheableQuadStore.pm000644 000765 000024 00000001143 12525176060 022563 0ustar00gregstaff000000 000000 package Test::Attean::TimeCacheableQuadStore; use v5.14; use warnings; use Test::Roo::Role; use Test::Moose; use Attean; use Attean::RDF; requires 'create_store'; # create_store( quads => \@quads ) sub acceptable_mtime_delta { return 60 * 60 * 24; } test 'timecacheablequadstore' => sub { my $self = shift; my $time = time(); my $store = $self->create_store(quads => []); my $mtime = $store->mtime_for_quads(); my $diff = abs($mtime - $time); my $delta = $self->acceptable_mtime_delta; cmp_ok($diff, '<', $delta, "mtime within delta ($diff seconds from expected)"); }; 1; Attean-0.034/lib/Test/Attean/MutableQuadStore.pm000644 000765 000024 00000007417 12703546523 021523 0ustar00gregstaff000000 000000 package Test::Attean::MutableQuadStore; use v5.14; use warnings; use Test::Roo::Role; use Test::Moose; use Attean; use Attean::RDF; requires 'create_store'; # create_store( quads => \@quads ) with 'Test::Attean::StoreCleanup'; test 'mutablequadstore add_quad' => sub { my $self = shift; my $q1 = quad(iri('s'), iri('p'), iri('o'), iri('g')); my $q2 = quad(iri('x'), iri('y'), iri('z'), iri('g')); my $q3 = quad(iri('x'), iri('y'), iri('z'), iri('g2')); my $store = $self->create_store(quads => []); my $size = 0; for my $q ($q1, $q2, $q3) { $store->add_quad($q); is($store->size, ++$size, "size $size"); } $self->cleanup_store($store); }; test 'mutablequadstore remove_quad' => sub { my $self = shift; my $q1 = quad(iri('s'), iri('p'), iri('o'), iri('g')); my $q2 = quad(iri('x'), iri('y'), iri('z'), iri('g')); my $q3 = quad(iri('x'), iri('y'), iri('z'), iri('g2')); my $store = $self->create_store(quads => [$q3, $q2, $q1]); my $size = 3; for my $q ($q1, $q2, $q3) { is($store->size, $size, "size $size"); $store->remove_quad($q); $size--; } $store->remove_quad($q2); is($store->size, 0, "size $size"); $self->cleanup_store($store); }; test 'mutablequadstore create_graph' => sub { my $self = shift; my $store = $self->create_store(quads => []); my $count = 0; foreach my $g (iri('g1'), iri('g2'), iri('g3')) { $store->create_graph($g); my @graphs = sort map { $_->value } $store->get_graphs->elements; my $graphs = scalar(@graphs); ok($graphs == 0 or $graphs == ++$count); } $store->create_graph(iri('g2')); my @graphs = sort map { $_->value } $store->get_graphs->elements; my $graphs = scalar(@graphs); ok($graphs == 0 or $graphs == $count); $self->cleanup_store($store); }; test 'mutablequadstore drop_graph' => sub { # drop_graph removes all the quads in a specific graph and removes the # graph from the list of graphs returned as an iterator from # $store->get_graphs my $self = shift; my $q1 = quad(iri('s'), iri('p'), iri('o'), iri('g')); my $q2 = quad(iri('x'), iri('y'), iri('z'), iri('g')); my $q3 = quad(iri('x'), iri('y'), iri('z'), iri('g2')); { my $store = $self->create_store(quads => [$q1, $q2, $q3]); $store->drop_graph(iri('g')); is($store->size, 1); my @graphs = sort map { $_->value } $store->get_graphs->elements; is_deeply(\@graphs, ['g2']); $self->cleanup_store($store); } { my $store = $self->create_store(quads => [$q1, $q2, $q3]); $store->drop_graph(iri('g2')); is($store->size, 2); my @graphs = sort map { $_->value } $store->get_graphs->elements; is_deeply(\@graphs, ['g']); $self->cleanup_store($store); } }; test 'mutablequadstore clear_graph' => sub { # clear_graph removes all the quads in a specific graph # depending on whether the implementation supports empty graphs, # the cleared graph may or may not disappear from the list of graphs # returned as an iterator from $store->get_graphs my $self = shift; my $q1 = quad(iri('s'), iri('p'), iri('o'), iri('g')); my $q2 = quad(iri('x'), iri('y'), iri('z'), iri('g')); my $q3 = quad(iri('x'), iri('y'), iri('z'), iri('g2')); { my $store = $self->create_store(quads => [$q1, $q2, $q3]); $store->clear_graph(iri('g')); is($store->size, 1); my @graphs = sort map { $_->value } $store->get_graphs->elements; my $graphs = scalar(@graphs); ok($graphs == 1 or $graphs == 2); $self->cleanup_store($store); } { my $store = $self->create_store(quads => [$q1, $q2, $q3]); $store->clear_graph(iri('g2')); is($store->size, 2); my @graphs = sort map { $_->value } $store->get_graphs->elements; my $graphs = scalar(@graphs); ok($graphs == 1 or $graphs == 2); $self->cleanup_store($store); } }; 1; Attean-0.034/lib/Test/Attean/MutableETagCacheableQuadStore.pm000644 000765 000024 00000001343 12706047473 024027 0ustar00gregstaff000000 000000 package Test::Attean::MutableETagCacheableQuadStore; use v5.14; use warnings; use Test::Roo::Role; use Test::Moose; use Attean; use Attean::RDF; requires 'create_store'; # create_store( quads => \@quads ) with 'Test::Attean::ETagCacheableQuadStore'; test 'mutable etagcacheablequadstore' => sub { my $self = shift; my $q1 = quad(iri('s'), iri('p'), iri('o'), iri('g')); my $q2 = quad(iri('x'), iri('y'), iri('z'), iri('g')); my $store = $self->create_store(quads => [$q1, $q2]); my $start = $store->etag_value_for_quads(); $store->remove_quad($q1); my $end = $store->etag_value_for_quads(); isnt($start, $end, "etag changed after update ($start => $end)"); $self->cleanup_store($store); }; 1; Attean-0.034/lib/Test/Attean/QuadStore.pm000644 000765 000024 00000006361 12705322076 020203 0ustar00gregstaff000000 000000 package Test::Attean::QuadStore; use v5.14; use warnings; use Test::Roo::Role; use Test::Moose; use Attean; use Attean::RDF; requires 'create_store'; # create_store( quads => \@quads ) with 'Test::Attean::StoreCleanup'; test 'quadstore roles' => sub { my $self = shift; my $store = $self->create_store(quads => []); ok $store->does('Attean::API::Store'); ok $store->does('Attean::API::QuadStore'); my $qiter = $store->get_quads(); ok $qiter->does('Attean::API::Iterator'); is($qiter->item_type, 'Attean::API::Quad'); my $giter = $store->get_graphs; ok $giter->does('Attean::API::Iterator'); is($giter->item_type, 'Attean::API::Term'); $self->cleanup_store($store); }; test 'quadstore get_quads empty' => sub { my $self = shift; my $store = $self->create_store(quads => []); { my $iter = $store->get_quads(); my @elements = $iter->elements; is(scalar(@elements), 0); } { my $iter = $store->get_quads(iri('s'), iri('p')); my @elements = $iter->elements; is(scalar(@elements), 0); } $self->cleanup_store($store); }; test 'quadstore get_quads with quads' => sub { my $self = shift; my $q1 = quad(iri('s'), iri('p'), iri('o'), iri('g')); my $q2 = quad(iri('x'), iri('y'), iri('z'), iri('g')); my $store = $self->create_store(quads => [$q1, $q2]); { my $iter = $store->get_quads(); my @elements = $iter->elements; is(scalar(@elements), 2, '2 quads'); } { my $iter = $store->get_quads(iri('s')); my @elements = $iter->elements; is(scalar(@elements), 1, '1 quad with as subject'); } { my $iter = $store->get_quads(variable('s'), undef, undef, iri('g')); my @elements = $iter->elements; is(scalar(@elements), 2, '2 quads with as graph'); } { my $iter = $store->get_quads(iri('abc')); my @elements = $iter->elements; is(scalar(@elements), 0, '0 quads with as subject'); } $self->cleanup_store($store); }; test 'count_quads' => sub { my $self = shift; my $q1 = quad(iri('s'), iri('p'), iri('o'), iri('g')); my $q2 = quad(iri('x'), iri('y'), iri('z'), iri('g')); my $store = $self->create_store(quads => [$q1, $q2]); is($store->count_quads(), 2, '2 quads'); is($store->count_quads(iri('s')), 1, '1 quad with as subject'); is($store->count_quads(variable('s'), undef, undef, iri('g')), 2, '2 quads with as graph'); is($store->count_quads(iri('abc')), 0, '0 quads with as subject'); cmp_ok($store->count_quads_estimate(iri('abc')), '>=', 0, 'count_quads_estimate'); $self->cleanup_store($store); }; # test 'count_quads_estimate' => sub {}; test 'size' => sub { my $self = shift; my $q1 = quad(iri('s'), iri('p'), iri('o'), iri('g')); my $q2 = quad(iri('x'), iri('y'), iri('z'), iri('g')); my $q3 = quad(iri('x'), iri('y'), iri('z'), iri('g2')); my $store = $self->create_store(quads => [$q1, $q2, $q3]); is($store->size(), 3); $self->cleanup_store($store); }; test 'get_graphs' => sub { my $self = shift; my $q1 = quad(iri('s'), iri('p'), iri('o'), iri('g')); my $q2 = quad(iri('x'), iri('y'), iri('z'), iri('g')); my $q3 = quad(iri('x'), iri('y'), iri('z'), iri('g2')); my $store = $self->create_store(quads => [$q1, $q2, $q3]); my $iter = $store->get_graphs; my @graphs = sort map { $_->value } $iter->elements; is_deeply(\@graphs, ['g', 'g2']); $self->cleanup_store($store); }; 1; Attean-0.034/lib/Test/Attean/MutableTripleStore.pm000644 000765 000024 00000002337 12703546731 022065 0ustar00gregstaff000000 000000 package Test::Attean::MutableTripleStore; use v5.14; use warnings; use Test::Roo::Role; use Test::Moose; use Attean; use Attean::RDF; requires 'create_store'; # create_store( triples => \@triples ) with 'Test::Attean::StoreCleanup'; test 'mutabletriplestore add_triple' => sub { my $self = shift; my $t1 = triple(iri('s'), iri('p'), iri('o')); my $t2 = triple(iri('x'), iri('y'), iri('z')); my $t3 = triple(iri('x'), iri('y'), literal('123')); my $store = $self->create_store(triples => []); my $size = 0; for my $t ($t1, $t2, $t3) { $store->add_triple($t); is($store->size, ++$size, "size $size"); } $self->cleanup_store($store); }; test 'mutabletriplestore remove_triple' => sub { my $self = shift; my $t1 = triple(iri('s'), iri('p'), iri('o')); my $t2 = triple(iri('x'), iri('y'), iri('z')); my $t3 = triple(iri('x'), iri('y'), literal('123')); my $store = $self->create_store(triples => [$t3, $t2, $t1]); my $size = 3; for my $t ($t1, $t2, $t3) { is($store->size, $size, "size $size"); $store->remove_triple($t); $size--; } $store->remove_triple($t2); is($store->size, 0, "size $size"); $self->cleanup_store($store); }; 1; Attean-0.034/lib/Test/Attean/W3CManifestTestSuite.pm000644 000765 000024 00000056637 14636707202 022247 0ustar00gregstaff000000 000000 package Test::Attean::W3CManifestTestSuite; use v5.14; use warnings; use Test::Roo::Role; use Attean; use Attean::RDF; use AtteanX::Parser::SPARQL; use Attean::SimpleQueryEvaluator; use Carp; use HTTP::Request; use HTTP::Response; use HTTP::Message::PSGI; use Data::Dumper; use Encode qw(encode encode_utf8); use Getopt::Long; use Regexp::Common qw /URI/; use Scalar::Util qw(blessed reftype); use List::MoreUtils qw(all); use Test::Modern; use Text::CSV; use Try::Tiny; use URI::file; use File::Spec; use Types::Standard qw(Str Bool ArrayRef HashRef InstanceOf ConsumerOf); require XML::Simple; my $XSD = 'http://www.w3.org/2001/XMLSchema#'; my $RDF = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'; my $RDFS = 'http://www.w3.org/2000/01/rdf-schema#'; my $RS = 'http://www.w3.org/2001/sw/DataAccess/tests/result-set#'; my $MF = 'http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#'; my $UT = 'http://www.w3.org/2009/sparql/tests/test-update#'; my $RQ = 'http://www.w3.org/2001/sw/DataAccess/tests/test-query#'; my $DAWGT = 'http://www.w3.org/2001/sw/DataAccess/tests/test-dawg#'; requires 'test_model'; requires 'manifest_paths'; has run_update_tests => (is => 'rw', isa => Bool, default => 1); has run_query_tests => (is => 'rw', isa => Bool, default => 1); has debug => (is => 'rw', isa => Bool, default => 0); has results => (is => 'rw', isa => Bool, default => 0); has strict_approval => (is => 'rw', isa => Bool, default => 0); has use_idp_planner => (is => 'rw', isa => Bool, default => 1); has pattern => (is => 'rw', isa => Str, default => ''); has tests_dir => (is => 'rw', required => 1, default => sub { $ENV{ATTEAN_SPARQL_TESTS_DIR} }); has model => (is => 'rw', isa => ConsumerOf['Attean::API::Model'], init_arg => undef); has manifests => (is => 'rw', isa => ArrayRef, init_arg => undef); has default_graph => (is => 'rw'); has failures => (is => 'rw', isa => HashRef, default => sub { +{} }); sub BUILD { my $self = shift; if ($self->pattern) { $self->results(1); } } sub memory_model { my $self = shift; my $store = Attean->get_store('Memory')->new(); my $model = Attean::MutableQuadModel->new( store => $store ); return $model; } sub setup { my $self = shift; $self->default_graph(iri('http://graph/')); warn 'setting up sparql test harness' if ($self->debug); my @manifests_iris = $self->manifest_paths(); unless (scalar(@manifests_iris)) { my $dir = $self->tests_dir; plan skip_all => "No manifest files found in $dir"; exit(0); } my $model = $self->memory_model(); my $class = Attean->get_parser("turtle") || die "Failed to load parser for 'turtle'"; my %loaded; my @manifests; my @load = map { iri("file://" . File::Spec->rel2abs($_)) } @manifests_iris; while (scalar(@load)) { foreach my $iri (@load) { warn "Loading " . $iri->value . "\n" if ($self->debug); $loaded{ $iri->value }++; } $model->load_urls_into_graph($self->default_graph, @load); @load = (); warn "done parsing manifests" if $self->debug; $self->model($model); my $subjects = $model->subjects( iri("${RDF}type"), iri("${MF}Manifest") ); my @manifest_matches = $subjects->elements; push(@manifests, @manifest_matches); foreach my $m (@manifest_matches) { my @list_heads = $model->objects( $m, iri("${MF}include") )->elements; my @elements = map { $model->get_list(undef, $_)->elements() } @list_heads; push(@load, grep { not exists($loaded{$_->value}) } @elements); } } $self->manifests(\@manifests); } sub syntax_test { my $self = shift; my $test_type = shift; my $model = shift; my $test = shift; my $count = shift // 1; my $type = iri( "http://www.w3.org/1999/02/22-rdf-syntax-ns#type" ); my $mfname = iri( "http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#name" ); my ($queryd) = $model->objects( $test, iri("${MF}action") )->elements; my ($approved) = $model->objects( $test, iri("${DAWGT}approval") )->elements; my ($name) = $model->objects( $test, $mfname )->elements; my $namevalue = $name->value; if ($self->strict_approval) { unless ($approved) { warn "- skipping test because it isn't approved\n" if ($self->debug); return; } if ($approved->equal("${DAWGT}NotClassified")) { warn "- skipping test because its approval is dawgt:NotClassified\n" if ($self->debug); return; } } my $is_pos_query = $model->count_quads($test, $type, iri("${MF}PositiveSyntaxTest11")); my $is_pos_update = $model->count_quads($test, $type, iri("${MF}PositiveUpdateSyntaxTest11")); my $is_neg_query = $model->count_quads($test, $type, iri("${MF}NegativeSyntaxTest")) + $model->count_quads($test, $type, iri("${MF}NegativeSyntaxTest11")); my $is_neg_update = $model->count_quads($test, $type, iri("${MF}NegativeUpdateSyntaxTest")) + $model->count_quads($test, $type, iri("${MF}NegativeUpdateSyntaxTest11")); my $uri = URI->new( $queryd->value ); my $filename = $uri->file; my (undef,$base,undef) = File::Spec->splitpath( $filename ); $base = "file://${base}"; warn "Loading SPARQL query from file $filename" if ($self->debug); my $sparql = do { local($/) = undef; open(my $fh, '<:utf8', $filename) or do { warn("$!: $filename; " . $test->as_string); return }; <$fh> }; my $bytes = encode_utf8($sparql); if ($self->debug) { my $q = $sparql; $q =~ s/\s+/ /g; warn "### test : " . $test->as_string . "\n"; warn "# file : $filename\n"; warn "# sparql : $q\n"; } my $pclass = Attean->get_parser('SPARQL'); my $parser = $pclass->new(); if ($test_type eq 'update') { $parser->update(1); } if ($is_pos_query or $is_pos_update) { my ($query) = eval { $parser->parse_list_from_bytes($bytes) }; my $ok = blessed($query); $self->record_result('syntax', $ok, $test->as_string); if ($ok) { pass("syntax $namevalue: $filename"); } else { fail("syntax $namevalue; $filename: $@"); } } elsif ($is_neg_query or $is_neg_update) { my ($query) = eval { $parser->parse_list_from_bytes($bytes) }; my $ok = $@ ? 1 : 0; $self->record_result('syntax', $ok, $test->as_string); if ($ok) { pass("syntax $namevalue: $filename"); } else { if ($self->debug) { warn $query->as_string; } fail("syntax $namevalue; $filename (unexpected successful parse)"); } } } sub update_eval_test { my $self = shift; my $model = shift; my $test = shift; my $count = shift // 1; my ($action) = $model->objects( $test, iri("${MF}action") )->elements; my ($result) = $model->objects( $test, iri("${MF}result") )->elements; my ($req) = $model->objects( $test, iri("${MF}requires") )->elements; my ($approved) = $model->objects( $test, iri("${DAWGT}approval") )->elements; my ($queryd) = $model->objects( $action, iri("${UT}request") )->elements; my @data = $model->objects( $action, iri("${UT}data") )->elements; my @gdata = $model->objects( $action, iri("${UT}graphData") )->elements; if ($self->strict_approval) { unless ($approved) { warn "- skipping test because it isn't approved\n" if ($self->debug); return; } if ($approved->equal(iri("${DAWGT}NotClassified"))) { warn "- skipping test because its approval is dawgt:NotClassified\n" if ($self->debug); return; } } my $uri = URI->new( $queryd->value ); my $filename = $uri->file; my (undef,$base,undef) = File::Spec->splitpath( $filename ); $base = "file://${base}"; warn "Loading SPARQL query from file $filename" if ($self->debug); my $sparql = do { local($/) = undef; open(my $fh, '<', $filename) or do { fail("$!: $filename; " . $test->as_string); return }; binmode($fh, ':utf8'); <$fh> }; my $q = $sparql; $q =~ s/\s+/ /g; if ($self->debug) { warn "### test : " . $test->value . "\n"; warn "# sparql : $q\n"; foreach my $data (@data) { warn "# data : " . $data->value . "\n" if (blessed($data)); } warn "# graph data : " . $_->value . "\n" for (@gdata); warn "# result : " . $result->value . "\n"; warn "# requires : " . $req->value . "\n" if (blessed($req)); } # TODO: set up remote endpoint mock warn "constructing model...\n" if ($self->debug); my $test_model = $self->test_model(); foreach my $data (@data) { eval { if (blessed($data)) { $test_model->load_urls_into_graph($self->default_graph, $data); } }; if ($@) { fail($test->value); print "# died: " . $test->value . ": $@\n"; return; } } foreach my $gdata (@gdata) { my ($data) = ($model->objects( $gdata, iri("${UT}data") )->elements)[0] || ($model->objects( $gdata, iri("${UT}graph") )->elements)[0]; my ($graph) = $model->objects( $gdata, iri("${RDFS}label") )->elements; my $uri = $graph->value; eval { $test_model->load_urls_into_graph(iri($uri), $data); }; if ($@) { fail($test->as_string); print "# died: " . $test->value . ": $@\n"; return; }; } my ($result_status) = $model->objects( $result, iri("${UT}result") )->elements; my @resgdata = $model->objects( $result, iri("${UT}graphData") )->elements; my ($resdata) = $model->objects( $result, iri("${UT}data") )->elements; my $expected_model = memory_model; eval { if (blessed($resdata)) { $expected_model->load_urls_into_graph($self->default_graph, $resdata); } }; if ($@) { fail($test->as_string); print "# died: " . $test->value . ": $@\n"; return; }; foreach my $gdata (@resgdata) { my ($data) = ($model->objects( $gdata, iri("${UT}data") )->elements)[0] || ($model->objects( $gdata, iri("${UT}graph") )->elements)[0]; my ($graph) = $model->objects( $gdata, iri("${RDFS}label") )->elements; my $uri = $graph->value; my $return = 0; if ($data) { eval { $expected_model->load_urls_into_graph(iri($uri), $data); }; if ($@) { fail($test->as_string); print "# died: " . $test->value . ": $@\n"; $return = 1; }; return if ($return); } } if ($self->debug) { warn "Dataset before update operation:\n"; warn $self->model_as_string($test_model); } my $ok = 0; eval { my $algebra = eval { Attean->get_parser('SPARQL')->parse_update($sparql) }; if ($@) { warn "Failed to parse query $filename: $@"; die $@; } unless ($algebra) { warn "No algebra generated for update\n"; fail($test->value); return; } if ($self->debug) { warn "# Algebra:\n" . $algebra->as_string . "\n"; } my $default_graphs = [$self->default_graph]; my $planner = Attean::IDPQueryPlanner->new(); my $plan = $planner->plan_for_algebra($algebra, $test_model, $default_graphs); if ($self->debug) { warn "# Plan:\n" . $plan->as_string . "\n"; } if ($self->debug) { warn "Running update...\n"; } my $iter = $plan->evaluate($test_model); $iter->elements; if ($self->debug) { warn "done.\n"; } if ($self->debug) { warn "Comparing results...\n"; } my $eqtest = Attean::BindingEqualityTest->new(); my $eq = $eqtest->equals($test_model, $expected_model); if ($self->debug) { warn "done.\n"; } $ok = is( $eq, 1, $test->value ); unless ($ok) { warn $eqtest->error; warn "Got model:\n" . $self->model_as_string($test_model); warn "Expected model:\n" . $self->model_as_string($expected_model); } }; if ($@) { warn "Failed to execute update: $@"; fail($test->value); } if (not($ok)) { print "# failed: " . $test->value . "\n"; } warn "ok\n" if ($self->debug); } sub query_eval_test { my $self = shift; my $model = shift; my $test = shift; my $count = shift // 1; my ($action) = $model->objects( $test, iri("${MF}action") )->elements; my ($result) = $model->objects( $test, iri("${MF}result") )->elements; my ($req) = $model->objects( $test, iri("${MF}requires") )->elements; my ($approved) = $model->objects( $test, iri("${DAWGT}approval") )->elements; my ($queryd) = $model->objects( $action, iri("${RQ}query") )->elements; my @data = $model->objects( $action, iri("${RQ}data") )->elements; my @gdata = $model->objects( $action, iri("${RQ}graphData") )->elements; my @sdata = $model->objects( $action, iri("${RQ}serviceData") )->elements; if ($self->strict_approval) { unless ($approved) { warn "- skipping test because it isn't approved\n" if ($self->debug); return; } if ($approved->equal("${DAWGT}NotClassified")) { warn "- skipping test because its approval is dawgt:NotClassified\n" if ($self->debug); return; } } my $uri = URI->new( $queryd->value ); my $filename = $uri->file; my (undef,$base,undef) = File::Spec->splitpath( $filename ); $base = "file://${base}"; warn "Loading SPARQL query from file $filename" if ($self->debug); my $sparql = do { local($/) = undef; open(my $fh, '<', $filename) or do { warn("$!: $filename; " . $test->value); return }; binmode($fh, ':utf8'); <$fh> }; my $q = $sparql; $q =~ s/\s+/ /g; if ($self->debug) { warn "### test : " . $test->value . "\n"; warn "# sparql : $q\n"; foreach my $data (@data) { warn "# data : " . ($data->value =~ s#file://##r) . "\n" if (blessed($data)); } warn "# graph data : " . ($_->value =~ s#file://##r) . "\n" for (@gdata); warn "# result : " . ($result->value =~ s#file://##r) . "\n"; warn "# requires : " . ($req->value =~ s#file://##r) . "\n" if (blessed($req)); } STRESS: foreach (1 .. $count) { print STDERR "constructing model... " if ($self->debug); my $test_model = $self->test_model(); my $next_stress = 0; try { foreach my $data (@data) { if (blessed($data)) { $test_model->load_urls_into_graph($self->default_graph, $data); } } foreach my $g (@gdata) { my $start = $test_model->size; $test_model->load_urls_into_graph($g, $g); my $end = $test_model->size; unless ($start < $end) { warn "*** Loading file did not result in any new quads: " . $g; } } } catch { fail($test->value); $self->record_result('evaluation', 0, $test->value); print "# died: " . $test->value . ": $_\n"; $next_stress++; }; next STRESS if $next_stress; print STDERR "ok\n" if ($self->debug); my $resuri = URI->new( $result->value ); my $resfilename = $resuri->file; TODO: { local($TODO) = (blessed($req)) ? "requires " . $req->value : ''; my $comment; eval { if ($self->debug) { my $q = $sparql; $q =~ s/([\x{256}-\x{1000}])/'\x{' . sprintf('%x', ord($1)) . '}'/eg; warn $q; } my ($actual, $type); { local($::DEBUG) = 1; print STDERR "getting actual results... " if ($self->debug); ($actual, $type) = $self->get_actual_results( $filename, $test_model, $sparql, $base ); print STDERR "ok\n" if ($self->debug); } print STDERR "getting expected results... " if ($self->debug); my $expected = $self->get_expected_results( $resfilename, $type ); print STDERR "ok\n" if ($self->debug); # warn "comparing results..."; $self->compare_results( $expected, $actual, $test->value, \$comment ); }; my $ok = not($@); unless ($ok) { warn $@; fail($test->value); $self->record_result('evaluation', 0, $test->value); }; if ($ok) { } else { print "# failed: " . $test->value . "\n"; } } } } sub get_actual_results { my $self = shift; my $filename = shift; my $model = shift; my $sparql = shift; my $base = shift; my $bytes = encode_utf8($sparql); my $s = AtteanX::Parser::SPARQL->new(base => $base); my $algebra; eval { ($algebra) = $s->parse_list_from_bytes($bytes); }; if ($@) { warn "Failed to parse query $filename: $@"; die $@; } if ($self->debug) { warn "Walking algebra:\n"; warn $algebra->as_string; } if ($self->debug) { my $iter = $model->get_quads; warn "Dataset:\n-------------\n"; while (my $q = $iter->next) { say $q->as_string; } warn "-------------\n"; } my $testns = 'http://example.com/test-results#'; my $rmodel = memory_model(); my $results; if ($self->use_idp_planner) { my $default_graphs = [$self->default_graph]; my $planner = Attean::IDPQueryPlanner->new(); my $plan = $planner->plan_for_algebra($algebra, $model, $default_graphs); if ($self->debug) { warn "Walking plan:\n"; warn $plan->as_string; } $results = eval { $plan->evaluate($model) }; warn $@ if $@; } else { my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => $self->default_graph ); $results = eval { $e->evaluate($algebra, $self->default_graph) }; warn $@ if $@; } my $count = 1; $results = $results->materialize; my $item = $results->peek; my $type = 'bindings'; if ($item) { if ($item->does('Attean::API::Triple')) { $type = 'graph'; } elsif ($item->does('Attean::API::Term')) { $type = 'boolean'; } } $self->print_results("Actual results", \$results) if ($self->results); return ($results, $type); if ($results->is_bindings) { return ($results, 'bindings'); } elsif ($results->is_boolean) { $rmodel->add_statement( triple( iri("${testns}result"), iri("${testns}boolean"), literal(($results->get_boolean ? 'true' : 'false'), undef, "${XSD}boolean") ) ); return ($rmodel->get_statements, 'boolean'); } elsif ($results->is_graph) { return ($results, 'graph'); } else { warn "unknown result type: " . Dumper($results); } } sub print_results { my $self = shift; my $name = shift; my $results = shift; $$results = $$results->materialize; print "$name:\n"; my $count = 1; while (my $r = $$results->next) { printf("%3d %s\n", $count++, $r->as_string); } $$results->reset; } sub get_expected_results { my $self = shift; my $file = shift; my $type = shift; if ($type eq 'graph') { my $model = memory_model(); $model->load_urls_into_graph($self->default_graph, iri("file://$file")); my $results = $model->get_quads->map(sub { shift->as_triple }, 'Attean::API::Triple'); $self->print_results("Expected results", \$results) if ($self->results); return $results; } elsif ($file =~ /[.](srj|json)/) { my $model = memory_model(); open(my $fh, '<', $file) or die $!; my $parser = Attean->get_parser('SPARQLJSON')->new(); my $results = $parser->parse_iter_from_io($fh)->materialize; my $item = $results->peek; if (blessed($item) and $item->does('Attean::API::Term')) { if ($self->results) { warn "Expected result: " . $item->as_string . "\n"; } return $results; } else { $self->print_results("Expected results", \$results) if ($self->results); return $results; } } elsif ($file =~ /[.]srx/) { my $model = memory_model(); my $parser = Attean->get_parser('sparqlxml')->new(); open(my $fh, '<', $file); my $results = $parser->parse_iter_from_io($fh); $self->print_results("Expected results", \$results) if ($self->results); return $results; } elsif ($file =~ /[.]csv/) { my $csv = Text::CSV->new({binary => 1}); open( my $fh, "<:encoding(utf8)", $file ) or die $!; my $header = $csv->getline($fh); my @vars = @$header; my @data; while (my $row = $csv->getline($fh)) { my %result; foreach my $i (0 .. $#vars) { my $var = $vars[$i]; my $value = $row->[ $i ]; # XXX @@ heuristics that won't always work. # XXX @@ expected to work on the test suite, though if ($value =~ /^_:(\w+)$/) { $value = blank($1); } elsif ($value =~ /$RE{URI}/) { $value = iri($value); } elsif (defined($value) and length($value)) { $value = literal($value); } if (ref($value)) { $result{ $var } = $value; } } push(@data, Attean::Result->new( bindings => \%result )); } my $results = Attean::ListIterator->new(values => \@data, item_type => 'Attean::API::Result', variables => \@vars); $self->print_results("Expected results", \$results) if ($self->results); return $results; } elsif ($file =~ /[.]tsv/) { my $parser = Attean->get_parser('SPARQLTSV')->new(); open( my $fh, "<:encoding(utf8)", $file ) or die $!; my $iter = $parser->parse_iter_from_io($fh); return $iter; } elsif ($file =~ /[.](ttl|rdf|nt)/) { my $model = memory_model(); $model->load_urls_into_graph($self->default_graph, iri("file://$file")); my ($res) = $model->subjects( iri("${RDF}type"), iri("${RS}ResultSet") )->elements; if (my($b) = $model->objects( $res, iri("${RS}boolean") )->elements) { my $bool = $b->value; my $term = literal(value => $bool, datatype => "${XSD}boolean"); if ($self->results) { warn "Expected result: " . $term->as_string . "\n"; } return Attean::ListIterator->new(values => [$term], item_type => 'Attean::API::Term'); } else { my @vars = $model->objects( $res, iri("${RS}resultVariable") )->elements; my @sols = $model->objects( $res, iri("${RS}solution") )->elements; my @names = map { $_->value } @vars; my @bindings; my %vars; foreach my $r (@sols) { my %data; my @b = $model->objects( $r, iri("${RS}binding") )->elements; foreach my $b (@b) { my ($value) = $model->objects( $b, iri("${RS}value") )->elements; my ($var) = $model->objects( $b, iri("${RS}variable") )->elements; $data{ $var->value } = $value; $vars{ $var->value }++; } push(@bindings, Attean::Result->new( bindings => \%data )); } my $results = Attean::ListIterator->new(values => \@bindings, item_type => 'Attean::API::Result', variables => [keys %vars]); $self->print_results("Expected results", \$results) if ($self->results); return $results; } } else { die "Unrecognized type of expected results: $file"; } } sub compare_results { my $self = shift; my $expected = shift->canonicalize->materialize; my $actual = shift->canonicalize->materialize; my $test = shift; my $comment = shift || do { my $foo; \$foo }; my $TODO = shift; if ($actual->does('Attean::API::ResultIterator') or $actual->does('Attean::API::TripleIterator')) { my $eqtest = Attean::BindingEqualityTest->new(); if ($test =~ /csv0/) { # CSV is a lossy format, so strip the languages and datatypes off of literals in the actual results (so that they'll match up with the (lossy) expected results my $mapper = Attean::TermMap->new(mapper => sub { my $term = shift; if ($term->does('Attean::API::Literal')) { return Attean::Literal->new(value => $term->value); } return $term; }); $actual = $actual->map($mapper->binding_mapper); } my $ok = eval { ok( $eqtest->equals( $actual, $expected ), $test ) or diag($eqtest->error) }; if ($@) { diag($@); } $self->record_result('evaluation', $ok, $test); return $ok; } elsif ($actual->does('Attean::API::TermIterator')) { my $a = $actual->next; my $e = $expected->next; my $name = $self->debug ? sprintf("$test: %s == %s", $a->as_string, $e->as_string) : $test; my $ok = ok( $a->equals($e), $name ); $self->record_result('evaluation', $ok, $test); return $ok; } else { die "Unexpected result type $actual"; } } sub record_result { my $self = shift; my $type = shift; my $ok = shift; my $name = shift; unless ($ok) { push(@{ $self->failures->{$type} }, $name); } } sub model_as_string { my $self = shift; my $model = shift; my $ser = Attean->get_serializer('nquads'); my $sep = ('####' x 25) . "\n"; my $s = sprintf("Model with %d quads:\n", $model->size); $s .= $ser->serialize_iter_to_bytes($model->get_quads); return $sep . $s . $sep; } sub DESTROY { my $self = shift; my $count = 0; while (my ($type, $failures) = each(%{ $self->failures })) { $count += scalar(@$failures); } if ($self->run_query_tests and $count) { my $d = Data::Dumper->new([$self->failures], [qw(failures)]); $d->Sortkeys(1)->Indent(2); my $msg = "Failing tests: " . $d->Dump; warn $msg; unless ($self->pattern) { open(my $fh, '>', sprintf('.sparql-test-suite-%d', scalar(time))); while (my ($type, $failures) = each(%{ $self->failures })) { say $fh $type; say $fh join("\n", sort @$failures); } } } } ############################################################################### 1; Attean-0.034/lib/Test/Attean/SPARQLSuite.pm000644 000765 000024 00000011502 14633174432 020304 0ustar00gregstaff000000 000000 package Test::Attean::SPARQLSuite; use v5.14; use warnings; use Test::Roo::Role; use Attean; use Attean::RDF; use AtteanX::Parser::SPARQL; use Attean::SimpleQueryEvaluator; use Test::Attean::W3CManifestTestSuite; use Carp; use HTTP::Request; use HTTP::Response; use HTTP::Message::PSGI; use Data::Dumper; use Encode qw(encode encode_utf8); use Getopt::Long; use Regexp::Common qw /URI/; use Scalar::Util qw(blessed reftype); use List::MoreUtils qw(all); use Test::Modern; use Text::CSV; use Try::Tiny; use URI::file; use File::Spec; use Types::Standard qw(Str Bool ArrayRef HashRef InstanceOf ConsumerOf); require XML::Simple; my $XSD = 'http://www.w3.org/2001/XMLSchema#'; my $RDF = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'; my $RDFS = 'http://www.w3.org/2000/01/rdf-schema#'; my $RS = 'http://www.w3.org/2001/sw/DataAccess/tests/result-set#'; my $MF = 'http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#'; my $UT = 'http://www.w3.org/2009/sparql/tests/test-update#'; my $RQ = 'http://www.w3.org/2001/sw/DataAccess/tests/test-query#'; my $DAWGT = 'http://www.w3.org/2001/sw/DataAccess/tests/test-dawg#'; with 'Test::Attean::W3CManifestTestSuite'; sub manifest_paths { my $self = shift; my @files; if ($self->run_query_tests) { push(@files, qw( aggregates bind cast bindings construct csv-tsv-res exists functions grouping json-res negation project-expression property-path subquery )); push(@files, qw( aggregates construct delete-insert grouping syntax-query syntax-fed syntax-update-1 syntax-update-2 )); } if ($self->run_update_tests) { push(@files, qw( add basic-update clear copy delete delete-data delete-insert delete-where drop move update-silent )); } my $dir = $self->tests_dir; unless (defined($dir)) { plan skip_all => "No manifest directory given"; exit(0); } unless (-d $dir and -r $dir) { plan skip_all => "Manifest directory not readable: $dir"; exit(0); } my @manifests = grep { -r $_ } map { File::Spec->catfile($dir, $_, 'manifest.ttl') } @files; } ############################################################################### Test::Roo::top_test 'SPARQL 1.1 tests' => sub { my $self = shift; my $PATTERN = $self->pattern; my @manifests = @{ $self->manifests }; my $model = $self->model; foreach my $m (@manifests) { # warn "Manifest: " . $m->as_string . "\n" if ($self->debug); my ($list) = $model->objects( $m, iri("${MF}entries") )->elements; unless (blessed($list)) { warn "No mf:entries found for manifest " . $m->as_string . "\n" if ($self->debug); } my @tests = $model->get_list( $self->default_graph, $list )->elements; foreach my $test (@tests) { unless ($test->value =~ /$PATTERN/) { next; } # if ($LIST_TESTS) { # say $test->value; # } if ($self->run_query_tests) { { # Evaluation Tests my $et = $model->count_quads($test, iri("${RDF}type"), iri("${MF}QueryEvaluationTest")); my $ct = $model->count_quads($test, iri("${RDF}type"), iri("${MF}CSVResultFormatTest")); if ($et + $ct) { my ($name) = $model->objects( $test, iri("${MF}name") )->elements; warn "### query eval test: " . $test->as_string . " >>> " . $name->value . "\n" if ($self->debug); $self->query_eval_test( $model, $test ); } } { # Syntax Tests my $total = 0; foreach my $type (qw(PositiveSyntaxTest11 NegativeSyntaxTest11)) { $total += $model->count_quads($test, iri("${RDF}type"), iri("${MF}$type")); } if ($total) { my ($name) = $model->objects( $test, iri("${MF}name") )->elements; warn "### query syntax test: " . $test->as_string . " >>> " . $name->value . "\n" if ($self->debug); $self->syntax_test( 'query', $model, $test ); } } } if ($self->run_update_tests) { { # Evaluation Tests if ($model->count_quads($test, iri("${RDF}type"), iri("${UT}UpdateEvaluationTest")) or $model->count_quads($test, iri("${RDF}type"), iri("${MF}UpdateEvaluationTest"))) { my ($name) = $model->objects( $test, iri("${MF}name") )->elements; unless ($test->value =~ /$PATTERN/) { next; } warn "### update eval test: " . $test->as_string . " >>> " . $name->value . "\n" if ($self->debug); $self->update_eval_test( $model, $test, ); } } { # Syntax Tests my $total = 0; foreach my $type (qw(PositiveUpdateSyntaxTest11 NegativeUpdateSyntaxTest11)) { $total += $model->count_quads($test, iri("${RDF}type"), iri("${MF}$type")); } if ($total) { my ($name) = $model->objects( $test, iri("${MF}name") )->elements; warn "### query syntax test: " . $test->as_string . " >>> " . $name->value . "\n" if ($self->debug); $self->syntax_test( 'update', $model, $test ); } } } } } }; 1; Attean-0.034/lib/Test/Attean/MutableTimeCacheableQuadStore.pm000644 000765 000024 00000001641 12706047436 024105 0ustar00gregstaff000000 000000 package Test::Attean::MutableTimeCacheableQuadStore; use v5.14; use warnings; use Test::Roo::Role; use Test::Moose; use Attean; use Attean::RDF; requires 'create_store'; # create_store( quads => \@quads ) with 'Test::Attean::StoreCleanup'; with 'Test::Attean::TimeCacheableQuadStore'; sub caching_sleep_time { return 30; } test 'mutable timecacheablequadstore' => sub { my $self = shift; my $q1 = quad(iri('s'), iri('p'), iri('o'), iri('g')); my $q2 = quad(iri('x'), iri('y'), iri('z'), iri('g')); my $store = $self->create_store(quads => [$q1, $q2]); my $start = $store->mtime_for_quads(); my $s = $self->caching_sleep_time; note("Sleeping for $s seconds"); sleep($s); $store->remove_quad($q1); my $end = $store->mtime_for_quads(); my $diff = abs($end - $start); isnt($start, $end, "mtime changed after update (by $diff seconds)"); $self->cleanup_store($store); }; 1; Attean-0.034/lib/Types/PaxHeader/Attean.pm000644 000765 000024 00000000225 14636707634 020437 xustar00gregstaff000000 000000 30 mtime=1719373724.632898731 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/lib/Types/Attean.pm000644 000765 000024 00000010710 14636707634 016466 0ustar00gregstaff000000 000000 package Types::Attean; use strict; use warnings; use Type::Library -base, -declare => qw( AtteanIRI AtteanBlank AtteanLiteral AtteanSubject AtteanPredicate AtteanObject AtteanGraph AtteanTriple AtteanQuad ); use Types::Standard qw( Str InstanceOf ConsumerOf ScalarRef ); use Types::URI qw( Uri Iri ); use Types::Namespace qw( Namespace ); use Types::Path::Tiny qw( Path ); use Types::UUID qw( Uuid ); my $TrineNode = InstanceOf['RDF::Trine::Node::Resource']; my $TrineNS = InstanceOf['RDF::Trine::Namespace']; my $XmlNS = InstanceOf['XML::Namespace']; our $VERSION = '0.034'; =head1 NAME Types::Attean - Type constraints for dealing with Attean classes =head1 SYNOPSIS TODO package IRI::Counter { use Moo; # or Moose use Types::Attean qw( AtteanIRI ); has iri => ( is => "ro", isa => AtteanIRI, required => 1, ); sub count_uses_in_document { ... } } =head1 DESCRIPTION Types::Attean is a type constraint library suitable for use with L/L attributes, L sub signatures, and so forth. It builds on L. =head1 TYPES =over =item C<< AtteanIRI >> A class type for L. Can coerce from L, L, L, L, L, L and strings. Additionally, a C can be coerced into a C URI. =item C<< AtteanBlank >> A role type for L. =item C<< AtteanLiteral >> A role type for L. =item C<< AtteanSubject >> A role type for a term that can be used as a subject in a triple or quad (i.e., L). =item C<< AtteanPredicate >> A role type for a term that can be used as a predicate in a triple or quad (i.e., L). =item C<< AtteanObject >> A role type for a term that can be used as an object in a triple or quad (i.e., L). =item C<< AtteanGraph >> A role type for a term that can be used as a graph in a quad (i.e., L). =item C<< AtteanTriple >> A role type for L. =item C<< AtteanQuad >> A role type for L. =back =head1 OTHER COERCIONS This library can also coerce from C to the C type defined in L. =cut __PACKAGE__->add_type( name => AtteanIRI, parent => InstanceOf['Attean::IRI'] ); AtteanIRI->coercion->add_type_coercions( Str ,=> q{ do { require Attean::IRI; "Attean::IRI"->new($_) } }, # HashRef ,=> q{ do { require Attean::IRI; "Attean::IRI"->new(URI::FromHash::uri(%$_)) } }, # TODO: Perhaps use for a shortcut to populate rather than parse? Namespace ,=> q{ do { require Attean::IRI; "Attean::IRI"->new($_->as_string) } }, Uri ,=> q{ do { require Attean::IRI; "Attean::IRI"->new($_->as_string) } }, Iri ,=> q{ do { require Attean::IRI; "Attean::IRI"->new($_->as_string) } }, Uuid ,=> q{ do { require Attean::IRI; "Attean::IRI"->new("urn:uuid:$_") } }, Path ,=> q{ do { require Attean::IRI; my $u = "URI::file"->new($_); "Attean::IRI"->new($u->as_string) } }, ScalarRef ,=> q{ do { require Attean::IRI; my $u = "URI"->new("data:"); $u->data($$_); "Attean::IRI"->new($u->as_string) } }, $TrineNode ,=> q{ do { require Attean::IRI; "Attean::IRI"->new($_->uri_value) } }, $TrineNS ,=> q{ do { require Attean::IRI; "Attean::IRI"->new($_->uri->uri_value) } }, $XmlNS ,=> q{ do { require Attean::IRI; "Attean::IRI"->new($_->uri) } }, ); require Attean::IRI; __PACKAGE__->add_type( name => AtteanBlank, parent => ConsumerOf['Attean::API::Blank'] ); __PACKAGE__->add_type( name => AtteanLiteral, parent => ConsumerOf['Attean::API::Literal'] ); __PACKAGE__->add_type( name => AtteanSubject, parent => ConsumerOf['Attean::API::BlankOrIRI'] ); __PACKAGE__->add_type( name => AtteanPredicate, parent => ConsumerOf['Attean::API::IRI'] ); __PACKAGE__->add_type( name => AtteanObject, parent => ConsumerOf['Attean::API::Term'] ); __PACKAGE__->add_type( name => AtteanGraph, parent => ConsumerOf['Attean::API::BlankOrIRI'] ); __PACKAGE__->add_type( name => AtteanTriple, parent => ConsumerOf['Attean::API::Triple'] ); __PACKAGE__->add_type( name => AtteanQuad, parent => ConsumerOf['Attean::API::Quad'] ); 1; Attean-0.034/xt/pod.t000644 000765 000024 00000000233 11760736733 014440 0ustar00gregstaff000000 000000 use strict; use warnings; use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); Attean-0.034/xt/PaxHeader/eval-sparql-star-memory-simpleeval.t000755 000765 000024 00000000236 14250266232 024465 xustar00gregstaff000000 000000 30 mtime=1654746266.938051343 69 LIBARCHIVE.xattr.com.apple.lastuseddate#PS=3URZZgAAAAB4sMU0AAAAAA 59 SCHILY.xattr.com.apple.lastuseddate#PS=ÝDYfx°Å4 Attean-0.034/xt/eval-sparql-star-memory-simpleeval.t000755 000765 000024 00000001425 14250266232 022515 0ustar00gregstaff000000 000000 #!/usr/bin/env perl use v5.14; use strict; use warnings; no warnings 'redefine'; no warnings 'once'; binmode(\*STDERR, ':encoding(utf8)'); binmode(\*STDOUT, ':encoding(utf8)'); use autodie; use Test::Roo; use List::MoreUtils qw(all); use FindBin qw($Bin); with 'Test::Attean::SPARQLStarSuite'; sub BUILD { my $self = shift; my $path = File::Spec->catfile( $Bin, 'data', 'rdf-star', 'sparql', 'eval' ); $self->tests_dir($path); } my %args = (use_idp_planner => 0, run_update_tests => 0); while (defined(my $opt = shift)) { if ($opt eq '-v') { $args{debug}++; } else { $args{pattern} = $opt; } } run_me(\%args); done_testing; sub test_model { my $store = Attean->get_store('Memory')->new(); my $model = Attean::MutableQuadModel->new( store => $store ); return $model; } Attean-0.034/xt/PaxHeader/eval-sparql-star-memory.t000755 000765 000024 00000000425 14325620471 022330 xustar00gregstaff000000 000000 30 mtime=1666654521.989743175 69 LIBARCHIVE.xattr.com.apple.lastuseddate#PS=6URZZgAAAADYON4QAAAAAA 59 SCHILY.xattr.com.apple.lastuseddate#PS=éDYfØ8Þ 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/xt/eval-sparql-star-memory.t000755 000765 000024 00000001377 14325620471 020366 0ustar00gregstaff000000 000000 #!/usr/bin/env perl use v5.14; use strict; use warnings; no warnings 'redefine'; no warnings 'once'; binmode(\*STDERR, ':encoding(utf8)'); binmode(\*STDOUT, ':encoding(utf8)'); use autodie; use Test::Roo; use List::MoreUtils qw(all); use FindBin qw($Bin); with 'Test::Attean::SPARQLStarSuite'; sub BUILD { my $self = shift; my $path = File::Spec->catfile( $Bin, 'data', 'rdf-star', 'sparql', 'eval' ); $self->tests_dir($path); } my %args = (run_update_tests => 0); while (defined(my $opt = shift)) { if ($opt eq '-v') { $args{debug}++; } else { $args{pattern} = $opt; } } run_me(\%args); done_testing; sub test_model { my $store = Attean->get_store('Memory')->new(); my $model = Attean::MutableQuadModel->new( store => $store ); return $model; } Attean-0.034/xt/dawg11-memory.t000755 000765 000024 00000001406 14626405101 016240 0ustar00gregstaff000000 000000 #!/usr/bin/env perl use v5.14; use strict; use warnings; no warnings 'redefine'; no warnings 'once'; binmode(\*STDERR, ':encoding(utf8)'); binmode(\*STDOUT, ':encoding(utf8)'); use autodie; use Test::Roo; use List::MoreUtils qw(all); use FindBin qw($Bin); with 'Test::Attean::SPARQLSuite'; sub BUILD { my $self = shift; my $path = File::Spec->catfile( $Bin, 'data', 'sparql', 'sparql11' ); $self->tests_dir($path); } my %args = (use_idp_planner => 1); while (defined(my $opt = shift)) { if ($opt eq '-v') { $args{debug}++; $args{results}++; } else { $args{pattern} = $opt; } } run_me(\%args); done_testing; sub test_model { my $store = Attean->get_store('Memory')->new(); my $model = Attean::MutableQuadModel->new( store => $store ); return $model; } Attean-0.034/xt/pod-coverage.t000644 000765 000024 00000000777 12643235470 016237 0ustar00gregstaff000000 000000 use strict; use warnings; use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; use Module::Load::Conditional qw[can_load]; my @modules = all_modules(); foreach my $mod (@modules) { next if ($mod =~ /^Test::/); if (can_load( modules => { $mod => 0 } )) { pod_coverage_ok($mod, { also_private => [ qr{^[A-Z][A-Z0-9_]*$} ] }); } else { note("Ignoring $mod for POD coverage tests (failed to load)"); } } done_testing(); Attean-0.034/t/store-simpletriple.t000644 000765 000024 00000002733 12651242417 017327 0ustar00gregstaff000000 000000 use Test::Roo; use Test::Modern; use Test::Exception; use v5.14; use warnings; no warnings 'redefine'; use Attean; sub create_store { my $self = shift; return Attean->get_store('SimpleTripleStore')->new(@_); } with 'Test::Attean::TripleStore'; run_me; # run these Test::Attean tests # use Try::Tiny; # $Error::TypeTiny::StackTrace = 1; # try { { my $s = Attean::Blank->new('x'); my $p = Attean::IRI->new('http://example.org/p1'); my $o = Attean::Literal->new(value => 'foo', language => 'en-US'); my $t = Attean::Triple->new($s, $p, $o); my @triples; push(@triples, $t); my $s2 = Attean::IRI->new('http://example.org/values'); foreach my $value (1 .. 3) { my $o = Attean::Literal->new(value => $value, datatype => 'http://www.w3.org/2001/XMLSchema#integer'); my $p = Attean::IRI->new("http://example.org/p$value"); my $t = Attean::Triple->new($s2, $p, $o); push(@triples, $t); } my $store = Attean->get_store('SimpleTripleStore')->new( triples => \@triples ); isa_ok($store, 'AtteanX::Store::SimpleTripleStore'); is($store->size, 4); is($store->count_triples($s), 1); is($store->count_triples($s2), 3); is($store->count_triples(), 4); is($store->count_triples(undef, $p), 2); { my $iter = $store->get_triples($s2); while (my $t = $iter->next()) { my $o = $t->object->value; like($o, qr/^[123]$/, "Literal value: $o"); } } } # catch { # my $exception = $_; # warn "Caught error: $exception"; # warn $exception->stack_trace; # }; done_testing(); Attean-0.034/t/parser-sparqljson.t000644 000765 000024 00000005315 12651717125 017154 0ustar00gregstaff000000 000000 use v5.14; use warnings; use autodie; use Test::Modern; use utf8; use Attean; sub iri { Attean::IRI->new(shift) } sub blank { Attean::Blank->new(shift) } sub literal { my ($value, $lang, $dt) = @_; if ($lang) { return Attean::Literal->new(value => $value, language => $lang); } elsif ($dt) { return Attean::Literal->new(value => $value, datatype => $dt); } else { return Attean::Literal->new($value); } } subtest 'parser construction and metadata' => sub { my $parser = Attean->get_parser('SPARQLJSON')->new(); isa_ok($parser, 'AtteanX::Parser::SPARQLJSON'); is($parser->canonical_media_type, 'application/sparql-results+json', 'canonical_media_type'); my %extensions = map { $_ => 1 } @{ $parser->file_extensions }; ok(exists $extensions{'srj'}, 'file_extensions'); my $type = $parser->handled_type; can_ok($type, 'role'); is($type->role, 'Attean::API::ResultOrTerm'); }; { my $json = <<'END'; { "head": { "vars": [ "x", "hpage", "name", "age", "mbox", "friend" ] } , "results": { "bindings": [ { "x": { "type": "bnode" , "value": "r2" } , "hpage": { "type": "uri" , "value": "http://work.example.org/bob/" } , "name": { "type": "literal" , "value": "Bob", "xml:lang": "en" } , "age": { "type": "literal" , "value": "30", "datatype": "http://www.w3.org/2001/XMLSchema#integer" } , "mbox": { "type": "uri" , "value": "mailto:bob@work.example.org" } } ] } } END my $counter = 0; my $parser = Attean->get_parser('SPARQLJSON')->new(handler => sub { $counter++; my $result = shift; does_ok($result, 'Attean::API::Result'); my @vars = $result->variables; is_deeply([sort @vars], [qw(age hpage mbox name x)]); my $x = $result->value('x'); does_ok($x, 'Attean::API::Blank'); is($x->value, 'r2'); my $age = $result->value('age'); does_ok($age, 'Attean::API::Literal'); is($age->value, '30'); is($age->datatype->value, 'http://www.w3.org/2001/XMLSchema#integer'); my $hpage = $result->value('hpage'); does_ok($hpage, 'Attean::API::IRI'); is($hpage->value, 'http://work.example.org/bob/'); }); $parser->parse_cb_from_bytes($json); } { my $tsv = <<'END'; { "head": { "vars": [ "x", "name" ] } , "results": { "bindings": [ { "x": { "type": "bnode" , "value": "r2" } , "name": { "type": "literal" , "value": "Bob", "xml:lang": "en" } }, { "x": { "type": "uri" , "value": "http://example.org/eve" } , "name": { "type": "literal" , "value": "Eve" } } ] } } END open(my $fh, '<', \$tsv); my $counter = 0; my $parser = Attean->get_parser('SPARQLJSON')->new(handler => sub {}); my @results = $parser->parse_list_from_io($fh); is(scalar(@results), 2); } done_testing(); Attean-0.034/t/PaxHeader/cost_planner.t000644 000765 000024 00000000200 12706047343 020111 xustar00gregstaff000000 000000 69 LIBARCHIVE.xattr.com.apple.lastuseddate#PS=1+IqYAAAAAAojhkmAAAAAA 59 SCHILY.xattr.com.apple.lastuseddate#PS=×â*`(Ž& Attean-0.034/t/cost_planner.t000644 000765 000024 00000021253 12706047343 016153 0ustar00gregstaff000000 000000 use v5.14; use autodie; use utf8; use Test::Modern; use Test::Exception; use Digest::SHA qw(sha1_hex); use Attean; use Attean::RDF; use AtteanX::Store::Memory; package TestPlanner { use Moo; extends 'Attean::QueryPlanner'; with 'Attean::API::NaiveJoinPlanner'; with 'Attean::API::SimpleCostPlanner'; } my $p = TestPlanner->new(); isa_ok($p, 'TestPlanner'); does_ok($p, 'Attean::API::QueryPlanner'); my $store = AtteanX::Store::Memory->new(); my $model = Attean::MutableQuadModel->new( store => $store ); my $graph = iri('http://example.org/'); my $t = triplepattern(variable('s'), iri('p'), literal('1')); my $u = triplepattern(variable('s'), iri('p'), variable('o')); my $v = triplepattern(variable('s'), iri('q'), blank('xyz')); my $w = triplepattern(variable('a'), iri('b'), iri('c')); subtest 'Empty BGP' => sub { note("An empty BGP should produce the join identity table plan"); my $bgp = Attean::Algebra::BGP->new(triples => []); my $plan = $p->plan_for_algebra($bgp, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', 'Empty BGP'); isa_ok($plan, 'Attean::Plan::Table'); my $rows = $plan->rows; is(scalar(@$rows), 1); }; subtest '1-triple BGP' => sub { note("A 1-triple BGP should produce a single Attean::Plan::Quad plan object"); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $plan = $p->plan_for_algebra($bgp, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', '1-triple BGP'); isa_ok($plan, 'Attean::Plan::Quad'); }; subtest '2-triple BGP without join variable' => sub { note("A 2-triple BGP without a join variable should produce a distinct join"); my $bgp = Attean::Algebra::BGP->new(triples => [$t, $w]); my $plan = $p->plan_for_algebra($bgp, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', '2-triple BGP'); does_ok($plan, 'Attean::API::Plan::Join'); ok($plan->distinct); }; subtest '2-triple BGP with join variable' => sub { note("A 2-triple BGP with a join variable and without any ordering should produce a distinct join"); my $bgp = Attean::Algebra::BGP->new(triples => [$t, $u]); my $plan = $p->plan_for_algebra($bgp, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', '2-triple BGP'); does_ok($plan, 'Attean::API::Plan::Join'); ok($plan->distinct); }; subtest 'Distinct 2-triple BGP with join variable, no blank nodes' => sub { note("A 2-triple BGP with a join variable without any blank nodes is necessarily distinct, so a distinct operation should be a no-op, resulting in just a join"); my $bgp = Attean::Algebra::BGP->new(triples => [$t, $u]); my $dist = Attean::Algebra::Distinct->new( children => [$bgp] ); my $plan = $p->plan_for_algebra($dist, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', 'Distinct 2-triple BGP without blanks'); does_ok($plan, 'Attean::API::Plan::Join'); ok($plan->distinct); }; subtest 'Distinct 3-triple BGP with join variable and blank nodes' => sub { note("A 3-triple BGP with a blank node isn't necessarily distinct, so a distinct operation should result in a HashDistinct plan"); my $bgp = Attean::Algebra::BGP->new(triples => [$t, $u, $v]); my $dist = Attean::Algebra::Distinct->new( children => [$bgp] ); my $plan = $p->plan_for_algebra($dist, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', 'Distinct 3-triple BGP with blanks'); isa_ok($plan, 'Attean::Plan::HashDistinct'); ok($plan->distinct); }; # TODO: A 1-triple BGP with ASC(-1 * ?s) sorting should result in a Project(Order(Extend(Quad(....)))) pattern subtest 'Sorted 1-triple BGP' => sub { note("A 1-triple BGP with ASC(?s) sorting should result in a Order(Quad(....)) pattern"); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $sorted = order_algebra_by_variables($bgp, 's'); my $plan = $p->plan_for_algebra($sorted, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', 'Sorted 1-triple BGP'); # Sorting introduces a isa_ok($plan, 'Attean::Plan::OrderBy'); ok($plan->distinct, 'Plan is distinct'); my $order = $plan->ordered; is(scalar(@$order), 1, 'Count of ordering comparators'); my $cmp = $order->[0]; ok($cmp->ascending, 'Ordering is ascending'); my $expr = $cmp->expression; isa_ok($expr, 'Attean::ValueExpression'); is($expr->value->value, 's'); }; subtest 'Join planning is equivalent to BGP planning' => sub { note("A join between two 1-triple BGPs should result in the same plan as the equivalent 2-triple BGP"); my $plan1 = $p->plan_for_algebra(Attean::Algebra::BGP->new(triples => [$t, $u]), $model, [$graph]); my $bgp1 = Attean::Algebra::BGP->new(triples => [$t]); my $bgp2 = Attean::Algebra::BGP->new(triples => [$u]); my $join = Attean::Algebra::Join->new(children => [$bgp1, $bgp2]); my $plan2 = $p->plan_for_algebra($join, $model, [$graph]); does_ok($_, 'Attean::API::Plan') for ($plan1, $plan2); does_ok($_, 'Attean::API::Plan::Join') for ($plan1, $plan2); # we don't do a single deep comparison on the plans here, because while they are equivalent plans, # BGP planning handles the annotating of the distinct flag on sub-plans differently than the # general join planning. foreach my $pos (0,1) { does_ok($_->children->[$pos], 'Attean::API::Plan') for ($plan1, $plan2); isa_ok($_->children->[$pos], 'Attean::Plan::Quad') for ($plan1, $plan2); is_deeply([$plan1->children->[$pos]->values], [$plan2->children->[$pos]->values]); } }; subtest 'Variable Filter' => sub { note("FILTER(?o) should result in a EBVFilter(...) pattern"); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $expr = Attean::ValueExpression->new(value => variable('o')); my $filter = Attean::Algebra::Filter->new(children => [$bgp], expression => $expr); my $plan = $p->plan_for_algebra($filter, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', 'Variable filter'); isa_ok($plan, 'Attean::Plan::EBVFilter'); is($plan->variable, 'o'); }; subtest 'Expression Filter' => sub { note("FILTER(?s && ?o) should result in a Project(EBVFilter(Extend(...))) pattern"); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $expr1 = Attean::ValueExpression->new(value => variable('s')); my $expr2 = Attean::ValueExpression->new(value => variable('o')); my $expr = Attean::BinaryExpression->new( operator => '&&', children => [$expr1, $expr2] ); my $filter = Attean::Algebra::Filter->new(children => [$bgp], expression => $expr); my $plan = $p->plan_for_algebra($filter, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', 'Expression filter'); isa_ok($plan, 'Attean::Plan::Project'); isa_ok($plan->children->[0], 'Attean::Plan::EBVFilter'); isa_ok($plan->children->[0]->children->[0], 'Attean::Plan::Extend'); }; subtest 'IRI named graph' => sub { note("1-triple BGP restricted to an IRI-named graph should result in a Quad plan"); my $ng = iri('http://eample.org/named/'); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $named = Attean::Algebra::Graph->new(children => [$bgp], graph => $ng); my $plan = $p->plan_for_algebra($named, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', 'IRI-named graph'); isa_ok($plan, 'Attean::Plan::Quad'); }; subtest 'Variable named graph (model with 0 named graphs)' => sub { note("1-triple BGP restricted to a variable-named graph should result in an empty Union plan"); my $ng = variable('g'); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $named = Attean::Algebra::Graph->new(children => [$bgp], graph => $ng); my $plan = $p->plan_for_algebra($named, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', 'IRI-named graph'); isa_ok($plan, 'Attean::Plan::Union'); is(scalar(@{ $plan->children }), 0); }; subtest 'Naive join planning should leave cartesian products intact' => sub { my $t1 = triplepattern(variable('s'), iri('p'), literal('1')); # ?s my $t2 = triplepattern(variable('a'), iri('b'), variable('o')); # ?a ?o my $t3 = triplepattern(variable('s'), iri('p'), variable('o')); # ?s ?o my $bgp = Attean::Algebra::BGP->new(triples => [$t1, $t2, $t3]); my $plan = $p->plan_for_algebra($bgp, $model, [$graph]); does_ok($plan, 'Attean::API::Plan::Join'); my ($lhs, $rhs) = @{ $plan->children }; does_ok($lhs, 'Attean::API::Plan::Join'); my @quads = (@{ $lhs->children }, $rhs); foreach my $q (@quads) { isa_ok($q, 'Attean::Plan::Quad'); } my ($q1, $q2, $q3) = @quads; is_deeply([sort @{ $q1->in_scope_variables }], ['s']); is_deeply([sort @{ $q2->in_scope_variables }], ['a', 'o']); is_deeply([sort @{ $q3->in_scope_variables }], ['o', 's']); }; done_testing(); sub order_algebra_by_variables { my $algebra = shift; my @vars = @_; my @cmps; foreach my $var (@vars) { my $expr = Attean::ValueExpression->new(value => variable($var)); my $cmp = Attean::Algebra::Comparator->new(ascending => 1, expression => $expr); push(@cmps, $cmp); } my $sorted = Attean::Algebra::OrderBy->new( children => [$algebra], comparators => \@cmps ); return $sorted; } Attean-0.034/t/PaxHeader/parser-sparql.t000644 000765 000024 00000000425 14273230345 020224 xustar00gregstaff000000 000000 30 mtime=1659711717.358550968 69 LIBARCHIVE.xattr.com.apple.lastuseddate#PS=xZSfYgAAAAB4xnQzAAAAAA 59 SCHILY.xattr.com.apple.lastuseddate#PS=Å”ŸbxÆt3 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/t/parser-sparql.t000644 000765 000024 00000020273 14273230345 016256 0ustar00gregstaff000000 000000 use v5.14; use autodie; use utf8; use Test::Modern; use Test::Exception; use FindBin qw($Bin); use File::Glob qw(bsd_glob); use File::Spec; use Attean; use Attean::RDF; use AtteanX::SPARQL::Constants; use Type::Tiny::Role; subtest 'parser construction and metadata' => sub { { my $parser = Attean->get_parser('SPARQL')->new(); isa_ok( $parser, 'AtteanX::Parser::SPARQL' ); is($parser->canonical_media_type, 'application/sparql-query', 'canonical_media_type'); my %extensions = map { $_ => 1 } @{ $parser->file_extensions }; ok(exists $extensions{'rq'}, 'file_extensions'); } { my $parser = Attean->get_parser('SPARQLLex')->new(); isa_ok( $parser, 'AtteanX::Parser::SPARQLLex' ); is($parser->canonical_media_type, 'application/x-sparql-query-tokens', 'canonical_media_type'); my %extensions = map { $_ => 1 } @{ $parser->file_extensions }; ok(exists $extensions{'rq'}, 'file_extensions'); } }; { my $parser = Attean->get_parser('SPARQL')->new(); isa_ok($parser, 'AtteanX::Parser::SPARQL'); my $type = $parser->handled_type; can_ok($type, 'role'); is($type->role, 'Attean::API::Algebra'); } { my $parser = Attean->get_parser('SPARQL')->new(); my $q = $parser->parse("SELECT * { ?s

'''hello!''' OPTIONAL { ?s ?x } FILTER(!BOUND(?x)) } LIMIT 5 OFFSET 5"); does_ok($q, 'Attean::API::Algebra'); isa_ok($q, 'Attean::Algebra::Query'); my $s = $q->child; isa_ok($s, 'Attean::Algebra::Slice'); } { my $data = "ASK { ?s ?p ?o FILTER(?o > -2.0 && ?o < +3e0 ) }"; open(my $fh, '<', \$data); my $parser = Attean->get_parser('SPARQL')->new(); my $iter = $parser->parse_iter_from_io($fh); does_ok($iter, 'Attean::API::Iterator'); my $q = $iter->next; does_ok($q, 'Attean::API::Algebra'); my $a = $q->child; isa_ok($a, 'Attean::Algebra::Ask'); } { my $map = URI::NamespaceMap->new(); my $parser = Attean->get_parser('SPARQL')->new( namespaces => $map ); my $content = <<'END'; PREFIX ex: PREFIX foaf: SELECT * WHERE { ?s a foaf:Person ; foaf:name 'Alice' } OFFSET 10 END my ($q) = $parser->parse_list_from_bytes($content); is_deeply([sort $map->list_prefixes], [qw(ex foaf)]); my $foaf = $map->namespace_uri('foaf'); isa_ok($foaf, 'URI::Namespace'); is($foaf->as_string, 'http://xmlns.com/foaf/0.1/'); my $a = $q->child; isa_ok($a, 'Attean::Algebra::Slice') } subtest 'escaping' => sub { my $sparql = q[ASK { ex:p "\\"", '\\'', '\\u706b\\U0000661F' \\u007d]; open(my $fh, '<:encoding(UTF-8)', \$sparql); my $l = AtteanX::Parser::SPARQLLex->new(); my $iter = $l->parse_iter_from_io($fh); expect($iter->next, KEYWORD, ['ASK']); expect($iter->next, LBRACE, ['{'],); expect($iter->next, IRI, ['s'], 'subject'); expect($iter->next, PREFIXNAME, ['ex:', 'p'], 'predicate'); expect($iter->next, STRING1D, ['"'], 'double quote'); expect($iter->next, COMMA, [',']); expect($iter->next, STRING1S, ["'"], 'single quote'); expect($iter->next, COMMA, [',']); expect($iter->next, STRING1S, ["ç«æ˜Ÿ"], 'unicode \\u and \\U escapes'); expect($iter->next, RBRACE, ['}'], 'escaped closing brace'); }; subtest 'custom function' => sub { my $sparql = q[PREFIX ex: SELECT * WHERE { ?s ?p ?o FILTER(ex:test(?o)) }]; open(my $fh, '<:encoding(UTF-8)', \$sparql); my $parser = AtteanX::Parser::SPARQL->new(); my ($a) = $parser->parse($sparql); my ($f) = $a->subpatterns_of_type('Attean::Algebra::Filter'); isa_ok($f, 'Attean::Algebra::Filter'); my $expr = $f->expression; isa_ok($expr, 'Attean::FunctionExpression'); is($expr->operator, 'INVOKE'); my ($iri, $term) = map { $_->value } @{ $expr->children }; does_ok($iri, 'Attean::API::IRI'); is($iri->value, 'http://example.org/test'); does_ok($term, 'Attean::API::Variable'); is($term->value, 'o'); }; subtest 'syntax coverage: top-level filter custom function call' => sub { my $sparql = q[PREFIX ex: SELECT * WHERE { ?s ?p ?o FILTER ex:test(?o) }]; my $a = AtteanX::Parser::SPARQL->parse($sparql); my ($f) = $a->subpatterns_of_type('Attean::Algebra::Filter'); isa_ok($f, 'Attean::Algebra::Filter'); my $expr = $f->expression; isa_ok($expr, 'Attean::FunctionExpression'); is($expr->operator, 'INVOKE'); my ($iri, $term) = map { $_->value } @{ $expr->children }; does_ok($iri, 'Attean::API::IRI'); is($iri->value, 'http://example.org/test'); does_ok($term, 'Attean::API::Variable'); is($term->value, 'o'); }; subtest 'parse coverage: NIL' => sub { my $a = AtteanX::Parser::SPARQL->parse('SELECT * WHERE { ?s ?p () }'); does_ok($a, 'Attean::API::Algebra'); my ($bgp) = $a->subpatterns_of_type('Attean::Algebra::BGP'); isa_ok($bgp, 'Attean::Algebra::BGP'); my @t = @{ $bgp->triples }; is(scalar(@t), 1); my $t = $t[0]; does_ok($t, 'Attean::API::TriplePattern'); my $nil = $t->object; does_ok($nil, 'Attean::IRI'); is($nil->value, 'http://www.w3.org/1999/02/22-rdf-syntax-ns#nil'); }; subtest 'parse coverage: TriplesSameSubject' => sub { my $a = AtteanX::Parser::SPARQL->parse('CONSTRUCT { ( ?s ?o ) } WHERE { ?s ?p ?o }'); does_ok($a, 'Attean::API::Algebra'); }; subtest 'parse coverage: RANK' => sub { local($TODO) = 'Fix RANK projection'; my $sparql = <<"END"; PREFIX : SELECT ?age ?name ?school WHERE { ?p :name ?name ; :school ?school ; :age ?age . } GROUP BY ?school RANK(ASC(?age)) AS ?rank HAVING (?rank < 2) END my $a = eval { AtteanX::Parser::SPARQL->parse($sparql) }; does_ok($a, 'Attean::API::Algebra'); }; subtest 'parse error' => sub { dies_ok { my $a = AtteanX::Parser::SPARQL->parse('* WHERE { ?s ?p ?o }'); } 'missing method'; dies_ok { my $a = AtteanX::Parser::SPARQL->parse_update('INSERT {

}'); } 'unexpected EOF in update'; }; subtest 'pre-defined base IRI' => sub { my $base = iri('http://example.org/base/'); my $parser = Attean->get_parser('SPARQL')->new( base => $base ); my ($resolved_term) = $parser->parse_nodes(''); is($resolved_term->value, 'http://example.org/base/test'); my ($algebra) = $parser->parse_list_from_bytes('ASK { }'); my $string = $algebra->as_string; like($string, qr{http://example.org/base/subj}); like($string, qr{http://example.org/pred}); like($string, qr{http://example.org/base/obj/value}); }; subtest 'parse_cb_from_bytes' => sub { my $cb = sub { my $a = shift; does_ok($a, 'Attean::API::Algebra'); }; my $p = Attean->get_parser('SPARQL')->new(handler => $cb); my $data = "ASK { ?s ?p ?o }"; open(my $fh, '<', \$data); $p->parse_cb_from_io($fh); }; subtest 'SPARQL 1.2 HINT syntax' => sub { my $sparql = <<"END"; PREFIX : SELECT * WHERE { HINT(:impl :joinType "Ordered") ?p :name ?name ; :school ?school ; :age ?age . } END open(my $fh, '<:encoding(UTF-8)', \$sparql); my $l = AtteanX::Parser::SPARQLLex->new(); my $iter = $l->parse_iter_from_io($fh); expect($iter->next, KEYWORD, ['PREFIX']); expect($iter->next, PREFIXNAME, [':']); expect($iter->next, IRI, ['http://example.org/']); expect($iter->next, KEYWORD, ['SELECT']); expect($iter->next, STAR, ['*'],); expect($iter->next, KEYWORD, ['WHERE']); expect($iter->next, LBRACE, ['{'],); expect($iter->next, KEYWORD, ['HINT'], 'hint keyword'); expect($iter->next, LPAREN, ['(']); }; subtest 'SPARQL 1.2 HINT algebra' => sub { my $sparql = <<"END"; PREFIX : SELECT * WHERE { HINT(:impl :joinType "Ordered") ?p :name ?name ; :school ?school ; :age ?age . } END my $a = eval { AtteanX::Parser::SPARQL->parse($sparql) }; does_ok($a, 'Attean::API::Algebra'); my ($bgp) = $a->subpatterns_of_type('Attean::Algebra::BGP'); my $hints = $bgp->hints; is(scalar(@$hints), 1, 'number of hints'); my $hint = shift(@$hints); is(scalar(@$hint), 3, 'count of terms in hint'); is($hint->[0]->value, 'http://example.org/impl', 'first term of HINT'); is($hint->[1]->value, 'http://example.org/joinType', 'second term of HINT'); is($hint->[2]->value, 'Ordered', 'third term of HINT'); }; done_testing(); sub expect { my $token = shift; my $type = shift; my $values = shift; my $name = shift // ''; if (length($name)) { $name = "${name}: "; } is($token->type, $type, "${name}token type"); is_deeply($token->args, $values, "${name}token values"); } Attean-0.034/t/serializer-sparqlhtml.t000644 000765 000024 00000006705 12652740134 020025 0ustar00gregstaff000000 000000 use Test::Modern; use Test::Exception; use v5.14; use warnings; no warnings 'redefine'; use Attean; use Attean::RDF; use Type::Tiny::Role; my $constraint = 'Attean::API::Result'; my $s = Attean::Blank->new('x'); my $p = Attean::IRI->new('http://example.org/p'); my $o1 = Attean::Literal->new(value => '1', datatype => 'http://www.w3.org/2001/XMLSchema#integer'); my $o2 = Attean::Literal->new(value => '2', language => 'en-US'); my $t1 = Attean::Result->new(bindings => { subject => $s, predicate => $p, object => $o1 }); my $t2 = Attean::Result->new(bindings => { subject => $s, predicate => $p, object => $o2 }); my $t3 = Attean::Result->new(bindings => { subject => iri('http://perlrdf.org/') }); my @triples = ($t1, $t2, $t3); { my $ser = Attean->get_serializer('SPARQLHTML')->new(); does_ok($ser, 'Attean::API::Serializer'); does_ok($ser, 'Attean::API::ResultSerializer'); isa_ok($ser, 'AtteanX::Serializer::SPARQLHTML'); my $expected = <<'END'; ?subject ?predicate ?object _:x "1"^^ _:x "2"@en-US END subtest 'serialize_iter_to_bytes' => sub { my $i = Attean::ListIterator->new(values => [@triples], item_type => $constraint, variables => [qw(subject predicate object)]); my $b = $ser->serialize_iter_to_bytes($i); my @rows = ($b =~ /(=', 4, 'at least 1 header row and 3 data rows'); like($b, qr[x]); like($b, qr[http://example.org/p]); like($b, qr[1]); like($b, qr[x]); like($b, qr[2]); like($b, qr[http://perlrdf.org/]); }; subtest 'serialize_iter_to_io' => sub { my $i = Attean::ListIterator->new(values => [@triples], item_type => $constraint, variables => [qw(subject predicate object)]); my $b = ''; open(my $fh, '>', \$b); $ser->serialize_iter_to_io($fh, $i); close($fh); my @rows = ($b =~ /(=', 4, 'at least 1 header row and 3 data rows'); like($b, qr[x]); like($b, qr[http://example.org/p]); like($b, qr[1]); like($b, qr[x]); like($b, qr[2]); like($b, qr[http://perlrdf.org/]); }; } { my $sclass = Attean->get_serializer('SPARQLHTML'); my $map = URI::NamespaceMap->new( { foaf => 'http://xmlns.com/foaf/0.1/' }); my $n1 = Attean::IRI->new('http://xmlns.com/foaf/0.1/Person'); my $n2 = Attean::IRI->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'); subtest 'serialize IRI with namespace map' => sub { my $s = $sclass->new(namespaces => $map); is ($s->node_as_html($n1), 'foaf:Person', 'Return HTML link for IRI with abbrev'); is ($s->node_as_html($n2), 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type', 'Return HTML link for IRI - 1'); }; subtest 'serialize IRI without namespace map' => sub { my $s = $sclass->new(); is ($s->node_as_html($n1), 'http://xmlns.com/foaf/0.1/Person', 'Return HTML link for IRI - 2'); is ($s->node_as_html($n2), 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type', 'Return HTML link for IRI - 3'); }; } done_testing(); Attean-0.034/t/parser_serializer_api.t000644 000765 000024 00000004412 14626405101 020031 0ustar00gregstaff000000 000000 use v5.14; use autodie; use utf8; use Test::Modern; use Attean; use Attean::RDF; subtest 'Parser by file extension' => sub { is(Attean->get_parser('rq'), 'AtteanX::Parser::SPARQL', 'rq'); is(Attean->get_parser('ru'), 'AtteanX::Parser::SPARQL', 'ru'); is(Attean->get_parser('nt'), 'AtteanX::Parser::NTriples', 'nt'); is(Attean->get_parser('srj'), 'AtteanX::Parser::SPARQLJSON', 'srj'); is(Attean->get_parser('srx'), 'AtteanX::Parser::SPARQLXML', 'srx'); is(Attean->get_parser('tsv'), 'AtteanX::Parser::SPARQLTSV', 'tsv'); is(Attean->get_parser('ttl'), 'AtteanX::Parser::Turtle', 'ttl'); is(Attean->get_parser('nq'), 'AtteanX::Parser::NQuads', 'nq'); is(Attean->get_parser('rdf'), 'AtteanX::Parser::RDFXML', 'rdf'); is(Attean->get_parser('xrdf'), 'AtteanX::Parser::RDFXML', 'xrdf'); like(Attean->get_parser('rq'), qr'AtteanX::Parser::SPARQL', 'rq'); # may be SPARQL or SPARQLLex }; subtest 'Serializer by file extension' => sub { is(Attean->get_serializer('rq'), 'AtteanX::Serializer::SPARQL', 'rq'); is(Attean->get_serializer('ru'), 'AtteanX::Serializer::SPARQL', 'ru'); is(Attean->get_serializer('txt'), 'AtteanX::Serializer::TextTable', 'txt'); is(Attean->get_serializer('text'), 'AtteanX::Serializer::TextTable', 'text'); like(Attean->get_serializer('nt'), qr'AtteanX::Serializer::\w*NTriples', 'nt'); # may be NTriples or CanonicalNTriples is(Attean->get_serializer('csv'), 'AtteanX::Serializer::SPARQLCSV', 'csv'); is(Attean->get_serializer('srj'), 'AtteanX::Serializer::SPARQLJSON', 'srj'); is(Attean->get_serializer('json'), 'AtteanX::Serializer::SPARQLJSON', 'json'); is(Attean->get_serializer('srx'), 'AtteanX::Serializer::SPARQLXML', 'srx'); like(Attean->get_serializer('xml'), qr'AtteanX::Serializer::(SPARQLXML|RDFXML)', 'xml'); is(Attean->get_serializer('tsv'), 'AtteanX::Serializer::SPARQLTSV', 'tsv'); is(Attean->get_serializer('nq'), 'AtteanX::Serializer::NQuads', 'nq'); is(Attean->get_serializer('rdf'), 'AtteanX::Serializer::RDFXML', 'rdf'); like(Attean->get_serializer('html'), qr'AtteanX::Serializer::[^:]*(HTML|RDFa)[^:]*', 'html'); # if AtteanX::Serializer::RDFa is installed, the html extension may map to either RDFa or SPARQLHTML like(Attean->get_serializer('ttl'), qr'AtteanX::Serializer::Turtle', 'ttl'); # may be Turtle or TurtleTokens }; done_testing(); Attean-0.034/t/serializer-sparqlxml.t000644 000765 000024 00000006553 12650316433 017661 0ustar00gregstaff000000 000000 use Test::Modern; use Test::Exception; use v5.14; use warnings; no warnings 'redefine'; use Attean; use Attean::RDF; use Type::Tiny::Role; my $constraint = 'Attean::API::Result'; my $s = Attean::Blank->new('x'); my $p = Attean::IRI->new('http://example.org/p'); my $o1 = Attean::Literal->new(value => '1', datatype => 'http://www.w3.org/2001/XMLSchema#integer'); my $o2 = Attean::Literal->new(value => '2', language => 'en-US'); my $t1 = Attean::Result->new(bindings => { subject => $s, predicate => $p, object => $o1 }); my $t2 = Attean::Result->new(bindings => { subject => $s, predicate => $p, object => $o2 }); my $t3 = Attean::Result->new(bindings => { subject => iri('http://perlrdf.org/') }); my @triples = ($t1, $t2, $t3); { my $ser = Attean->get_serializer('SPARQLXML')->new(); does_ok($ser, 'Attean::API::Serializer'); does_ok($ser, 'Attean::API::ResultSerializer'); isa_ok($ser, 'AtteanX::Serializer::SPARQLXML'); my $expected = <<'END'; x http://example.org/p 1 x http://example.org/p 2 http://perlrdf.org/ END { my $i = Attean::ListIterator->new(values => [@triples], item_type => $constraint, variables => [qw(subject predicate object)]); my $b = $ser->serialize_iter_to_bytes($i); is($b, $expected, 'serialize_iter_to_bytes'); } { my $i = Attean::ListIterator->new(values => [@triples], item_type => $constraint, variables => [qw(subject predicate object)]); my $data = ''; open(my $fh, '>', \$data); $ser->serialize_iter_to_io($fh, $i); close($fh); is($data, $expected, 'serialize_iter_to_io'); } { my $expected_reorder = <<'END'; http://example.org/p x 1 http://example.org/p x 2 http://perlrdf.org/ END my $i = Attean::ListIterator->new(values => [@triples], item_type => $constraint, variables => [qw(predicate subject object)]); my $data = ''; open(my $fh, '>', \$data); $ser->serialize_iter_to_io($fh, $i); close($fh); is($data, $expected_reorder, 'variable order sensitivity'); } } done_testing(); Attean-0.034/t/types-iri.t000644 000765 000024 00000003245 13643157172 015415 0ustar00gregstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Attean; use Test::Requires { 'Attean::IRI' => '0.023' }; use Types::Namespace qw( to_Uri to_Iri to_Namespace ); use Types::Attean qw(to_AtteanIRI); use Attean::IRI; use Module::Load::Conditional qw(can_load); my $atteaniri = Attean::IRI->new('http://www.example.net/'); { my $uri = to_Uri($atteaniri); isa_ok($uri, 'URI'); is("$uri", 'http://www.example.net/', "Correct string URI to Uri"); my $iri = to_Iri($atteaniri); isa_ok($iri, 'IRI'); is($iri->as_string, 'http://www.example.net/', "Correct string URI to Iri"); my $nsuri = to_Namespace($atteaniri); isa_ok($nsuri, 'URI::Namespace'); is($nsuri->as_string, 'http://www.example.net/', "Correct string URI to Namespace"); } _test_to_attean(URI->new('http://www.example.net/')); _test_to_attean(IRI->new('http://www.example.net/')); _test_to_attean(URI::Namespace->new('http://www.example.net/')); _test_to_attean('http://www.example.net/'); SKIP: { skip 'RDF::Trine is not installed', 3 unless can_load( modules => { 'RDF::Trine' => 0 }); _test_to_attean(RDF::Trine::iri('http://www.example.net/')); } sub _test_to_attean { my $uri = shift; my $airi = to_AtteanIRI($uri); isa_ok($airi, 'Attean::IRI'); is($airi->as_string, 'http://www.example.net/', 'Correct string URI from ' . ref($uri)); ok($airi->equals($atteaniri), 'Is the same URI'); # TODO: Something like this should work too? # my $aciri = Attean::IRI->new($uri); # isa_ok($aciri, 'Attean::IRI'); # is($aciri->as_string, 'http://www.example.net/', 'Correct string URI from ' . ref($uri)); # ok($aciri->equals($atteaniri), 'Is the same URI'); } done_testing; Attean-0.034/t/simple.t000644 000765 000024 00000006372 13234131154 014751 0ustar00gregstaff000000 000000 use Test::Modern; use Test::Exception; use v5.14; use warnings; no warnings 'redefine'; use Attean; { note('Attean::Variable'); my $a = Attean::Variable->new('foo'); does_ok($a, 'Attean::API::TermOrVariable'); is($a->value, 'foo', 'value'); is($a->ntriples_string, '?foo', 'ntriples_string'); } { note('Attean::Blank'); my $a = Attean::Blank->new('foo'); does_ok($a, 'Attean::API::Term'); does_ok($a, 'Attean::API::TermOrVariable'); is($a->value, 'foo', 'value'); is($a->ntriples_string, '_:foo', 'ntriples_string'); } { note('Attean::Literal (lang)'); my $a = Attean::Literal->new(value => 'foo', language => 'en-US'); does_ok($a, 'Attean::API::Term'); does_ok($a, 'Attean::API::Literal'); does_ok($a, 'Attean::API::TermOrVariable'); is($a->value, 'foo', 'value'); is($a->language, 'en-US', 'language'); does_ok($a->datatype, 'Attean::API::IRI', 'datatype IRI'); is($a->datatype->as_string, 'http://www.w3.org/1999/02/22-rdf-syntax-ns#langString', 'language literal datatype is rdf:langString'); is($a->ntriples_string, '"foo"@en-US', 'ntriples_string'); } { note('Attean::Literal (typed)'); my $a = Attean::Literal->new(value => '123', datatype => 'http://www.w3.org/2001/XMLSchema#integer'); does_ok($a, 'Attean::API::Term'); does_ok($a, 'Attean::API::Literal'); does_ok($a, 'Attean::API::TermOrVariable'); is($a->value, '123', 'value'); is($a->language, undef, 'no language method on typed literals'); does_ok($a->datatype, 'Attean::API::IRI', 'datatype IRI'); is($a->datatype->as_string, 'http://www.w3.org/2001/XMLSchema#integer', 'language literal datatype is xsd:integer'); is($a->ntriples_string, '"123"^^', 'ntriples_string'); } { note('Attean::IRI'); my $a = Attean::IRI->new('http://example.org/'); does_ok($a, 'Attean::API::Term'); is($a->value, 'http://example.org/', 'value'); is($a->ntriples_string, '', 'ntriples_string'); } { note('Attean::Triple'); my $s = Attean::Blank->new('x'); my $p = Attean::IRI->new('http://example.org/p'); my $o = Attean::Literal->new(value => 'foo', language => 'en-US'); my $t = Attean::Triple->new($s, $p, $o); does_ok($t, 'Attean::API::Triple'); isa_ok($t, 'Attean::Triple'); does_ok($t->subject, 'Attean::API::BlankOrIRI'); isa_ok($t->predicate, 'Attean::IRI'); does_ok($t->object, 'Attean::API::Term'); is($t->tuples_string, '_:x "foo"@en-US .', 'tuples string'); } { note('Attean::Triple with pattern'); my $s = Attean::Variable->new('x'); my $p = Attean::IRI->new('http://example.org/p'); my $o = Attean::Literal->new(value => 'foo', language => 'en-US'); my $s2 = Attean::IRI->new('http://example.org/o'); dies_ok { my $t1 = Attean::Triple->new($s, $p, $o); } 'croaks on a variable'; dies_ok { my $t2 = Attean::Triple->new($s2, $p, $s); } 'croaks on a variable shuffled'; } { note('Attean::Result'); my $iri = Attean::IRI->new('http://example.org/p'); my $literal = Attean::Literal->integer(123); my $r = Attean::Result->new( bindings => { 's' => $iri, 'o' => $literal } ); does_ok($r, 'Attean::API::Binding'); isa_ok($r, 'Attean::Result'); is_deeply([sort $r->variables], [qw(o s)]); is($r->as_string, '{o="123"^^, s=}'); } done_testing(); Attean-0.034/t/PaxHeader/parser-turtle-star.t000644 000765 000024 00000000425 14247206116 021210 xustar00gregstaff000000 000000 30 mtime=1654459470.794267534 69 LIBARCHIVE.xattr.com.apple.lastuseddate#PS=PN/8YAAAAAAgv/sVAAAAAA 59 SCHILY.xattr.com.apple.lastuseddate#PS=<ßü` ¿û 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/t/parser-turtle-star.t000644 000765 000024 00000003175 14247206116 017244 0ustar00gregstaff000000 000000 use v5.14; use autodie; use utf8; use Test::Modern; use Test::Exception; use FindBin qw($Bin); use File::Glob qw(bsd_glob); use File::Spec; use Attean; use Attean::RDF; use AtteanX::Parser::Turtle; use AtteanX::Parser::Turtle::Constants; use Type::Tiny::Role; subtest 'Turtle-star quoted triples' => sub { my $turtle = <<"END"; BASE PREFIX : <#> _:a :name "Alice" . << _:a :name "Alice" >> :statedBy :bob . END open(my $fh, '<', \$turtle); my $parser = Attean->get_parser('Turtle')->new(); my $iter = $parser->parse_iter_from_io($fh); does_ok($iter, 'Attean::API::Iterator'); my $t1 = $iter->next; my $t2 = $iter->next; is($t1->object->value, 'Alice'); is($t2->object->value, 'http://example.org/#bob'); my $qt = $t2->subject; ok($qt->does('Attean::API::Triple')); is($qt->object->value, 'Alice'); }; subtest 'Turtle-star annotated triples' => sub { my $turtle = <<"END"; PREFIX : :s :p :o {| :r :z |} . END open(my $fh, '<', \$turtle); my $parser = Attean->get_parser('Turtle')->new(); my $iter = $parser->parse_iter_from_io($fh); does_ok($iter, 'Attean::API::Iterator'); my $t1 = $iter->next; my $t2 = $iter->next; is($t1->object->value, 'http://example/o'); is($t2->object->value, 'http://example/z'); my $qt = $t2->subject; ok($qt->does('Attean::API::Triple')); is($qt->object->value, 'http://example/o'); }; done_testing(); sub expect { my $token = shift; my $type = shift; my $values = shift; my $name = shift // ''; if (length($name)) { $name = "${name}: "; } is($token->type, $type, "${name}token type"); is_deeply($token->args, $values, "${name}token values"); } Attean-0.034/t/simple-eval.t000644 000765 000024 00000045576 14250725001 015706 0ustar00gregstaff000000 000000 use Test::Modern; use Test::Exception; use v5.14; use warnings; no warnings 'redefine'; use Test::LWP::UserAgent; use Attean parsers => ['Turtle']; use Attean::RDF; use Attean::SimpleQueryEvaluator; { my $store = Attean->get_store('Memory')->new(); my $model = Attean::MutableQuadModel->new( store => $store ); my $graph = Attean::IRI->new('http://example.org/graph'); { my $data = <<"END"; _:a _:a . . 2, 3 . END $model->load_triples('turtle', $graph, $data); } my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => $graph ); isa_ok($e, 'Attean::SimpleQueryEvaluator'); my $active_graph = $graph; { my $t = Attean::TriplePattern->new(map { variable($_) } qw(s p o)); my $bgp = Attean::Algebra::BGP->new( triples => [$t] ); does_ok($bgp, 'Attean::API::Algebra'); my $iter = $e->evaluate($bgp, $active_graph); my $count = 0; while (my $r = $iter->next) { $count++; does_ok($r, 'Attean::API::Result'); my $s = $r->value('s'); is($s->value, 'a'); my $p = $r->value('p'); does_ok($p, 'Attean::API::IRI'); like($p->value, qr/^[bc]$/); } is($count, 4); } { my $t1 = Attean::TriplePattern->new(iri('a'), iri('b'), variable('o1')); my $t2 = Attean::TriplePattern->new(iri('a'), iri('c'), variable('o2')); my $bgp = Attean::Algebra::BGP->new( triples => [$t1, $t2] ); does_ok($bgp, 'Attean::API::Algebra'); my $iter = $e->evaluate($bgp, $active_graph); my $count = 0; while (my $r = $iter->next) { $count++; like($r->as_string, qr[{o1=, o2="[23]"\^\^}]); } is($count, 2); } } { my $g = iri('g'); my $store = Attean->get_store('Memory')->new(); my $model = Attean::MutableQuadModel->new( store => $store ); { my $data = <<"END";

.

.

. . "0"^^ . "1"^^ . "2"^^ . "07"^^ . END $model->load_triples('nquads', $g, $data); } { note('Project'); my $t = triplepattern(variable('s'), iri('q'), variable('o')); my $b = Attean::Algebra::BGP->new( triples => [$t] ); my $p = Attean::Algebra::Project->new( children => [$b], variables => [variable('s')] ); my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => $g ); my $iter = $e->evaluate($p, $g); my @subj = $iter->elements; is(scalar(@subj), 1, 'expected project count'); my ($r) = @subj; does_ok($r, 'Attean::API::Result'); is_deeply([$r->variables], ['s'], 'expected projection variable'); } { note('Distinct'); my $t = triplepattern(variable('s'), variable('p'), variable('o')); my $b = Attean::Algebra::BGP->new( triples => [$t] ); my $p = Attean::Algebra::Project->new( children => [$b], variables => [variable('p')] ); my $d = Attean::Algebra::Distinct->new( children => [$p] ); my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => $g ); my $proj = $e->evaluate($p, $g); my @ppreds = $proj->elements; is(scalar(@ppreds), 4, 'pre-distinct projected count'); my $dist = $e->evaluate($d, $g); my @dpreds = $dist->elements; is(scalar(@dpreds), 2, 'post-distinct projected count'); my %preds = map { $_->value('p')->value => 1 } @dpreds; is_deeply(\%preds, { 'p' => 1, 'q' => 1 }); } { note('Filter'); my $t = triplepattern(variable('s'), variable('p'), variable('o')); my $bgp = Attean::Algebra::BGP->new( triples => [$t] ); my $expr = Attean::ValueExpression->new( value => variable('o') ); my $f = Attean::Algebra::Filter->new( children => [$bgp], expression => $expr ); my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => $g ); my $iter = $e->evaluate($f, iri('ints')); my @quads = $iter->elements; is(scalar(@quads), 3, 'filter count'); my @values = sort { $a <=> $b } map { 0+($_->value('o')->value) } @quads; is_deeply(\@values, [1, 2, 7]); } { note('IRI Graph'); my $t = triplepattern(variable('s'), iri('values'), variable('o')); my $bgp = Attean::Algebra::BGP->new( triples => [$t] ); my $graph = Attean::Algebra::Graph->new( children => [$bgp], graph => iri('ints') ); my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => $g ); my $iter = $e->evaluate($graph, $g); my @quads = $iter->elements; is(scalar(@quads), 4, 'graph count'); my @values = sort { $a <=> $b } map { 0+($_->value('o')->value) } @quads; is_deeply(\@values, [0, 1, 2, 7]); } { note('Variable Graph'); my $t = triplepattern(variable('s'), iri('values'), variable('o')); my $bgp = Attean::Algebra::BGP->new( triples => [$t] ); my $graph = Attean::Algebra::Graph->new( children => [$bgp], graph => variable('graph') ); my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => $g ); my $iter = $e->evaluate($graph, $g); my @quads = $iter->elements; is(scalar(@quads), 4, 'graph count'); my ($r) = @quads; does_ok($r, 'Attean::API::Result'); my $gt = $r->value('graph'); does_ok($gt, 'Attean::API::Term'); is($gt->value, 'ints'); } { note('Join'); my $t1 = triplepattern(iri('a'), iri('p'), variable('o')); my $bgp1 = Attean::Algebra::BGP->new( triples => [$t1] ); my $t2 = triplepattern(variable('o'), iri('p'), iri('c')); my $bgp2 = Attean::Algebra::BGP->new( triples => [$t2] ); my $j = Attean::Algebra::Join->new( children => [$bgp1, $bgp2] ); my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => $g ); my $iter = $e->evaluate($j, $g); my @results = $iter->elements; is(scalar(@results), 1, 'expected result count'); my ($r) = @results; does_ok($r, 'Attean::API::Result'); my $term = $r->value('o'); is($term->value, 'b'); } { note('Slice'); my $t = triplepattern(variable('s'), variable('p'), variable('o')); my $b = Attean::Algebra::BGP->new( triples => [$t] ); my $s_o = Attean::Algebra::Slice->new( children => [$b], offset => 1 ); my $s_l = Attean::Algebra::Slice->new( children => [$b], limit => 1 ); my $s_ol = Attean::Algebra::Slice->new( children => [$b], limit => 1, offset => 1 ); my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => $g ); my @r_o = $e->evaluate($s_o, $g)->elements; my @r_l = $e->evaluate($s_l, $g)->elements; my @r_ol = $e->evaluate($s_ol, $g)->elements; is(scalar(@r_o), 3, 'offset count'); is(scalar(@r_l), 1, 'limit count'); is(scalar(@r_ol), 1, 'offset/limit count'); } { note('Order'); my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => $g ); my $sort_by = sub { my $algebra = shift; my @cmps; while (scalar(@_)) { my ($variable, $asc) = splice(@_, 0, 2); my $expr = Attean::ValueExpression->new( value => variable($variable) ); my $cmp = Attean::Algebra::Comparator->new( expression => $expr, ascending => $asc ); push(@cmps, $cmp); } return Attean::Algebra::OrderBy->new( children => [$algebra], comparators => \@cmps ); }; my $b = Attean::Algebra::BGP->new( triples => [triplepattern(variable('s'), variable('p'), variable('o'))] ); { my $order_o = $sort_by->( $b, 'o', 1 ); my @rows_o = $e->evaluate($order_o, $g)->elements; my @values_o = map { $_->value('o')->value } @rows_o; is_deeply(\@values_o, [qw(b c d e)], 'ORDER ascending'); } { my $order_o = $sort_by->( $b, 'o', 0 ); my @rows_o = $e->evaluate($order_o, $g)->elements; my @values_o = map { $_->value('o')->value } @rows_o; is_deeply(\@values_o, [qw(e d c b)], 'ORDER descending'); } { my $order_so = $sort_by->( $b, 's' => 1, 'o' => 0 ); my @rows_so = $e->evaluate($order_so, $g)->elements; my @values_so = map { [$_->value('s')->value, $_->value('o')->value] } @rows_so; is_deeply(\@values_so, [[qw(a b)], [qw(b c)], [qw(c e)], [qw(c d)]], 'ORDER mixed'); # foreach my $r (@rows_so) { say $r->as_string } } } { note('ZeroOrOnePath'); my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => $g ); { # ? ?o my $pred = Attean::Algebra::PredicatePath->new( predicate => iri('q') ); my $pp = Attean::Algebra::ZeroOrOnePath->new( children => [ $pred ] ); my $path = Attean::Algebra::Path->new( subject => iri('a'), path => $pp, object => variable('o') ); my $iter = $e->evaluate($path, $g); my @rows = $iter->elements; is(scalar(@rows), 1); is($rows[0]->value('o')->value, 'a'); } { # ?s ? my $pred = Attean::Algebra::PredicatePath->new( predicate => iri('q') ); my $pp = Attean::Algebra::ZeroOrOnePath->new( children => [ $pred ] ); my $path = Attean::Algebra::Path->new( subject => variable('s'), path => $pp, object => iri('c') ); my $iter = $e->evaluate($path, $g); my @rows = $iter->elements; is(scalar(@rows), 1); is($rows[0]->value('s')->value, 'c'); } { # ? my $pred = Attean::Algebra::PredicatePath->new( predicate => iri('q') ); my $pp = Attean::Algebra::ZeroOrOnePath->new( children => [ $pred ] ); my $path = Attean::Algebra::Path->new( subject => iri('c'), path => $pp, object => iri('c') ); my $iter = $e->evaluate($path, $g); my @rows = $iter->elements; is(scalar(@rows), 1); is_deeply([$rows[0]->variables], []); } { # ? my $pred = Attean::Algebra::PredicatePath->new( predicate => iri('q') ); my $pp = Attean::Algebra::ZeroOrOnePath->new( children => [ $pred ] ); my $path = Attean::Algebra::Path->new( subject => iri('c'), path => $pp, object => iri('d') ); my $iter = $e->evaluate($path, $g); my @rows = $iter->elements; is(scalar(@rows), 0); } { # ?s ? ?o my $pred = Attean::Algebra::PredicatePath->new( predicate => iri('q') ); my $pp = Attean::Algebra::ZeroOrOnePath->new( children => [ $pred ] ); my $path = Attean::Algebra::Path->new( subject => variable('s'), path => $pp, object => variable('o') ); my $iter = $e->evaluate($path, $g); my @rows = $iter->elements; is(scalar(@rows), 6); } } { note('NegatedPropertySet'); my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => $g ); { # !

?o my $pp = Attean::Algebra::NegatedPropertySet->new( predicates => [iri('p')] ); my $path = Attean::Algebra::Path->new( subject => iri('c'), path => $pp, object => variable('o') ); my $iter = $e->evaluate($path, $g); my @rows = $iter->elements; is(scalar(@rows), 1); is($rows[0]->value('o')->value, 'e'); } } { note('Sequence Path'); my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => $g ); { #

/ ?o my $p1 = Attean::Algebra::PredicatePath->new( predicate => iri('p') ); my $p2 = Attean::Algebra::PredicatePath->new( predicate => iri('q') ); my $pp = Attean::Algebra::SequencePath->new( children => [ $p1, $p2 ] ); my $path = Attean::Algebra::Path->new( subject => iri('b'), path => $pp, object => variable('o') ); my $iter = $e->evaluate($path, $g); my @rows = $iter->elements; is(scalar(@rows), 1); is($rows[0]->value('o')->value, 'e'); } } { note('BIND'); my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => $g ); { my $t = triplepattern(variable('s'), variable('p'), variable('o')); my $b = Attean::Algebra::BGP->new( triples => [$t] ); my $expr = Attean::ValueExpression->new( value => variable('o') ); my $extend = Attean::Algebra::Extend->new(children => [$b], variable => variable('x'), expression => $expr); my $iter = $e->evaluate($extend, $g); my @rows = $iter->elements; is(scalar(@rows), 4); like($rows[0]->value('x')->value, qr'^[bcde]$'); } } { note('CONSTRUCT'); my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => $g ); { my $t = triplepattern(variable('s'), iri('q'), variable('o')); my $u = triplepattern(variable('o'), iri('qqq'), variable('s')); my $b = Attean::Algebra::BGP->new( triples => [$t] ); my $c = Attean::Algebra::Construct->new( children => [$b], triples => [$u] ); my $iter = $e->evaluate($c, $g); my @rows = $iter->elements; is(scalar(@rows), 1); is($rows[0]->as_string, ' .'); } } { note('CAST'); my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => $g ); { my $t = triplepattern(variable('s'), iri('values'), variable('o')); my $bgp = Attean::Algebra::BGP->new( triples => [$t] ); my $graph = Attean::Algebra::Graph->new( children => [$bgp], graph => iri('ints') ); my $var = Attean::ValueExpression->new( value => variable('o') ); my $expr = Attean::CastExpression->new( children => [$var], datatype => iri('http://www.w3.org/2001/XMLSchema#decimal') ); my $extend = Attean::Algebra::Extend->new(children => [$graph], variable => variable('x'), expression => $expr); my $iter = $e->evaluate($extend, $g); my @rows = $iter->elements; is(scalar(@rows), 4); foreach my $r (@rows) { is($r->value('x')->datatype->value, 'http://www.w3.org/2001/XMLSchema#decimal', 'decimal datatype'); like($r->value('x')->value, qr/^[0127]\.0$/, 'decimal value'); } } } } { my $store = Attean->get_store('Memory')->new(); my $model = Attean::MutableQuadModel->new( store => $store ); { my $data = <<'END'; @prefix ex: . @prefix in: . in:a ex:p1 in:b . in:b ex:p2 in:c . in:a ex:p1 in:d . in:d ex:p2 in:c . END $model->load_triples('turtle', iri('pp11'), $data); } { my $data = <<'END'; @prefix : . @prefix foaf: . :a foaf:knows :b . :b foaf:knows :c . END $model->load_triples('turtle', iri('pp14'), $data); } { # pp14 my $p1 = Attean::Algebra::PredicatePath->new( predicate => iri('http://xmlns.com/foaf/0.1/knows') ); my $pp = Attean::Algebra::ZeroOrMorePath->new( children => [$p1] ); my $path = Attean::Algebra::Path->new( subject => variable('X'), path => $pp, object => variable('Y') ); my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => iri('pp14') ); my $iter = $e->evaluate($path, iri('pp14')); my @rows = $iter->elements; is(scalar(@rows), 6); my @expected = ( q(a a), q(a b), q(a c), q(b b), q(b c), q(c c), ); my @got; foreach my $r (@rows) { my $str = join(' ', map { $r->value($_)->value } qw(X Y)); $str =~ s#http://example.org/##g; push(@got, $str); } is_deeply([sort @got], \@expected); # while (my $q = $iter->next) { say $q->as_string } } # { # # pp12 # my $p1 = Attean::Algebra::PredicatePath->new( predicate => iri('http://www.example.org/schema#p1') ); # my $p2 = Attean::Algebra::PredicatePath->new( predicate => iri('http://www.example.org/schema#p2') ); # my $seq = Attean::Algebra::SequencePath->new( children => [$p1, $p2] ); # my $pp = Attean::Algebra::OneOrMorePath->new( children => [$seq] ); # my $path = Attean::Algebra::Path->new( subject => iri('http://www.example.org/instance#a'), path => $pp, object => variable('x') ); # my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => iri('pp11') ); # my $iter = $e->evaluate($path, iri('pp11')); # while (my $q = $iter->next) { say $q->as_string } # } { note('Service'); my $ua = Test::LWP::UserAgent->new(); $ua->map_response(qr{example.org/sparql}, HTTP::Response->new('200', 'OK', ['Content-Type' => 'application/sparql-results+xml'], <<'XML')); http://example.org/s4 http://example.org/p 4 http://example.org/s3 http://example.org/p 3 XML my $g = iri('g'); my $ep = iri('http://example.org/sparql'); my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => $g, user_agent => $ua ); my $t = triplepattern(variable('s'), variable('p'), variable('o')); my $bgp = Attean::Algebra::BGP->new( triples => [$t] ); my $algebra = Attean::Algebra::Service->new( endpoint => $ep, children => [$bgp], ); my $iter = $e->evaluate($algebra, $g); my @results = $iter->elements; is(scalar(@results), 2, 'expected result count'); my @objects = sort { $a <=> $b } map { $_->value('o')->value } @results; is_deeply(\@objects, [3,4], 'expected values'); } } { my $store = Attean->get_store('Memory')->new(); my $model = Attean::MutableQuadModel->new( store => $store ); my $graph = Attean::IRI->new('http://example.org/graph'); { my $data = <<'END'; @prefix test: . @prefix deps: . @prefix httph: . @prefix http: . @prefix nfo: . @prefix : . :test_list a test:FixtureTable ; test:fixtures :public_writeread_unauthn_alt . :public_writeread_unauthn_alt a test:AutomatedTest ; test:purpose "More elaborate HTTP vocab for PUT then GET test"@en ; test:test_script ; test:params [ test:steps ( [ test:request :public_writeread_unauthn_alt_put_req ; test:response_assertion :public_writeread_unauthn_alt_put_res ] [ test:request :public_writeread_unauthn_alt_get_req ; test:response_assertion :public_writeread_unauthn_alt_get_res ] ) ] . END $model->load_triples('turtle', $graph, $data); } my $active_graph = $graph; my $test = URI::Namespace->new('http://ontologi.es/doap-tests#'); my $b = $model->objects(undef, iri('http://www.w3.org/1999/02/22-rdf-syntax-ns#first'))->next(); my $t1 = triplepattern($b, iri($test->request->as_string), variable('request')); my $t2 = triplepattern($b, iri($test->response_assertion->as_string), variable('response_assertion')); my $bgp = bgp($t1, $t2); { my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => $graph, ground_blanks => 0 ); my $iter = $e->evaluate($bgp, $graph); my @v = $iter->elements; is(scalar(@v), 2); } { my $e = Attean::SimpleQueryEvaluator->new( model => $model, default_graph => $graph, ground_blanks => 1 ); my $iter = $e->evaluate($bgp, $graph); my @v = $iter->elements; is(scalar(@v), 1); } } done_testing(); Attean-0.034/t/PaxHeader/http-negotiation.t000644 000765 000024 00000006503 14525575742 020745 xustar00gregstaff000000 000000 30 mtime=1700199394.238321573 1830 LIBARCHIVE.xattr.com.apple.ResourceFork=AAABAAAABQgAAAQIAAAAMgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAQAAAAZL0FwcGxpY2F0aW9ucy9CQkVkaXQuYXBwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAUIAAAECAAAADILAAAAYBAAAAAcADIAAHVzcm8AAAAKAAD//wAAAAAGAAAA 1380 SCHILY.xattr.com.apple.ResourceFork=2/Applications/BBEdit.app2 `2usro ÿÿ 85 LIBARCHIVE.xattr.com.apple.FinderInfo=VEVYVAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 70 SCHILY.xattr.com.apple.FinderInfo=TEXT Attean-0.034/t/http-negotiation.t000644 000765 000024 00000006513 14525575742 016775 0ustar00gregstaff000000 000000 use v5.14; use autodie; use utf8; use Test::More; use Test::Exception; use Attean; { my %negotiate_expect = ( "text/plain" => [qr'AtteanX::Serializer::.*NTriples', 'text/plain'], "application/rdf+xml;q=0,text/plain;q=1" => [qr'AtteanX::Serializer::.*NTriples', 'text/plain'], # Allow both NTriples and CanonicalNTriples # "application/rdf+xml" => ['RDFXML', 'application/rdf+xml'], # "image/jpeg;q=1,application/rdf+xml;q=0.5" => ['RDFXML', 'application/rdf+xml'], # "application/rdf+xml;q=1,text/plain" => ['RDFXML', 'application/rdf+xml'], # "application/rdf+xml;q=0.5,text/turtle;q=0.7,text/xml" => ['Turtle', 'text/turtle'], # "application/x-turtle;q=1,text/turtle;q=0.7" => ['Turtle', 'application/x-turtle'], ); while (my ($accept,$data) = each(%negotiate_expect)) { my ($sregex, $etype) = @$data; my $h = new HTTP::Headers; $h->header(Accept => $accept); my ($type, $s) = Attean->negotiate_serializer( request_headers => $h ); is( $type, $etype, "expected media type for $sregex serialization is $etype" ); unless (like( $s, $sregex, "HTTP negotiated $sregex serializer" )) { warn "# $accept"; } } } { my $h = new HTTP::Headers; $h->header(Accept=>"application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,*/*;0.5"); my ($type, $s) = Attean->negotiate_serializer( request_headers => $h ); ok ( $type, "choose some serializer for Accept: */*: $type" ); } { my $h = new HTTP::Headers; $h->header(Accept=>"application/rdf+xml;q=1,text/plain;q=0.7"); my ($type, $s) = Attean->negotiate_serializer( request_headers => $h, restrict => [ 'ntriples' ] ); is ( $type, 'text/plain', 'choose less wanted serializer with restrict option' ); } { my $h = new HTTP::Headers; $h->header(Accept=>"application/xhtml+xml;q=0.8,text/plain;q=0.9,text/turtle;q=0.7"); my ($type, $s) = Attean->negotiate_serializer( request_headers => $h, restrict => [ 'ntriples' ], extend => { 'text/html' => 'html', 'application/xhtml+xml' => 'xhtml', }, ); is( $type, 'application/xhtml+xml', "negotiation with both 'restrict' restriction and 'extend' custom type" ); is( $s, 'xhtml', 'negotiation custom type thunk' ); } { my $h = new HTTP::Headers; $h->header(Accept=>"application/rdf+xml;q=0.9,text/turtle;q=0.7"); my ($type, $s) = Attean->negotiate_serializer( request_headers => $h, extend => { 'application/rdf+xml' => 'rdfxml', }, ); is($type, 'application/rdf+xml', 'extended negotiation with media type collision'); is($s, 'rdfxml', 'extended negotiation with media type collision'); } my %negotiate_fail = ( "image/jpeg" => undef, "application/rdf+xml" => ['turtle','rdfjson'] ); while (my ($accept,$restrict) = each(%negotiate_fail)) { dies_ok { my $h = new HTTP::Headers; $h->header(Accept => $accept); my ($type, $s) = Attean->negotiate_serializer( request_headers => $h, restrict => $restrict ); } "HTTP negotiated serialization throws on unknown/unwanted media type $accept"; } { my ($sname, $etype) = (); my $h = new HTTP::Headers; $h->header(Accept => ""); my ($type, $s) = Attean->negotiate_serializer( request_headers => $h ); use Data::Dumper; like( $type, qr'^((application/n-triples)|(text/plain))$', "expected media type with empty accept header" ) or die Dumper($type, $s); like($s, qr/^AtteanX::Serializer::.*NTriples$/, "HTTP negotiated empty accept header to proper serializer" ); } done_testing(); Attean-0.034/t/export-functions.t000644 000765 000024 00000002727 13406772446 017027 0ustar00gregstaff000000 000000 use Test::Modern; use v5.14; use warnings; use Attean; use Attean::RDF; ok(my $vfoo = variable('foo'), 'Variable ?foo assignment OK'); isa_ok($vfoo, 'Attean::Variable'); does_ok($vfoo, 'Attean::API::Variable'); is($vfoo->value, 'foo', 'Variable ?foo has name'); ok(my $vbar = variable('bar'), 'Variable ?bar assignment OK'); ok(my $prop = iri('http://example.org/prop'), 'Variable iri prop assignment OK'); isa_ok($prop, 'Attean::IRI'); does_ok($prop, 'Attean::API::Term'); is($prop->value, 'http://example.org/prop', 'Variable iri prop has iri'); ok(my $t1 = triplepattern($vfoo, $prop, $vbar), 'Variable triplepattern Assignment OK'); isa_ok($t1, 'Attean::TriplePattern'); does_ok($t1, 'Attean::API::TriplePattern'); is($t1->as_string, '?foo ?bar .', 'Pattern string OK'); ok(my $lit = literal('Foobar'), 'Variable literal assignment OK'); isa_ok($lit, 'Attean::Literal'); does_ok($prop, 'Attean::API::Term'); is($lit->value, 'Foobar', 'Literal string OK'); ok(my $t2 = triplepattern($vbar, iri('http://example.org/prop2'), $lit), 'Variable triplepattern 2 assignment OK'); is($t2->as_string, '?bar "Foobar" .', 'Pattern string OK'); ok(my $bgp = bgp($t1, $t2), 'Variable bgp assignment OK'); isa_ok($bgp, 'Attean::Algebra::BGP'); does_ok($bgp, 'Attean::API::Algebra'); is($bgp->as_string, "- BGP { ?foo ?bar ., ?bar \"Foobar\" . }\n", 'Pattern string OK'); done_testing; Attean-0.034/t/PaxHeader/iter.t000644 000765 000024 00000000224 13760013063 016364 xustar00gregstaff000000 000000 29 mtime=1606424115.20679222 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/t/iter.t000644 000765 000024 00000015627 13760013063 014430 0ustar00gregstaff000000 000000 use Test::Modern; use Test::Exception; use v5.14; use warnings; no warnings 'redefine'; use Attean; use Attean::RDF; use Type::Tiny; use Types::Standard qw(Int); { note('ListIterator[Attean::Triple]'); my $s = Attean::Blank->new('x'); my $p = Attean::IRI->new('http://example.org/p'); my $o1 = Attean::Literal->new(value => '1', datatype => 'http://www.w3.org/2001/XMLSchema#integer'); my $o2 = Attean::Literal->new(value => '2', datatype => 'http://www.w3.org/2001/XMLSchema#integer'); my $t1 = Attean::Triple->new($s, $p, $o1); my $t2 = Attean::Triple->new($s, $p, $o2); my $i = Attean::ListIterator->new(values => [$t1, $t2], item_type => 'Attean::API::Triple'); does_ok($i, 'Attean::API::Iterator'); isa_ok($i, 'Attean::ListIterator'); my $x1 = $i->next; does_ok($x1, 'Attean::API::Triple'); my $x2 = $i->next; does_ok($x2, 'Attean::API::Triple'); is($i->next, undef, 'eof'); } { note('ListIterator[Term != Triple]'); my $p = Attean::IRI->new('http://example.org/p'); my $g = Attean::IRI->new('http://example.org/g'); dies_ok { my $i = Attean::ListIterator->new(values => [$p, $g], item_type => 'Attean::API::Triple'); }; } { note('ListIterator[Int != Triple]'); dies_ok { my $i = Attean::ListIterator->new(values => [1, 2, 3], item_type => 'Attean::API::Triple'); }; } { note('CodeIterator[Int]->map'); my $value = 0; my $code = sub { return ++$value }; my $iter = Attean::CodeIterator->new( generator => $code, item_type => 'Int' ); is($iter->next, 1, 'expected value'); is($iter->next, 2, 'expected value'); is($iter->next, 3, 'expected value'); my $double = $iter->map(sub { $_ * 2 }); does_ok($double, 'Attean::API::Iterator'); is($double->item_type, 'Int', 'expected item_type'); is($double->next, 8, 'expected value'); is($double->next, 10, 'expected value'); } { note('CodeIterator[Int] with generator producing multiple items'); my $value = 0; my $code = sub { my @list = ($value+1, $value+2); $value += 2; return @list; }; my $iter = Attean::CodeIterator->new( generator => $code, item_type => 'Int' ); is($iter->next, 1, 'expected value'); is($iter->next, 2, 'expected value'); is($iter->next, 3, 'expected value'); } { note('CodeIterator[Int]->map'); my $value = 0; my $code = sub { return ++$value }; my $iter = Attean::CodeIterator->new( generator => $code, item_type => 'Int' ); my $ints = $iter->map( sub { Attean::Literal->new(value => $_, datatype => 'http://www.w3.org/2001/XMLSchema#integer') }, 'Attean::API::Literal' ); does_ok($ints, 'Attean::API::Iterator'); is($ints->item_type, 'Attean::API::Literal', 'expected item_type'); my $l1 = $ints->next; does_ok($l1, 'Attean::API::Literal'); is($l1->value, '1', 'expected value'); is($l1->datatype->value, 'http://www.w3.org/2001/XMLSchema#integer', 'expected literal datatype'); my $l2 = $ints->next; does_ok($l2, 'Attean::API::Literal'); is($l2->value, '2', 'expected value'); } { note('ListIterator[Int]->grep'); my $value = 0; my $iter = Attean::ListIterator->new(values => [1, 2, 3, 4, 5], item_type => 'Int'); my $evens = $iter->grep(sub { $_ % 2 == 0 }); does_ok($evens, 'Attean::API::Iterator'); is($evens->item_type, 'Int', 'expected item_type'); is($evens->next, 2, 'expected value'); is($evens->next, 4, 'expected value'); is($evens->next, undef, 'expected eof'); } { note('ListIterator[Term]->uniq'); my $value = 0; my $iter = Attean::ListIterator->new(values => [map { Attean::Literal->integer($_) } (1, 1, 2, 3, 2, 4, 4, 5, 4, 4, 4)], item_type => 'Attean::API::Term'); my $uniq = $iter->uniq(); does_ok($uniq, 'Attean::API::Iterator'); is($uniq->item_type, 'Attean::API::Term', 'expected item_type'); my @elements = map { int($_->value) } $uniq->elements(); is_deeply(\@elements, [1,2,3,4,5]); } { note('CodeIterator[Int] slice'); my $value = 0; my $code = sub { return ++$value }; my $iter = Attean::CodeIterator->new(generator => $code, item_type => 'Int')->offset(5)->limit(5); does_ok($iter, 'Attean::API::Iterator'); is($iter->item_type, 'Int', 'expected item_type'); is($iter->next, 6, 'expected value'); is($iter->next, 7, 'expected value'); is($iter->next, 8, 'expected value'); is($iter->next, 9, 'expected value'); is($iter->next, 10, 'expected value'); is($iter->next, undef, 'expected eof'); } { note('ListIterator[Int] reset'); my $value = 0; my $code = sub { return ++$value }; my $iter = Attean::ListIterator->new(values => [1, 2], item_type => 'Int'); does_ok($iter, 'Attean::API::RepeatableIterator'); is($iter->next, 1, 'expected value'); is($iter->next, 2, 'expected value'); $iter->reset; is($iter->next, 1, 'expected value after reset'); is($iter->next, 2, 'expected value'); is($iter->next, undef, 'expected eof'); } { note('ListIterator[Mixed] as_quads'); my $t = triple(blank('eve'), iri('http://xmlns.com/foaf/0.1/name'), literal('Eve')); my $q = quad(blank('eve'), iri('http://xmlns.com/foaf/0.1/name'), literal('Eve'), iri('graph')); my $iter = Attean::ListIterator->new(values => [$t, $q], item_type => 'Attean::API::TripleOrQuad'); does_ok($iter, 'Attean::API::MixedStatementIterator'); my $quads = $iter->as_quads(iri('default')); does_ok($quads, 'Attean::API::QuadIterator'); is($quads->next->as_string, '_:eve "Eve" .', 'expected triple coerced to quad'); is($quads->next->as_string, '_:eve "Eve" .', 'expected quad'); is($iter->next, undef, 'expected eof'); } { note('ListIterator[Mixed]->uniq'); my $t = triple(blank('eve'), iri('http://xmlns.com/foaf/0.1/name'), literal('Eve')); my $q = quad(blank('eve'), iri('http://xmlns.com/foaf/0.1/name'), literal('Eve'), iri('graph')); my $iter = Attean::ListIterator->new(values => [$t, $q, $t, $q, $t], item_type => 'Attean::API::TripleOrQuad'); my $uniq = $iter->uniq(); does_ok($uniq, 'Attean::API::Iterator'); is($uniq->item_type, 'Attean::API::TripleOrQuad', 'expected item_type'); my @elements = map { $_->as_string } $uniq->elements(); is_deeply(\@elements, ['_:eve "Eve" .', '_:eve "Eve" .']); } { note('CodeIterator[Triple] with non-Triple scalar items'); my $code = sub { return 'Hello'; }; my $iter = Attean::CodeIterator->new( generator => $code, item_type => 'Attean::API::Triple' ); dies_ok { $iter->next } 'expected failure'; } { note('CodeIterator[Triple] with non-Triple object items'); my $value = 0; my $code = sub { return Attean::Literal->integer(++$value); }; my $iter = Attean::CodeIterator->new( generator => $code, item_type => 'Attean::API::Triple' ); dies_ok { $iter->next } 'expected failure'; } { my $iter = Attean::IteratorSequence->new( item_type => 'Int' ); $iter->push(Attean::ListIterator->new(values => [1, 2], item_type => 'Int')); $iter->push(Attean::ListIterator->new(values => [3, 4], item_type => 'Int')); my @ints = $iter->elements; is_deeply(\@ints, [1..4], 'IteratorSequence push'); } done_testing(); Attean-0.034/t/serializer-rdfxml.t000644 000765 000024 00000016134 12711557166 017136 0ustar00gregstaff000000 000000 use Test::Modern; use Test::Exception; use utf8; use v5.14; use warnings; use Encode qw(decode); no warnings 'redefine'; use Attean; use Attean::RDF; use Type::Tiny::Role; subtest 'serializer construction and metadata' => sub { my $ser = Attean->get_serializer('RDFXML')->new(); does_ok($ser, 'Attean::API::Serializer'); isa_ok($ser, 'AtteanX::Serializer::RDFXML'); is($ser->canonical_media_type, 'application/rdf+xml', 'canonical_media_type'); my %types = map { $_ => 1 } @{ $ser->media_types }; ok(exists $types{'application/rdf+xml'}, 'media_types'); my $type = $ser->handled_type; can_ok($type, 'role'); is($type->role, 'Attean::API::Triple'); my %extensions = map { $_ => 1 } @{ $ser->file_extensions }; ok(exists $extensions{'rdf'}, 'file_extensions'); }; my $constraint = 'Attean::API::Triple'; my $s = blank('x'); my $t = blank('y'); my $p = iri('http://example.org/p'); my $q = iri('http://example.org/q'); my $r = iri('http://example.org/r'); my $o1 = Attean::Literal->integer(1); my $o2 = Attean::Literal->integer(2); my $o3 = Attean::Literal->new(value => '3'); my $o4 = Attean::Literal->new(value => 'ç«æ˜Ÿ', language => 'ja'); my $t1 = triple($s, $p, $o1); my $t2 = triple($s, $p, $o2); my $t3 = triple($s, $q, $o3); my $t4 = triple($t, $r, $o4); subtest 'RDF/XML with object-list' => sub { my $ser = Attean->get_serializer('RDFXML')->new(); does_ok($ser, 'Attean::API::Serializer'); does_ok($ser, 'Attean::API::TripleSerializer'); isa_ok($ser, 'AtteanX::Serializer::RDFXML'); my $expected = <<'END'; 1 2 END { my $i = Attean::ListIterator->new(values => [$t1, $t2], item_type => $constraint); my $data1 = $ser->serialize_iter_to_bytes($i); my $data2 = $ser->serialize_list_to_bytes($t1, $t2); is($data1, $expected, 'serialize_iter_to_bytes'); is($data1, $data2, 'serialize_list_to_bytes'); } { my $i = Attean::ListIterator->new(values => [$t1, $t2], item_type => $constraint); my $data = ''; open(my $fh, '>', \$data); $ser->serialize_iter_to_io($fh, $i); close($fh); is($data, $expected, 'serialize_iter_to_io'); } { my $i = Attean::ListIterator->new(values => [$t1, $t2], item_type => $constraint); my $data = ''; open(my $fh, '>', \$data); $ser->serialize_list_to_io($fh, $t1, $t2); close($fh); is($data, $expected, 'serialize_iter_to_io'); } }; subtest 'RDF/XML with predicate-object list' => sub { my $ser = Attean->get_serializer('RDFXML')->new(); my $expected = <<'END'; 1 2 3 ç«æ˜Ÿ END my $i = Attean::ListIterator->new(values => [$t1, $t2, $t3, $t4], item_type => $constraint); my $data1 = $ser->serialize_iter_to_bytes($i); my $data2 = $ser->serialize_list_to_bytes($t1, $t2, $t3, $t4); my $string1 = decode('UTF-8', $data1, Encode::FB_CROAK); my $string2 = decode('UTF-8', $data2, Encode::FB_CROAK); is($string1, $expected, 'serialize_iter_to_bytes'); is($string1, $string2, 'serialize_list_to_bytes'); }; subtest 'RDF/XML with prefix namespace declaration' => sub { my $map = URI::NamespaceMap->new( { foaf => iri('http://xmlns.com/foaf/0.1/') } ); my $ser = Attean->get_serializer('RDFXML')->new( namespaces => $map ); my $expected = <<'END'; 1 2 END my $iter = Attean::ListIterator->new(values => [$t1, $t2], item_type => 'Attean::API::Triple'); my $rdfxml = $ser->serialize_iter_to_bytes($iter); is($rdfxml, $expected, 'serialize_iter_to_bytes'); }; subtest 'RDF/XML with prefix namespace declaration and use' => sub { my $map = URI::NamespaceMap->new( { ex => iri('http://example.org/') } ); my $ser = Attean->get_serializer('RDFXML')->new( namespaces => $map ); my $expected = <<'END'; 1 2 END my $iter = Attean::ListIterator->new(values => [$t1, $t2], item_type => 'Attean::API::Triple'); my $rdfxml = $ser->serialize_iter_to_bytes($iter); is($rdfxml, $expected, 'serialize_iter_to_bytes'); }; subtest 'AbbreviatingSerializer with explicit namespace map' => sub { my $map = URI::NamespaceMap->new( { foaf => iri('http://xmlns.com/foaf/0.1/') } ); my $p = Attean->get_parser('Turtle')->new(); my $iter = $p->parse_iter_from_bytes('@prefix foaf: . a foaf:Person ; foaf:name "Alice" .'); my $s = Attean->get_serializer('RDFXML')->new( namespaces => $map ); my $bytes = $s->serialize_iter_to_bytes($iter); like($bytes, qr[xmlns:foaf="http://xmlns.com/foaf/0.1/"], 'serialization has prefix declaration'); like($bytes, qr, 'serialization has IRI'); like($bytes, qr/ sub { my $map = URI::NamespaceMap->new(); my $p = Attean->get_parser('Turtle')->new( namespaces => $map ); my $iter = $p->parse_iter_from_bytes('@prefix foaf: . @prefix ex: . a foaf:Person ; foaf:name "Alice" .'); my $s = Attean->get_serializer('RDFXML')->new( namespaces => $map ); my $bytes = $s->serialize_iter_to_bytes($iter); like($bytes, qr[xmlns:ex="http://example.org/"], 'serialization has prefix declaration'); like($bytes, qr[xmlns:foaf="http://xmlns.com/foaf/0.1/"], 'serialization has prefix declaration'); like($bytes, qr, 'serialization has IRI'); like($bytes, qr/list_prefixes], [qw(ex foaf)]); }; done_testing(); sub expect { my $token = shift; my $type = shift; my $values = shift; my $name = shift // ''; if (length($name)) { $name = "${name}: "; } is($token->type, $type, "${name}token type"); is_deeply($token->args, $values, "${name}token values"); } Attean-0.034/t/parser.t000644 000765 000024 00000006030 12705564261 014756 0ustar00gregstaff000000 000000 use v5.14; use autodie; use utf8; use Test::Modern; use Test::Exception; use FindBin qw($Bin); use File::Glob qw(bsd_glob); use File::Spec; use Attean; my $p = Attean->get_parser('Turtle'); is($p, 'AtteanX::Parser::Turtle'); subtest 'all acceptable parsers' => sub { my $accept = Attean->acceptable_parsers(); ok(length($accept), 'got accept header value'); # check to make sure some of the default parsers are present: like($accept, qr'text/turtle'); like($accept, qr'application/rdf[+]xml'); like($accept, qr'text/tab-separated-values'); }; subtest 'acceptable PULL parsers' => sub { my $accept = Attean->acceptable_parsers(prefer => q[pull]); # check to make sure some of the default parsers are present: like($accept, qr'application/n-quads'); like($accept, qr'application/n-triples'); like($accept, qr'text/tab-separated-values'); unlike($accept, qr'application/rdf[+]xml'); }; subtest 'acceptable PUSH parsers' => sub { my $accept = Attean->acceptable_parsers(prefer => q[Attean::API::PushParser]); # check to make sure some of the default parsers are present: like($accept, qr'text/turtle'); like($accept, qr'application/rdf[+]xml'); like($accept, qr'application/sparql-results[+]xml'); unlike($accept, qr'application/n-quads'); unlike($accept, qr'application/n-triples'); unlike($accept, qr'text/tab-separated-values'); }; subtest 'acceptable ATONCE parsers' => sub { my $accept = Attean->acceptable_parsers(prefer => q[AtOnce]); like($accept, qr'application/sparql-results[+]json'); unlike($accept, qr'text/turtle'); unlike($accept, qr'application/n-quads'); unlike($accept, qr'application/n-triples'); }; subtest 'acceptable SPARQL RESULT parsers' => sub { my $accept = Attean->acceptable_parsers(handles => q[result]); like($accept, qr'application/sparql-results[+]json'); like($accept, qr'application/sparql-results[+]xml'); like($accept, qr'text/tab-separated-values'); unlike($accept, qr'text/turtle'); unlike($accept, qr'application/rdf[+]xml'); unlike($accept, qr'application/n-quads'); unlike($accept, qr'application/n-triples'); }; subtest 'acceptable TRIPLE parsers' => sub { my $accept = Attean->acceptable_parsers(handles => q[Attean::API::Triple]); like($accept, qr'application/n-quads'); like($accept, qr'application/n-triples'); like($accept, qr'application/octet-stream'); like($accept, qr'application/x-turtle'); like($accept, qr'application/turtle'); like($accept, qr'text/turtle'); like($accept, qr'application/rdf[+]xml'); unlike($accept, qr'application/sparql-results[+]json'); unlike($accept, qr'application/sparql-results[+]xml'); unlike($accept, qr'text/tab-separated-values'); }; subtest 'parser access by filename' => sub { my $pclass = Attean->get_parser(filename => 'foo.nt'); is($pclass, 'AtteanX::Parser::NTriples'); }; subtest 'parser access by media type' => sub { my $pclass = Attean->get_parser(media_type => 'application/n-triples'); is($pclass, 'AtteanX::Parser::NTriples'); }; dies_ok { Attean->get_parser(foo => 'bar'); } 'bad get_parser argument dies'; done_testing(); Attean-0.034/t/plans.t000644 000765 000024 00000006153 12715007025 014574 0ustar00gregstaff000000 000000 =pod =encoding utf-8 =head1 PURPOSE Tests for various plans =cut use v5.14; use autodie; use utf8; use feature "state"; use Test::Modern; use Test::Exception; use Digest::SHA qw(sha1_hex); use Attean; use Attean::RDF; use Attean::Plan::Iterator; my $ci = Attean::CodeIterator->new( generator => sub { state $i = 0; return undef if ($i > 2); return Attean::Result->new(bindings => { 'o' => literal($i++) }); }, item_type => 'Attean::API::Result', variables => ['o'] ); isa_ok($ci, 'Attean::CodeIterator'); my @values = map { Attean::Result->new(bindings => { 'o' => literal($_) }) } (1,2,3); my $li = Attean::ListIterator->new( values => \@values, item_type => 'Attean::API::Result', variables => ['o'] ); isa_ok($li, 'Attean::ListIterator'); #subtest 'CodeIterator without size' => sub { my $plan = Attean::Plan::Iterator->new( variables => [variable('o')], iterator => $ci, distinct => 0, ordered => [] ); isa_ok($plan, 'Attean::Plan::Iterator'); does_ok($plan, 'Attean::API::Plan'); can_ok($plan, 'iterator'); ok(! $plan->has_size_estimate, 'Has no size estimate'); is($plan->as_string, "- Iterator (?o)\n", 'Correct serialization'); }; #subtest 'CodeIterator with size' => sub { my $plan = Attean::Plan::Iterator->new( variables => [variable('o')], iterator => $ci, distinct => 0, size_estimate => 2, ordered => [] ); isa_ok($plan, 'Attean::Plan::Iterator'); does_ok($plan, 'Attean::API::Plan'); can_ok($plan, 'iterator'); ok($plan->has_size_estimate, 'Has size estimate'); is($plan->size_estimate, 2, 'Correct returned estimate'); is($plan->as_string, "- Iterator (?o with 2 elements)\n", 'Correct serialization'); }; { my $plan = Attean::Plan::Iterator->new( variables => [variable('o')], iterator => $li, distinct => 0, ordered => [] ); isa_ok($plan, 'Attean::Plan::Iterator'); does_ok($plan, 'Attean::API::Plan'); can_ok($plan, 'iterator'); is($plan->size_estimate, 3, 'Correct returned estimate'); ok($plan->has_size_estimate, 'Has size estimate for ListIterator'); is($plan->as_string, "- Iterator (?o with 3 elements)\n", 'Correct serialization'); }; { my $plan = Attean::Plan::Iterator->new( variables => [variable('o')], iterator => $li, distinct => 0, size_estimate => 4, ordered => [] ); isa_ok($plan, 'Attean::Plan::Iterator'); does_ok($plan, 'Attean::API::Plan'); can_ok($plan, 'iterator'); ok($plan->has_size_estimate, 'Has size estimate for ListIterator'); is($plan->size_estimate, 4, 'Correct returned estimate when overriding'); is($plan->as_string, "- Iterator (?o with 4 elements)\n", 'Correct serialization'); }; { my $li = Attean::ListIterator->new( values => \@values, item_type => 'Attean::API::Result', variables => ['o'] ); $li->next; my $store = Attean->get_store('Memory')->new(); my $model = Attean::MutableQuadModel->new( store => $store ); my $plan = Attean::Plan::Iterator->new( variables => [variable('o')], iterator => $li, distinct => 0, ordered => [] ); my $c = $plan->impl($model); isa_ok($c, 'CODE'); my $i = $c->(); does_ok($i, 'Attean::API::Iterator'); my @r = $i->elements; is(scalar(@r), 3); }; done_testing; Attean-0.034/t/parser-sparql-star.t000644 000765 000024 00000013544 14250266232 017227 0ustar00gregstaff000000 000000 use v5.14; use autodie; use utf8; use Test::Modern; use Test::Exception; use FindBin qw($Bin); use File::Glob qw(bsd_glob); use File::Spec; use Attean; use Attean::RDF; use AtteanX::SPARQL::Constants; use Type::Tiny::Role; subtest 'triple-pattern subject' => sub { my $parser = Attean->get_parser('SPARQL')->new(); my $q = $parser->parse("PREFIX foaf: SELECT * WHERE { << ?s a foaf:Person >> foaf:believedBy }"); does_ok($q, 'Attean::API::Algebra'); isa_ok($q, 'Attean::Algebra::Query'); my $p = $q->child; isa_ok($p, 'Attean::Algebra::Project'); my $s = $p->child; isa_ok($s, 'Attean::Algebra::BGP'); my $triples = $s->triples(); is(scalar(@$triples), 1, 'number of triples'); my ($t) = @$triples; isa_ok($t->subject, 'Attean::TriplePattern'); is($t->subject->as_string, '?s .'); is($t->predicate->as_string, 'http://xmlns.com/foaf/0.1/believedBy'); is($t->object->as_string, 'http://kasei.us/about/#greg'); }; subtest 'triple-pattern object' => sub { my $parser = Attean->get_parser('SPARQL')->new(); my $q = $parser->parse("PREFIX foaf: SELECT * WHERE { foaf:believes << ?s a foaf:Person >> }"); does_ok($q, 'Attean::API::Algebra'); isa_ok($q, 'Attean::Algebra::Query'); my $p = $q->child; isa_ok($p, 'Attean::Algebra::Project'); my $s = $p->child; isa_ok($s, 'Attean::Algebra::BGP'); my $triples = $s->triples(); is(scalar(@$triples), 1, 'number of triples'); my ($t) = @$triples; is($t->subject->as_string, 'http://kasei.us/about/#greg'); is($t->predicate->as_string, 'http://xmlns.com/foaf/0.1/believes'); isa_ok($t->object, 'Attean::TriplePattern'); is($t->object->as_string, '?s .'); }; subtest 'triple-pattern bind' => sub { my $parser = Attean->get_parser('SPARQL')->new(); my $q = $parser->parse("PREFIX foaf: SELECT * WHERE { BIND(<< ?s a foaf:Person >> AS ?tp) }"); does_ok($q, 'Attean::API::Algebra'); isa_ok($q, 'Attean::Algebra::Query'); my $p = $q->child; isa_ok($p, 'Attean::Algebra::Project'); my $e = $p->child; isa_ok($e, 'Attean::Algebra::Extend'); my $expr = $e->expression; isa_ok($expr, 'Attean::ValueExpression'); my $value = $expr->value; isa_ok($value, 'Attean::TriplePattern'); }; subtest 'object annotation 1' => sub { my $parser = Attean->get_parser('SPARQL')->new(); my $q = $parser->parse("PREFIX foaf: SELECT * WHERE { ?s a foaf:Person {| foaf:believedBy |} }"); does_ok($q, 'Attean::API::Algebra'); isa_ok($q, 'Attean::Algebra::Query'); my $p = $q->child; isa_ok($p, 'Attean::Algebra::Project'); my $s = $p->child; isa_ok($s, 'Attean::Algebra::BGP'); my $triples = $s->triples(); is(scalar(@$triples), 2, 'number of triples'); my ($t, $a) = @$triples; isa_ok($a->subject, 'Attean::TriplePattern'); is($a->subject->as_string, '?s .'); is($a->predicate->as_string, 'http://xmlns.com/foaf/0.1/believedBy'); is($a->object->as_string, 'http://kasei.us/about/#greg'); foreach my $pos (qw(subject predicate object)) { is($a->subject->$pos()->as_string, $t->$pos()->as_string); } }; subtest 'object annotation 2' => sub { my $parser = Attean->get_parser('SPARQL')->new(); my $q = $parser->parse("PREFIX foaf: SELECT * WHERE { ?s a foaf:Person {| foaf:believedBy ; a |} }"); does_ok($q, 'Attean::API::Algebra'); isa_ok($q, 'Attean::Algebra::Query'); my $p = $q->child; isa_ok($p, 'Attean::Algebra::Project'); my $s = $p->child; isa_ok($s, 'Attean::Algebra::BGP'); my $triples = $s->triples(); is(scalar(@$triples), 3, 'number of triples'); my ($t, $a1, $a2) = @$triples; isa_ok($a1->subject, 'Attean::TriplePattern'); is($a1->subject->as_string, '?s .'); is($a2->subject->as_string, '?s .'); is($a1->predicate->as_string, 'http://xmlns.com/foaf/0.1/believedBy'); is($a1->object->as_string, 'http://kasei.us/about/#greg'); is($a2->predicate->as_string, 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type'); is($a2->object->as_string, 'http://example.org/Assertion'); foreach my $pos (qw(subject predicate object)) { is($a1->subject->$pos()->as_string, $t->$pos()->as_string); is($a2->subject->$pos()->as_string, $t->$pos()->as_string); } }; subtest 'sparql-star tokens' => sub { my $sparql = "SELECT * { << ?s a >> }"; open(my $fh, '<:encoding(UTF-8)', \$sparql); my $l = AtteanX::Parser::SPARQLLex->new(); my $iter = $l->parse_iter_from_io($fh); expect($iter->next, KEYWORD, ['SELECT']); expect($iter->next, STAR, ['*']); expect($iter->next, LBRACE, ['{'],); expect($iter->next, LTLT, ['<<'],); expect($iter->next, VAR, ['s'], 'subject'); expect($iter->next, A, ['a'], 'rdf:type'); expect($iter->next, IRI, ['http://xmlns.com/foaf/0.1/Person'], 'foaf:Person'); expect($iter->next, GTGT, ['>>'],); expect($iter->next, IRI, ['http://xmlns.com/foaf/0.1/believedBy'], 'believedBy'); expect($iter->next, IRI, ['http://kasei.us/about/#greg'], '#greg'); expect($iter->next, RBRACE, ['}'], 'escaped closing brace'); }; done_testing(); sub expect { my $token = shift; my $type = shift; my $values = shift; my $name = shift // ''; if (length($name)) { $name = "${name}: "; } is($token->type, $type, "${name}token type (" . join(',', @$values) . ')'); is_deeply($token->args, $values, "${name}token values"); } Attean-0.034/t/PaxHeader/binding-equality.t000644 000765 000024 00000006637 14525575742 020725 xustar00gregstaff000000 000000 30 mtime=1700199394.237264448 69 LIBARCHIVE.xattr.com.apple.lastuseddate#PS=1uIqYAAAAAB4e8sxAAAAAA 59 SCHILY.xattr.com.apple.lastuseddate#PS=Öâ*`x{Ë1 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 1830 LIBARCHIVE.xattr.com.apple.ResourceFork=AAABAAAABQgAAAQIAAAAMgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAQAAAAZL0FwcGxpY2F0aW9ucy9CQkVkaXQuYXBwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAUIAAAECAAAADIIAAAAVxAAAAAcADIAAHVzcm8AAAAKAAD//wAAAAADAAAA 1380 SCHILY.xattr.com.apple.ResourceFork=2/Applications/BBEdit.app2W2usro ÿÿ Attean-0.034/t/binding-equality.t000644 000765 000024 00000012762 14525575742 016750 0ustar00gregstaff000000 000000 use Test::More; use Test::Exception; use strict; use warnings; no warnings 'redefine'; use Attean; use Attean::RDF; use Attean::BindingEqualityTest; my $graph = iri('http://example.org/'); note('Triples'); { my $foaf_a = <<'END'; @prefix foaf: . foaf:knows . END my $foaf_b = <<'END'; @prefix foaf: . foaf:knows . END my @models = map { model_with_turtle($graph, $_) } ($foaf_a, $foaf_b); test_model_equality( @models, 1, 'equal graphs with no blank nodes' ); } ### { my $foaf_a = <<'END'; @prefix foaf: . _:a a foaf:Person ; foaf:name "Alice" . _:b a foaf:Person ; foaf:name "Bob" . . END my $foaf_b = <<'END'; @prefix foaf: . _:alice a foaf:Person ; foaf:name "Alice" . _:bob a foaf:Person ; foaf:name "Bob" . . END my @models = map { model_with_turtle($graph, $_) } ($foaf_a, $foaf_b); test_model_equality( @models, 1, 'simple blank node map' ); my $test = Attean::BindingEqualityTest->new(); my $map = $test->injection_map(map { $_->get_quads } @models); is_deeply($map, {qw(a alice b bob)}, 'injection map'); } { my $foaf_a = <<'END'; @prefix foaf: . _:a foaf:knows _:eve . END my $foaf_b = <<'END'; @prefix foaf: . _:alice a foaf:Person ; foaf:knows _:b . END my @models = map { model_with_turtle($graph, $_) } ($foaf_a, $foaf_b); my $test = Attean::BindingEqualityTest->new(); my @iters = map { $_->get_quads } @models; ok( $test->is_subgraph_of(@iters), "subgraph test with blank nodes" ) or diag($test->error); my $map = $test->injection_map(map { $_->get_quads } @models); is_deeply($map, {qw(a alice eve b)}, 'injection map'); } { my $foaf_a = <<'END'; @prefix foaf: . [] a foaf:Person ; foaf:name "Alice" . a foaf:Person ; foaf:name "Bob" . . END my $foaf_b = <<'END'; @prefix foaf: . _:alice a foaf:Person ; foaf:name "Alice" . _:bob a foaf:Person ; foaf:name "Bob" . . END my @models = map { model_with_turtle($graph, $_) } ($foaf_a, $foaf_b); test_model_equality( @models, 0, 'blank node does not map to iri' ); } { my $foaf_a = " .\n"; my $foaf_b = " .\n"; my @models = map { model_with_turtle($graph, $_) } ($foaf_a, $foaf_b); test_model_equality( @models, 0, 'different non-blank statements' ); } { my $foaf_a = "_:a _:a .\n"; my $foaf_b = "_:a _:b .\n"; my @models = map { model_with_turtle($graph, $_) } ($foaf_a, $foaf_b); test_model_equality( @models, 0, 'different number of blank nodes' ); } { my $foaf_a = "_:a _:a .\n"; my $foaf_b = "_:a _:b, _:c.\n"; my @models = map { model_with_turtle($graph, $_) } ($foaf_a, $foaf_b); test_model_equality( @models, 0, 'different number of blank statements' ); } note('Results'); { my $a = Attean::Result->new(); my $b = Attean::Result->new(); test_iter_equality(results_iter([], $a), results_iter([], $b), 1, 'empty results'); } { my $a = Attean::Result->new( bindings => { x => literal('x') } ); my $b = Attean::Result->new( bindings => { x => literal('y') } ); test_iter_equality(results_iter(['x'], $a), results_iter(['x'], $b), 0, 'different IRIs results'); } { my $a = Attean::Result->new( bindings => { x => blank('x') } ); my $b = Attean::Result->new( bindings => { x => blank('y') } ); test_iter_equality(results_iter(['x'], $a), results_iter(['x'], $b), 1, 'different blanks results'); } { my $x = blank('x'); my $y = blank('y'); my $a = Attean::Result->new( bindings => { foo => $x, bar => $y, baz => literal('1') } ); my $b = Attean::Result->new( bindings => { foo => $y, bar => $x, baz => literal('1') } ); test_iter_equality(results_iter([qw(foo bar baz)], $a), results_iter([qw(foo bar baz)], $b), 1, 'multi-blank mapping results'); } { my $x = blank('x'); my $y = blank('y'); my $a = Attean::Result->new( bindings => { foo => $x, bar => $y, baz => literal('1') } ); my $b = Attean::Result->new( bindings => { foo => $y, bar => $x, baz => literal('1') } ); my $test = Attean::BindingEqualityTest->new(); my $map = $test->injection_map(results_iter([qw(foo bar baz)], $a), results_iter([qw(foo bar baz)], $b)); is_deeply($map, {qw(x y y x)}, 'injection map'); } done_testing(); sub model_with_turtle { my $graph = shift; my $data = shift; my $parser = Attean->get_parser('Turtle')->new(); my $store = Attean->get_store('Memory')->new(); my $model = Attean::MutableQuadModel->new( store => $store ); my $iter = $parser->parse_iter_from_bytes($data); $store->add_iter($iter->as_quads($graph)); return $model; } sub test_iter_equality { my $iter_a = shift; my $iter_b = shift; my $expect = shift; my $name = shift; my $test = Attean::BindingEqualityTest->new(); is( $test->equals( $iter_a, $iter_b ), $expect, $name ) or diag($test->error); } sub results_iter { my $vars = shift; my @results = @_; return Attean::ListIterator->new(values => \@results, item_type => 'Attean::API::Result', variables => $vars); } sub test_turtle_equality { my $rdf_a = shift; my $rdf_b = shift; my $model_a = model_with_turtle(iri('http://example.org/'), $rdf_a); my $model_b = model_with_turtle(iri('http://example.org/'), $rdf_b); return test_iter_equality($model_a->get_quads, $model_b->get_quads, @_); } sub test_model_equality { my ($model_a, $model_b) = splice(@_, 0, 2); return test_iter_equality($model_a->get_quads, $model_b->get_quads, @_); } Attean-0.034/t/PaxHeader/parser-nquads.t000644 000765 000024 00000000200 12651717125 020210 xustar00gregstaff000000 000000 69 LIBARCHIVE.xattr.com.apple.lastuseddate#PS=Ndr8YAAAAABA65UgAAAAAA 59 SCHILY.xattr.com.apple.lastuseddate#PS=5Úü`@ë• Attean-0.034/t/parser-nquads.t000644 000765 000024 00000006543 12651717125 016257 0ustar00gregstaff000000 000000 use v5.14; use warnings; use autodie; use Test::Modern; use utf8; use Attean; sub iri { Attean::IRI->new(shift) } sub blank { Attean::Blank->new(shift) } sub literal { my ($value, $lang, $dt) = @_; if ($lang) { return Attean::Literal->new(value => $value, language => $lang); } elsif ($dt) { return Attean::Literal->new(value => $value, datatype => $dt); } else { return Attean::Literal->new($value); } } subtest 'parser construction and metadata' => sub { my $parser = Attean->get_parser('NQuads')->new(); isa_ok($parser, 'AtteanX::Parser::NQuads'); is($parser->canonical_media_type, 'application/n-quads', 'canonical_media_type'); my %extensions = map { $_ => 1 } @{ $parser->file_extensions }; ok(exists $extensions{'nq'}, 'file_extensions'); my $type = $parser->handled_type; can_ok($type, 'role'); is($type->role, 'Attean::API::TripleOrQuad'); }; my $parser = Attean->get_parser('NQuads')->new(); isa_ok( $parser, 'AtteanX::Parser::NQuads' ); { my $store = Attean->get_store('Memory')->new(); my $ntriples = <<"END"; _:a . _:a . END my @list = $parser->parse_list_from_bytes($ntriples); is(scalar(@list), 2); my ($t1, $t2) = @list; does_ok($t1, 'Attean::API::Triple'); does_ok($t2, 'Attean::API::Triple'); is($t1->subject->value, 'a'); is($t2->subject->value, 'a'); is($t1->predicate->value, 'b'); is($t2->predicate->value, 'b'); is($t1->object->value, 'a'); is($t2->object->value, 'a'); } { my $store = Attean->get_store('Memory')->new(); my $nquads = <<"END"; _:a . _:a . _:a _:graph . END my $iter = $parser->parse_iter_from_bytes($nquads); my $graph = Attean::IRI->new('http://example.org/default'); my $quads = $iter->map( sub { $_->does('Attean::API::Quad') ? $_ : $_->as_quad($graph) }, 'Attean::API::Quad' ); $store->add_iter($quads); is( $store->size, 3, 'expected model size after ntriples parse' ); is( $store->count_quads(blank('a')), 1, 'expected 1 count bfff' ); is( $store->count_quads(iri('a')), 2, 'expected 2 count bfff' ); is( $store->count_quads(iri('b')), 0, 'expected 0 count bfff' ); is( $store->count_quads(undef, iri('b')), 3, 'expected 2 count fbff' ); is( $store->count_quads(undef, undef, undef, iri('g')), 1, 'expected 1 count fffb' ); is( $store->count_quads(undef, undef, undef, blank('graph')), 1, 'expected 1 count fffb' ); is( $store->count_quads(undef, undef, undef, iri('http://example.org/default')), 1, 'expected 1 count fffb' ); } { my $store = Attean->get_store('Memory')->new(); my $nquads = <<"END"; _:a . _:a . END open(my $fh, '<', \$nquads); my @list = $parser->parse_list_from_io($fh); is(scalar(@list), 2); my ($t1, $t2) = @list; does_ok($t1, 'Attean::API::Quad'); does_ok($t2, 'Attean::API::Quad'); is($t1->subject->value, 'a'); is($t2->subject->value, 'a'); is($t1->predicate->value, 'b'); is($t2->predicate->value, 'b'); is($t1->object->value, 'a'); is($t2->object->value, 'a'); is($t1->graph->value, 'g1'); is($t2->graph->value, 'g2'); } { my $store = Attean->get_store('Memory')->new(); my $nquads = <<"END"; _:a . _:a . END open(my $fh, '<', \$nquads); my $counter = 0; my $parser = Attean->get_parser('NQuads')->new(handler => sub { $counter++; my $q = shift; does_ok($q, 'Attean::API::Quad'); }); $parser->parse_cb_from_io($fh); is($counter, 2); } done_testing(); Attean-0.034/t/serializer-turtle.t000644 000765 000024 00000021053 12702516551 017146 0ustar00gregstaff000000 000000 use Test::Modern; use Test::Exception; use v5.14; use warnings; no warnings 'redefine'; use Attean; use Attean::RDF; use Type::Tiny::Role; use AtteanX::Parser::Turtle::Constants; subtest 'serializer construction and metadata' => sub { { my $ser = Attean->get_serializer('Turtle')->new(); does_ok($ser, 'Attean::API::Serializer'); isa_ok($ser, 'AtteanX::Serializer::Turtle'); is($ser->canonical_media_type, 'text/turtle', 'canonical_media_type'); my %types = map { $_ => 1 } @{ $ser->media_types }; ok(exists $types{'text/turtle'}, 'media_types'); my $type = $ser->handled_type; can_ok($type, 'role'); is($type->role, 'Attean::API::Triple'); my %extensions = map { $_ => 1 } @{ $ser->file_extensions }; ok(exists $extensions{'ttl'}, 'file_extensions'); } { my $ser = Attean->get_serializer('TurtleTokens')->new(); does_ok($ser, 'Attean::API::Serializer'); isa_ok($ser, 'AtteanX::Serializer::TurtleTokens'); is($ser->canonical_media_type, 'text/turtle', 'canonical_media_type'); my %types = map { $_ => 1 } @{ $ser->media_types }; ok(exists $types{'text/turtle'}, 'media_types'); my $type = $ser->handled_type; can_ok($type, 'role'); is($type->role, 'AtteanX::Parser::Turtle::Token'); my %extensions = map { $_ => 1 } @{ $ser->file_extensions }; ok(exists $extensions{'ttl'}, 'file_extensions'); } }; my $constraint = 'Attean::API::Triple'; my $s = blank('x'); my $t = blank('y'); my $p = iri('http://example.org/p'); my $q = iri('http://example.org/q'); my $r = iri('http://example.org/r'); my $o1 = Attean::Literal->integer(1); my $o2 = Attean::Literal->integer(2); my $o3 = Attean::Literal->new(value => '3'); my $o4 = Attean::Literal->new(value => 'ç«æ˜Ÿ', language => 'ja'); my $t1 = triple($s, $p, $o1); my $t2 = triple($s, $p, $o2); my $t3 = triple($s, $q, $o3); my $t4 = triple($t, $r, $o4); subtest 'turtle with object-list' => sub { my $ser = Attean->get_serializer('Turtle')->new(); does_ok($ser, 'Attean::API::Serializer'); does_ok($ser, 'Attean::API::TripleSerializer'); isa_ok($ser, 'AtteanX::Serializer::Turtle'); my $expected = <<"END"; _:x 1 , 2 . END { my $i = Attean::ListIterator->new(values => [$t1, $t2], item_type => $constraint); my $data1 = $ser->serialize_iter_to_bytes($i); my $data2 = $ser->serialize_list_to_bytes($t1, $t2); is($data1, $expected, 'serialize_iter_to_bytes'); is($data1, $data2, 'serialize_list_to_bytes'); } { my $i = Attean::ListIterator->new(values => [$t1, $t2], item_type => $constraint); my $data = ''; open(my $fh, '>', \$data); $ser->serialize_iter_to_io($fh, $i); close($fh); is($data, $expected, 'serialize_iter_to_io'); } { my $i = Attean::ListIterator->new(values => [$t1, $t2], item_type => $constraint); my $data = ''; open(my $fh, '>', \$data); $ser->serialize_list_to_io($fh, $t1, $t2); close($fh); is($data, $expected, 'serialize_iter_to_io'); } }; subtest 'turtle with predicate-object list' => sub { my $ser = Attean->get_serializer('Turtle')->new(); my $expected = <<'END'; _:x 1 , 2 ; "3" . _:y "ç«æ˜Ÿ"@ja . END my $i = Attean::ListIterator->new(values => [$t1, $t2, $t3, $t4], item_type => $constraint); my $data1 = $ser->serialize_iter_to_bytes($i); my $data2 = $ser->serialize_list_to_bytes($t1, $t2, $t3, $t4); is($data1, $expected, 'serialize_iter_to_bytes'); is($data1, $data2, 'serialize_list_to_bytes'); }; subtest 'turtle with prefix namespace declaration' => sub { my $map = URI::NamespaceMap->new( { foaf => iri('http://xmlns.com/foaf/0.1/') } ); my $ser = Attean->get_serializer('Turtle')->new( namespaces => $map ); my $expected = <<'END'; @prefix foaf: . _:x 1 , 2 . END my $iter = Attean::ListIterator->new(values => [$t1, $t2], item_type => 'Attean::API::Triple'); my $turtle = $ser->serialize_iter_to_bytes($iter); is($turtle, $expected, 'serialize_iter_to_bytes'); }; subtest 'turtle with prefix namespace declaration and use' => sub { my $map = URI::NamespaceMap->new( { ex => iri('http://example.org/') } ); my $ser = Attean->get_serializer('Turtle')->new( namespaces => $map ); my $expected = <<'END'; @prefix ex: . _:x ex:p 1 , 2 . END my $iter = Attean::ListIterator->new(values => [$t1, $t2], item_type => 'Attean::API::Triple'); my $turtle = $ser->serialize_iter_to_bytes($iter); is($turtle, $expected, 'serialize_iter_to_bytes'); }; subtest 'escaping' => sub { my @tokens; my $dq = literal('"'); my $sq = literal("'"); my $bq = literal(q["']); @tokens = $dq->sparql_tokens->elements; expect(shift(@tokens), STRING1D, ['"'], 'double quote'); @tokens = $sq->sparql_tokens->elements; expect(shift(@tokens), STRING1D, ["'"], 'single quote'); @tokens = $bq->sparql_tokens->elements; expect(shift(@tokens), STRING1D, [q["']], 'double and single quotes'); my $ser = Attean->get_serializer('Turtle')->new(); my @triples = map { triple(iri('s'), iri('p'), $_) } ($dq, $sq, $bq); my $iter = Attean::ListIterator->new(values => \@triples, item_type => 'Attean::API::Triple'); my $turtle = $ser->serialize_iter_to_bytes($iter); my $expected = qq[

"\\"" , "'" , "\\"'" .\n]; is($turtle, $expected, 'serialize_iter_to_bytes'); }; subtest 'token serialization' => sub { my $ser = Attean->get_serializer('TurtleTokens')->new(); my @tokens; push(@tokens, AtteanX::Parser::Turtle::Token->fast_constructor(A, -1, -1, -1, -1, ['a'])); push(@tokens, AtteanX::Parser::Turtle::Token->fast_constructor(COMMENT, -1, -1, -1, -1, ['comment'])); push(@tokens, AtteanX::Parser::Turtle::Token->fast_constructor(STRING1S, -1, -1, -1, -1, ['xyz'])); push(@tokens, AtteanX::Parser::Turtle::Token->fast_constructor(COMMA, -1, -1, -1, -1, [','])); push(@tokens, AtteanX::Parser::Turtle::Token->fast_constructor(STRING3S, -1, -1, -1, -1, ['hello'])); push(@tokens, AtteanX::Parser::Turtle::Token->fast_constructor(COMMA, -1, -1, -1, -1, [','])); push(@tokens, AtteanX::Parser::Turtle::Token->fast_constructor(STRING3D, -1, -1, -1, -1, ['world'])); push(@tokens, AtteanX::Parser::Turtle::Token->fast_constructor(HATHAT, -1, -1, -1, -1, ['^^'])); push(@tokens, AtteanX::Parser::Turtle::Token->fast_constructor(PREFIXNAME, -1, -1, -1, -1, ['xsd:', 'string'])); my $iter = Attean::ListIterator->new(values => \@tokens, item_type => 'AtteanX::Parser::Turtle::Token'); my $data = $ser->serialize_iter_to_bytes($iter); like($data, qr/\ba\b/); like($data, qr/# comment/); like($data, qr/'xyz'(?!')/); like($data, qr/'''hello'''/); like($data, qr/"""world"""\^\^xsd:string/); }; subtest 'AbbreviatingSerializer with explicit namespace map' => sub { my $map = URI::NamespaceMap->new( { foaf => iri('http://xmlns.com/foaf/0.1/') } ); my $p = Attean->get_parser('Turtle')->new(); my $iter = $p->parse_iter_from_bytes('@prefix foaf: . a foaf:Person ; foaf:name "Alice" .'); my $s = Attean->get_serializer('Turtle')->new( namespaces => $map ); my $bytes = $s->serialize_iter_to_bytes($iter); like($bytes, qr[prefix foaf: .], 'serialization has prefix declaration'); like($bytes, qr, 'serialization has IRI'); like($bytes, qr/foaf:Person/, 'serialization has prefix name foaf:Person'); like($bytes, qr/foaf:name "Alice"/, 'serialization has prefix name foaf:name'); }; subtest 'End-to-end AbbreviatingSerializer' => sub { my $map = URI::NamespaceMap->new(); my $p = Attean->get_parser('Turtle')->new( namespaces => $map ); my $iter = $p->parse_iter_from_bytes('@prefix foaf: . @prefix ex: . a foaf:Person ; foaf:name "Alice" .'); my $s = Attean->get_serializer('Turtle')->new( namespaces => $map ); my $bytes = $s->serialize_iter_to_bytes($iter); like($bytes, qr[prefix ex: .], 'serialization has prefix declaration ex:'); like($bytes, qr[prefix foaf: .], 'serialization has prefix declaration'); like($bytes, qr, 'serialization has IRI'); like($bytes, qr/foaf:Person/, 'serialization has prefix name foaf:Person'); like($bytes, qr/foaf:name "Alice"/, 'serialization has prefix name foaf:name'); is_deeply([sort $map->list_prefixes], [qw(ex foaf)]); }; done_testing(); sub expect { my $token = shift; my $type = shift; my $values = shift; my $name = shift // ''; if (length($name)) { $name = "${name}: "; } is($token->type, $type, "${name}token type"); is_deeply($token->args, $values, "${name}token values"); } Attean-0.034/t/idp_planner.t000644 000765 000024 00000024712 12722663622 015764 0ustar00gregstaff000000 000000 use v5.14; use autodie; use utf8; use Test::Modern; use Test::Exception; use Digest::SHA qw(sha1_hex); use Attean; use Attean::RDF; use Attean::IDPQueryPlanner; use AtteanX::Store::Memory; package TestStore { use Moo; use namespace::clean; extends 'AtteanX::Store::Memory'; sub cost_for_plan { # we do this because the superclass would return a cost of 0 for quads when the store is empty # and if 0 was returned, there won't be any meaningful difference between the cost of different join algorithms my $self = shift; my $plan = shift; if ($plan->isa('Attean::Plan::Quad')) { return 3; } return; } } # Attean::Plan::Quad # Attean::Plan::NestedLoopJoin # Attean::Plan::HashJoin # Attean::Plan::EBVFilter # Attean::Plan::Merge # Attean::Plan::Union # Attean::Plan::Extend # Attean::Plan::HashDistinct # Attean::Plan::Unique # Attean::Plan::Slice # Attean::Plan::Project # Attean::Plan::OrderBy # Attean::Plan::Service # Attean::Plan::Table my $p = Attean::IDPQueryPlanner->new(); isa_ok($p, 'Attean::IDPQueryPlanner'); does_ok($p, 'Attean::API::CostPlanner'); { my $store = TestStore->new(); my $model = Attean::MutableQuadModel->new( store => $store ); my $graph = iri('http://example.org/'); my $t = triplepattern(variable('s'), iri('p'), literal('1')); my $u = triplepattern(variable('s'), iri('p'), variable('o')); my $v = triplepattern(variable('s'), iri('q'), blank('xyz')); my $w = triplepattern(variable('a'), iri('b'), iri('c')); subtest 'Empty BGP' => sub { note("An empty BGP should produce the join identity table plan"); my $bgp = Attean::Algebra::BGP->new(triples => []); my $plan = $p->plan_for_algebra($bgp, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', 'Empty BGP'); isa_ok($plan, 'Attean::Plan::Table'); my $rows = $plan->rows; is(scalar(@$rows), 1); }; subtest '1-triple BGP' => sub { note("A 1-triple BGP should produce a single Attean::Plan::Quad plan object"); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $plan = $p->plan_for_algebra($bgp, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', '1-triple BGP'); isa_ok($plan, 'Attean::Plan::Quad'); }; subtest '2-triple BGP without join variable' => sub { note("A 2-triple BGP without a join variable should produce a distinct nested loop join"); my $bgp = Attean::Algebra::BGP->new(triples => [$t, $w]); my $plan = $p->plan_for_algebra($bgp, $model, [$graph]); like($plan->as_string, qr/Join.*Quad.*Quad/s); does_ok($plan, 'Attean::API::Plan', '2-triple BGP'); isa_ok($plan, 'Attean::Plan::NestedLoopJoin'); ok($plan->distinct); }; subtest '2-triple BGP with join variable' => sub { note("A 2-triple BGP with a join variable and without any ordering should produce a distinct hash join"); my $bgp = Attean::Algebra::BGP->new(triples => [$t, $u]); my $plan = $p->plan_for_algebra($bgp, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', '2-triple BGP'); isa_ok($plan, 'Attean::Plan::HashJoin'); ok($plan->distinct); }; subtest 'Distinct 2-triple BGP with join variable, no blank nodes' => sub { note("A 2-triple BGP with a join variable without any blank nodes is necessarily distinct, so a distinct operation should be a no-op, resulting in just a nested loop join"); my $bgp = Attean::Algebra::BGP->new(triples => [$t, $u]); my $dist = Attean::Algebra::Distinct->new( children => [$bgp] ); my $plan = $p->plan_for_algebra($dist, $model, [$graph]); like($plan->as_string, qr/[Dd]istinct/s); does_ok($plan, 'Attean::API::Plan', 'Distinct 2-triple BGP without blanks'); isa_ok($plan, 'Attean::Plan::HashJoin'); ok($plan->distinct); }; subtest 'Distinct 3-triple BGP with join variable and blank nodes' => sub { note("A 3-triple BGP with a blank node isn't necessarily distinct, so a distinct operation should result in a HashDistinct plan"); my $bgp = Attean::Algebra::BGP->new(triples => [$t, $u, $v]); my $dist = Attean::Algebra::Distinct->new( children => [$bgp] ); my $plan = $p->plan_for_algebra($dist, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', 'Distinct 3-triple BGP with blanks'); isa_ok($plan, 'Attean::Plan::HashDistinct'); ok($plan->distinct); }; # TODO: A 1-triple BGP with ASC(-1 * ?s) sorting should result in a Project(Order(Extend(Quad(....)))) pattern subtest 'Sorted 1-triple BGP' => sub { note("A 1-triple BGP with ASC(?s) sorting should result in a Order(Quad(....)) pattern"); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $sorted = order_algebra_by_variables($bgp, 's'); my $plan = $p->plan_for_algebra($sorted, $model, [$graph]); like($plan->as_string, qr/Order.*ASC\(\?s\)/s); does_ok($plan, 'Attean::API::Plan', 'Sorted 1-triple BGP'); # Sorting introduces a isa_ok($plan, 'Attean::Plan::OrderBy'); ok($plan->distinct, 'Plan is distinct'); my $order = $plan->ordered; is(scalar(@$order), 1, 'Count of ordering comparators'); my $cmp = $order->[0]; ok($cmp->ascending, 'Ordering is ascending'); my $expr = $cmp->expression; isa_ok($expr, 'Attean::ValueExpression'); is($expr->value->value, 's'); }; subtest 'Join planning is equivalent to BGP planning' => sub { note("A join between two 1-triple BGPs should result in the same plan as the equivalent 2-triple BGP"); my $plan1 = $p->plan_for_algebra(Attean::Algebra::BGP->new(triples => [$t, $u]), $model, [$graph]); my $bgp1 = Attean::Algebra::BGP->new(triples => [$t]); my $bgp2 = Attean::Algebra::BGP->new(triples => [$u]); my $join = Attean::Algebra::Join->new(children => [$bgp1, $bgp2]); my $plan2 = $p->plan_for_algebra($join, $model, [$graph]); does_ok($_, 'Attean::API::Plan') for ($plan1, $plan2); isa_ok($_, 'Attean::Plan::HashJoin') for ($plan1, $plan2); # we don't do a single deep comparison on the plans here, because while they are equivalent plans, # BGP planning handles the annotating of the distinct flag on sub-plans differently than the # general join planning. foreach my $pos (0,1) { does_ok($_->children->[$pos], 'Attean::API::Plan') for ($plan1, $plan2); isa_ok($_->children->[$pos], 'Attean::Plan::Quad') for ($plan1, $plan2); is_deeply([$plan1->children->[$pos]->values], [$plan2->children->[$pos]->values]); } }; subtest 'Variable Filter' => sub { note("FILTER(?o) should result in a EBVFilter(...) pattern"); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $expr = Attean::ValueExpression->new(value => variable('o')); my $filter = Attean::Algebra::Filter->new(children => [$bgp], expression => $expr); my $plan = $p->plan_for_algebra($filter, $model, [$graph]); like($plan->as_string, qr/Filter/s); does_ok($plan, 'Attean::API::Plan', 'Variable filter'); isa_ok($plan, 'Attean::Plan::EBVFilter'); is($plan->variable, 'o'); }; subtest 'Expression Filter' => sub { note("FILTER(?s && ?o) should result in a Project(EBVFilter(Extend(...))) pattern"); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $expr1 = Attean::ValueExpression->new(value => variable('s')); my $expr2 = Attean::ValueExpression->new(value => variable('o')); my $expr = Attean::BinaryExpression->new( operator => '&&', children => [$expr1, $expr2] ); my $filter = Attean::Algebra::Filter->new(children => [$bgp], expression => $expr); my $plan = $p->plan_for_algebra($filter, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', 'Expression filter'); isa_ok($plan, 'Attean::Plan::Project'); isa_ok($plan->children->[0], 'Attean::Plan::EBVFilter'); isa_ok($plan->children->[0]->children->[0], 'Attean::Plan::Extend'); }; subtest 'IRI named graph' => sub { note("1-triple BGP restricted to an IRI-named graph should result in a Quad plan"); my $ng = iri('http://eample.org/named/'); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $named = Attean::Algebra::Graph->new(children => [$bgp], graph => $ng); my $plan = $p->plan_for_algebra($named, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', 'IRI-named graph'); isa_ok($plan, 'Attean::Plan::Quad'); }; subtest 'Variable named graph (model with 0 named graphs)' => sub { note("1-triple BGP restricted to a variable-named graph should result in an empty Union plan"); my $ng = variable('g'); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $named = Attean::Algebra::Graph->new(children => [$bgp], graph => $ng); my $plan = $p->plan_for_algebra($named, $model, [$graph]); like($plan->as_string, qr/Union/s); does_ok($plan, 'Attean::API::Plan', 'IRI-named graph'); isa_ok($plan, 'Attean::Plan::Union'); is(scalar(@{ $plan->children }), 0); }; subtest 'Describe' => sub { my $store = TestStore->new(); my $model = Attean::MutableQuadModel->new( store => $store ); my $subj = Attean::Blank->new('x'); my $pred = Attean::IRI->new('http://example.org/p1'); my $o1 = Attean::Literal->new(value => 'foo', language => 'en-US'); my $o2 = Attean::Literal->new(value => 'bar', language => 'en-GB'); my $q1 = Attean::Quad->new($subj, $pred, $o1, $graph); my $q2 = Attean::Quad->new($subj, $pred, $o2, $graph); my $i = Attean::ListIterator->new(values => [$q1, $q2], item_type => 'Attean::API::Quad'); $model->add_iter($i); note("Describe query with 1-triple BGP"); my $bgp = Attean::Algebra::BGP->new(triples => [Attean::TriplePattern->new(variable('s'), $pred, variable('o'))]); my $describe = Attean::Algebra::Describe->new(children => [$bgp], terms => [variable('s')]); my $plan = $p->plan_for_algebra($describe, $model, [$graph]); like($plan->as_string, qr/Describe/s); does_ok($plan, 'Attean::API::Plan'); isa_ok($plan, 'Attean::Plan::Describe'); is(scalar(@{ $plan->children }), 1); my $code = $plan->impl($model); my $iter = $code->(); my $row = $iter->next(); does_ok($row, 'Attean::API::Quad'); }; subtest 'Issues and Regressions' => sub { { my $sparql = 'SELECT * WHERE { { SELECT ?o (AVG(?v) AS ?mean) WHERE { ?s ?o ; ?v . } GROUP BY ?o } }'; my $algebra = Attean->get_parser('SPARQL')->parse($sparql); my $plan = $p->plan_for_algebra($algebra, $model, [$graph]); is_deeply([sort @{ $plan->in_scope_variables }], [qw(mean o)], 'sub-query in-scope variables (#78)'); } } } done_testing(); sub order_algebra_by_variables { my $algebra = shift; my @vars = @_; my @cmps; foreach my $var (@vars) { my $expr = Attean::ValueExpression->new(value => variable($var)); my $cmp = Attean::Algebra::Comparator->new(ascending => 1, expression => $expr); push(@cmps, $cmp); } my $sorted = Attean::Algebra::OrderBy->new( children => [$algebra], comparators => \@cmps ); return $sorted; } Attean-0.034/t/PaxHeader/store-simple.t000644 000765 000024 00000006503 14525575742 020073 xustar00gregstaff000000 000000 30 mtime=1700199394.243070157 1830 LIBARCHIVE.xattr.com.apple.ResourceFork=AAABAAAABQgAAAQIAAAAMgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAQAAAAZL0FwcGxpY2F0aW9ucy9CQkVkaXQuYXBwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAUIAAAECAAAADIaAAAAjhAAAAAcADIAAHVzcm8AAAAKAAD//wAAAAAVAAAA 1380 SCHILY.xattr.com.apple.ResourceFork=2/Applications/BBEdit.app2Ž2usro ÿÿ 85 LIBARCHIVE.xattr.com.apple.FinderInfo=VEVYVAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 70 SCHILY.xattr.com.apple.FinderInfo=TEXT Attean-0.034/t/store-simple.t000644 000765 000024 00000003155 14525575742 016122 0ustar00gregstaff000000 000000 use Test::Roo; use Test::Modern; use Test::Exception; use v5.14; use warnings; no warnings 'redefine'; use Attean; sub create_store { my $self = shift; return Attean->get_store('Simple')->new(@_); } with 'Test::Attean::QuadStore'; run_me; # run these Test::Attean tests # use Try::Tiny; # $Error::TypeTiny::StackTrace = 1; # try { { my $s = Attean::Blank->new('x'); my $p = Attean::IRI->new('http://example.org/p1'); my $o = Attean::Literal->new(value => 'foo', language => 'en-US'); my $g = Attean::IRI->new('http://example.org/graph'); my $q = Attean::Quad->new($s, $p, $o, $g); my @quads; push(@quads, $q); my $s2 = Attean::IRI->new('http://example.org/values'); foreach my $value (1 .. 3) { my $o = Attean::Literal->new(value => $value, datatype => 'http://www.w3.org/2001/XMLSchema#integer'); my $p = Attean::IRI->new("http://example.org/p$value"); my $q = Attean::Quad->new($s2, $p, $o, $g); push(@quads, $q); } my $store = Attean->get_store('Simple')->new( quads => \@quads ); isa_ok($store, 'AtteanX::Store::Simple'); is($store->size, 4); is($store->count_quads($s), 1); is($store->count_quads($s2), 3); is($store->count_quads(), 4); is($store->count_quads(undef, $p), 2); { my $iter = $store->get_quads($s2); while (my $q = $iter->next()) { my $o = $q->object->value; like($o, qr/^[123]$/, "Literal value: $o"); } } my $iter = $store->get_graphs; my @graphs = $iter->elements; is(scalar(@graphs), 1); is($graphs[0]->value, 'http://example.org/graph'); } # catch { # my $exception = $_; # warn "Caught error: $exception"; # warn $exception->stack_trace; # }; done_testing(); Attean-0.034/t/parser-sparqltsv.t000644 000765 000024 00000003734 12651717125 017022 0ustar00gregstaff000000 000000 use v5.14; use warnings; use autodie; use Test::Modern; use utf8; use Attean; sub iri { Attean::IRI->new(shift) } sub blank { Attean::Blank->new(shift) } sub literal { my ($value, $lang, $dt) = @_; if ($lang) { return Attean::Literal->new(value => $value, language => $lang); } elsif ($dt) { return Attean::Literal->new(value => $value, datatype => $dt); } else { return Attean::Literal->new($value); } } subtest 'parser construction and metadata' => sub { my $parser = Attean->get_parser('SPARQLTSV')->new(); isa_ok($parser, 'AtteanX::Parser::SPARQLTSV'); is($parser->canonical_media_type, 'text/tab-separated-values', 'canonical_media_type'); my %extensions = map { $_ => 1 } @{ $parser->file_extensions }; ok(exists $extensions{'tsv'}, 'file_extensions'); my $type = $parser->handled_type; can_ok($type, 'role'); is($type->role, 'Attean::API::Result'); }; { my $tsv = <<'END'; ?x ?hpage ?name ?age ?mbox ?friend _:r2 "Bob"@en 30 END my $counter = 0; my $parser = Attean->get_parser('SPARQLTSV')->new(handler => sub { $counter++; my $result = shift; does_ok($result, 'Attean::API::Result'); my @vars = $result->variables; is_deeply([sort @vars], [qw(age hpage mbox name x)]); my $x = $result->value('x'); does_ok($x, 'Attean::API::Blank'); is($x->value, 'r2'); my $age = $result->value('age'); does_ok($age, 'Attean::API::Literal'); is($age->value, '30'); is($age->datatype->value, 'http://www.w3.org/2001/XMLSchema#integer'); my $hpage = $result->value('hpage'); does_ok($hpage, 'Attean::API::IRI'); is($hpage->value, 'http://work.example.org/bob/'); }); $parser->parse_cb_from_bytes($tsv); } { my $tsv = <<'END'; ?x ?name _:r2 "Bob"@en "Eve" END open(my $fh, '<', \$tsv); my $counter = 0; my $parser = Attean->get_parser('SPARQLTSV')->new(handler => sub {}); my @results = $parser->parse_list_from_io($fh); is(scalar(@results), 2); } done_testing(); Attean-0.034/t/model-triple.t000644 000765 000024 00000022020 13430436573 016054 0ustar00gregstaff000000 000000 use Test::Modern; use Test::Exception; use v5.14; use warnings; no warnings 'redefine'; use Attean; use Attean::RDF; use Type::Tiny::Role; subtest 'MutableTripleModel' => sub { my $store = Attean->get_store('SimpleTripleStore')->new(); isa_ok($store, 'AtteanX::Store::SimpleTripleStore'); my $model = Attean::MutableTripleModel->new( stores => { 'http://example.org/graph' => $store } ); isa_ok($model, 'Attean::MutableTripleModel'); my $s = Attean::Blank->new('x'); my $p = Attean::IRI->new('http://example.org/p1'); my $o = Attean::Literal->new(value => 'foo', language => 'en-US'); my $g = Attean::IRI->new('http://example.org/graph'); my $q = Attean::Quad->new($s, $p, $o, $g); does_ok($q, 'Attean::API::Quad'); isa_ok($q, 'Attean::Quad'); $model->add_quad($q); is($model->size, 1, 'model->size'); { my $iter = $model->get_quads($s, undef, undef, $g); does_ok($iter, 'Attean::API::Iterator'); my $q = $iter->next; does_ok($q, 'Attean::API::Quad'); my ($s, $p, $o, $g) = $q->values; is($s->value, 'x'); is($o->value, 'foo'); } my $s2 = Attean::IRI->new('http://example.org/values'); foreach my $value (1 .. 3) { my $o = Attean::Literal->new(value => $value, datatype => 'http://www.w3.org/2001/XMLSchema#integer'); my $p = Attean::IRI->new("http://example.org/p$value"); my $q = Attean::Quad->new($s2, $p, $o, $g); $model->add_quad($q); } is($model->size, 4, 'model->size'); is($model->count_quads($s), 1, 'count_quads($s)'); is($model->count_quads($s2), 3, 'count_quads($s2)'); is($model->count_quads(), 4, 'count_quads()'); is($model->count_quads_estimate($s2), 3, 'count_quads_estimate'); is($model->count_quads(undef, $p), 2, 'count_quads'); ok($model->holds($s2), 'holds($tp)'); ok(!$model->holds($s2, $g), 'holds(@tp)'); { note('get_quads single-term matching with undef placeholders'); my $iter = $model->get_quads($s2); while (my $q = $iter->next()) { my $o = $q->object->value; like($o, qr/^[123]$/, "Literal value: $o"); } } { note('get_quads single-term matching with variable object placeholders'); my @vars = map { Attean::Variable->new($_) } qw(p o g); my $iter = $model->get_quads($s2, @vars); does_ok($iter, 'Attean::API::Iterator'); while (my $q = $iter->next()) { my $o = $q->object->value; like($o, qr/^[123]$/, "Literal value: $o"); } } { note('get_bindings single-term matching'); my $v = Attean::Variable->new('pred'); my $iter = $model->get_bindings($s2, $v); does_ok($iter, 'Attean::API::Iterator'); my $count = 0; while (my $b = $iter->next()) { $count++; does_ok($b, 'Attean::API::Result'); is_deeply([$b->variables], [qw(pred)], 'expected binding variables'); my $p = $b->value('pred'); my $v = $p->value; does_ok($p, 'Attean::API::Term'); like($v, qr<^http://example.org/p[123]$>, "Predicate value: $v"); } is($count, 3, 'expected binding count'); } { note('get_quads union-term matching'); my $p2 = Attean::IRI->new("http://example.org/p2"); my $p3 = Attean::IRI->new("http://example.org/p3"); my $iter = $model->get_quads(undef, [$p2, $p3]); my $count = 0; while (my $q = $iter->next()) { $count++; my $o = $q->object->value; like($o, qr/^[23]$/, "Literal value: $o"); } is($count, 2); } note('removing data...'); $model->remove_quad($q); is($model->size, 3); is($model->count_quads(undef, $p), 1); { note('objects() matching'); my $objects = $model->objects(); does_ok($objects, 'Attean::API::Iterator'); is($objects->item_type, 'Attean::API::Term', 'expected item_type'); my $count = 0; while (my $obj = $objects->next) { $count++; does_ok($obj, 'Attean::API::Literal'); like($obj->value, qr/^[123]$/, "Literal value: $o"); } is($count, 3); } }; subtest 'AddativeMutableTripleModel' => sub { my $store1 = Attean->get_store('SimpleTripleStore')->new(); isa_ok($store1, 'AtteanX::Store::SimpleTripleStore'); my $o = Attean::Literal->new(value => 'foo', language => 'en-US'); $store1->add_triple(triple(blank('x'), iri('http://example.org/p1'), $o)); my $model = Attean::AddativeMutableTripleModel->new( stores => { 'http://example.org/graph' => $store1 }, store_constructor => sub { return Attean->get_store('SimpleTripleStore')->new() } ); isa_ok($model, 'Attean::AddativeMutableTripleModel'); my @graphs1 = $model->get_graphs->elements; is(scalar(@graphs1), 1); is($graphs1[0]->value, 'http://example.org/graph'); my $store2 = Attean->get_store('SimpleTripleStore')->new(); $store2->add_triple(triple(blank('x'), iri('http://example.org/p1'), Attean::Literal->integer(3))); $model->add_store('http://example.org/graph2' => $store2); my @graphs2 = sort map { $_->value } $model->get_graphs->elements; is(scalar(@graphs2), 2); is_deeply(\@graphs2, ['http://example.org/graph', 'http://example.org/graph2']); $model->create_graph(iri('http://example.org/graph3')); my @graphs3 = sort map { $_->value } $model->get_graphs->elements; is(scalar(@graphs3), 3); is_deeply(\@graphs3, ['http://example.org/graph', 'http://example.org/graph2', 'http://example.org/graph3']); $model->drop_graph(iri('http://example.org/graph')); my @graphs4 = sort map { $_->value } $model->get_graphs->elements; is(scalar(@graphs4), 2); is_deeply(\@graphs4, ['http://example.org/graph2', 'http://example.org/graph3']); }; { my $store = Attean->get_store('SimpleTripleStore')->new(); my $model = Attean::MutableTripleModel->new( stores => { 'http://example.org/graph' => $store } ); my $g = Attean::IRI->new('http://example.org/graph'); my $a = Attean->get_parser('SPARQL')->parse('SELECT * WHERE { ?s ?p ?o }'); my @p = $model->plans_for_algebra($a, undef, [$g], [$g]); is(scalar(@p), 0); } { my $store = Attean->get_store('SimpleTripleStore')->new(); my $model = Attean::MutableTripleModel->new( stores => { 'http://example.org/graph' => $store } ); my $g = Attean::IRI->new('http://example.org/graph'); dies_ok { $model->create_graph($g) } 'create_graph dies on Attean::MutableTripleModel'; } { my $store = Attean->get_store('SimpleTripleStore')->new(); my $model = Attean::MutableTripleModel->new( stores => { 'http://example.org/graph' => $store } ); my $g = Attean::IRI->new('http://example.org/graph'); my @pre_graphs = $model->get_graphs->elements; is(scalar(@pre_graphs), 1); $model->drop_graph($g); my @post_graphs = $model->get_graphs->elements; is(scalar(@post_graphs), 0); } { my $store = Attean->get_store('SimpleTripleStore')->new(); my $model = Attean::MutableTripleModel->new( stores => { 'http://example.org/graph' => $store } ); my $g = Attean::IRI->new('http://example.org/graph'); dies_ok { $model->clear_graph($g) } 'clear_graph dies on Attean::MutableTripleModel'; } subtest 'Model add_iter' => sub { my $store = Attean->get_store('SimpleTripleStore')->new(); my $model = Attean::MutableTripleModel->new( stores => { 'http://example.org/graph' => $store } ); my $s = Attean::Blank->new('x'); my $p = Attean::IRI->new('http://example.org/p1'); my $o1 = Attean::Literal->new(value => 'foo', language => 'en-US'); my $o2 = Attean::Literal->new(value => 'bar', language => 'en-GB'); my $g = Attean::IRI->new('http://example.org/graph'); my $q1 = Attean::Quad->new($s, $p, $o1, $g); my $q2 = Attean::Quad->new($s, $p, $o2, $g); my $i = Attean::ListIterator->new(values => [$q1, $q2], item_type => 'Attean::API::Quad'); is($model->size, 0, 'size before add_iter'); $model->add_iter($i); is($model->size, 2, 'size after add_iter'); }; subtest 'holds and algebra_holds methods' => sub { my $graph = Attean::IRI->new('http://example.org/graph'); my $store = Attean->get_store('SimpleTripleStore')->new(); my $model = Attean::MutableTripleModel->new( stores => { 'http://example.org/graph' => $store } ); my $parser = Attean->get_parser('turtle')->new(); my $data = <<'END'; @prefix : . @prefix foaf: . :alice a foaf:Person ; foaf:name "Alice" ; foaf:knows :bob . :bob a foaf:Person ; foaf:name "Bob" ; foaf:knows :alice . :eve a foaf:Person ; foaf:name "Eve" . END my $iter = $parser->parse_iter_from_bytes($data); my $quads = $iter->as_quads($graph); $model->add_iter($quads); ok($model->holds(iri('http://example.org/alice')), 'holds(subj)'); ok($model->holds(iri('http://example.org/alice'), iri('http://xmlns.com/foaf/knows')), 'holds(subj, pred)'); ok(!$model->holds(iri('http://example.org/eve'), iri('http://xmlns.com/foaf/knows')), '!holds(subj, pred)'); ok($model->holds(triplepattern(iri('http://example.org/alice'), iri('http://xmlns.com/foaf/name'), variable('name'))), 'holds(triplepattern)'); ok($model->algebra_holds(bgp(triplepattern(iri('http://example.org/alice'), iri('http://xmlns.com/foaf/name'), variable('name')), triplepattern(iri('http://example.org/alice'), iri('http://xmlns.com/foaf/knows'), variable('friend'))), $graph), 'algebra_holds(bgp)'); ok(!$model->algebra_holds(bgp(triplepattern(iri('http://example.org/eve'), iri('http://xmlns.com/foaf/name'), variable('name')), triplepattern(iri('http://example.org/eve'), iri('http://xmlns.com/foaf/knows'), variable('friend'))), $graph), '!algebra_holds(bgp)'); }; done_testing(); Attean-0.034/t/PaxHeader/parser-rdfxml.t000644 000765 000024 00000000425 14077157257 020232 xustar00gregstaff000000 000000 30 mtime=1627184815.945615204 69 LIBARCHIVE.xattr.com.apple.lastuseddate#PS=i939YAAAAADoW+UIAAAAAA 59 SCHILY.xattr.com.apple.lastuseddate#PS=‹Ýý`è[å 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/t/parser-rdfxml.t000644 000765 000024 00000006122 14077157257 016261 0ustar00gregstaff000000 000000 use v5.14; use warnings; use autodie; use Test::Modern; use Test::Exception; use utf8; use Attean; use Attean::RDF; subtest 'parser construction and metadata' => sub { my $parser = Attean->get_parser('RDFXML')->new(); isa_ok( $parser, 'AtteanX::Parser::RDFXML' ); is($parser->canonical_media_type, 'application/rdf+xml', 'canonical_media_type'); my %extensions = map { $_ => 1 } @{ $parser->file_extensions }; ok(exists $extensions{'rdf'}, 'file_extensions'); }; subtest 'empty document' => sub { my $parser = Attean->get_parser('RDFXML')->new(); my @list = $parser->parse_list_from_bytes(''); is(scalar(@list), 0); }; subtest 'invalid documents' => sub { my $parser = Attean->get_parser('RDFXML')->new(); dies_ok { my @list = $parser->parse_list_from_bytes('parse_list_from_bytes(<<"END"); # # # # # # END # use Data::Dumper; # warn Dumper(\@list); # }, 'invalid RDF/XML'; }; subtest 'simple triple parse with namespaces' => sub { my $map = URI::NamespaceMap->new(); my $parser = Attean->get_parser('RDFXML')->new( namespaces => $map ); my $store = Attean->get_store('Memory')->new(); my $content = <<"END"; END my @list = $parser->parse_list_from_bytes($content); is(scalar(@list), 1); my ($t) = @list; does_ok($t, 'Attean::API::Triple'); is($t->as_string, ' "v" .'); is_deeply([sort $map->list_prefixes], [qw(eg rdf)]); my $rdf = $map->namespace_uri('rdf'); isa_ok($rdf, 'URI::Namespace'); is($rdf->as_string, 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'); }; subtest 'bnode prefix' => sub { my $parser = Attean->get_parser('RDFXML')->new( bnode_prefix => 'foo' ); my ($t) = $parser->parse_list_from_bytes(<<"END"); Hello! END my $subj = $t->subject; does_ok($subj, 'Attean::API::Blank'); like($subj->value, qr/^foo/, 'bnode prefix'); }; subtest 'pre-defined base IRI' => sub { my $base = iri('http://example.org/base/'); my $parser = Attean->get_parser('RDFXML')->new( base => $base ); my $content = <<"END"; END my $iter = $parser->parse_iter_from_bytes($content); does_ok($iter, 'Attean::API::Iterator'); my $t = $iter->next; is($t->subject->value, 'http://example.org/base/#subj'); is($t->object->value, 'http://example.org/base/obj/value'); }; done_testing(); Attean-0.034/t/PaxHeader/serializer.t000644 000765 000024 00000006250 14525575742 017620 xustar00gregstaff000000 000000 30 mtime=1700199394.242640365 1830 LIBARCHIVE.xattr.com.apple.ResourceFork=AAABAAAABQgAAAQIAAAAMgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAQAAAAZL0FwcGxpY2F0aW9ucy9CQkVkaXQuYXBwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAUIAAAECAAAADIUAAAAexAAAAAcADIAAHVzcm8AAAAKAAD//wAAAAAPAAAA 1380 SCHILY.xattr.com.apple.ResourceFork=2/Applications/BBEdit.app2{2usro ÿÿ Attean-0.034/t/serializer.t000644 000765 000024 00000001447 14525575742 015652 0ustar00gregstaff000000 000000 use Test::Modern; use Test::Exception; use v5.14; use warnings; no warnings 'redefine'; use Attean; use Attean::RDF; use Encode; use Type::Tiny::Role; my $constraint = 'Attean::API::Triple'; subtest 'serializer access' => sub { my $sclass = Attean->get_serializer('NTriples'); is($sclass, 'AtteanX::Serializer::NTriples'); }; subtest 'serializer access by name' => sub { my $sclass = Attean->get_serializer(media_type => 'application/n-triples'); like($sclass, qr'^AtteanX::Serializer::\w*NTriples$'); }; subtest 'serializer access by media type' => sub { my $sclass = Attean->get_serializer(media_type => 'application/n-triples'); like($sclass, qr'^AtteanX::Serializer::\w*NTriples$'); }; dies_ok { Attean->get_serializer(foo => 'bar'); } 'bad get_serializer argument dies'; done_testing(); Attean-0.034/t/PaxHeader/algebra.t000644 000765 000024 00000000200 12726707707 017030 xustar00gregstaff000000 000000 69 LIBARCHIVE.xattr.com.apple.lastuseddate#PS=1OIqYAAAAAB4DjQnAAAAAA 59 SCHILY.xattr.com.apple.lastuseddate#PS=Ôâ*`x4' Attean-0.034/t/algebra.t000644 000765 000024 00000025750 12726707707 015100 0ustar00gregstaff000000 000000 use v5.14; use autodie; use utf8; use Test::Modern; use Test::Exception; use Digest::SHA qw(sha1_hex); use Attean; use Attean::RDF; { my $b = Attean::Algebra::BGP->new(triples => []); isa_ok($b, 'Attean::Algebra::BGP'); ok($b->does('Attean::API::QueryTree'), 'bgp consumes QueryTree'); ok($b->is_leaf, 'bgp is_leaf'); is($b->arity, 0, 'bgp arity'); ok(not($b->unary), 'BGP is not unary'); } { my $t = triple(iri('s'), iri('p'), literal('1')); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); isa_ok($bgp, 'Attean::Algebra::BGP'); ok($bgp->is_leaf, 'bgp is_leaf'); my $dist = Attean::Algebra::Distinct->new( children => [$bgp] ); is($dist->arity, 1, 'Distinct arity'); ok($dist->unary, 'Distinct is unary'); isa_ok($dist, 'Attean::Algebra::Distinct'); ok(not($dist->is_leaf), 'distinct not is_leaf'); { my @prefix_seen; my @postfix_seen; my $prefix = sub { my $node = shift; my $name = ref($node); $name =~ s/^.*://; push(@prefix_seen, $name); }; my $postfix = sub { my $node = shift; my $name = ref($node); $name =~ s/^.*://; push(@postfix_seen, $name); }; $dist->walk( prefix => $prefix, postfix => $postfix ); is_deeply(\@prefix_seen, [qw'Distinct BGP'], 'prefix walk order'); is_deeply(\@postfix_seen, [qw'BGP Distinct'], 'postfix walk order'); } } { my $t = triplepattern(variable('s'), iri('p'), literal('1')); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); ok($bgp->has_only_subtree_types('Attean::Algebra::BGP')); my $join = Attean::Algebra::Join->new( children => [$bgp, $bgp] ); ok(not $join->has_only_subtree_types('Attean::Algebra::BGP')); my @walk; $join->walk(prefix => sub { push(@walk, shift) }); is(scalar(@walk), 3, 'expected walk count'); my @cover; $join->cover(prefix => sub { push(@cover, shift) }); is(scalar(@cover), 2, 'expected cover count'); } { my $p1 = iri('p1'); my $pp1 = Attean::Algebra::PredicatePath->new( predicate => $p1 ); ok($pp1->does('Attean::API::PropertyPath'), 'PredicatePath consumes PropertyPath'); is($pp1->as_string, '', 'PredicatePath as_string'); my $p2 = iri('p2'); my $pp2 = Attean::Algebra::PredicatePath->new( predicate => $p2 ); my $nps = Attean::Algebra::NegatedPropertySet->new( predicates => [$p1, $p2] ); ok($nps->does('Attean::API::PropertyPath'), 'NegatedPropertySet consumes PropertyPath'); is($nps->as_string, '!(|)', 'NegatedPropertySet as_string'); my $seq1 = Attean::Algebra::SequencePath->new( children => [$pp2] ); is($seq1->as_string, '', 'unary SequencePath as_string'); my $seq = Attean::Algebra::SequencePath->new( children => [$pp1, $pp2] ); is($seq->as_string, '(/)', 'SequencePath as_string'); my $alt1 = Attean::Algebra::AlternativePath->new( children => [$pp2] ); is($alt1->as_string, '', 'unary AlternativePath as_string'); my $alt = Attean::Algebra::AlternativePath->new( children => [$pp1, $pp2] ); is($alt->as_string, '(|)', 'AlternativePath as_string'); my $inv1 = Attean::Algebra::InversePath->new( children => [$pp2] ); is($inv1->as_string, '^', 'InversePath as_string'); my $inv_seq = Attean::Algebra::InversePath->new( children => [$seq] ); is($inv_seq->as_string, '^(/)', 'complex InversePath as_string'); my $inv_seq_star = Attean::Algebra::ZeroOrMorePath->new( children => [$inv_seq] ); is($inv_seq_star->as_string, '(^(/))*', 'complex ZeroOrMorePath as_string'); } { note('BGP canonicalization'); my $b = blank('person'); my $rdf_type = iri('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'); my $foaf_name = iri('http://xmlns.com/foaf/0.1/name'); my $foaf_knows = iri('http://xmlns.com/foaf/0.1/knows'); my $foaf_Person = iri('http://xmlns.com/foaf/0.1/Person'); my $bgp1 = Attean::Algebra::BGP->new( triples => [ triplepattern($b, $rdf_type, $foaf_Person), triplepattern($b, $foaf_name, variable('name')), triplepattern($b, $foaf_knows, variable('knows')), ] ); my $bgp2 = Attean::Algebra::BGP->new( triples => [ triplepattern(blank('s'), $foaf_knows, variable('person')), triplepattern(blank('s'), $rdf_type, $foaf_Person), triplepattern(blank('s'), $foaf_name, variable('myname')), ] ); my $hash1 = sha1_hex( join("\n", map { $_->tuples_string } (@{$bgp1->triples}) ) ); my $hash2 = sha1_hex( join("\n", map { $_->tuples_string } (@{$bgp2->triples}) ) ); isnt($hash1, $hash2, 'non-matching pre-canonicalized BGP hashes'); my ($cbgp1, $m1) = $bgp1->canonical_bgp_with_mapping; my ($cbgp2, $m2) = $bgp2->canonical_bgp_with_mapping; my $chash1 = sha1_hex( join("\n", map { $_->tuples_string } (@{$cbgp1->triples}) ) ); my $chash2 = sha1_hex( join("\n", map { $_->tuples_string } (@{$cbgp2->triples}) ) ); is($chash1, $chash2, 'matching canonicalized BGP hashes' ); is_deeply($m1, { '?name' => { 'prefix' => '?', 'id' => 'v003', 'type' => 'variable' }, '?knows' => { 'id' => 'v002', 'prefix' => '?', 'type' => 'variable' }, '_:person' => { 'id' => 'v001', 'prefix' => '_:', 'type' => 'blank' } }, 'BGP1 mapping'); is_deeply($m2, { '?person' => { 'prefix' => '?', 'id' => 'v002', 'type' => 'variable' }, '_:s' => { 'prefix' => '_:', 'id' => 'v001', 'type' => 'blank' }, '?myname' => { 'type' => 'variable', 'id' => 'v003', 'prefix' => '?' } }, 'BGP2 mapping'); } subtest 'Triple canonicalization' => sub { my $t = triplepattern(variable('bar'), iri('p'), variable('foo')); my $u = triplepattern(variable('subject'), iri('p'), variable('object')); my $v = triplepattern(variable('foo'), iri('p'), variable('foo')); my $w = triplepattern(variable('x'), iri('p'), variable('x')); is($t->canonicalize->as_string, $u->canonicalize->as_string, 'Canonical strings match for 2-variable triple'); isnt($t->canonicalize->as_string, $v->canonicalize->as_string, 'Canonical strings do not match for 2-variable triple'); is($v->canonicalize->as_string, $w->canonicalize->as_string, 'Canonical strings match for 1 shared-variable triple'); }; subtest 'Quad canonicalization' => sub { my $t = quadpattern(variable('bar'), iri('p'), variable('foo'), iri('g')); my $u = quadpattern(variable('subject'), iri('p'), variable('object'), iri('g')); my $v = quadpattern(variable('foo'), iri('p'), literal('1'), variable('foo')); my $w = quadpattern(variable('x'), iri('p'), literal('1'), variable('x')); my $x = quadpattern(variable('x'), iri('p'), variable('x'), variable('x')); my $y = quadpattern(variable('x'), iri('p'), variable('x'), variable('x')); is($t->canonicalize->as_string, $u->canonicalize->as_string, 'Canonical strings match for 2-variable quad'); isnt($t->canonicalize->as_string, $v->canonicalize->as_string, 'Canonical strings do not match for 2-variable quad'); is($v->canonicalize->as_string, $w->canonicalize->as_string, 'Canonical strings match for 1 shared-variable quad'); is($x->canonicalize->as_string, $y->canonicalize->as_string, 'Canonical strings match for 1 twice-shared-variable quad'); }; { my $t = triplepattern(variable('s'), iri('p'), variable('o')); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my @groups = Attean::ValueExpression->new( value => variable('s') ); my @aggs = Attean::AggregateExpression->new( distinct => 0, operator => 'SUM', children => [Attean::ValueExpression->new( value => variable('s') )], scalar_vars => {}, variable => variable("sum"), ); my $agg = Attean::Algebra::Group->new( children => [$bgp], groupby => \@groups, aggregates => \@aggs, ); my $s = $agg->as_string; like($s, qr/Group [{] [?]s [}] aggregate [{] [?]sum ↠SUM\([?]s\) [}]/, 'aggregate serialization'); } subtest 'Aggregation' => sub { my $t = triplepattern(variable('s'), iri('p'), variable('o')); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my @groups = Attean::ValueExpression->new( value => variable('s') ); my @aggs = Attean::AggregateExpression->new( distinct => 0, operator => 'SUM', children => [Attean::ValueExpression->new( value => variable('s') )], scalar_vars => {}, variable => variable("sum"), ); my $agg = Attean::Algebra::Group->new( children => [$bgp], groupby => \@groups, aggregates => \@aggs, ); my $s = $agg->as_string; like($s, qr/Group [{] [?]s [}] aggregate [{] [?]sum ↠SUM\([?]s\) [}]/, 'aggregate serialization'); }; subtest 'Ranking' => sub { # RANKing example for 2 youngest students per school my $bgp = Attean::Algebra::BGP->new(triples => [ triplepattern(variable('p'), iri('ex:name'), variable('name')), triplepattern(variable('p'), iri('ex:school'), variable('school')), triplepattern(variable('p'), iri('ex:age'), variable('age')), ]); my @groups = Attean::ValueExpression->new( value => variable('school') ); my $r_agg = Attean::AggregateExpression->new( distinct => 0, operator => 'RANK', children => [Attean::ValueExpression->new( value => variable('age') )], scalar_vars => {}, variable => variable("rank"), ); my $agg = Attean::Algebra::Group->new( children => [$bgp], groupby => \@groups, aggregates => [$r_agg], ); my $rank = Attean::Algebra::Filter->new( children => [$agg], expression => Attean::BinaryExpression->new( children => [ Attean::ValueExpression->new( value => variable('rank') ), Attean::ValueExpression->new( value => Attean::Literal->integer('2') ), ], operator => '<=' ), ); my $s = $rank->as_string; like($s, qr/Group [{] [?]school [}] aggregate [{] [?]rank ↠RANK\([?]age\) [}]/, 'ranking serialization'); }; subtest 'Query Serialization' => sub { { my $a = Attean->get_parser('SPARQL')->parse('SELECT * WHERE { ?s ?p 2 }'); like($a->as_string, qr/Query.*Project.*BGP/s); } { my $a = Attean->get_parser('SPARQL')->parse('SELECT REDUCED * WHERE { SERVICE { ?s

*/ 2 } } ORDER BY ?s'); like($a->as_string, qr/Query.*Reduced.*Project.*Order.*Service.*Path/s); } { my $a = Attean->get_parser('SPARQL')->parse('SELECT * WHERE { { ?s

1 . BIND(?s+1 AS ?x) } UNION { GRAPH { ?s

1 } } }'); like($a->as_string, qr/Project.*Union.*Extend.*BGP.*Graph.*BGP/s); } { my $a = Attean->get_parser('SPARQL')->parse('SELECT * WHERE { { ?s

1 } MINUS { ?s 2 } }'); like($a->as_string, qr/Query.*Project.*Minus.*BGP.*BGP/s); } { my $a = Attean->get_parser('SPARQL')->parse('SELECT * WHERE { ?s 2 } VALUES (?z) { ("abc") ("def") }'); like($a->as_string, qr/Query.*Project.*Join.*BGP.*Table/s); } { my $a = Attean->get_parser('SPARQL')->parse('CONSTRUCT { ?s ?p 1 } WHERE { ?s ?p 2 }'); like($a->as_string, qr/Query.*Construct.*BGP/s); like($a->as_string, qr/1/s); like($a->as_string, qr/2/s); } }; subtest 'Modify' => sub { my $a = Attean->get_parser('SPARQL')->parse_update('INSERT { ?s ?p 1 } WHERE { ?s ?p 2 }'); is_deeply([$a->in_scope_variables], []); like($a->as_string, qr/Update.*Insert.*Data/s); }; subtest 'Add' => sub { my $a = Attean->get_parser('SPARQL')->parse_update('ADD GRAPH TO DEFAULT'); is_deeply([$a->in_scope_variables], []); like($a->as_string, qr/Update.*Add/s); }; subtest 'Update Sequence' => sub { my $a = Attean->get_parser('SPARQL')->parse_update('ADD GRAPH TO DEFAULT; ADD GRAPH TO DEFAULT'); like($a->as_string, qr/Update.*Add.*Add/s); }; done_testing(); Attean-0.034/t/PaxHeader/term.t000644 000765 000024 00000006503 14525575742 016417 xustar00gregstaff000000 000000 30 mtime=1700199394.243504865 1830 LIBARCHIVE.xattr.com.apple.ResourceFork=AAABAAAABQgAAAQIAAAAMgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAQAAAAZL0FwcGxpY2F0aW9ucy9CQkVkaXQuYXBwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAUIAAAECAAAADIcAAAAlhAAAAAcADIAAHVzcm8AAAAKAAD//wAAAAAXAAAA 1380 SCHILY.xattr.com.apple.ResourceFork=2/Applications/BBEdit.app2–2usro ÿÿ 85 LIBARCHIVE.xattr.com.apple.FinderInfo=VEVYVAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 70 SCHILY.xattr.com.apple.FinderInfo=TEXT Attean-0.034/t/term.t000644 000765 000024 00000010303 14525575742 014437 0ustar00gregstaff000000 000000 use v5.14; use utf8; use Data::Dumper; use Test::Modern; use Type::Tiny::Role; use Attean::RDF; my $XSD = "http://www.w3.org/2001/XMLSchema#"; is(iri('http://example.org/')->ntriples_string, '', 'IRI ntriples_string'); is(iri('http://example.org/✪')->ntriples_string, '', 'unicode IRI ntriples_string'); is(literal("ðŸ¶\\\n✪")->ntriples_string, qq["ðŸ¶\\\\\\n✪"], 'unicode literal ntriples_string'); is(literal('Eve')->ntriples_string, '"Eve"', 'literal ntriples_string'); is(langliteral('Eve', 'en')->ntriples_string, '"Eve"@en', 'lang-literal ntriples_string'); is(blank('eve')->ntriples_string, '_:eve', 'blank ntriples_string'); ok(Attean::Literal->integer(1)->ebv, '1 EBV'); ok(not(Attean::Literal->integer(0)->ebv), '0 EBV'); ok(not(literal('')->ebv), '"" EBV'); ok(literal('foo')->ebv, '"foo" EBV'); ok(blank('foo')->ebv, '_:foo EBV'); ok(iri('foo')->ebv, ' EBV'); is(dtliteral('1', "${XSD}integer")->numeric_value, 1, 'integer numeric value'); is(dtliteral('1.5', "${XSD}float")->numeric_value, 1.5, 'float numeric value'); is(dtliteral('2.2e3', "${XSD}double")->numeric_value, 2200, 'double numeric value'); is(dtliteral('2.5', "${XSD}decimal")->numeric_value, 2.5, 'decimal numeric value'); subtest 'term type check methods' => sub { my $xl = literal("ðŸ¶\\\n✪"); my $dtl = dtliteral('1', "${XSD}integer"); my $ll = langliteral('Eve', 'en'); foreach my $l ($xl, $dtl, $ll) { ok($l->is_literal); foreach my $type (qw(variable blank resource iri)) { my $method = "is_$type"; ok(not($l->$method())); } } }; { my $l1 = literal(7); my $l2 = literal(10); is($l1->compare($l2), 1, 'non-numeric literal sort'); } { my $i1 = Attean::Literal->integer(7); my $i2 = Attean::Literal->integer(10); does_ok($i1, 'Attean::API::NumericLiteral'); does_ok($i2, 'Attean::API::NumericLiteral'); is($i1->compare($i2), -1, 'numeric literal sort'); } subtest 'XSD type promotion' => sub { { my $a = dtliteral('2', 'http://www.w3.org/2001/XMLSchema#long'); my $b = dtliteral('2', 'http://www.w3.org/2001/XMLSchema#short'); is($a->binary_promotion_type($b, '+'), 'http://www.w3.org/2001/XMLSchema#long'); } { my $a = dtliteral('2', 'http://www.w3.org/2001/XMLSchema#positiveInteger'); my $b = dtliteral('2', 'http://www.w3.org/2001/XMLSchema#unsignedByte'); is($a->binary_promotion_type($b, '+'), 'http://www.w3.org/2001/XMLSchema#nonNegativeInteger'); } { my $a = dtliteral('2', 'http://www.w3.org/2001/XMLSchema#positiveInteger'); my $b = dtliteral('2', 'http://www.w3.org/2001/XMLSchema#unsignedByte'); is($a->binary_promotion_type($b, '/'), 'http://www.w3.org/2001/XMLSchema#decimal'); } { my $a = dtliteral('2', 'http://www.w3.org/2001/XMLSchema#positiveInteger'); my $b = dtliteral('2', 'http://www.w3.org/2001/XMLSchema#unsignedByte'); is($a->binary_promotion_type($b, '/'), 'http://www.w3.org/2001/XMLSchema#decimal'); } { my $a = dtliteral('2', 'http://www.w3.org/2001/XMLSchema#float'); my $b = dtliteral('2', 'http://www.w3.org/2001/XMLSchema#float'); is($a->binary_promotion_type($b, '*'), 'http://www.w3.org/2001/XMLSchema#float'); } { my $a = dtliteral('2', 'http://www.w3.org/2001/XMLSchema#float'); my $b = dtliteral('2', 'http://www.w3.org/2001/XMLSchema#double'); is($a->binary_promotion_type($b, '*'), 'http://www.w3.org/2001/XMLSchema#double'); } }; subtest 'TermOrVariable apply_binding' => sub { my $i = Attean::Literal->integer(350); my $unbound = Attean::Variable->new(value => 'number'); my $bound = Attean::Variable->new(value => 'x'); my $b = Attean::Result->new( bindings => { x => literal('foo'), z => blank('bar') } ); my $a_i = $i->apply_binding($b); does_ok($a_i, 'Attean::API::Literal'); my $a_unbound = $unbound->apply_binding($b); does_ok($a_unbound, 'Attean::API::Variable'); my $a_bound = $bound->apply_binding($b); does_ok($a_bound, 'Attean::API::Literal'); is($a_bound->value, 'foo'); }; subtest 'blank comparison' => sub { my $b1 = blank('foo'); my $b2 = blank('bar'); my $b3 = blank('foo'); is($b1->compare($b3), 0, 'blank term equality comparison'); is($b1->compare($b2), 1, 'blank term equality comparison'); is($b2->compare($b3), -1, 'blank term equality comparison'); }; done_testing(); Attean-0.034/t/PaxHeader/model-quad.t000644 000765 000024 00000000225 14247555023 017462 xustar00gregstaff000000 000000 30 mtime=1654577683.242417568 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/t/model-quad.t000644 000765 000024 00000025665 14247555023 015530 0ustar00gregstaff000000 000000 use Test::Modern; use Test::Exception; use v5.14; use warnings; no warnings 'redefine'; use Attean; use Attean::RDF; use Type::Tiny::Role; { my $model = Attean->temporary_model; isa_ok($model, 'Attean::QuadModel'); does_ok($model, 'Attean::API::MutableModel'); } { my $store = Attean->get_store('Memory')->new(); isa_ok($store, 'AtteanX::Store::Memory'); my $model = Attean::MutableQuadModel->new( store => $store ); isa_ok($model, 'Attean::MutableQuadModel'); my $s = Attean::Blank->new('x'); my $p = Attean::IRI->new('http://example.org/p1'); my $o = Attean::Literal->new(value => 'foo', language => 'en-US'); my $g = Attean::IRI->new('http://example.org/graph'); my $q = Attean::Quad->new($s, $p, $o, $g); does_ok($q, 'Attean::API::Quad'); isa_ok($q, 'Attean::Quad'); $model->add_quad($q); is($model->size, 1); { my $iter = $model->get_quads($s); does_ok($iter, 'Attean::API::Iterator'); my $q = $iter->next; does_ok($q, 'Attean::API::Quad'); my ($s, $p, $o, $g) = $q->values; is($s->value, 'x'); is($o->value, 'foo'); } my $s2 = Attean::IRI->new('http://example.org/values'); foreach my $value (1 .. 3) { my $o = Attean::Literal->new(value => $value, datatype => 'http://www.w3.org/2001/XMLSchema#integer'); my $p = Attean::IRI->new("http://example.org/p$value"); my $g = Attean::IRI->new("http://example.org/graph" . ($value+1)); my $q = Attean::Quad->new($s2, $p, $o, $g); $model->add_quad($q); } is($model->size, 4); is($model->count_quads($s), 1); is($model->count_quads($s2), 3); is($model->count_quads(), 4); is($model->count_quads(undef, $p), 2); ok($model->holds($s2)); ok(!$model->holds($s2, $g)); { note('get_quads single-term matching with undef placeholders'); my $iter = $model->get_quads($s2); while (my $q = $iter->next()) { my $o = $q->object->value; like($o, qr/^[123]$/, "Literal value: $o"); } } { note('get_quads single-term matching with variable object placeholders'); my @vars = map { Attean::Variable->new($_) } qw(p o g); my $iter = $model->get_quads($s2, @vars); does_ok($iter, 'Attean::API::Iterator'); while (my $q = $iter->next()) { my $o = $q->object->value; like($o, qr/^[123]$/, "Literal value: $o"); } } { note('get_bindings single-term matching'); my $v = Attean::Variable->new('pred'); my $iter = $model->get_bindings($s2, $v); does_ok($iter, 'Attean::API::Iterator'); my $count = 0; while (my $b = $iter->next()) { $count++; does_ok($b, 'Attean::API::Result'); is_deeply([$b->variables], [qw(pred)], 'expected binding variables'); my $p = $b->value('pred'); my $v = $p->value; does_ok($p, 'Attean::API::Term'); like($v, qr<^http://example.org/p[123]$>, "Predicate value: $v"); } is($count, 3, 'expected binding count'); } { note('get_quads union-term matching'); my $g2 = Attean::IRI->new("http://example.org/graph2"); my $g3 = Attean::IRI->new("http://example.org/graph3"); my $g4 = Attean::IRI->new("http://example.org/graph4"); my $p1 = Attean::IRI->new("http://example.org/p1"); my $p3 = Attean::IRI->new("http://example.org/p3"); my $iter = $model->get_quads(undef, [$p1, $p3], undef, [$g2, $g3, $g4]); my $count = 0; while (my $q = $iter->next()) { $count++; my $o = $q->object->value; like($o, qr/^[13]$/, "Literal value: $o"); } is($count, 2); } note('removing data...'); $model->remove_quad($q); is($model->size, 3); is($model->count_quads(undef, $p), 1); { note('objects() matching'); my $objects = $model->objects(); does_ok($objects, 'Attean::API::Iterator'); is($objects->item_type, 'Attean::API::Term', 'expected item_type'); my $count = 0; while (my $obj = $objects->next) { $count++; does_ok($obj, 'Attean::API::Literal'); like($obj->value, qr/^[123]$/, "Literal value: $o"); } is($count, 3); } { note('graphs() union-term matching'); my $p1 = Attean::IRI->new("http://example.org/p1"); my $p3 = Attean::IRI->new("http://example.org/p3"); my $graphs = $model->graphs(undef, [$p1, $p3]); does_ok($graphs, 'Attean::API::Iterator'); is($graphs->item_type, 'Attean::API::Term', 'expected item_type'); my $count = 0; while (my $g = $graphs->next) { $count++; like($g->value, qr<^http://example.org/graph[24]$>, "Graph value: $g"); } is($count, 2, 'expected graph count'); } } subtest 'Model add_iter' => sub { my $store = Attean->get_store('Memory')->new(); my $model = Attean::MutableQuadModel->new( store => $store ); my $s = Attean::Blank->new('x'); my $p = Attean::IRI->new('http://example.org/p1'); my $o1 = Attean::Literal->new(value => 'foo', language => 'en-US'); my $o2 = Attean::Literal->new(value => 'bar', language => 'en-GB'); my $g = Attean::IRI->new('http://example.org/graph'); my $q1 = Attean::Quad->new($s, $p, $o1, $g); my $q2 = Attean::Quad->new($s, $p, $o2, $g); my $i = Attean::ListIterator->new(values => [$q1, $q2], item_type => 'Attean::API::Quad'); is($model->size, 0, 'size before add_iter'); $model->add_iter($i); is($model->size, 2, 'size after add_iter'); }; subtest 'List helper methods' => sub { my $graph = Attean::IRI->new('http://example.org/list-graph'); my $store = Attean->get_store('Memory')->new(); my $model = Attean::MutableQuadModel->new( store => $store ); dies_ok { $model->add_list() } 'add_list with bad arguments'; dies_ok { $model->get_list($graph) } 'get_list with bad arguments'; my $head = $model->add_list($graph, map { Attean::Literal->integer($_) } (1 .. 3)); my $iter = $model->get_quads; # while (my $q = $iter->next) { say $q->as_string } is($model->size, 6, 'expected add_list model size'); my $list = $model->get_list($graph, $head); does_ok($list, 'Attean::API::Iterator', 'get_list returned iterator'); is_deeply([map { $_->value } $list->elements], [1,2,3], 'get_list elements'); }; subtest 'Sequence helper methods' => sub { my $graph = Attean::IRI->new('http://example.org/list-graph'); my $store = Attean->get_store('Memory')->new(); my $parser = Attean->get_parser('ntriples')->new(); my $data = <<'END'; . "banana" . "apple" . "pear" . END my $iter = $parser->parse_iter_from_bytes($data); my $quads = $iter->as_quads($graph); $store->add_iter($quads); my $model = Attean::MutableQuadModel->new( store => $store ); my $seq = $model->get_sequence($graph, iri('http://example.org/favourite-fruit')); does_ok($seq, 'Attean::API::Iterator', 'get_sequence returned iterator'); is_deeply([map { $_->value } $seq->elements], [qw(banana apple pear)], 'get_sequence elements'); $model->add_quad(quad(iri('http://example.org/favourite-fruit'), iri('http://www.w3.org/1999/02/22-rdf-syntax-ns#_2'), literal('kiwi'), $graph)); dies_ok { $model->get_sequence($graph, iri('http://example.org/favourite-fruit')) } 'get_sequence dies on invalid sequence data'; }; subtest 'holds and algebra_holds methods' => sub { my $graph = Attean::IRI->new('http://example.org/graph'); my $store = Attean->get_store('Memory')->new(); my $parser = Attean->get_parser('turtle')->new(); my $data = <<'END'; @prefix : . @prefix foaf: . :alice a foaf:Person ; foaf:name "Alice" ; foaf:knows :bob . :bob a foaf:Person ; foaf:name "Bob" ; foaf:knows :alice . :eve a foaf:Person ; foaf:name "Eve" . END my $iter = $parser->parse_iter_from_bytes($data); my $quads = $iter->as_quads($graph); $store->add_iter($quads); my $model = Attean::MutableQuadModel->new( store => $store ); ok($model->holds(iri('http://example.org/alice')), 'holds(subj)'); ok($model->holds(iri('http://example.org/alice'), iri('http://xmlns.com/foaf/knows')), 'holds(subj, pred)'); ok(!$model->holds(iri('http://example.org/eve'), iri('http://xmlns.com/foaf/knows')), '!holds(subj, pred)'); ok($model->holds(triplepattern(iri('http://example.org/alice'), iri('http://xmlns.com/foaf/name'), variable('name'))), 'holds(triplepattern)'); ok($model->algebra_holds(bgp(triplepattern(iri('http://example.org/alice'), iri('http://xmlns.com/foaf/name'), variable('name')), triplepattern(iri('http://example.org/alice'), iri('http://xmlns.com/foaf/knows'), variable('friend'))), $graph), 'algebra_holds(bgp)'); ok(!$model->algebra_holds(bgp(triplepattern(iri('http://example.org/eve'), iri('http://xmlns.com/foaf/name'), variable('name')), triplepattern(iri('http://example.org/eve'), iri('http://xmlns.com/foaf/knows'), variable('friend'))), $graph), '!algebra_holds(bgp)'); }; package TruePlan { use Moo; extends 'Attean::Plan::Exists'; sub plan_as_string { return 'AlwaysTrue' } sub impl { return sub { return Attean::ListIterator->new(values => [Attean::Literal->true], item_type => 'Attean::API::Term'); } } } package AllAlgebrasHoldMemoryStore { use Moo; extends 'AtteanX::Store::Memory'; with 'Attean::API::CostPlanner'; sub plans_for_algebra { my $self = shift; my $algebra = shift; if ($algebra->isa('Attean::Algebra::Ask')) { return TruePlan->new(); } return; } sub cost_for_plan { my $self = shift; my $plan = shift; if ($plan->isa('TruePlan')) { return 1 } return; } } subtest 'holds planning optimization' => sub { my $graph = Attean::IRI->new('http://example.org/graph'); my $store = AllAlgebrasHoldMemoryStore->new(); my $parser = Attean->get_parser('turtle')->new(); my $data = <<'END'; @prefix : . :x :p 1, 2, 3 . END my $iter = $parser->parse_iter_from_bytes($data); my $quads = $iter->as_quads($graph); $store->add_iter($quads); my $model = Attean::MutableQuadModel->new( store => $store ); # holds() calls will fail because node of the matching data is in the store ok(!$model->holds(iri('http://example.org/alice')), 'holds(subj)'); ok(!$model->holds(iri('http://example.org/alice'), iri('http://xmlns.com/foaf/knows')), 'holds(subj, pred)'); ok(!$model->holds(iri('http://example.org/eve'), iri('http://xmlns.com/foaf/knows')), '!holds(subj, pred)'); ok(!$model->holds(triplepattern(iri('http://example.org/alice'), iri('http://xmlns.com/foaf/name'), variable('name'))), 'holds(triplepattern)'); # algebra_holds calls will pass because AllAlgebrasHoldMemoryStore will override query planning to return TruePlan query plans ok($model->algebra_holds(bgp(triplepattern(iri('http://example.org/alice'), iri('http://xmlns.com/foaf/name'), variable('name')), triplepattern(iri('http://example.org/alice'), iri('http://xmlns.com/foaf/knows'), variable('friend'))), $graph), 'algebra_holds(bgp)'); ok($model->algebra_holds(bgp(triplepattern(iri('http://example.org/eve'), iri('http://xmlns.com/foaf/name'), variable('name')), triplepattern(iri('http://example.org/eve'), iri('http://xmlns.com/foaf/knows'), variable('friend'))), $graph), '!algebra_holds(bgp)'); }; done_testing(); Attean-0.034/t/PaxHeader/expression.t000644 000765 000024 00000006503 14525575742 017647 xustar00gregstaff000000 000000 30 mtime=1700199394.238194573 1830 LIBARCHIVE.xattr.com.apple.ResourceFork=AAABAAAABQgAAAQIAAAAMgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAQAAAAZL0FwcGxpY2F0aW9ucy9CQkVkaXQuYXBwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAUIAAAECAAAADIKAAAAXRAAAAAcADIAAHVzcm8AAAAKAAD//wAAAAAFAAAA 1380 SCHILY.xattr.com.apple.ResourceFork=2/Applications/BBEdit.app2 ]2usro ÿÿ 85 LIBARCHIVE.xattr.com.apple.FinderInfo=VEVYVAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 70 SCHILY.xattr.com.apple.FinderInfo=TEXT Attean-0.034/t/expression.t000644 000765 000024 00000012172 14525575742 015675 0ustar00gregstaff000000 000000 use v5.14; use autodie; use utf8; use Test::Modern; use Test::Exception; use Attean; use Attean::RDF; use Attean::Expression; use Attean::SimpleQueryEvaluator; { my $t = Attean::Literal->true; isa_ok($t, 'Attean::Literal'); is($t->value, 'true'); } my $true = Attean::Literal->true; my $false = Attean::Literal->false; my $t = Attean::ValueExpression->new( value => $true ); my $f = Attean::ValueExpression->new( value => $false ); my $two = Attean::ValueExpression->new( value => Attean::Literal->integer(2) ); my $foo = Attean::ValueExpression->new( value => literal('foo') ); dies_ok { Attean::BinaryExpression->new( children => [$t, $f], operator => '***' ) } 'Bad BinaryExpression operator'; is($foo->as_string, '"foo"'); is($two->as_string, '2'); is($two->arity, 0); my $eval = Attean::SimpleQueryEvaluator::ExpressionEvaluator->new(); { my $tt = $eval->evaluate_expression($t); is_deeply($tt, $true, 'ValueExpression evaluate'); } { my $e = Attean::BinaryExpression->new( children => [$t, $f], operator => '&&' ); ok($e->does('Attean::API::Expression')); is($e->as_string, '(true && false)', 'binary &&'); } { my $e = Attean::UnaryExpression->new( children => [$f], operator => '!' ); ok($e->does('Attean::API::Expression')); is($e->arity, 1); is($e->as_string, '!(false)', 'unary not'); } { my $e = Attean::UnaryExpression->new( children => [$f], operator => 'not' ); ok($e->does('Attean::API::Expression')); is($e->as_string, '!(false)', 'unary not'); } { my $e = Attean::FunctionExpression->new( children => [$f, $t], operator => 'coalesce' ); ok($e->does('Attean::API::Expression')); is($e->operator, 'COALESCE'); is($e->as_string, 'COALESCE(false, true)', 'function coalesce'); } { my $expr = Attean::ValueExpression->new( value => variable('foo') ); my $b = Attean::Result->new( bindings => { foo => literal('bar'), baz => iri('quux') } ); my $foo = $eval->evaluate_expression($expr, $b); does_ok($foo, 'Attean::API::Literal'); is($foo->value, 'bar'); } note('Expression evaluation'); my $ident = Attean::Result->new(); { my $a = integer(2); my $b = integer(4); my $error = Attean::BinaryExpression->new( children => [integer(1), integer(0)], operator => '/' ); { my $plus = Attean::BinaryExpression->new( children => [$a, $b], operator => '+' ); my $v = $eval->evaluate_expression($plus, $ident); does_ok($v, 'Attean::API::NumericLiteral'); is($v->numeric_value, 6, 'numeric +'); is($v->datatype->value, 'http://www.w3.org/2001/XMLSchema#integer', 'expected result datatype'); } { my $plus = Attean::BinaryExpression->new( children => [$a, $b], operator => '-' ); my $v = $eval->evaluate_expression($plus, $ident); does_ok($v, 'Attean::API::NumericLiteral'); is($v->numeric_value, -2, 'numeric -'); is($v->datatype->value, 'http://www.w3.org/2001/XMLSchema#integer', 'expected result datatype'); } { my $plus = Attean::BinaryExpression->new( children => [$a, $b], operator => '*' ); my $v = $eval->evaluate_expression($plus, $ident); does_ok($v, 'Attean::API::NumericLiteral'); is($v->numeric_value, 8, 'numeric *'); is($v->datatype->value, 'http://www.w3.org/2001/XMLSchema#integer', 'expected result datatype'); } { my $plus = Attean::BinaryExpression->new( children => [$a, $b], operator => '/' ); my $v = $eval->evaluate_expression($plus, $ident); does_ok($v, 'Attean::API::NumericLiteral'); is($v->numeric_value, 0.5, 'numeric /'); is($v->datatype->value, 'http://www.w3.org/2001/XMLSchema#decimal', 'expected result datatype'); } { my $iri = Attean::ValueExpression->new( value => iri('http://example.org/') ); my $plus = Attean::BinaryExpression->new( children => [$a, $iri], operator => '+' ); is($eval->evaluate_expression($plus, $ident), undef, 'TypeError on bad operand numeric op'); } { # The SPARQL 1.1 logical truth table from my %values = ('T' => $t, 'F' => $f, 'E' => $error); my %expected; $expected{qw(T T)} = { '||' => 'T', '&&' => 'T' }; $expected{qw(T F)} = { '||' => 'T', '&&' => 'F' }; $expected{qw(F T)} = { '||' => 'T', '&&' => 'F' }; $expected{qw(F F)} = { '||' => 'F', '&&' => 'F' }; $expected{qw(T E)} = { '||' => 'T', '&&' => 'E' }; $expected{qw(E T)} = { '||' => 'T', '&&' => 'E' }; $expected{qw(F E)} = { '||' => 'E', '&&' => 'F' }; $expected{qw(E F)} = { '||' => 'E', '&&' => 'F' }; $expected{qw(E E)} = { '||' => 'E', '&&' => 'E' }; foreach my $op (qw(|| &&)) { foreach my $l (qw(T F E)) { foreach my $r (qw(T F E)) { my $lhs = $values{$l}; my $rhs = $values{$r}; my $expr = Attean::BinaryExpression->new( children => [$lhs, $rhs], operator => $op ); my $expect = $expected{$l, $r}{$op}; if ($expect eq 'E') { my $term = $eval->evaluate_expression($expr, $ident); is($term, undef, "$l $op $r => $expect"); } else { my $value = ($expect eq 'T') ? 'true' : 'false'; my $term = $eval->evaluate_expression($expr, $ident); is($term->value, $value, "$l $op $r => $expect"); } } } } } } done_testing(); sub integer { my $value = shift; return Attean::ValueExpression->new( value => Attean::Literal->integer($value) ); } Attean-0.034/t/PaxHeader/serializer-nquads.t000644 000765 000024 00000006250 14525575742 021111 xustar00gregstaff000000 000000 30 mtime=1700199394.241191156 1830 LIBARCHIVE.xattr.com.apple.ResourceFork=AAABAAAABQgAAAQIAAAAMgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAQAAAAZL0FwcGxpY2F0aW9ucy9CQkVkaXQuYXBwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAUIAAAECAAAADIVAAAAfhAAAAAcADIAAHVzcm8AAAAKAAD//wAAAAAQAAAA 1380 SCHILY.xattr.com.apple.ResourceFork=2/Applications/BBEdit.app2~2usro ÿÿ Attean-0.034/t/serializer-nquads.t000644 000765 000024 00000003446 14525575742 017144 0ustar00gregstaff000000 000000 use Test::Modern; use Test::Exception; use v5.14; use warnings; no warnings 'redefine'; use Attean; use Type::Tiny::Role; my $constraint = 'Attean::API::TripleOrQuad'; my $s = Attean::Blank->new('x'); my $p = Attean::IRI->new('http://example.org/p'); my $o1 = Attean::Literal->new(value => '1', datatype => 'http://www.w3.org/2001/XMLSchema#integer'); my $o2 = Attean::Literal->new(value => '2', datatype => 'http://www.w3.org/2001/XMLSchema#integer'); my $graph = Attean::IRI->new('http://example.org/default'); my $t1 = Attean::Triple->new($s, $p, $o1); my $t2 = Attean::Quad->new($s, $p, $o2, $graph); my @bindings = ($t1, $t2); my $ser = Attean->get_serializer('NQuads')->new(); does_ok($ser, 'Attean::API::Serializer'); does_ok($ser, 'Attean::API::MixedStatementSerializer'); isa_ok($ser, 'AtteanX::Serializer::NQuads'); my $expected = <<"END"; _:x "1"^^ . _:x "2"^^ . END { my $i = Attean::ListIterator->new(values => [@bindings], item_type => $constraint); my $data1 = $ser->serialize_iter_to_bytes($i); my $data2 = $ser->serialize_list_to_bytes(@bindings); is($data1, $expected, 'serialize_iter_to_bytes'); is($data1, $data2, 'serialize_list_to_bytes'); } { my $i = Attean::ListIterator->new(values => [@bindings], item_type => $constraint); my $data = ''; open(my $fh, '>', \$data); $ser->serialize_iter_to_io($fh, $i); close($fh); is($data, $expected, 'serialize_iter_to_io'); } { my $i = Attean::ListIterator->new(values => [@bindings], item_type => $constraint); my $data = ''; open(my $fh, '>', \$data); $ser->serialize_list_to_io($fh, @bindings); close($fh); is($data, $expected, 'serialize_iter_to_io'); } done_testing(); Attean-0.034/t/serializer-sparqljson.t000644 000765 000024 00000004755 12723721161 020033 0ustar00gregstaff000000 000000 use Test::Modern; use Test::Exception; use utf8; use v5.14; use warnings; no warnings 'redefine'; use JSON qw(decode_json); use Attean; use Attean::RDF; use Type::Tiny::Role; my $constraint = 'Attean::API::Result'; my @vars = qw(subject predicate object); my $s = Attean::Blank->new('x'); my $p = Attean::IRI->new('http://example.org/p'); my $o1 = Attean::Literal->new(value => '1', datatype => 'http://www.w3.org/2001/XMLSchema#integer'); my $o2 = Attean::Literal->new(value => 'ç«', language => 'en-US'); my $t1 = Attean::Result->new(bindings => { subject => $s, predicate => $p, object => $o1 }); my $t2 = Attean::Result->new(bindings => { subject => $s, predicate => $p, object => $o2 }); my $t3 = Attean::Result->new(bindings => { subject => iri('http://perlrdf.org/') }); my @triples = ($t1, $t2, $t3); is(Attean->get_serializer('sparqljson'), 'AtteanX::Serializer::SPARQLJSON', 'get serializer by name'); is(Attean->get_serializer(media_type => 'application/sparql-results+json'), 'AtteanX::Serializer::SPARQLJSON', 'get serializer by media type'); { my $ser = Attean->get_serializer('SPARQLJSON')->new(); does_ok($ser, 'Attean::API::Serializer'); does_ok($ser, 'Attean::API::AppendableSerializer'); does_ok($ser, 'Attean::API::ResultSerializer'); isa_ok($ser, 'AtteanX::Serializer::SPARQLJSON'); my @media_types = @{ $ser->media_types }; is($media_types[0], $ser->canonical_media_type(), 'media_types'); my $expected = {"head" => {"vars" => ["object","predicate","subject"]},"results" => {"bindings" => [{"object" => {"type" => "literal","value" => "1"},"predicate" => {"type" => "uri","value" => "http://example.org/p"},"subject" => {"type" => "bnode","value" => "x"}},{"object" => {"type" => "literal","value" => "ç«"},"predicate" => {"type" => "uri","value" => "http://example.org/p"},"subject" => {"type" => "bnode","value" => "x"}},{"subject" => {"type" => "uri","value" => "http://perlrdf.org/"}}]}}; { my $i = Attean::ListIterator->new(values => [@triples], item_type => $constraint, variables => [@vars]); my $b = $ser->serialize_iter_to_bytes($i); my $data = decode_json($b); is_deeply($data, $expected, 'serialize_iter_to_bytes'); } { my $i = Attean::ListIterator->new(values => [@triples], item_type => $constraint, variables => [@vars]); my $bytes = ''; open(my $fh, '>:encoding(UTF-8)', \$bytes); $ser->serialize_iter_to_io($fh, $i); close($fh); my $data = decode_json($bytes); is_deeply($data, $expected, 'serialize_iter_to_io'); } } done_testing(); Attean-0.034/t/parser-ntriples.t000644 000765 000024 00000011312 12651717125 016612 0ustar00gregstaff000000 000000 use v5.14; use warnings; use autodie; use Test::Modern; use utf8; use Attean; sub iri { Attean::IRI->new(shift) } sub blank { Attean::Blank->new(shift) } sub literal { my ($value, $lang, $dt) = @_; if ($lang) { return Attean::Literal->new(value => $value, language => $lang); } elsif ($dt) { return Attean::Literal->new(value => $value, datatype => $dt); } else { return Attean::Literal->new($value); } } subtest 'parser construction and metadata' => sub { my $parser = Attean->get_parser('NTriples')->new(); isa_ok($parser, 'AtteanX::Parser::NTriples'); is($parser->canonical_media_type, 'application/n-triples', 'canonical_media_type'); my %extensions = map { $_ => 1 } @{ $parser->file_extensions }; ok(exists $extensions{'nt'}, 'file_extensions'); my $type = $parser->handled_type; can_ok($type, 'role'); is($type->role, 'Attean::API::Triple'); }; my $parser = Attean->get_parser('NTriples')->new(); isa_ok( $parser, 'AtteanX::Parser::NTriples' ); { my $store = Attean->get_store('Memory')->new(); my $ntriples = <<"END"; _:a . _:a . END my @list = $parser->parse_list_from_bytes($ntriples); is(scalar(@list), 2); my ($t1, $t2) = @list; does_ok($t1, 'Attean::API::Triple'); does_ok($t2, 'Attean::API::Triple'); is($t1->subject->value, 'a'); is($t2->subject->value, 'a'); is($t1->predicate->value, 'b'); is($t2->predicate->value, 'b'); is($t1->object->value, 'a'); is($t2->object->value, 'a'); } { my $store = Attean->get_store('Memory')->new(); my $ntriples = <<"END"; _:a . _:a . END my $iter = $parser->parse_iter_from_bytes($ntriples); my $graph = Attean::IRI->new('http://example.org/graph'); my $quads = $iter->as_quads($graph); $store->add_iter($quads); is( $store->size, 2, 'expected model size after ntriples parse' ); is( $store->count_quads(blank('a')), 1, 'expected 1 count bff' ); is( $store->count_quads(iri('a')), 1, 'expected 1 count bff' ); is( $store->count_quads(iri('b')), 0, 'expected 0 count bff' ); is( $store->count_quads(undef, iri('b')), 2, 'expected 2 count fbf' ); } { my $ntriples = qq[_:eve .\n]; my @list = $parser->parse_list_from_bytes($ntriples); is( scalar(@list), 1, 'expected model size after ntriples parse' ); is($list[0]->predicate->value, 'http://example.com/resumé', 'expected 1 count fbf with unicode escaping' ); } { my $ntriples = qq[_:eve "Resume" .\n]; my @list = $parser->parse_list_from_bytes($ntriples); is( scalar(@list), 1, 'expected model size after ntriples parse' ); is($list[0]->object->value, 'Resume', 'expected 1 count fbf with unicode escaping' ); } { my %got; my $handler = sub { my $st = shift; my $o = $st->object; $got{ $o->ntriples_string }++ }; my $ntriples = <<"END"; _:anon . # comment "x" . "\\u00E9" . "

"^^ . "chat"\@fr . END $parser->handler($handler); $parser->parse_cb_from_bytes($ntriples); my %expect = ( q["é"] => 1, q["chat"@fr] => 1, q["x"] => 1, q["

"^^] => 1, q[] => 1, ); is_deeply( \%got, \%expect, 'expected statement object parsing' ); $parser->handler(sub {}); } { # escaping tests { my $ntriples = qq[_:a "0\\t1" .\n]; my ($st) = $parser->parse_list_from_bytes($ntriples); is($st->object->value, "0\t1", 'expected plain literal with tab-encoding' ); } { my $ntriples = qq[_:a "0\\n1" .\n]; my ($st) = $parser->parse_list_from_bytes($ntriples); is($st->object->value, "0\n1", 'expected plain literal with newline-encoding' ); } { my $ntriples = qq[_:a "0\\"\\\\1" .\n]; my ($st) = $parser->parse_list_from_bytes($ntriples); is($st->object->value, qq[0"\\1], 'expected plain literal with quote and backslash-encoding' ); } { my $ntriples = qq[_:a "0\\U000000611" .\n]; my ($st) = $parser->parse_list_from_bytes($ntriples); is($st->object->value, qq[0a1], 'expected plain literal with U-encoding' ); } } subtest 'parse_term_from_bytes' => sub { my $parser = Attean->get_parser('NTriples')->new(); my $turtle = '"hello"@en'; my $term = $parser->parse_term_from_bytes($turtle); does_ok($term, 'Attean::API::Literal'); is($term->value, 'hello'); is($term->language, 'en'); }; done_testing(); Attean-0.034/t/convenience.t000644 000765 000024 00000002534 14305214742 015755 0ustar00gregstaff000000 000000 use Test::Modern; use Test::Exception; use v5.14; use warnings; no warnings 'redefine'; use Encode; use Attean parsers => ['Turtle']; use Attean::RDF; use Attean::SimpleQueryEvaluator; subtest 'load_triples' => sub { my $data = ' 14 .'; my $sparql = 'SELECT ?o WHERE { ?s ?p ?o }'; my $graph = iri('http://example.org/'); my $model = Attean->temporary_model; $model->load_triples('turtle', $graph, $data); my $s = Attean->get_parser('SPARQL')->new(); my ($algebra) = $s->parse($sparql); my $results = $model->evaluate($algebra, $graph); my $r = $results->next; does_ok($r, 'Attean::API::Result'); my $o = $r->value('o'); is($o->value, '14'); does_ok($o, 'Attean::API::Literal'); }; subtest 'load_triples_from_io' => sub { my $data = ' 14 .'; my $bytes = encode('UTF-8', $data, Encode::FB_CROAK); my $fh; open($fh, '<:utf8', \$bytes); my $sparql = 'SELECT ?o WHERE { ?s ?p ?o }'; my $graph = iri('http://example.org/'); my $model = Attean->temporary_model; $model->load_triples_from_io('turtle', $graph, $fh); my $s = Attean->get_parser('SPARQL')->new(); my ($algebra) = $s->parse($sparql); my $results = $model->evaluate($algebra, $graph); my $r = $results->next; does_ok($r, 'Attean::API::Result'); my $o = $r->value('o'); is($o->value, '14'); does_ok($o, 'Attean::API::Literal'); }; done_testing(); Attean-0.034/t/serializer-sparqlcsv.t000644 000765 000024 00000003775 12650262662 017663 0ustar00gregstaff000000 000000 use Test::Modern; use Test::Exception; use v5.14; use warnings; no warnings 'redefine'; use Attean; use Attean::RDF; use Type::Tiny::Role; my $constraint = 'Attean::API::Result'; my $s = Attean::Blank->new('x'); my $p = Attean::IRI->new('http://example.org/p'); my $o1 = Attean::Literal->new(value => '1', datatype => 'http://www.w3.org/2001/XMLSchema#integer'); my $o2 = Attean::Literal->new(value => '2', language => 'en-US'); my $t1 = Attean::Result->new(bindings => { subject => $s, predicate => $p, object => $o1 }); my $t2 = Attean::Result->new(bindings => { subject => $s, predicate => $p, object => $o2 }); my $t3 = Attean::Result->new(bindings => { subject => iri('http://perlrdf.org/') }); my @triples = ($t1, $t2, $t3); { my $ser = Attean->get_serializer('SPARQLCSV')->new(); does_ok($ser, 'Attean::API::Serializer'); does_ok($ser, 'Attean::API::ResultSerializer'); isa_ok($ser, 'AtteanX::Serializer::SPARQLCSV'); my $expected = <<'END'; subject,predicate,object _:x,http://example.org/p,1 _:x,http://example.org/p,2 http://perlrdf.org/,, END { my $i = Attean::ListIterator->new(values => [@triples], item_type => $constraint, variables => [qw(subject predicate object)]); my $b = $ser->serialize_iter_to_bytes($i); is($b, $expected, 'serialize_iter_to_bytes'); } { my $i = Attean::ListIterator->new(values => [@triples], item_type => $constraint, variables => [qw(subject predicate object)]); my $data = ''; open(my $fh, '>', \$data); $ser->serialize_iter_to_io($fh, $i); close($fh); is($data, $expected, 'serialize_iter_to_io'); } { my $expected_reorder = <<'END'; predicate,subject,object http://example.org/p,_:x,1 http://example.org/p,_:x,2 ,http://perlrdf.org/, END my $i = Attean::ListIterator->new(values => [@triples], item_type => $constraint, variables => [qw(predicate subject object)]); my $data = ''; open(my $fh, '>', \$data); $ser->serialize_iter_to_io($fh, $i); close($fh); is($data, $expected_reorder, 'variable order sensitivity'); } } done_testing(); Attean-0.034/t/serializer-sparqltsv.t000644 000765 000024 00000004173 12650262233 017667 0ustar00gregstaff000000 000000 use Test::Modern; use Test::Exception; use v5.14; use warnings; no warnings 'redefine'; use Attean; use Attean::RDF; use Type::Tiny::Role; my $constraint = 'Attean::API::Result'; my $s = Attean::Blank->new('x'); my $p = Attean::IRI->new('http://example.org/p'); my $o1 = Attean::Literal->new(value => '1', datatype => 'http://www.w3.org/2001/XMLSchema#integer'); my $o2 = Attean::Literal->new(value => '2', language => 'en-US'); my $t1 = Attean::Result->new(bindings => { subject => $s, predicate => $p, object => $o1 }); my $t2 = Attean::Result->new(bindings => { subject => $s, predicate => $p, object => $o2 }); my $t3 = Attean::Result->new(bindings => { subject => iri('http://perlrdf.org/') }); my @triples = ($t1, $t2, $t3); { my $ser = Attean->get_serializer('SPARQLTSV')->new(); does_ok($ser, 'Attean::API::Serializer'); does_ok($ser, 'Attean::API::ResultSerializer'); isa_ok($ser, 'AtteanX::Serializer::SPARQLTSV'); my $expected = <<'END'; ?subject ?predicate ?object _:x "1"^^ _:x "2"@en-US END { my $i = Attean::ListIterator->new(values => [@triples], item_type => $constraint, variables => [qw(subject predicate object)]); my $b = $ser->serialize_iter_to_bytes($i); is($b, $expected, 'serialize_iter_to_bytes'); } { my $i = Attean::ListIterator->new(values => [@triples], item_type => $constraint, variables => [qw(subject predicate object)]); my $data = ''; open(my $fh, '>', \$data); $ser->serialize_iter_to_io($fh, $i); close($fh); is($data, $expected, 'serialize_iter_to_io'); } { my $expected_reorder = <<'END'; ?predicate ?subject ?object _:x "1"^^ _:x "2"@en-US END my $i = Attean::ListIterator->new(values => [@triples], item_type => $constraint, variables => [qw(predicate subject object)]); my $data = ''; open(my $fh, '>', \$data); $ser->serialize_iter_to_io($fh, $i); close($fh); is($data, $expected_reorder, 'variable order sensitivity'); } } done_testing(); Attean-0.034/t/PaxHeader/parser-turtle.t000644 000765 000024 00000000425 14077156565 020256 xustar00gregstaff000000 000000 30 mtime=1627184501.846362492 69 LIBARCHIVE.xattr.com.apple.lastuseddate#PS=PN/8YAAAAAAgv/sVAAAAAA 59 SCHILY.xattr.com.apple.lastuseddate#PS=<ßü` ¿û 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/t/parser-turtle.t000644 000765 000024 00000007132 14077156565 016307 0ustar00gregstaff000000 000000 use v5.14; use autodie; use utf8; use Test::Modern; use Test::Exception; use FindBin qw($Bin); use File::Glob qw(bsd_glob); use File::Spec; use Attean; use Attean::RDF; use AtteanX::Parser::Turtle; use AtteanX::Parser::Turtle::Constants; use Type::Tiny::Role; subtest 'parser construction and metadata' => sub { my $parser = Attean->get_parser('Turtle')->new(); isa_ok($parser, 'AtteanX::Parser::Turtle'); is($parser->canonical_media_type, 'text/turtle', 'canonical_media_type'); my %extensions = map { $_ => 1 } @{ $parser->file_extensions }; ok(exists $extensions{'ttl'}, 'file_extensions'); my $type = $parser->handled_type; can_ok($type, 'role'); is($type->role, 'Attean::API::Triple'); }; { my $turtle = "

1, 2 .\n"; open(my $fh, '<', \$turtle); my $parser = Attean->get_parser('Turtle')->new(); my $iter = $parser->parse_iter_from_io($fh); does_ok($iter, 'Attean::API::Iterator'); is($iter->next->object->value, '1'); is($iter->next->object->value, '2'); is($iter->next, undef); } { my $map = URI::NamespaceMap->new(); my $parser = Attean->get_parser('Turtle')->new( namespaces => $map ); my $content = <<'END'; @prefix ex: . @prefix foaf: . _:x a foaf:Person . END $parser->parse_cb_from_bytes($content, sub {}); is_deeply([sort $map->list_prefixes], [qw(ex foaf)]); my $foaf = $map->namespace_uri('foaf'); isa_ok($foaf, 'URI::Namespace'); is($foaf->as_string, 'http://xmlns.com/foaf/0.1/'); } subtest 'escaping' => sub { my $turtle = q[ ex:p "\\"", '\\'', '\\u706b\\U0000661F' .]; open(my $fh, '<:encoding(UTF-8)', \$turtle); my $l = AtteanX::Parser::Turtle::Lexer->new($fh); expect($l->get_token, IRI, ['s'], 'subject'); expect($l->get_token, PREFIXNAME, ['ex:', 'p'], 'predicate'); expect($l->get_token, STRING1D, ['"'], 'double quote'); expect($l->get_token, COMMA, [',']); expect($l->get_token, STRING1S, ["'"], 'single quote'); expect($l->get_token, COMMA, [',']); expect($l->get_token, STRING1S, ["ç«æ˜Ÿ"], 'unicode \\u and \\U escapes'); }; subtest 'parse_term_from_bytes' => sub { my $parser = Attean->get_parser('Turtle')->new(); my $turtle = '"""hello"""@en'; my $term = $parser->parse_term_from_bytes($turtle); does_ok($term, 'Attean::API::Literal'); is($term->value, 'hello'); is($term->language, 'en'); }; subtest 'turtle numeric u escaping' => sub { open(my $fh, '<', \q['\\u006F']); my $l = AtteanX::Parser::Turtle::Lexer->new($fh); my $t = $l->get_token; is($t->value, 'o'); }; subtest 'turtle numeric U escaping' => sub { open(my $fh, '<', \q['\\U0000006F']); my $l = AtteanX::Parser::Turtle::Lexer->new($fh); my $t = $l->get_token; is($t->value, 'o'); }; subtest 'pre-defined base IRI' => sub { my $base = iri('http://example.org/base/'); my $parser = Attean->get_parser('Turtle')->new( base => $base ); my $resolved_term = $parser->parse_term_from_bytes(''); is($resolved_term->value, 'http://example.org/base/test'); my $absolute_term = $parser->parse_term_from_bytes(''); is($absolute_term->value, 'tag:test'); my $iter = $parser->parse_iter_from_bytes(' .'); does_ok($iter, 'Attean::API::Iterator'); my $t = $iter->next; is($t->subject->value, 'http://example.org/base/subj'); is($t->predicate->value, 'http://example.org/pred'); is($t->object->value, 'http://example.org/base/obj/value'); }; done_testing(); sub expect { my $token = shift; my $type = shift; my $values = shift; my $name = shift // ''; if (length($name)) { $name = "${name}: "; } is($token->type, $type, "${name}token type"); is_deeply($token->args, $values, "${name}token values"); } Attean-0.034/t/naive_planner.t000644 000765 000024 00000025351 12715465722 016315 0ustar00gregstaff000000 000000 use v5.14; use autodie; use utf8; use Test::Modern; use Test::Exception; use Digest::SHA qw(sha1_hex); use Attean; use Attean::RDF; use AtteanX::Store::Memory; package TestPlanner { use Moo; extends 'Attean::QueryPlanner'; with 'Attean::API::NaiveJoinPlanner'; } my $p = TestPlanner->new(); isa_ok($p, 'TestPlanner'); does_ok($p, 'Attean::API::QueryPlanner'); my $store = AtteanX::Store::Memory->new(); my $model = Attean::MutableQuadModel->new( store => $store ); my $graph = iri('http://example.org/'); my $t = triplepattern(variable('s'), iri('p'), literal('1')); my $u = triplepattern(variable('s'), iri('p'), variable('o')); my $v = triplepattern(variable('s'), iri('q'), blank('xyz')); my $w = triplepattern(variable('a'), iri('b'), iri('c')); dies_ok { my $p = Attean::QueryPlanner->new(); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $plan = $p->plan_for_algebra($bgp, $model, [$graph]); } 'QueryPlanner base class cannot be used directly'; subtest 'Empty BGP' => sub { note("An empty BGP should produce the join identity table plan"); my $bgp = Attean::Algebra::BGP->new(triples => []); my $plan = $p->plan_for_algebra($bgp, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', 'Empty BGP'); isa_ok($plan, 'Attean::Plan::Table'); my $rows = $plan->rows; is(scalar(@$rows), 1); }; subtest '1-triple BGP' => sub { note("A 1-triple BGP should produce a single Attean::Plan::Quad plan object"); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $plan = $p->plan_for_algebra($bgp, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', '1-triple BGP'); isa_ok($plan, 'Attean::Plan::Quad'); }; subtest '2-triple BGP without join variable' => sub { note("A 2-triple BGP without a join variable should produce a distinct join"); my $bgp = Attean::Algebra::BGP->new(triples => [$t, $w]); my $plan = $p->plan_for_algebra($bgp, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', '2-triple BGP'); does_ok($plan, 'Attean::API::Plan::Join'); ok($plan->distinct); }; subtest '2-triple BGP with join variable' => sub { note("A 2-triple BGP with a join variable and without any ordering should produce a distinct join"); my $bgp = Attean::Algebra::BGP->new(triples => [$t, $u]); my $plan = $p->plan_for_algebra($bgp, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', '2-triple BGP'); does_ok($plan, 'Attean::API::Plan::Join'); ok($plan->distinct); }; subtest 'Distinct 2-triple BGP with join variable, no blank nodes' => sub { note("A 2-triple BGP with a join variable without any blank nodes is necessarily distinct, so a distinct operation should be a no-op, resulting in just a join"); my $bgp = Attean::Algebra::BGP->new(triples => [$t, $u]); my $dist = Attean::Algebra::Distinct->new( children => [$bgp] ); my $plan = $p->plan_for_algebra($dist, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', 'Distinct 2-triple BGP without blanks'); does_ok($plan, 'Attean::API::Plan::Join'); ok($plan->distinct); }; subtest 'Distinct 3-triple BGP with join variable and blank nodes' => sub { note("A 3-triple BGP with a blank node isn't necessarily distinct, so a distinct operation should result in a HashDistinct plan"); my $bgp = Attean::Algebra::BGP->new(triples => [$t, $u, $v]); my $dist = Attean::Algebra::Distinct->new( children => [$bgp] ); my $plan = $p->plan_for_algebra($dist, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', 'Distinct 3-triple BGP with blanks'); isa_ok($plan, 'Attean::Plan::HashDistinct'); ok($plan->distinct); }; # TODO: A 1-triple BGP with ASC(-1 * ?s) sorting should result in a Project(Order(Extend(Quad(....)))) pattern subtest 'Sorted 1-triple BGP' => sub { note("A 1-triple BGP with ASC(?s) sorting should result in a Order(Quad(....)) pattern"); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $sorted = order_algebra_by_variables($bgp, 's'); my $plan = $p->plan_for_algebra($sorted, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', 'Sorted 1-triple BGP'); # Sorting introduces a isa_ok($plan, 'Attean::Plan::OrderBy'); ok($plan->distinct, 'Plan is distinct'); my $order = $plan->ordered; is(scalar(@$order), 1, 'Count of ordering comparators'); my $cmp = $order->[0]; ok($cmp->ascending, 'Ordering is ascending'); my $expr = $cmp->expression; isa_ok($expr, 'Attean::ValueExpression'); is($expr->value->value, 's'); }; subtest 'Join planning is equivalent to BGP planning' => sub { note("A join between two 1-triple BGPs should result in the same plan as the equivalent 2-triple BGP"); my $plan1 = $p->plan_for_algebra(Attean::Algebra::BGP->new(triples => [$t, $u]), $model, [$graph]); my $bgp1 = Attean::Algebra::BGP->new(triples => [$t]); my $bgp2 = Attean::Algebra::BGP->new(triples => [$u]); my $join = Attean::Algebra::Join->new(children => [$bgp1, $bgp2]); my $plan2 = $p->plan_for_algebra($join, $model, [$graph]); does_ok($_, 'Attean::API::Plan') for ($plan1, $plan2); does_ok($_, 'Attean::API::Plan::Join') for ($plan1, $plan2); # we don't do a single deep comparison on the plans here, because while they are equivalent plans, # BGP planning handles the annotating of the distinct flag on sub-plans differently than the # general join planning. foreach my $pos (0,1) { does_ok($_->children->[$pos], 'Attean::API::Plan') for ($plan1, $plan2); isa_ok($_->children->[$pos], 'Attean::Plan::Quad') for ($plan1, $plan2); is_deeply([$plan1->children->[$pos]->values], [$plan2->children->[$pos]->values]); } }; subtest 'Variable Filter' => sub { note("FILTER(?o) should result in a EBVFilter(...) pattern"); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $expr = Attean::ValueExpression->new(value => variable('o')); my $filter = Attean::Algebra::Filter->new(children => [$bgp], expression => $expr); my $plan = $p->plan_for_algebra($filter, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', 'Variable filter'); isa_ok($plan, 'Attean::Plan::EBVFilter'); is($plan->variable, 'o'); }; subtest 'Expression Filter' => sub { note("FILTER(?s && ?o) should result in a Project(EBVFilter(Extend(...))) pattern"); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $expr1 = Attean::ValueExpression->new(value => variable('s')); my $expr2 = Attean::ValueExpression->new(value => variable('o')); my $expr = Attean::BinaryExpression->new( operator => '&&', children => [$expr1, $expr2] ); my $filter = Attean::Algebra::Filter->new(children => [$bgp], expression => $expr); my $plan = $p->plan_for_algebra($filter, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', 'Expression filter'); isa_ok($plan, 'Attean::Plan::Project'); isa_ok($plan->children->[0], 'Attean::Plan::EBVFilter'); isa_ok($plan->children->[0]->children->[0], 'Attean::Plan::Extend'); }; subtest 'IRI named graph' => sub { note("1-triple BGP restricted to an IRI-named graph should result in a Quad plan"); my $ng = iri('http://eample.org/named/'); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $named = Attean::Algebra::Graph->new(children => [$bgp], graph => $ng); my $plan = $p->plan_for_algebra($named, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', 'IRI-named graph'); isa_ok($plan, 'Attean::Plan::Quad'); }; subtest 'Variable named graph (model with 0 named graphs)' => sub { note("1-triple BGP restricted to a variable-named graph should result in an empty Union plan"); my $ng = variable('g'); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $named = Attean::Algebra::Graph->new(children => [$bgp], graph => $ng); my $plan = $p->plan_for_algebra($named, $model, [$graph]); does_ok($plan, 'Attean::API::Plan', 'IRI-named graph'); isa_ok($plan, 'Attean::Plan::Union'); is(scalar(@{ $plan->children }), 0); }; subtest 'Naive join planning should leave cartesian products intact' => sub { my $t1 = triplepattern(variable('s'), iri('p'), literal('1')); # ?s my $t2 = triplepattern(variable('a'), iri('b'), variable('o')); # ?a ?o my $t3 = triplepattern(variable('s'), iri('p'), variable('o')); # ?s ?o my $bgp = Attean::Algebra::BGP->new(triples => [$t1, $t2, $t3]); my $plan = $p->plan_for_algebra($bgp, $model, [$graph]); does_ok($plan, 'Attean::API::Plan::Join'); my ($lhs, $rhs) = @{ $plan->children }; does_ok($lhs, 'Attean::API::Plan::Join'); my @quads = (@{ $lhs->children }, $rhs); foreach my $q (@quads) { isa_ok($q, 'Attean::Plan::Quad'); } my ($q1, $q2, $q3) = @quads; is_deeply([sort @{ $q1->in_scope_variables }], ['s']); is_deeply([sort @{ $q2->in_scope_variables }], ['a', 'o']); is_deeply([sort @{ $q3->in_scope_variables }], ['o', 's']); }; subtest 'Named graphs restricted by available graphs' => sub { my $store = AtteanX::Store::Memory->new(); my $model = Attean::MutableQuadModel->new( store => $store ); my $g1 = iri('http://example.org/g1'); my $g2 = iri('http://example.org/g2'); my $g3 = iri('http://example.org/g3'); my $s = Attean::Blank->new('x'); my $pred = Attean::IRI->new('http://example.org/p1'); my $o1 = Attean::Literal->new(value => 'foo', language => 'en-US'); my $o2 = Attean::Literal->new(value => 'bar', language => 'en-GB'); my $q1 = Attean::Quad->new($s, $pred, $o1, $g1); my $q2 = Attean::Quad->new($s, $pred, $o2, $g2); my $i = Attean::ListIterator->new(values => [$q1, $q2], item_type => 'Attean::API::Quad'); $model->add_iter($i); { my $a = Attean->get_parser('SPARQL')->parse('SELECT * WHERE { GRAPH { ?s ?p ?o } }'); { my $plan = $p->plan_for_algebra($a, $model, [$graph], [], available_graphs => [$g1]); isa_ok($plan, 'Attean::Plan::Quad'); } { # isn't an available graph, so the named graph algebra should result in an empty query plan (in this case, a Project(Table()) my $plan = $p->plan_for_algebra($a, $model, [$graph], [], available_graphs => [$g2]); isa_ok($plan, 'Attean::Plan::Project'); my $sp = $plan->child; isa_ok($sp, 'Attean::Plan::Table'); } } { my $a = Attean->get_parser('SPARQL')->parse('SELECT * WHERE { GRAPH ?g {} }'); { my $plan = $p->plan_for_algebra($a, $model, [$graph], [], available_graphs => [$g1, $g2]); isa_ok($plan, 'Attean::Plan::Union'); my $children = $plan->children; is(scalar(@$children), 2); } { # Only one of the restricted 'available' graphs is actually in the model, so the result should be a single Extend(), not a union of two Extend()s my $plan = $p->plan_for_algebra($a, $model, [$graph], [], available_graphs => [$g1, $g3]); isa_ok($plan, 'Attean::Plan::Extend'); } } }; done_testing(); sub order_algebra_by_variables { my $algebra = shift; my @vars = @_; my @cmps; foreach my $var (@vars) { my $expr = Attean::ValueExpression->new(value => variable($var)); my $cmp = Attean::Algebra::Comparator->new(ascending => 1, expression => $expr); push(@cmps, $cmp); } my $sorted = Attean::Algebra::OrderBy->new( children => [$algebra], comparators => \@cmps ); return $sorted; } Attean-0.034/t/PaxHeader/serializer-sparql.t000755 000765 000024 00000000225 14245662577 021121 xustar00gregstaff000000 000000 30 mtime=1654089087.185979502 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/t/serializer-sparql.t000755 000765 000024 00000114241 14245662577 017154 0ustar00gregstaff000000 000000 #!/usr/bin/env perl use v5.14; use autodie; use utf8; use Test::Modern; use Test::Exception; use Digest::SHA qw(sha1_hex); use AtteanX::SPARQL::Constants; use Attean; use Attean::RDF; subtest 'serializer construction and metadata' => sub { my $ser = Attean->get_serializer('SPARQL')->new(); does_ok($ser, 'Attean::API::Serializer'); isa_ok($ser, 'AtteanX::Serializer::SPARQL'); is($ser->canonical_media_type, 'application/sparql-query', 'canonical_media_type'); my %types = map { $_ => 1 } @{ $ser->media_types }; ok(exists $types{'application/sparql-query'}, 'media_types'); my $type = $ser->handled_type; can_ok($type, 'role'); is($type->role, 'AtteanX::SPARQL::Token'); my %extensions = map { $_ => 1 } @{ $ser->file_extensions }; ok(exists $extensions{'rq'}, 'file_extensions'); }; subtest 'sparql token as_string' => sub { my $t = AtteanX::SPARQL::Token->fast_constructor(IRI, -1, -1, -1, -1, ['http://example.org/hello']); is($t->as_string, 'IRI(http://example.org/hello)'); }; my $ser = Attean->get_serializer('SPARQL')->new(); subtest 'expected tokens: empty BGP tokens' => sub { my $a = Attean::Algebra::BGP->new(triples => []); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); expect_token_stream($i, []); ws_is($a->as_sparql, ''); }; subtest 'expected tokens: quad pattern' => sub { my $q = Attean::QuadPattern->parse('

"foo"@en '); my $i = $q->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); expect_token_stream($i, [KEYWORD, IRI, LBRACE, IRI, IRI, STRING1D, LANG, RBRACE]); ws_is($q->as_sparql, 'GRAPH {

"foo"@en }'); }; subtest 'expected tokens: 1-triple BGP tokens' => sub { my $t = triple(iri('s'), iri('p'), literal('1')); my $a = Attean::Algebra::BGP->new(triples => [$t]); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); expect_token_stream($i, [IRI, IRI, STRING1D, DOT]); ws_is($a->as_sparql, '

"1" .'); }; subtest 'expected tokens: 2-BGP join tokens' => sub { my $t = triplepattern(variable('s'), iri('p'), literal('1')); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $a = Attean::Algebra::Join->new( children => [$bgp, $bgp] ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # { ?s

"1" . ?s

"1" . } expect_token_stream($i, [LBRACE, VAR, IRI, STRING1D, DOT, VAR, IRI, STRING1D, DOT, RBRACE]); ws_is($a->as_sparql, '{ ?s

"1" . ?s

"1" . }'); }; subtest 'expected tokens: 2-triple BGP tokens with language and datatype' => sub { my $t = triplepattern(variable('s'), iri('p'), Attean::Literal->new(value => '1', datatype => iri('http://example.org/type'))); my $u = triplepattern(variable('s'), iri('q'), Attean::Literal->new(value => 'hello', language => 'en-US')); my $bgp = Attean::Algebra::BGP->new(triples => [$t, $u]); my $a = Attean::Algebra::Join->new( children => [$bgp] ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # { ?s

"1"^^ . ?s

"1" . } expect_token_stream($i, [LBRACE, VAR, IRI, STRING1D, HATHAT, IRI, DOT, VAR, IRI, STRING1D, LANG, DOT, RBRACE]); ws_is($a->as_sparql, '{ ?s

"1"^^ . ?s "hello"@en-US . }'); }; subtest 'expected tokens: distinct/bgp' => sub { my $t = triple(iri('s'), iri('p'), literal('1')); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $a = Attean::Algebra::Distinct->new( children => [$bgp] ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # SELECT DISTINCT * WHERE {

"1" } expect_token_stream($i, [KEYWORD, KEYWORD, STAR, KEYWORD, LBRACE, IRI, IRI, STRING1D, DOT, RBRACE]); ws_is($a->as_sparql, 'SELECT DISTINCT * WHERE {

"1" . }'); }; subtest 'expected tokens: reduced/bgp' => sub { my $t = triple(iri('s'), iri('p'), literal('1')); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $a = Attean::Algebra::Reduced->new( children => [$bgp] ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # SELECT REDUCED * WHERE {

"1" } expect_token_stream($i, [KEYWORD, KEYWORD, STAR, KEYWORD, LBRACE, IRI, IRI, STRING1D, DOT, RBRACE]); ws_is($a->as_sparql, 'SELECT REDUCED * WHERE {

"1" . }'); }; subtest 'expected tokens: bgp/limit' => sub { my $t = triple(iri('s'), iri('p'), literal('1')); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $a = Attean::Algebra::Slice->new( children => [$bgp], limit => 5 ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # SELECT * WHERE {

"1" } LIMIT 5 expect_token_stream($i, [KEYWORD, STAR, KEYWORD, LBRACE, IRI, IRI, STRING1D, DOT, RBRACE, KEYWORD, INTEGER]); ws_is($a->as_sparql, 'SELECT * WHERE {

"1" . } LIMIT 5'); }; subtest 'expected tokens: bgp/slice' => sub { my $t = triple(iri('s'), iri('p'), literal('1')); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $a = Attean::Algebra::Slice->new( children => [$bgp], limit => 5, offset => 5 ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # SELECT * WHERE {

"1" } LIMIT 5 OFFSET 5 expect_token_stream($i, [KEYWORD, STAR, KEYWORD, LBRACE, IRI, IRI, STRING1D, DOT, RBRACE, KEYWORD, INTEGER, KEYWORD, INTEGER]); ws_is($a->as_sparql, 'SELECT * WHERE {

"1" . } LIMIT 5 OFFSET 5'); }; subtest 'expected tokens: distinct/bgp/slice' => sub { my $t = triple(iri('s'), iri('p'), literal('1')); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $dist = Attean::Algebra::Distinct->new( children => [$bgp] ); my $a = Attean::Algebra::Slice->new( children => [$dist], limit => 5, offset => 5 ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # SELECT DISTINCT * WHERE {

"1" } LIMIT 5 OFFSET 5 expect_token_stream($i, [KEYWORD, KEYWORD, STAR, KEYWORD, LBRACE, IRI, IRI, STRING1D, DOT, RBRACE, KEYWORD, INTEGER, KEYWORD, INTEGER]); ws_is($a->as_sparql, 'SELECT DISTINCT * WHERE {

"1" . } LIMIT 5 OFFSET 5'); }; subtest 'property paths' => sub { subtest 'expected tokens: predicate path' => sub { my $p1 = iri('p1'); my $a = Attean::Algebra::PredicatePath->new( predicate => $p1 ); my $i = $a->sparql_tokens; expect_token_stream($i, [IRI]); subtest 'predicate path' => sub { my $p = Attean::Algebra::Path->new( path => $a, subject => iri('s'), object => iri('o') ); ws_is($p->as_sparql, ' '); } }; subtest 'expected tokens: nps path' => sub { my $p1 = iri('p1'); my $p2 = iri('p2'); my $a = Attean::Algebra::NegatedPropertySet->new( predicates => [$p1, $p2] ); my $i = $a->sparql_tokens; # !(|) expect_token_stream($i, [BANG, LPAREN, IRI, OR, IRI, RPAREN]); subtest 'nps path' => sub { my $a = Attean::Algebra::Path->new( path => $a, subject => iri('s'), object => iri('o') ); ws_is($a->as_sparql, ' !(|) '); } }; subtest 'expected tokens: 1-IRI sequence path' => sub { my $p2 = iri('p2'); my $pp2 = Attean::Algebra::PredicatePath->new( predicate => $p2 ); my $a = Attean::Algebra::SequencePath->new( children => [$pp2] ); my $i = $a->sparql_tokens; expect_token_stream($i, [IRI]); subtest 'sequence path' => sub { my $p = Attean::Algebra::Path->new( path => $a, subject => iri('s'), object => iri('o') ); ws_is($p->as_sparql, ' '); } }; subtest 'expected tokens: 2-IRI sequence path' => sub { my $p1 = iri('p1'); my $p2 = iri('p2'); my $pp1 = Attean::Algebra::PredicatePath->new( predicate => $p1 ); my $pp2 = Attean::Algebra::PredicatePath->new( predicate => $p2 ); my $a = Attean::Algebra::SequencePath->new( children => [$pp1, $pp2] ); my $i = $a->sparql_tokens; expect_token_stream($i, [IRI, SLASH, IRI]); my $p = Attean::Algebra::Path->new( path => $a, subject => iri('s'), object => iri('o') ); ws_is($p->as_sparql, ' / '); }; subtest 'expected tokens: 1-IRI alternative path' => sub { my $p2 = iri('p2'); my $pp2 = Attean::Algebra::PredicatePath->new( predicate => $p2 ); my $a = Attean::Algebra::AlternativePath->new( children => [$pp2] ); my $i = $a->sparql_tokens; expect_token_stream($i, [IRI]); subtest 'alternative path' => sub { my $p = Attean::Algebra::Path->new( path => $a, subject => iri('s'), object => iri('o') ); ws_is($p->as_sparql, ' '); } }; subtest 'expected tokens: 2-IRI alternative path' => sub { my $p1 = iri('p1'); my $p2 = iri('p2'); my $pp1 = Attean::Algebra::PredicatePath->new( predicate => $p1 ); my $pp2 = Attean::Algebra::PredicatePath->new( predicate => $p2 ); my $a = Attean::Algebra::AlternativePath->new( children => [$pp1, $pp2] ); my $i = $a->sparql_tokens; # | expect_token_stream($i, [IRI, OR, IRI]); subtest 'alternative path' => sub { my $p = Attean::Algebra::Path->new( path => $a, subject => iri('s'), object => iri('o') ); ws_is($p->as_sparql, ' | '); } }; subtest 'expected tokens: 1-IRI inverse path' => sub { my $p2 = iri('p2'); my $pp2 = Attean::Algebra::PredicatePath->new( predicate => $p2 ); my $a = Attean::Algebra::InversePath->new( children => [$pp2] ); my $i = $a->sparql_tokens; # ^ expect_token_stream($i, [HAT, IRI]); subtest 'inverse path' => sub { my $p = Attean::Algebra::Path->new( path => $a, subject => iri('s'), object => iri('o') ); ws_is($p->as_sparql, ' ^ '); } }; subtest 'expected tokens: 2-IRI inverse path' => sub { my $p1 = iri('p1'); my $p2 = iri('p2'); my $pp1 = Attean::Algebra::PredicatePath->new( predicate => $p1 ); my $pp2 = Attean::Algebra::PredicatePath->new( predicate => $p2 ); my $seq = Attean::Algebra::AlternativePath->new( children => [$pp1, $pp2] ); my $a = Attean::Algebra::InversePath->new( children => [$seq] ); my $i = $a->sparql_tokens; # ^(|) expect_token_stream($i, [HAT, LPAREN, IRI, OR, IRI, RPAREN]); subtest 'inverse path' => sub { my $p = Attean::Algebra::Path->new( path => $a, subject => iri('s'), object => iri('o') ); ws_is($p->as_sparql, ' ^(|) '); } }; subtest 'expected tokens: zero or more 2-IRI inverse path' => sub { my $p1 = iri('p1'); my $p2 = iri('p2'); my $pp1 = Attean::Algebra::PredicatePath->new( predicate => $p1 ); my $pp2 = Attean::Algebra::PredicatePath->new( predicate => $p2 ); my $seq = Attean::Algebra::AlternativePath->new( children => [$pp1, $pp2] ); my $inv = Attean::Algebra::InversePath->new( children => [$seq] ); my $a = Attean::Algebra::ZeroOrMorePath->new( children => [$inv] ); my $i = $a->sparql_tokens; # (^(/))* expect_token_stream($i, [LPAREN, HAT, LPAREN, IRI, OR, IRI, RPAREN, RPAREN, STAR]); subtest '* path' => sub { my $p = Attean::Algebra::Path->new( path => $a, subject => iri('s'), object => iri('o') ); ws_is($p->as_sparql, ' (^(|))* '); } }; subtest 'expected tokens: one or more 2-IRI inverse path' => sub { my $p1 = iri('p1'); my $p2 = iri('p2'); my $pp1 = Attean::Algebra::PredicatePath->new( predicate => $p1 ); my $pp2 = Attean::Algebra::PredicatePath->new( predicate => $p2 ); my $seq = Attean::Algebra::AlternativePath->new( children => [$pp1, $pp2] ); my $inv = Attean::Algebra::InversePath->new( children => [$seq] ); my $a = Attean::Algebra::OneOrMorePath->new( children => [$inv] ); my $i = $a->sparql_tokens; # (^(/))+ expect_token_stream($i, [LPAREN, HAT, LPAREN, IRI, OR, IRI, RPAREN, RPAREN, PLUS]); subtest '+ path' => sub { my $p = Attean::Algebra::Path->new( path => $a, subject => iri('s'), object => iri('o') ); ws_is($p->as_sparql, ' (^(|))+ '); } }; subtest 'expected tokens: zero or one 2-IRI inverse path' => sub { my $p1 = iri('p1'); my $p2 = iri('p2'); my $pp1 = Attean::Algebra::PredicatePath->new( predicate => $p1 ); my $pp2 = Attean::Algebra::PredicatePath->new( predicate => $p2 ); my $seq = Attean::Algebra::AlternativePath->new( children => [$pp1, $pp2] ); my $inv = Attean::Algebra::InversePath->new( children => [$seq] ); my $a = Attean::Algebra::ZeroOrOnePath->new( children => [$inv] ); my $i = $a->sparql_tokens; # (^(/))+ expect_token_stream($i, [LPAREN, HAT, LPAREN, IRI, OR, IRI, RPAREN, RPAREN, QUESTION]); subtest '? path' => sub { my $p = Attean::Algebra::Path->new( path => $a, subject => iri('s'), object => iri('o') ); ws_is($p->as_sparql, ' (^(|))? '); } }; subtest 'expected tokens: 2-IRI sequence path triple' => sub { my $p1 = iri('p1'); my $p2 = iri('p2'); my $pp1 = Attean::Algebra::PredicatePath->new( predicate => $p1 ); my $pp2 = Attean::Algebra::PredicatePath->new( predicate => $p2 ); my $seq = Attean::Algebra::SequencePath->new( children => [$pp1, $pp2] ); my $a = Attean::Algebra::Path->new( path => $seq, subject => iri('s'), object => iri('o') ); my $i = $a->sparql_tokens; expect_token_stream($i, [IRI, IRI, SLASH, IRI, IRI]); ws_is($a->as_sparql, ' / '); }; }; subtest 'expected tokens: named graph tokens' => sub { my $bgp = Attean::Algebra::BGP->new(triples => [triple(iri('s'), iri('p'), literal('1'))]); my $g = iri('graphname'); my $a = Attean::Algebra::Graph->new( children => [$bgp], graph => $g ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # GRAPH {

"1" . } expect_token_stream($i, [KEYWORD, IRI, LBRACE, IRI, IRI, STRING1D, DOT, RBRACE]); ws_is($a->as_sparql, 'GRAPH {

"1" . }'); }; subtest 'expected tokens: service tokens' => sub { my $bgp = Attean::Algebra::BGP->new(triples => [triple(iri('s'), iri('p'), literal('1'))]); my $g = iri('http://example.org/sparql'); my $a = Attean::Algebra::Service->new( children => [$bgp], endpoint => $g ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # SERVICE {

"1" . } expect_token_stream($i, [KEYWORD, IRI, LBRACE, IRI, IRI, STRING1D, DOT, RBRACE]); ws_is($a->as_sparql, 'SERVICE {

"1" . }'); }; subtest 'expected tokens: union tokens' => sub { my $lhs = Attean::Algebra::BGP->new(triples => [triple(iri('s'), iri('p'), literal('1'))]); my $rhs = Attean::Algebra::BGP->new(triples => [triple(iri('s'), iri('p'), literal('2'))]); my $a = Attean::Algebra::Union->new( children => [$lhs, $rhs] ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); expect_token_stream($i, [LBRACE, IRI, IRI, STRING1D, DOT, RBRACE, KEYWORD, LBRACE, IRI, IRI, STRING1D, DOT, RBRACE]); ws_is($a->as_sparql, '{

"1" . } UNION {

"2" . }'); }; subtest 'expected tokens: minus tokens' => sub { my $lhs = Attean::Algebra::BGP->new(triples => [triplepattern(variable('s'), iri('p'), literal('1'))]); my $rhs = Attean::Algebra::BGP->new(triples => [triplepattern(variable('s'), iri('p'), literal('2'))]); my $a = Attean::Algebra::Minus->new( children => [$lhs, $rhs] ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # { ?s

"1" . } MINUS { ?s

"2" . } expect_token_stream($i, [LBRACE, VAR, IRI, STRING1D, DOT, RBRACE, KEYWORD, LBRACE, VAR, IRI, STRING1D, DOT, RBRACE]); ws_is($a->as_sparql, '{ ?s

"1" . } MINUS { ?s

"2" . }'); }; subtest 'expected tokens: optional tokens' => sub { my $lhs = Attean::Algebra::BGP->new(triples => [triplepattern(variable('s'), iri('p'), literal('1'))]); my $rhs = Attean::Algebra::BGP->new(triples => [triplepattern(variable('s'), iri('p'), literal('2'))]); my $a = Attean::Algebra::LeftJoin->new( children => [$lhs, $rhs] ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # { ?s

"1" . } OPTIONAL { ?s

"1" . } expect_token_stream($i, [LBRACE, VAR, IRI, STRING1D, DOT, RBRACE, KEYWORD, LBRACE, VAR, IRI, STRING1D, DOT, RBRACE]); ws_is($a->as_sparql, '{ ?s

"1" . } OPTIONAL { ?s

"2" . }'); }; subtest 'expected tokens: table tokens' => sub { my @rows; push(@rows, Attean::Result->new( bindings => { 's' => iri('http://example.org/') })); push(@rows, Attean::Result->new( bindings => { 's' => literal('sparql') })); my $a = Attean::Algebra::Table->new(variables => [variable('s')], rows => \@rows); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # VALUES (?s) { () ("sparql") } expect_token_stream($i, [KEYWORD, LPAREN, VAR, RPAREN, LBRACE, LPAREN, IRI, RPAREN, LPAREN, STRING1D, RPAREN, RBRACE]); ws_is($a->as_sparql, 'VALUES (?s) { () ("sparql") }'); }; subtest 'expected tokens: optional+filter tokens' => sub { my $lhs = Attean::Algebra::BGP->new(triples => [triplepattern(variable('s'), iri('p'), literal('1'))]); my $rhs = Attean::Algebra::BGP->new(triples => [triplepattern(variable('s'), iri('p'), literal('2'))]); my $e = Attean::ValueExpression->new( value => variable('s') ); my $expr = Attean::FunctionExpression->new( operator => 'ISIRI', children => [$e] ); my $a = Attean::Algebra::LeftJoin->new( children => [$lhs, $rhs], expression => $expr ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # { ?s

"1" . } OPTIONAL { ?s

"1" . FILTER(ISIRI(?s)) } expect_token_stream($i, [LBRACE, VAR, IRI, STRING1D, DOT, RBRACE, KEYWORD, LBRACE, VAR, IRI, STRING1D, DOT, KEYWORD, LPAREN, KEYWORD, LPAREN, VAR, RPAREN, RPAREN, RBRACE]); ws_is($a->as_sparql, '{ ?s

"1" . } OPTIONAL { ?s

"2" . FILTER(ISIRI(?s)) }'); }; subtest 'expected tokens: project' => sub { my $bgp = Attean::Algebra::BGP->new(triples => [triplepattern(variable('s'), iri('p'), literal('1'))]); my $a = Attean::Algebra::Project->new( children => [$bgp], variables => [variable('p')] ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # SELECT ?p WHERE { ?s

"1" . } expect_token_stream($i, [KEYWORD, VAR, KEYWORD, LBRACE, VAR, IRI, STRING1D, DOT, RBRACE]); ws_is($a->as_sparql, 'SELECT ?p WHERE { ?s

"1" . }'); }; subtest 'expected tokens: comparator tokens' => sub { my $bgp = Attean::Algebra::BGP->new(triples => [triplepattern(variable('s'), iri('p'), literal('1'))]); my $expr = Attean::ValueExpression->new( value => variable('s') ); my $a = Attean::Algebra::Comparator->new(ascending => 0, expression => $expr); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # DESC(?s) expect_token_stream($i, [KEYWORD, LPAREN, VAR, RPAREN]); }; subtest 'expected tokens: comparator tokens' => sub { my $bgp = Attean::Algebra::BGP->new(triples => [triplepattern(variable('s'), iri('p'), literal('1'))]); my $expr = Attean::ValueExpression->new( value => variable('s') ); my $cmp = Attean::Algebra::Comparator->new(ascending => 0, expression => $expr); my $a = Attean::Algebra::OrderBy->new( children => [$bgp], comparators => [$cmp] ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # SELECT * WHERE { ?s

"1" . } ORDER BY DESC(?s) expect_token_stream($i, [KEYWORD, STAR, KEYWORD, LBRACE, VAR, IRI, STRING1D, DOT, RBRACE, KEYWORD, KEYWORD, KEYWORD, LPAREN, VAR, RPAREN]); }; subtest 'expected tokens: ASK tokens' => sub { my $bgp = Attean::Algebra::BGP->new(triples => [triplepattern(variable('s'), iri('p'), literal('1'))]); my $a = Attean::Algebra::Ask->new( children => [$bgp] ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # ASK { ?s

"1" . } expect_token_stream($i, [KEYWORD, LBRACE, VAR, IRI, STRING1D, DOT, RBRACE]); ws_is($a->as_sparql, 'ASK { ?s

"1" . }'); }; subtest 'expected tokens: CONSTRUCT tokens' => sub { my $bgp = Attean::Algebra::BGP->new(triples => [triplepattern(variable('s'), iri('p'), literal('1'))]); my $t = triplepattern(variable('s'), iri('q'), literal('2')); my $a = Attean::Algebra::Construct->new( children => [$bgp], triples => [$t] ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # CONSTRUCT { ?s "2" } WHERE { ?s

"1" . } expect_token_stream($i, [KEYWORD, LBRACE, VAR, IRI, STRING1D, DOT, RBRACE, KEYWORD, LBRACE, VAR, IRI, STRING1D, DOT, RBRACE]); ws_is($a->as_sparql, 'CONSTRUCT { ?s "2" . } WHERE { ?s

"1" . }'); }; subtest 'expected tokens: DESCRIBE tokens' => sub { my $bgp = Attean::Algebra::BGP->new(triples => [triplepattern(variable('s'), iri('p'), literal('1'))]); my $a = Attean::Algebra::Describe->new( children => [$bgp], terms => [variable('s'), iri('q')] ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # DESCRIBE ?s WHERE { ?s

"1" . } expect_token_stream($i, [KEYWORD, VAR, IRI, KEYWORD, LBRACE, VAR, IRI, STRING1D, DOT, RBRACE]); ws_is($a->as_sparql, 'DESCRIBE ?s WHERE { ?s

"1" . }'); }; subtest 'expected tokens: project expressions tokens' => sub { my $t1 = triplepattern(variable('s'), iri('p'), variable('o1')); my $t2 = triplepattern(variable('s'), iri('q'), variable('o2')); my $bgp = Attean::Algebra::BGP->new(triples => [$t1, $t2]); my $e1 = Attean::ValueExpression->new( value => variable('o1') ); my $e2 = Attean::ValueExpression->new( value => variable('o2') ); my $expr = Attean::BinaryExpression->new( operator => '+', children => [$e1, $e2] ); my $extend = Attean::Algebra::Extend->new(children => [$bgp], variable => variable('sum'), expression => $expr); subtest 'project ordering 1' => sub { my $a = Attean::Algebra::Project->new( children => [$extend], variables => [variable('s'), variable('sum')] ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # SELECT ?s (?o1 + ?o2 AS ?sum) WHERE { ?s

?o1 . ?s ?o2 . } expect_token_stream($i, [KEYWORD, VAR, LPAREN, VAR, PLUS, VAR, KEYWORD, VAR, RPAREN, KEYWORD, LBRACE, VAR, IRI, VAR, DOT, VAR, IRI, VAR, DOT, RBRACE]); ws_is($a->as_sparql, 'SELECT ?s (?o1 + ?o2 AS ?sum) WHERE { ?s

?o1 . ?s ?o2 . }'); }; subtest 'project ordering 2' => sub { my $a = Attean::Algebra::Project->new( children => [$extend], variables => [variable('sum'), variable('s')] ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # SELECT (?o1 + ?o2 AS ?sum) ?s WHERE { ?s

?o1 . ?s ?o2 . } expect_token_stream($i, [KEYWORD, LPAREN, VAR, PLUS, VAR, KEYWORD, VAR, RPAREN, VAR, KEYWORD, LBRACE, VAR, IRI, VAR, DOT, VAR, IRI, VAR, DOT, RBRACE]); ws_is($a->as_sparql, 'SELECT (?o1 + ?o2 AS ?sum) ?s WHERE { ?s

?o1 . ?s ?o2 . }'); }; }; subtest 'expected tokens: binary filter tokens' => sub { my $t1 = triplepattern(variable('s'), iri('p'), variable('o1')); my $t2 = triplepattern(variable('s'), iri('q'), variable('o2')); my $bgp = Attean::Algebra::BGP->new(triples => [$t1, $t2]); my $e1 = Attean::ValueExpression->new( value => variable('o1') ); my $e2 = Attean::ValueExpression->new( value => variable('o2') ); my $expr = Attean::BinaryExpression->new( operator => '>', children => [$e1, $e2] ); my $a = Attean::Algebra::Filter->new(children => [$bgp], expression => $expr); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # ?s

?o1 . ?s ?o2 . FILTER(?o1 > ?o2) expect_token_stream($i, [VAR, IRI, VAR, DOT, VAR, IRI, VAR, DOT, KEYWORD, LPAREN, VAR, GT, VAR, RPAREN]); }; subtest 'expected tokens: function filter tokens' => sub { my $t = triplepattern(variable('s'), iri('p'), variable('o')); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $e = Attean::ValueExpression->new( value => variable('o') ); my $expr = Attean::FunctionExpression->new( operator => 'ISIRI', children => [$e] ); my $a = Attean::Algebra::Filter->new(children => [$bgp], expression => $expr); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # ?s

?o . FILTER(ISIRI(?o)) expect_token_stream($i, [VAR, IRI, VAR, DOT, KEYWORD, LPAREN, KEYWORD, LPAREN, VAR, RPAREN, RPAREN]); }; subtest 'expected tokens: cast filter tokens' => sub { my $t = triplepattern(variable('s'), iri('p'), variable('o')); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $e = Attean::ValueExpression->new( value => variable('o') ); my $expr = Attean::CastExpression->new( datatype => iri('http://www.w3.org/2001/XMLSchema#integer'), children => [$e] ); my $a = Attean::Algebra::Filter->new(children => [$bgp], expression => $expr); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # ?s

?o . FILTER((?o)) expect_token_stream($i, [VAR, IRI, VAR, DOT, KEYWORD, LPAREN, IRI, LPAREN, VAR, RPAREN, RPAREN]); }; subtest 'expected tokens: exists filter tokens' => sub { my $t = triplepattern(variable('s'), iri('p'), variable('o')); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $u = triplepattern(variable('s'), iri('q'), literal('1')); my $expr = Attean::ExistsExpression->new( pattern => Attean::Algebra::BGP->new(triples => [$u]) ); my $a = Attean::Algebra::Filter->new(children => [$bgp], expression => $expr); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # ?s

?o . FILTER( EXISTS { ?s "1" } ) expect_token_stream($i, [VAR, IRI, VAR, DOT, KEYWORD, LPAREN, KEYWORD, LBRACE, VAR, IRI, STRING1D, DOT, RBRACE, RPAREN]); }; subtest 'expected tokens: non-projected extend tokens' => sub { my $t1 = triplepattern(variable('s'), iri('p'), variable('o1')); my $t2 = triplepattern(variable('s'), iri('q'), variable('o2')); my $bgp1 = Attean::Algebra::BGP->new(triples => [$t1, $t2]); my $e1 = Attean::ValueExpression->new( value => variable('o1') ); my $e2 = Attean::ValueExpression->new( value => variable('o2') ); my $expr = Attean::BinaryExpression->new( operator => '+', children => [$e1, $e2] ); my $extend = Attean::Algebra::Extend->new(children => [$bgp1], variable => variable('sum'), expression => $expr); subtest 'bare extend' => sub { my $a = $extend; my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # ?s

?o1 . ?s ?o2 . BIND(?o1 + ?o2 AS ?sum) expect_token_stream($i, [VAR, IRI, VAR, DOT, VAR, IRI, VAR, DOT, KEYWORD, LPAREN, VAR, PLUS, VAR, KEYWORD, VAR, RPAREN]); }; subtest 'extend within projection' => sub { my $t3 = triplepattern(variable('s'), iri('r'), variable('o3')); my $bgp2 = Attean::Algebra::BGP->new(triples => [$t3]); my $join = Attean::Algebra::Join->new( children => [$extend, $bgp2] ); my $a = Attean::Algebra::Project->new( children => [$join], variables => [variable('s'), variable('o3'), variable('sum')] ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # SELECT ?s ?o3 ?sum WHERE { ?s

?o1 . ?s ?o2 . BIND(?o1 + ?o2 AS ?sum) ?s ?o3 } expect_token_stream($i, [KEYWORD, VAR, VAR, VAR, KEYWORD, LBRACE, VAR, IRI, VAR, DOT, VAR, IRI, VAR, DOT, KEYWORD, LPAREN, VAR, PLUS, VAR, KEYWORD, VAR, RPAREN, VAR, IRI, VAR, DOT, RBRACE]); }; }; subtest 'expected tokens: aggregation' => sub { my $t = triplepattern(variable('s'), iri('p'), variable('o')); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my @groups = Attean::ValueExpression->new( value => variable('s') ); my @aggs = Attean::AggregateExpression->new( distinct => 0, operator => 'SUM', children => [Attean::ValueExpression->new( value => variable('o') )], scalar_vars => {}, variable => variable("sum"), ); my $a = Attean::Algebra::Group->new( children => [$bgp], groupby => \@groups, aggregates => \@aggs, ); my $i = $a->sparql_tokens; does_ok($i, 'Attean::API::Iterator'); # SELECT (SUM(?o) AS ?sum) WHERE { ?s

?o . } GROUP BY ?s expect_token_stream($i, [KEYWORD, LPAREN, KEYWORD, LPAREN, VAR, RPAREN, KEYWORD, VAR, RPAREN, KEYWORD, LBRACE, VAR, IRI, VAR, DOT, RBRACE, KEYWORD, KEYWORD, VAR]); }; # Attean::Algebra::Construct # Attean::Algebra::Extend # Attean::Algebra::Sequence subtest 'BGP with blank' => sub { my $b = blank('person'); my $rdf_type = iri('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'); my $foaf_name = iri('http://xmlns.com/foaf/0.1/name'); my $foaf_knows = iri('http://xmlns.com/foaf/0.1/knows'); my $foaf_Person = iri('http://xmlns.com/foaf/0.1/Person'); my $bgp1 = Attean::Algebra::BGP->new( triples => [ triplepattern($b, $rdf_type, $foaf_Person), triplepattern($b, $foaf_name, variable('name')), triplepattern($b, $foaf_knows, variable('knows')), ] ); lives_ok { my $string = $bgp1->as_sparql; is($string, <<"END", 'expected serialization'); _:person . _:person ?name . _:person ?knows . END } 'as_sparql returns a string on blank'; }; subtest 'BGP canonicalization' => sub { my $b = blank('person'); my $rdf_type = iri('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'); my $foaf_name = iri('http://xmlns.com/foaf/0.1/name'); my $foaf_knows = iri('http://xmlns.com/foaf/0.1/knows'); my $foaf_Person = iri('http://xmlns.com/foaf/0.1/Person'); my $bgp1 = Attean::Algebra::BGP->new( triples => [ triplepattern($b, $rdf_type, $foaf_Person), triplepattern($b, $foaf_name, variable('name')), triplepattern($b, $foaf_knows, variable('knows')), ] ); my $bgp2 = Attean::Algebra::BGP->new( triples => [ triplepattern(blank('s'), $foaf_knows, variable('person')), triplepattern(blank('s'), $rdf_type, $foaf_Person), triplepattern(blank('s'), $foaf_name, variable('myname')), ] ); my $hash1 = sha1_hex( join("\n", map { $_->tuples_string } (@{$bgp1->triples}) ) ); my $hash2 = sha1_hex( join("\n", map { $_->tuples_string } (@{$bgp2->triples}) ) ); isnt($hash1, $hash2, 'non-matching pre-canonicalized BGP hashes'); my ($cbgp1, $m1) = $bgp1->canonical_bgp_with_mapping; my ($cbgp2, $m2) = $bgp2->canonical_bgp_with_mapping; my $chash1 = sha1_hex( join("\n", map { $_->tuples_string } (@{$cbgp1->triples}) ) ); my $chash2 = sha1_hex( join("\n", map { $_->tuples_string } (@{$cbgp2->triples}) ) ); is($chash1, $chash2, 'matching canonicalized BGP hashes' ); is_deeply($m1, { '?name' => { 'prefix' => '?', 'id' => 'v003', 'type' => 'variable' }, '?knows' => { 'id' => 'v002', 'prefix' => '?', 'type' => 'variable' }, '_:person' => { 'id' => 'v001', 'prefix' => '_:', 'type' => 'blank' } }, 'BGP1 mapping'); is_deeply($m2, { '?person' => { 'prefix' => '?', 'id' => 'v002', 'type' => 'variable' }, '_:s' => { 'prefix' => '_:', 'id' => 'v001', 'type' => 'blank' }, '?myname' => { 'type' => 'variable', 'id' => 'v003', 'prefix' => '?' } }, 'BGP2 mapping'); }; { my $t = triplepattern(variable('s'), iri('p'), variable('o')); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my @groups = Attean::ValueExpression->new( value => variable('s') ); my @aggs = Attean::AggregateExpression->new( distinct => 0, operator => 'SUM', children => [Attean::ValueExpression->new( value => variable('s') )], scalar_vars => {}, variable => variable("sum"), ); my $agg = Attean::Algebra::Group->new( children => [$bgp], groupby => \@groups, aggregates => \@aggs, ); my $s = $agg->as_string; like($s, qr/Group [{] [?]s [}] aggregate [{] [?]sum ↠SUM\([?]s\) [}]/, 'aggregate serialization'); } { note('Aggregation'); my $t = triplepattern(variable('s'), iri('p'), variable('o')); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my @groups = Attean::ValueExpression->new( value => variable('s') ); my @aggs = Attean::AggregateExpression->new( distinct => 0, operator => 'SUM', children => [Attean::ValueExpression->new( value => variable('s') )], scalar_vars => {}, variable => variable("sum"), ); my $agg = Attean::Algebra::Group->new( children => [$bgp], groupby => \@groups, aggregates => \@aggs, ); my $s = $agg->as_string; like($s, qr/Group [{] [?]s [}] aggregate [{] [?]sum ↠SUM\([?]s\) [}]/, 'aggregate serialization'); } { note('Ranking'); # RANKing example for 2 youngest students per school my $bgp = Attean::Algebra::BGP->new(triples => [ triplepattern(variable('p'), iri('ex:name'), variable('name')), triplepattern(variable('p'), iri('ex:school'), variable('school')), triplepattern(variable('p'), iri('ex:age'), variable('age')), ]); my @groups = Attean::ValueExpression->new( value => variable('school') ); my $r_agg = Attean::AggregateExpression->new( distinct => 0, operator => 'RANK', children => [Attean::ValueExpression->new( value => variable('age') )], scalar_vars => {}, variable => variable("rank"), ); my $agg = Attean::Algebra::Group->new( children => [$bgp], groupby => \@groups, aggregates => [$r_agg], ); my $rank = Attean::Algebra::Filter->new( children => [$agg], expression => Attean::BinaryExpression->new( children => [ Attean::ValueExpression->new( value => variable('rank') ), Attean::ValueExpression->new( value => Attean::Literal->integer('2') ), ], operator => '<=' ), ); my $s = $rank->as_string; like($s, qr/Group [{] [?]school [}] aggregate [{] [?]rank ↠RANK\([?]age\) [}]/, 'ranking serialization'); } subtest 'expected tokens: modify update' => sub { { my $s = Attean->get_parser('SPARQL')->parse_update('DELETE { ?s ?p ?o . } WHERE { ?s ?p ?o }')->as_sparql; ws_is($s, 'DELETE { ?s ?p ?o . } WHERE { ?s ?p ?o . }', 'DELETE'); } { my $s = Attean->get_parser('SPARQL')->parse_update('DELETE { ?s ?p ?o . } USING WHERE { ?s ?p ?o }')->as_sparql; ws_is($s, 'DELETE { ?s ?p ?o . } USING WHERE { ?s ?p ?o . }', 'DELETE + USING'); } { my $s = Attean->get_parser('SPARQL')->parse_update('DELETE { ?s ?p ?o . } USING USING WHERE { ?s ?p ?o }')->as_sparql; ws_is($s, 'DELETE { ?s ?p ?o . } USING USING WHERE { ?s ?p ?o . }', 'DELETE + Multiple USING'); } { my $s = Attean->get_parser('SPARQL')->parse_update('DELETE { ?s ?p ?o . } USING USING NAMED WHERE { ?s ?p ?o }')->as_sparql; ws_is($s, 'DELETE { ?s ?p ?o . } USING USING NAMED WHERE { ?s ?p ?o . }', 'DELETE + USING + USING NAMED'); } { my $s = Attean->get_parser('SPARQL')->parse_update('DELETE { ?s ?p ?o . } USING USING NAMED USING USING NAMED WHERE { ?s ?p ?o }')->as_sparql; ws_is($s, 'DELETE { ?s ?p ?o . } USING USING USING NAMED USING NAMED WHERE { ?s ?p ?o . }', 'DELETE + Multiple USING + Multiple USING NAMED'); } }; subtest 'expected tokens: custom query dataset' => sub { { my $s = Attean->get_parser('SPARQL')->parse_update('SELECT * FROM NAMED FROM WHERE { ?s ?p ?o }')->as_sparql; ws_is($s, 'SELECT * FROM FROM NAMED WHERE { ?s ?p ?o . }', 'SELECT FROM'); } { my $s = Attean->get_parser('SPARQL')->parse_update('ASK FROM NAMED FROM WHERE { ?s ?p ?o }')->as_sparql; ws_is($s, 'ASK FROM FROM NAMED { ?s ?p ?o . }', 'ASK FROM'); } { my $s = Attean->get_parser('SPARQL')->parse_update('DESCRIBE ?s FROM NAMED FROM WHERE { ?s ?p ?o }')->as_sparql; ws_is($s, 'DESCRIBE ?s FROM FROM NAMED WHERE { ?s ?p ?o . }', 'DESCRIBE FROM'); } { my $s = Attean->get_parser('SPARQL')->parse_update('CONSTRUCT { ?s ?p ?o } FROM NAMED FROM WHERE { ?s ?p ?o }')->as_sparql; ws_is($s, 'CONSTRUCT { ?s ?p ?o . } FROM FROM NAMED WHERE { ?s ?p ?o . }', 'CONSTRUCT FROM'); } }; subtest 'AbbreviatingSerializer with explicit namespace map' => sub { my $map = URI::NamespaceMap->new( { foaf => iri('http://xmlns.com/foaf/0.1/') } ); my $a = Attean->get_parser('SPARQL')->parse('PREFIX foaf: SELECT * WHERE { a foaf:Person ; foaf:name ?name }'); my $s = Attean->get_serializer('SPARQL')->new( namespaces => $map ); my $i = $a->sparql_tokens; my $bytes = $s->serialize_iter_to_bytes($i); like($bytes, qr[PREFIX foaf: ], 'serialization has prefix declaration'); like($bytes, qr, 'serialization has IRI'); like($bytes, qr/foaf:Person/, 'serialization has prefix name foaf:Person'); like($bytes, qr/foaf:name [?]name/, 'serialization has prefix name foaf:name'); }; subtest 'End-to-end AbbreviatingSerializer' => sub { my $map = URI::NamespaceMap->new(); my $parser = Attean->get_parser('SPARQL')->new( namespaces => $map ); my ($a) = $parser->parse_list_from_bytes('PREFIX foaf: PREFIX ex: SELECT * WHERE { a foaf:Person ; foaf:name ?name }'); my $s = Attean->get_serializer('SPARQL')->new( namespaces => $map ); my $i = $a->sparql_tokens; my $bytes = $s->serialize_iter_to_bytes($i); like($bytes, qr[PREFIX ex: ], 'serialization has prefix declaration ex:'); like($bytes, qr[PREFIX foaf: ], 'serialization has prefix declaration foaf:'); like($bytes, qr, 'serialization has IRI'); like($bytes, qr/foaf:Person/, 'serialization has prefix name foaf:Person'); like($bytes, qr/foaf:name [?]name/, 'serialization has prefix name foaf:name'); is_deeply([sort $map->list_prefixes], [qw(ex foaf)]); }; subtest 'Update sequence' => sub { my $s = Attean->get_parser('SPARQL')->parse_update('DELETE DATA {

"o" } ; INSERT DATA { "o" }')->as_sparql; ws_is($s, 'DELETE DATA {

"o" . } ; INSERT DATA { "o" . }', 'update sequence'); }; subtest 'SPARQL-star' => sub { my $s = Attean->get_parser('SPARQL')->parse("PREFIX foaf: SELECT * WHERE { << ?s a foaf:Person >> foaf:believedBy }")->as_sparql; ws_is($s, 'SELECT * WHERE{ << ?s >> . }'); }; subtest 'Regressions' => sub { { my $s = Attean->get_parser('SPARQL')->parse('SELECT * WHERE { SERVICE {} }')->as_sparql; ws_is($s, 'SELECT * WHERE { SERVICE {} }', 'missing projection in serialization of some SPARQL queries #67'); } }; done_testing(); sub warn_token_stream { my $i = shift; while (my $t = $i->next) { my $type = AtteanX::SPARQL::Constants::decrypt_constant($t->type); my $value = $t->value; warn sprintf("%-16s: %s\n", $type, $value); } } sub expect_token_stream { my $i = shift; my $expect = shift; while (my $t = $i->next) { my $type = AtteanX::SPARQL::Constants::decrypt_constant($t->type); is_token_of_type($t, shift(@$expect)); } is(scalar(@$expect), 0); } sub is_token_of_type { my $t = shift; my $got = $t->type; my $expect = shift; if ($expect == A) { Carp::confess; } my $got_name = AtteanX::SPARQL::Constants::decrypt_constant($got); my $expect_name = AtteanX::SPARQL::Constants::decrypt_constant($expect); if ($got == $expect) { pass("Expected token type $got_name"); } else { my $value = $t->value; fail("Not expected token type (expected $expect_name, but got $got_name $value)"); } } sub ws_is { my $got = shift; my $expect = shift; my $name = shift; for ($got, $expect) { chomp; s/\s+//sg; } is($got, $expect, $name); } Attean-0.034/t/PaxHeader/serializer-canonicalntriples.t000644 000765 000024 00000006250 14525575742 023326 xustar00gregstaff000000 000000 30 mtime=1700199394.241196156 1830 LIBARCHIVE.xattr.com.apple.ResourceFork=AAABAAAABQgAAAQIAAAAMgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAQAAAAZL0FwcGxpY2F0aW9ucy9CQkVkaXQuYXBwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAUIAAAECAAAADIUAAAAexAAAAAcADIAAHVzcm8AAAAKAAD//wAAAAAPAAAA 1380 SCHILY.xattr.com.apple.ResourceFork=2/Applications/BBEdit.app2{2usro ÿÿ Attean-0.034/t/serializer-canonicalntriples.t000644 000765 000024 00000003444 14525575742 021357 0ustar00gregstaff000000 000000 use Test::Modern; use Test::Exception; use v5.14; use warnings; no warnings 'redefine'; use Attean; use Attean::RDF; use Encode; use Type::Tiny::Role; my $constraint = 'Attean::API::Triple'; my $p = iri('http://example.org/p'); my $ser = Attean->get_serializer('CanonicalNTriples')->new(); does_ok($ser, 'Attean::API::Serializer'); does_ok($ser, 'Attean::API::TripleSerializer'); isa_ok($ser, 'AtteanX::Serializer::NTriples'); { my $t1 = triple(blank('x'), $p, Attean::Literal->integer(1)); my $t2 = triple(blank('x'), $p, Attean::Literal->integer(2)); my @triples = ($t1, $t2); my $expected = <<"END"; _:v001 "1"^^ . _:v001 "2"^^ . END my $i = Attean::ListIterator->new(values => [@triples], item_type => $constraint); my $bytes = $ser->serialize_list_to_bytes(@triples); my $data = decode('UTF-8', $bytes, Encode::FB_CROAK); is($data, $expected, 'canonical serialize_iter_to_bytes 1'); } { my $x = blank('x'); my $y = blank(); my $t1 = triple($x, $p, Attean::Literal->integer(2)); my $t2 = triple($x, $p, $y); my $t3 = triple($y, $p, $x); my $t4 = triple($y, $p, Attean::Literal->integer(7)); my @triples = ($t1, $t2, $t3, $t4); my $expected = <<"END"; _:v001 "2"^^ . _:v001 _:v002 . _:v002 "7"^^ . _:v002 _:v001 . END my $i = Attean::ListIterator->new(values => [@triples], item_type => $constraint); my $bytes = $ser->serialize_list_to_bytes(@triples); my $data = decode('UTF-8', $bytes, Encode::FB_CROAK); is($data, $expected, 'canonical serialize_iter_to_bytes 2'); } done_testing(); Attean-0.034/t/types-general.t000644 000765 000024 00000003021 14626405101 016225 0ustar00gregstaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use Test::More; use Test::TypeTiny; use Attean; use Test::Requires { 'Attean::IRI' => '0.023' }; use Attean::RDF qw( iri blank literal triple quad ); use Types::Attean qw( AtteanIRI AtteanBlank AtteanLiteral AtteanSubject AtteanPredicate AtteanObject AtteanGraph AtteanTriple AtteanQuad ); my $iri = iri('http://www.example.net/'); my $blank = blank('b0'); my $literal = literal('foo'); my $triple = triple( $blank, $iri, $literal ); my $quad = quad( $blank, $iri, $literal, blank('g0') ); should_pass( $iri , AtteanIRI ); should_pass( $blank , AtteanBlank ); should_pass( $literal, AtteanLiteral ); note 'IRI can be in any position'; should_pass( $iri , AtteanSubject ); should_pass( $iri , AtteanPredicate ); should_pass( $iri , AtteanObject ); should_pass( $iri , AtteanGraph ); should_pass( $blank , AtteanSubject ); should_fail( $blank , AtteanPredicate , 'blank can not be a predicate'); should_pass( $blank , AtteanObject ); should_pass( $blank , AtteanGraph ); should_fail( $literal, AtteanSubject ); should_fail( $literal, AtteanPredicate ); should_pass( $literal, AtteanObject , 'literal can only be an object'); should_fail( $literal, AtteanGraph ); should_pass( $triple , AtteanTriple ); should_fail( $triple , AtteanQuad , 'triple is not a quad'); should_pass( $quad , AtteanTriple , 'quad is also a triple'); should_pass( $quad , AtteanQuad ); done_testing; Attean-0.034/t/PaxHeader/treerewrite.t000644 000765 000024 00000006250 14525575742 020010 xustar00gregstaff000000 000000 30 mtime=1700199394.243487657 1830 LIBARCHIVE.xattr.com.apple.ResourceFork=AAABAAAABQgAAAQIAAAAMgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAQAAAAZL0FwcGxpY2F0aW9ucy9CQkVkaXQuYXBwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAUIAAAECAAAADIdAAAAmxAAAAAcADIAAHVzcm8AAAAKAAD//wAAAAAYAAAA 1380 SCHILY.xattr.com.apple.ResourceFork=2/Applications/BBEdit.app2›2usro ÿÿ Attean-0.034/t/treerewrite.t000644 000765 000024 00000007765 14525575742 016053 0ustar00gregstaff000000 000000 use v5.14; use autodie; use utf8; use Test::More; use Test::Exception; use Data::Dumper; use Attean; use Attean::RDF; use Attean::TreeRewriter; { my $t = triple(iri('s'), iri('p'), literal('1')); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); { my $w = Attean::TreeRewriter->new(); $w->register_pre_handler(sub { return (0, 1, shift); }); isa_ok($w, 'Attean::TreeRewriter'); my ($changed, $rewritten) = $w->rewrite($bgp, {}); ok(not($changed), 'not changed'); } { my $w = Attean::TreeRewriter->new(); $w->register_pre_handler(sub { my ($t, $parent, $thunk) = @_; return (0, 1, shift); }); isa_ok($w, 'Attean::TreeRewriter'); my ($changed, $rewritten) = $w->rewrite($bgp, {}); ok(not($changed), 'not changed'); } { my $w = Attean::TreeRewriter->new(types => []); my $seen = 0; $w->register_pre_handler(sub { my ($t, $parent, $thunk) = @_; $seen++; return (0, 1, shift); }); isa_ok($w, 'Attean::TreeRewriter'); my ($changed, $rewritten) = $w->rewrite($bgp, {}); ok(not($changed), 'not changed'); ok(not($seen), 'tree not walked'); } { my $w = Attean::TreeRewriter->new(types => ['Attean::API::DirectedAcyclicGraph', 'Attean::API::Binding']); $w->register_pre_handler(sub { my ($t, $parent, $thunk) = @_; if ($t->isa('Attean::Triple')) { my $s = $t->subject; if ($s->value =~ /s$/) { my $new = triple(iri('x'), iri('y'), iri('z')); return (1, 0, $new); } } return (0, 1, shift); }); isa_ok($w, 'Attean::TreeRewriter'); my ($changed, $rewritten) = $w->rewrite($bgp, {}); ok($changed, 'changed'); isa_ok($rewritten, 'Attean::Algebra::BGP'); my @triples = @{ $rewritten->triples }; is(scalar(@triples), 1, 'triple count'); my ($t) = @triples; isa_ok($t, 'Attean::Triple'); is($t->as_string, ' .'); } { my $w = Attean::TreeRewriter->new(types => ['Attean::API::DirectedAcyclicGraph', 'Attean::API::Binding', 'Attean::API::Literal']); $w->register_pre_handler(sub { my ($t, $parent, $thunk) = @_; if ($t->isa('Attean::Literal')) { my $value = 1 + $t->value; my $new = literal($value); return (1, 0, $new); } return (0, 1, $t); }); isa_ok($w, 'Attean::TreeRewriter'); my ($changed, $rewritten) = $w->rewrite($bgp, {}); ok($changed, 'changed'); isa_ok($rewritten, 'Attean::Algebra::BGP'); my @triples = @{ $rewritten->triples }; is(scalar(@triples), 1, 'triple count'); my ($t) = @triples; isa_ok($t, 'Attean::Triple'); is($t->as_string, '

"2" .'); } } { # rewrite iris s/^p/Z/ (e.g. -> ;

-> ) my $p1 = iri('p1'); my $pp1 = Attean::Algebra::PredicatePath->new( predicate => $p1 ); my $p2 = iri('p2'); my $pp2 = Attean::Algebra::PredicatePath->new( predicate => $p2 ); my $nps = Attean::Algebra::NegatedPropertySet->new( predicates => [$p1, $p2] ); my $seq = Attean::Algebra::SequencePath->new( children => [$pp1, $pp2] ); my $alt = Attean::Algebra::AlternativePath->new( children => [$pp1, $pp2] ); my $inv_seq = Attean::Algebra::InversePath->new( children => [$seq] ); my $inv_seq_star = Attean::Algebra::ZeroOrMorePath->new( children => [$inv_seq] ); my $t = triple(iri('s'), iri('p'), literal('1')); my $bgp = Attean::Algebra::BGP->new(triples => [$t]); my $join = Attean::Algebra::Join->new( children => [$bgp, $inv_seq_star, $alt, $nps] ); my $dist = Attean::Algebra::Distinct->new( children => [$join] ); my $w = Attean::TreeRewriter->new(types => ['Attean::API::DirectedAcyclicGraph', 'Attean::API::Binding', 'Attean::API::TermOrVariable']); $w->register_pre_handler(sub { my ($t, $parent, $thunk) = @_; if ($t->isa('Attean::IRI')) { if ($t->value =~ /^p(.*)$/) { my $value = $t->value; my $new = iri("Z$1"); return (1, 0, $new); } } return (0, 1, shift); }); my ($changed, $rewritten) = $w->rewrite($dist, {}); ok($changed, 'changed'); my $string = $rewritten->as_string; like($string, qr/ "1"/); like($string, qr/Property Path /); like($string, qr/Property Path /); } done_testing(); Attean-0.034/t/PaxHeader/term-map.t000644 000765 000024 00000000225 13761075303 017152 xustar00gregstaff000000 000000 30 mtime=1606712003.506159576 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/t/term-map.t000644 000765 000024 00000005341 13761075303 015205 0ustar00gregstaff000000 000000 use v5.14; use Data::Dumper; use Test::More; use Type::Tiny::Role; use Attean::RDF qw(iri blank literal dtliteral langliteral triple quad); my $t = triple(blank('xxx'), iri('p'), literal('1')); my $u = triple(blank('yyy'), iri('p'), literal('2')); subtest 'short blank node label mapping' => sub { my $mapper = Attean::TermMap->short_blank_map; my $bindings_mapper = $mapper->binding_mapper; { note('Mapping Iterator'); my $iter = Attean::ListIterator->new(values => [blank('a'), blank('zzz')], item_type => 'Attean::API::Term'); my $mapped = $iter->map( $mapper ); my $a = $mapped->next; my $b = $mapped->next; is($a->ntriples_string, '_:a'); is($b->ntriples_string, '_:b'); } { note('Mapping Triples'); my $iter = Attean::ListIterator->new(values => [$t, $u], item_type => 'Attean::API::Triple'); my $c = $iter->next->apply_map($mapper); my $d = $iter->next->apply_map($mapper); is($c->subject->ntriples_string, '_:c'); is($d->subject->ntriples_string, '_:d'); } { note('Mapping Iterator'); my $iter = Attean::ListIterator->new(values => [$u, $t], item_type => 'Attean::API::Triple'); my $mapped = $iter->map( $bindings_mapper ); my $d = $mapped->next; my $c = $mapped->next; is($c->subject->ntriples_string, '_:c'); is($d->subject->ntriples_string, '_:d'); } }; subtest 'UUID blank node label mapping' => sub { my $mapper = Attean::TermMap->uuid_blank_map; my $bindings_mapper = $mapper->binding_mapper; my $uuid_blank = qr/^_:b[0-9A-Za-z]{32}$/; { note('Mapping Iterator'); my $iter = Attean::ListIterator->new(values => [blank('a'), blank('zzz')], item_type => 'Attean::API::Term'); my $mapped = $iter->map( $mapper ); my $a = $mapped->next; my $b = $mapped->next; like($a->ntriples_string, $uuid_blank); like($b->ntriples_string, $uuid_blank); } { note('Mapping Triples'); my $iter = Attean::ListIterator->new(values => [$t, $u], item_type => 'Attean::API::Triple'); my $c = $iter->next->apply_map($mapper); my $d = $iter->next->apply_map($mapper); like($c->subject->ntriples_string, $uuid_blank); like($d->subject->ntriples_string, $uuid_blank); } { note('Mapping Iterator'); my $iter = Attean::ListIterator->new(values => [$u, $t], item_type => 'Attean::API::Triple'); my $mapped = $iter->map( $bindings_mapper ); my $d = $mapped->next; my $c = $mapped->next; like($c->subject->ntriples_string, $uuid_blank); like($d->subject->ntriples_string, $uuid_blank); } }; subtest 'canonicalize literal' => sub { my $i = Attean::Literal->integer('+12'); my $m = Attean::TermMap->canonicalization_map; my $new_i = $m->map($i); is($new_i->ntriples_string, '"12"^^'); }; done_testing(); Attean-0.034/t/PaxHeader/binding.t000644 000765 000024 00000006503 14525575742 017062 xustar00gregstaff000000 000000 30 mtime=1700199394.237572281 1830 LIBARCHIVE.xattr.com.apple.ResourceFork=AAABAAAABQgAAAQIAAAAMgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAQAAAAZL0FwcGxpY2F0aW9ucy9CQkVkaXQuYXBwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAUIAAAECAAAADIJAAAAWhAAAAAcADIAAHVzcm8AAAAKAAD//wAAAAAEAAAA 1380 SCHILY.xattr.com.apple.ResourceFork=2/Applications/BBEdit.app2 Z2usro ÿÿ 85 LIBARCHIVE.xattr.com.apple.FinderInfo=VEVYVAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 70 SCHILY.xattr.com.apple.FinderInfo=TEXT Attean-0.034/t/binding.t000644 000765 000024 00000013143 14525575742 015107 0ustar00gregstaff000000 000000 use Test::Modern; use Test::Exception; use v5.14; use warnings; no warnings 'redefine'; use Attean; use Attean::RDF; is_deeply([Attean::API::Triple->variables], [qw(subject predicate object)]); is_deeply([Attean::API::Quad->variables], [qw(subject predicate object graph)]); subtest 'Attean::Triple' => sub { my $b = triple(blank('eve'), iri('http://xmlns.com/foaf/0.1/name'), literal('Eve')); dies_ok { $b->value('xxx') } 'bad binding key'; does_ok($b, 'Attean::API::Binding'); is_deeply([$b->variables], [qw(subject predicate object)], 'variables'); is_deeply([$b->values], [blank('eve'), iri('http://xmlns.com/foaf/0.1/name'), literal('Eve')], 'values'); my %m = $b->mapping; is_deeply(\%m, { subject => blank('eve'), predicate => iri('http://xmlns.com/foaf/0.1/name'), object => literal('Eve') }, 'mapping'); is_deeply($b->value('subject'), blank('eve'), 'value'); my $qp = $b->as_quad_pattern(variable('g')); my $q = $b->as_quad(iri('graph')); does_ok($qp, 'Attean::API::Binding'); does_ok($qp, 'Attean::API::QuadPattern'); does_ok($q, 'Attean::API::Binding'); does_ok($q, 'Attean::API::Quad'); is_deeply($q, quad(blank('eve'), iri('http://xmlns.com/foaf/0.1/name'), literal('Eve'), iri('graph'))); }; subtest 'Attean::Quad' => sub { my $b = quad(blank('eve'), iri('http://xmlns.com/foaf/0.1/name'), literal('Eve'), iri('graph')); dies_ok { $b->value('xxx') } 'bad binding key'; does_ok($b, 'Attean::API::Binding'); is_deeply([$b->variables], [qw(subject predicate object graph)], 'variables'); is_deeply([$b->values], [blank('eve'), iri('http://xmlns.com/foaf/0.1/name'), literal('Eve'), iri('graph')], 'values'); my %m = $b->mapping; is_deeply(\%m, { subject => blank('eve'), predicate => iri('http://xmlns.com/foaf/0.1/name'), object => literal('Eve'), graph => iri('graph') }, 'mapping'); is_deeply($b->value('subject'), blank('eve'), 'value'); }; subtest 'Attean::Result' => sub { my $b = Attean::Result->new( bindings => { name => literal('Eve') } ); does_ok($b, 'Attean::API::Binding'); is_deeply([$b->variables], ['name'], 'variables'); is_deeply([$b->values], [literal('Eve')], 'values'); my %m = $b->mapping; is_deeply(\%m, { name => literal('Eve') }, 'mapping'); is_deeply($b->value('name'), literal('Eve'), 'value'); }; subtest 'Attean::Result joining' => sub { my $shared = blank('eve'); my $b1 = Attean::Result->new( bindings => { p => $shared, type => iri('http://xmlns.com/foaf/0.1/Person') } ); my $b2 = Attean::Result->new( bindings => { p => blank('eve'), name => literal('Eve') } ); my $b3 = Attean::Result->new( bindings => { p => blank('alice'), name => literal('Alice') } ); my $b4 = Attean::Result->new( bindings => { x => literal('xxx') } ); my $b5 = Attean::Result->new( bindings => { p => $shared, name => literal('Eve') } ); is($b1->join($b3), undef, 'intersecting result non-join'); is($b1->join($b4)->as_string, '{p=_:eve, type=, x="xxx"}', 'disjoint result join'); is($b1->join($b2)->as_string, '{name="Eve", p=_:eve, type=}', 'intersecting result join'); is($b1->join($b5)->as_string, '{name="Eve", p=_:eve, type=}', 'intersecting result join using shared term object'); }; subtest 'Attean::TriplePattern' => sub { my $b = triplepattern(variable('eve'), iri('http://xmlns.com/foaf/0.1/name'), literal('Eve')); does_ok($b, 'Attean::API::Binding'); my $qp = $b->as_quadpattern(variable('g')); does_ok($b, 'Attean::API::Binding'); isa_ok($qp, 'Attean::QuadPattern'); }; subtest 'statement application' => sub { { my $t = triple(iri('s'), iri('p'), iri('o')); my $b = triplepattern(variable('object'), iri('http://xmlns.com/foaf/0.1/name'), literal('Eve')); my $x = $b->apply_triple($t); does_ok($x, 'Attean::API::Binding'); is_deeply([$x->variables], ['subject']); my $o = $x->value('subject'); does_ok($o, 'Attean::API::IRI'); is($o->value, 'o'); } { my $q = triple(iri('s'), iri('p'), iri('o'), iri('ggg')); my $b = quadpattern(variable('object'), iri('http://xmlns.com/foaf/0.1/name'), variable('subject'), iri('http://example.org/graph')); my $x = $b->apply_quad($q); does_ok($x, 'Attean::API::Binding'); is_deeply([sort $x->variables], [qw(object subject)]); my $s = $x->value('subject'); does_ok($s, 'Attean::API::IRI'); is($s->value, 'o'); my $o = $x->value('object'); does_ok($o, 'Attean::API::IRI'); is($o->value, 's'); } }; subtest 'binding projection' => sub { my $b = Attean::Result->new(bindings => { subject => iri('s'), predicate => iri('http://xmlns.com/foaf/0.1/name'), object => literal('Hello!') }); my $p = $b->project(qw(predicate object)); does_ok($p, 'Attean::API::Result'); is_deeply([sort $b->variables], [qw(object predicate subject)]); is_deeply([sort $p->variables], [qw(object predicate)]); }; subtest 'Attean::API::Binding convenience parse method' => sub { { my $t = Attean::Triple->parse(' a '); does_ok($t, 'Attean::API::Triple'); is($t->predicate->value, 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type', 'parsed A'); } { my $map = URI::NamespaceMap->new({ foaf => 'http://xmlns.com/foaf/0.1/' }); my $t = Attean::TriplePattern->parse('?s a foaf:Person', namespaces => $map); does_ok($t, 'Attean::API::TriplePattern'); does_ok($t->subject, 'Attean::API::Variable'); is($t->object->value, 'http://xmlns.com/foaf/0.1/Person', 'parsed prefixname'); } { my $q = Attean::Quad->parse('

"foo"@en '); does_ok($q, 'Attean::API::Quad'); does_ok($q->graph, 'Attean::API::IRI'); is($q->graph->value, 'http://example.org/graph/', 'parsed quad graph'); } }; done_testing(); Attean-0.034/t/PaxHeader/00.load.t000644 000765 000024 00000006250 14525575742 016604 xustar00gregstaff000000 000000 30 mtime=1700199394.237257781 1830 LIBARCHIVE.xattr.com.apple.ResourceFork=AAABAAAABQgAAAQIAAAAMgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAQAAAAZL0FwcGxpY2F0aW9ucy9CQkVkaXQuYXBwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAUIAAAECAAAADIGAAAAURAAAAAcADIAAHVzcm8AAAAKAAD//wAAAAABAAAA 1380 SCHILY.xattr.com.apple.ResourceFork=2/Applications/BBEdit.app2Q2usro ÿÿ Attean-0.034/t/00.load.t000644 000765 000024 00000000143 14525575742 014626 0ustar00gregstaff000000 000000 use Test::More tests => 1; BEGIN { use_ok( 'Attean' ); } note( "Testing RDF $Attean::VERSION" ); Attean-0.034/t/PaxHeader/plan.t000644 000765 000024 00000000200 12725723146 016357 xustar00gregstaff000000 000000 69 LIBARCHIVE.xattr.com.apple.lastuseddate#PS=Z1TtYgAAAACQ7J0PAAAAAA 59 SCHILY.xattr.com.apple.lastuseddate#PS=gTíbì Attean-0.034/t/plan.t000644 000765 000024 00000004113 12725723146 014415 0ustar00gregstaff000000 000000 use v5.14; use autodie; use utf8; use Test::Modern; use Test::Exception; use Digest::SHA qw(sha1_hex); use Attean; use Attean::RDF; use AtteanX::Store::Memory; package TestPlanner { use Moo; extends 'Attean::QueryPlanner'; with 'Attean::API::NaiveJoinPlanner'; } my $p = TestPlanner->new(); my $store = AtteanX::Store::Memory->new(); my $model = Attean::MutableQuadModel->new( store => $store ); my $graph = iri('http://example.org/'); my $t = triplepattern(variable('s'), iri('p'), literal('1')); my $u = triplepattern(variable('s'), iri('p'), variable('o')); my $v = triplepattern(variable('s'), iri('q'), blank('xyz')); my $w = triplepattern(variable('a'), iri('b'), iri('c')); my $x = triplepattern(variable('a'), variable('b'), iri('c')); sub test_triples_for_connected_plan { my $triples = shift; my $connected = shift; my $note = shift; my $bgp = Attean::Algebra::BGP->new(triples => $triples); my $plan = $p->plan_for_algebra($bgp, $model, [$graph]); my $ok = $plan->subplans_of_type_are_variable_connected('Attean::Plan::Quad'); $ok = not($ok) unless ($connected); ok($ok, $note); } test_triples_for_connected_plan([], 1, 'Empty BGP'); test_triples_for_connected_plan([$t], 1, '1-triple BGP'); test_triples_for_connected_plan([$t, $u], 1, '2-triple BGP'); test_triples_for_connected_plan([$w, $x], 1, '2-triple BGP'); test_triples_for_connected_plan([$t, $u, $v], 1, '3-triple BGP'); test_triples_for_connected_plan([$t, $u, $v, $w], 0, '4-triple BGP'); test_triples_for_connected_plan([$x, $t, $u, $v, $w], 0, '5-triple BGP'); subtest 'Construct' => sub { my $t = Attean::Plan::Quad->new( subject => variable('s'), predicate => iri('p'), object => variable('o'), graph => iri('g'), distinct => 1, ordered => []); my $u = triplepattern(variable('s'), iri('q'), variable('o')); my $c = Attean::Plan::Construct->new(triples => [$u], children => [$t], distinct => 0, ordered => []); like($c->as_string, qr/Construct/s); like($c->as_string, qr/Quad.*[?]s[, ]*

[, ]*[?]o/, 'construct pattern'); like($c->as_string, qr/[?]s [?]o/, 'construct template'); }; done_testing(); Attean-0.034/t/parser-sparqlxml.t000644 000765 000024 00000006012 12706047322 016772 0ustar00gregstaff000000 000000 use v5.14; use warnings; use autodie; use Test::Modern; use utf8; use Attean; sub iri { Attean::IRI->new(shift) } sub blank { Attean::Blank->new(shift) } sub literal { my ($value, $lang, $dt) = @_; if ($lang) { return Attean::Literal->new(value => $value, language => $lang); } elsif ($dt) { return Attean::Literal->new(value => $value, datatype => $dt); } else { return Attean::Literal->new($value); } } subtest 'parser construction and metadata' => sub { my $parser = Attean->get_parser('SPARQLXML')->new(); isa_ok($parser, 'AtteanX::Parser::SPARQLXML'); is($parser->canonical_media_type, 'application/sparql-results+xml', 'canonical_media_type'); my %extensions = map { $_ => 1 } @{ $parser->file_extensions }; ok(exists $extensions{'srx'}, 'file_extensions'); my $type = $parser->handled_type; can_ok($type, 'role'); is($type->role, 'Attean::API::ResultOrTerm'); }; { my $xml = <<'END'; r2 http://work.example.org/bob/ Bob 30 mailto:bob@work.example.org END my $counter = 0; my $parser = Attean->get_parser('SPARQLXML')->new(handler => sub { $counter++; my $result = shift; does_ok($result, 'Attean::API::Result'); my @vars = $result->variables; is_deeply([sort @vars], [qw(age hpage mbox name x)]); my $x = $result->value('x'); does_ok($x, 'Attean::API::Blank'); is($x->value, 'r2'); my $age = $result->value('age'); does_ok($age, 'Attean::API::Literal'); is($age->value, '30'); is($age->datatype->value, 'http://www.w3.org/2001/XMLSchema#integer'); my $hpage = $result->value('hpage'); does_ok($hpage, 'Attean::API::IRI'); is($hpage->value, 'http://work.example.org/bob/'); }); $parser->parse_cb_from_bytes($xml); } { my $xml = <<'END'; r2 Bob http://example.org/eve Eve END open(my $fh, '<', \$xml); my $counter = 0; my $parser = Attean->get_parser('SPARQLXML')->new(handler => sub {}); my @results = $parser->parse_list_from_io($fh); is(scalar(@results), 2); } done_testing(); Attean-0.034/t/PaxHeader/store-memory.t000644 000765 000024 00000000200 12706047277 020072 xustar00gregstaff000000 000000 69 LIBARCHIVE.xattr.com.apple.lastuseddate#PS=uZOfYgAAAAA4xBUHAAAAAA 59 SCHILY.xattr.com.apple.lastuseddate#PS=¹“Ÿb8Ä Attean-0.034/t/store-memory.t000644 000765 000024 00000004225 12706047277 016134 0ustar00gregstaff000000 000000 use Test::Roo; use Test::Modern; use Test::Exception; use v5.14; use warnings; no warnings 'redefine'; use Attean; sub create_store { my $self = shift; my %args = @_; my $quads = $args{quads} // []; my $store = Attean->get_store('Memory')->new(); foreach my $q (@$quads) { $store->add_quad($q); } return $store; } sub caching_sleep_time { return 2; } with 'Test::Attean::QuadStore', 'Test::Attean::MutableQuadStore'; with 'Test::Attean::MutableTimeCacheableQuadStore', 'Test::Attean::MutableETagCacheableQuadStore'; run_me; # run these Test::Attean tests { my $store = Attean->get_store('Memory')->new(); isa_ok($store, 'AtteanX::Store::Memory'); my $s = Attean::Blank->new('x'); my $p = Attean::IRI->new('http://example.org/p1'); my $o = Attean::Literal->new(value => 'foo', language => 'en-US'); my $g = Attean::IRI->new('http://example.org/graph'); my $q = Attean::Quad->new($s, $p, $o, $g); does_ok($q, 'Attean::API::Quad'); isa_ok($q, 'Attean::Quad'); $store->add_quad($q); is($store->size, 1); { my $iter = $store->get_quads($s); does_ok($iter, 'Attean::API::Iterator'); my $q = $iter->next; does_ok($q, 'Attean::API::Quad'); my ($s, $p, $o, $g) = $q->values; is($s->value, 'x'); is($o->value, 'foo'); } my $s2 = Attean::IRI->new('http://example.org/values'); foreach my $value (1 .. 3) { my $o = Attean::Literal->new(value => $value, datatype => 'http://www.w3.org/2001/XMLSchema#integer'); my $p = Attean::IRI->new("http://example.org/p$value"); my $q = Attean::Quad->new($s2, $p, $o, $g); $store->add_quad($q); } is($store->size, 4); is($store->count_quads($s), 1); is($store->count_quads($s2), 3); is($store->count_quads(), 4); is($store->count_quads(undef, $p), 2); { my $iter = $store->get_quads($s2); while (my $q = $iter->next()) { my $o = $q->object->value; like($o, qr/^[123]$/, "Literal value: $o"); } } $store->remove_quad($q); is($store->size, 3); is($store->count_quads(undef, $p), 1); $store->remove_quads(undef, iri('http://example.org/p2')); is($store->size, 2); $store->remove_quads(undef, [map { iri("http://example.org/p$_") } (1,3) ]); is($store->size, 0); } done_testing(); Attean-0.034/t/serializer-ntriples.t000644 000765 000024 00000003330 12651242417 017465 0ustar00gregstaff000000 000000 use Test::Modern; use Test::Exception; use v5.14; use warnings; no warnings 'redefine'; use Attean; use Type::Tiny::Role; my $constraint = 'Attean::API::Triple'; my $s = Attean::Blank->new('x'); my $p = Attean::IRI->new('http://example.org/p'); my $o1 = Attean::Literal->new(value => '1', datatype => 'http://www.w3.org/2001/XMLSchema#integer'); my $o2 = Attean::Literal->new(value => '2', datatype => 'http://www.w3.org/2001/XMLSchema#integer'); my $t1 = Attean::Triple->new($s, $p, $o1); my $t2 = Attean::Triple->new($s, $p, $o2); my @triples = ($t1, $t2); { my $ser = Attean->get_serializer('NTriples')->new(); does_ok($ser, 'Attean::API::Serializer'); does_ok($ser, 'Attean::API::TripleSerializer'); isa_ok($ser, 'AtteanX::Serializer::NTriples'); my $expected = <<"END"; _:x "1"^^ . _:x "2"^^ . END { my $i = Attean::ListIterator->new(values => [@triples], item_type => $constraint); my $data1 = $ser->serialize_iter_to_bytes($i); my $data2 = $ser->serialize_list_to_bytes(@triples); is($data1, $expected, 'serialize_iter_to_bytes'); is($data1, $data2, 'serialize_list_to_bytes'); } { my $i = Attean::ListIterator->new(values => [@triples], item_type => $constraint); my $data = ''; open(my $fh, '>', \$data); $ser->serialize_iter_to_io($fh, $i); close($fh); is($data, $expected, 'serialize_iter_to_io'); } { my $i = Attean::ListIterator->new(values => [@triples], item_type => $constraint); my $data = ''; open(my $fh, '>', \$data); $ser->serialize_list_to_io($fh, @triples); close($fh); is($data, $expected, 'serialize_iter_to_io'); } } done_testing(); Attean-0.034/t/join_rotating_planner.t000644 000765 000024 00000017604 12706763135 020062 0ustar00gregstaff000000 000000 use v5.14; use Test::Modern; use Attean; use Attean::RDF; use Attean::IDPQueryPlanner; ############################################################################### package MyBGP { use Moo; use Scalar::Util qw(blessed reftype); use Types::Standard qw(ConsumerOf ArrayRef); use namespace::clean; with 'Attean::API::NullaryQueryTree', 'Attean::API::UnionScopeVariablesPlan'; sub plan_as_string { return 'BGP' } sub impl { die "Unimplemented" } } package MyPlanner { use Moo; use namespace::clean; extends 'Attean::QueryPlanner'; with 'Attean::API::NaiveJoinPlanner'; with 'Attean::API::SimpleCostPlanner'; with 'AtteanX::API::JoinRotatingPlanner'; sub allow_join_rotation { my $self = shift; my $join = shift; # Inspect $join to conditionally allow/disallow join rotation return 1; } sub coalesce_rotated_join { my $self = shift; my $join = shift; my ($lhs, $rhs) = @{ $join->children }; if ($lhs->isa('Attean::Plan::Quad') and $rhs->isa('Attean::Plan::Quad')) { return MyBGP->new(children => [$lhs, $rhs], distinct => 0); } elsif ($lhs->isa('MyBGP') and $rhs->isa('Attean::Plan::Quad')) { my @quads = (@{ $lhs->children }, $rhs); return MyBGP->new(children => \@quads, distinct => 0); } elsif ($rhs->isa('MyBGP') and $lhs->isa('Attean::Plan::Quad')) { my @quads = ($lhs, @{ $rhs->children }); return MyBGP->new(children => \@quads, distinct => 0); } elsif ($rhs->isa('MyBGP') and $lhs->isa('MyBGP')) { my @quads = (@{ $lhs->children }, @{ $rhs->children }); return MyBGP->new(children => \@quads, distinct => 0); } return $join; } around 'cost_for_plan' => sub { my $orig = shift; my $self = shift; my $plan = shift; if ($plan->isa('MyBGP')) { # Force MyBGP objects to cost less than an equivalent join over Quad plans. return 1; } return $orig->($self, $plan, @_); } } package MyPlanner1 { # this planner uses the default allow_join_rotation() use Moo; use namespace::clean; extends 'Attean::QueryPlanner'; with 'Attean::API::NaiveJoinPlanner'; with 'Attean::API::SimpleCostPlanner'; with 'AtteanX::API::JoinRotatingPlanner'; sub coalesce_rotated_join { my $self = shift; my $join = shift; my ($lhs, $rhs) = @{ $join->children }; if ($lhs->isa('Attean::Plan::Quad') and $rhs->isa('Attean::Plan::Quad')) { return MyBGP->new(children => [$lhs, $rhs], distinct => 0); } elsif ($lhs->isa('MyBGP') and $rhs->isa('Attean::Plan::Quad')) { my @quads = (@{ $lhs->children }, $rhs); return MyBGP->new(children => \@quads, distinct => 0); } elsif ($rhs->isa('MyBGP') and $lhs->isa('Attean::Plan::Quad')) { my @quads = ($lhs, @{ $rhs->children }); return MyBGP->new(children => \@quads, distinct => 0); } elsif ($rhs->isa('MyBGP') and $lhs->isa('MyBGP')) { my @quads = (@{ $lhs->children }, @{ $rhs->children }); return MyBGP->new(children => \@quads, distinct => 0); } return $join; } around 'cost_for_plan' => sub { my $orig = shift; my $self = shift; my $plan = shift; if ($plan->isa('MyBGP')) { # Force MyBGP objects to cost less than an equivalent join over Quad plans. return 1; } return $orig->($self, $plan, @_); } } package MyPlanner2 { # this planner uses the default coalesce_rotated_join() use Moo; use namespace::clean; extends 'Attean::QueryPlanner'; with 'Attean::API::NaiveJoinPlanner'; with 'Attean::API::SimpleCostPlanner'; with 'AtteanX::API::JoinRotatingPlanner'; sub allow_join_rotation { my $self = shift; my $join = shift; # Inspect $join to conditionally allow/disallow join rotation return 1; } around 'cost_for_plan' => sub { my $orig = shift; my $self = shift; my $plan = shift; if ($plan->isa('MyBGP')) { # Force MyBGP objects to cost less than an equivalent join over Quad plans. return 1; } return $orig->($self, $plan, @_); } } package MyTestStore { use Moo; use namespace::clean; extends 'AtteanX::Store::Memory'; sub cost_for_plan { # we do this because the superclass would return a cost of 0 for quads when the store is empty # and if 0 was returned, there won't be any meaningful difference between the cost of different join algorithms my $self = shift; my $plan = shift; if ($plan->isa('Attean::Plan::Quad')) { return 3; } return; } } ############################################################################### { my $store = MyTestStore->new(); my $model = Attean::MutableQuadModel->new( store => $store ); my $graph = iri('http://example.org/'); # my $t = triplepattern(variable('s'), iri('p'), literal('1')); my $t = triplepattern(variable('s'), iri('p'), variable('o')); my $v = triplepattern(variable('s'), iri('q'), literal('xyz')); my $w = triplepattern(variable('o'), iri('b'), iri('c')); my $bgp1 = Attean::Algebra::BGP->new(triples => [$t]); my $bgp2 = Attean::Algebra::BGP->new(triples => [$w]); my $service = Attean::Algebra::Service->new(children => [$bgp2], endpoint => iri('http://endpoint.example.org/sparql')); my $bgp3 = Attean::Algebra::BGP->new(triples => [$v]); my $join1 = Attean::Algebra::Join->new(children => [$bgp1, $service]); # (t ⋈ Service(w)) ⋈ v my $join2 = Attean::Algebra::Join->new(children => [$join1, $bgp3]); subtest 'before BGP merging' => sub { # This tests the various possible plans that can be produced for this # algebra, allowing for join commutativity. Without join rotation or # coalescing, the resulting plan should have a top-level join, with # children being a quad, and another join of a quad and a service. # # A possible plan for this algebra: # - Hash Join { s } # - Quad { ?s, , "xyz", } (distinct) # - Hash Join { o } # - Service SELECT * WHERE { { ?o . } } # - Quad { ?s,

, ?o, } (distinct) my $p = Attean::IDPQueryPlanner->new(); my $plan = $p->plan_for_algebra($join2, $model, [$graph]); # warn $plan->as_string; does_ok($plan, 'Attean::API::Plan::Join'); my ($lhs, $rhs) = @{ $plan->children }; my $join; if ($lhs->does('Attean::API::Plan::Join')) { does_ok($lhs, 'Attean::API::Plan::Join'); isa_ok($rhs, 'Attean::Plan::Quad'); $join = $lhs; } else { does_ok($rhs, 'Attean::API::Plan::Join'); isa_ok($lhs, 'Attean::Plan::Quad'); $join = $rhs; } my ($join_lhs, $join_rhs) = @{ $join->children }; if ($join_lhs->isa('Attean::Plan::Quad')) { isa_ok($join_lhs, 'Attean::Plan::Quad'); isa_ok($join_rhs, 'Attean::Plan::Service'); } else { isa_ok($join_rhs, 'Attean::Plan::Quad'); isa_ok($join_lhs, 'Attean::Plan::Service'); } }; foreach my $planner_class (qw(MyPlanner MyPlanner1)) { subtest "after BGP merging ($planner_class)" => sub { # This test is similar, but requires that the resulting plan has # undergone join rotation and quad coalescing, and that the lowest # cost plan will be a join with children being a service and a BGP. # # A possible plan for this algebra: # - NestedLoop Join # - Service SELECT * WHERE { { ?o . } } # - BGP # - Quad { ?s,

, ?o, } (distinct) # - Quad { ?s, , "xyz", } (distinct) # (t ⋈ Service(w)) ⋈ v # should yield one of the following after rewriting: # - BGP(tv) ⋈ Service(w) # - Service(w) ⋈ BGP(tv) my $p = $planner_class->new(); my $plan = $p->plan_for_algebra($join2, $model, [$graph]); # warn $plan->as_string; does_ok($plan, 'Attean::API::Plan::Join'); my ($lhs, $rhs) = @{ $plan->children }; if ($lhs->isa('MyBGP')) { isa_ok($lhs, 'MyBGP'); isa_ok($rhs, 'Attean::Plan::Service'); } else { isa_ok($rhs, 'MyBGP'); isa_ok($lhs, 'Attean::Plan::Service'); } }; } subtest "after BGP merging (MyPlanner2)" => sub { my $p = MyPlanner2->new(); my $plan = $p->plan_for_algebra($join2, $model, [$graph]); does_ok($plan, 'Attean::API::Plan::Join'); }; } done_testing(); Attean-0.034/meta/PaxHeader/changes.ttl000644 000765 000024 00000000225 14636707761 020077 xustar00gregstaff000000 000000 30 mtime=1719373809.329305049 64 LIBARCHIVE.xattr.com.apple.TextEncoding=VVRGLTg7MTM0MjE3OTg0 55 SCHILY.xattr.com.apple.TextEncoding=UTF-8;134217984 Attean-0.034/meta/changes.ttl000644 000765 000024 00000116134 14636707761 016135 0ustar00gregstaff000000 000000 # -*-n3-*- @prefix : . @prefix dc: . @prefix dcs: . @prefix foaf: . @prefix rdfs: . @prefix xsd: . @prefix dcterms: . @prefix doap: . @prefix my: . <> dc:title "Changes for Attean" ; dc:description "Changes for Attean" ; dc:subject my:project ; dc:creator my:developer ; . my:project a :Project ; :name "Attean" ; :shortdesc "A Semantic Web Framework" ; :programming-language "Perl" ; :created "2014-09-27"^^xsd:date ; :maintainer my:developer ; :homepage ; :bug-database ; :download-page ; :download-mirror ; :release my:v_0-001 , my:v_0-002 , my:v_0-003 , my:v_0-004 , my:v_0-005 , my:v_0-006 , my:v_0-007 , my:v_0-008 , my:v_0-009 , my:v_0-010 , my:v_0-011 , my:v_0-012 , my:v_0-013 , my:v_0-014 , my:v_0-015 , my:v_0-016 , my:v_0-017 , my:v_0-018 , my:v_0-019 , my:v_0-020 , my:v_0-021 , my:v_0-022 , my:v_0-023 , my:v_0-024 , my:v_0-025 , my:v_0-026 , my:v_0-027 , my:v_0-028 , my:v_0-029 , my:v_0-030 , my:v_0-031 , my:v_0-032 , my:v_0-033 , my:v_0-034 ; . my:v_0-034 a :Version ; dc:issued "2024-06-25"^^xsd:date ; :revision "0.034" ; dcterms:replaces my:v_0-033 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Add support for composite types (CDTs)." ], [ a dcs:Addition ; rdfs:label "Allow extension functions to register as functional forms." ], [ a dcs:Addition ; rdfs:label "Add registry to allow extension literal datatypes to map to Moo roles." ], [ a dcs:Update ; rdfs:label "Fix bit-rotten code in W3C test suite harnesses." ], [ a dcs:Update ; rdfs:label "Fix bugs discovered based on run of updated W3C test suite harnesses." ], [ a dcs:Update ; rdfs:label "Change in `import()` behaviour for Perl > 5.39.1 (#168 from @zmughal)." ], [ a dcs:Update ; rdfs:label "Improve Attean::API::CanonicalizingLiteral to have strict and non-strict c14n variants." ], [ a dcs:Update ; rdfs:label "Add HTTP::Headers to test requirements." ], [ a dcs:Update ; rdfs:label "Add types for RDF triple/quad and their terms (#166 from @zmughal)." ], [ a dcs:Update ; rdfs:label "Fix casing for AtteanIRI type (#165 from @zmughal)." ], [ a dcs:Update ; rdfs:label "Add GitHub workflow using perlrdf/devops actions (#163 from @zmughal)." ], [ a dcs:Update ; rdfs:label "Add Attean::API::NumericLiteral->equals." ], [ a dcs:Update ; rdfs:label "Fix handling of BOUND and error-causing INVOKE expressions in Attean::Plan." ], [ a dcs:Update ; rdfs:label "Impove error reporting in Attean::API::MutableModel->load_urls_into_graph." ] ] . my:v_0-033 a :Version ; dc:issued "2022-10-02"^^xsd:date ; :revision "0.033" ; dcterms:replaces my:v_0-032 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Add new Attean::SPARQLClient protocol implementation." ], [ a dcs:Update ; rdfs:label "Update SERVICE evaluation classes to use Attean::SPARQLClient." ], [ a dcs:Update ; rdfs:label "Fixed handling of endpoint URLs containing query parameters." ], [ a dcs:Update ; rdfs:label "Protocol HTTP requests can now be signed by specifying a 'request_signer'." ] ] . my:v_0-032 a :Version ; dc:issued "2022-08-14"^^xsd:date ; :revision "0.032" ; dcterms:replaces my:v_0-031 ; dcs:changeset [ dcs:item [ a dcs:Update ; rdfs:label "Fix for bug caused by newly added TermOrVariableOrTriplePattern role." ] ] . my:v_0-031 a :Version ; dc:issued "2022-08-04"^^xsd:date ; :revision "0.031" ; dcterms:replaces my:v_0-030 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Add support for parsing and evaluating SPARQL-star queries." ], [ a dcs:Addition ; rdfs:label "Add initial implementation for TriG-star parser." ], [ a dcs:Update ; rdfs:label "Update Turtle, SPARQL-XML, and SPARQL-JSON parsers to support RDF-star." ], [ a dcs:Update ; rdfs:label "Update docs and add tests for handling of base URIs in parsers (#158)." ], [ a dcs:Update ; rdfs:label "Improve implementation, docs, and tests for accessing parsers and serializers by file extension." ] ] . my:v_0-030 a :Version ; dc:issued "2021-02-06"^^xsd:date ; :revision "0.030" ; dcterms:replaces my:v_0-029 ; dcs:changeset [ dcs:item [ a dcs:Update ; rdfs:label "Fix bug in attean_parse for parsers that are not either pull or push parsers." ] ] . my:v_0-029 a :Version ; dc:issued "2021-02-01"^^xsd:date ; :revision "0.029" ; dcterms:replaces my:v_0-028 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Added -n CLI argument to attean_parse to allow numbering of results." ], [ a dcs:Addition ; rdfs:label "Add Attean::API::MutableModel->load_triples_from_io (#157)." ], [ a dcs:Update ; rdfs:label "Updated AtteanX::Serializer::TextTable to print table borders and rules." ], [ a dcs:Update ; rdfs:label "Update Attean get_parser and get_serializer to allow searching file extensions and media types for 1-arg calls." ], [ a dcs:Update ; rdfs:label "Updated Attean::API::Serializer to require file_extensions." ], [ a dcs:Update ; rdfs:label "Fix bug in Attean::API::ResultSerializer->serialize_list_to_io." ] ] . my:v_0-028 a :Version ; dc:issued "2020-11-02"^^xsd:date ; :revision "0.028" ; dcterms:replaces my:v_0-027 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Add uniq method on iterators over objects with an as_string method." ], [ a dcs:Update ; rdfs:label "Improve documentation about statement projection accessors (e.g. subjects) not being unique (#152)." ], [ a dcs:Update ; rdfs:label "Fix utf8 handling of syntax tests in dawg test harness." ], [ a dcs:Update ; rdfs:label "Fix Attean::QuadModel->get_quads when called with an empty term set in some position." ], [ a dcs:Update ; rdfs:label "Remove AtteanX::Store::DBI which was not a real DBI store and was accidentally checked-in (#134)." ], [ a dcs:Update ; rdfs:label "Switch UUID dependency from Data::UUID to UUID::Tiny (#145)." ], [ a dcs:Update ; rdfs:label "Added Attean::API::RepeatableIterator->size method (#89)." ] ] . my:v_0-027 a :Version ; dc:issued "2020-11-06"^^xsd:date ; :revision "0.027" ; dcterms:replaces my:v_0-026 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Add canonicalization support for xsd:negativeInteger." ], [ a dcs:Addition ; rdfs:label "Added TextTable SPARQL results serializer." ], [ a dcs:Update ; rdfs:label "Fix evaluation of aggregates over empty groups." ], [ a dcs:Update ; rdfs:label "Fix handling of utf-8 encoding in AtteanX::Parser::SPARQLXML." ], [ a dcs:Update ; rdfs:label "Fix SPARQL lexer to accept variables using the $ sigil." ], [ a dcs:Update ; rdfs:label "Improve Attean::API::Result->apply_map handling of unbound variables." ], [ a dcs:Update ; rdfs:label "Improve handling of XPath Constructor (casting) functions." ], [ a dcs:Update ; rdfs:label "Improve Test::Attean::SPARQLSuite." ], [ a dcs:Update ; rdfs:label "Update module metadata URLs (#155 from @szabgab)." ] ] . my:v_0-026 a :Version ; dc:issued "2020-02-20"^^xsd:date ; :revision "0.026" ; dcterms:replaces my:v_0-025 ; dcs:changeset [ dcs:item [ a dcs:Update ; rdfs:label "Improve type coercions (#148 from @kjetilk)." ], [ a dcs:Update ; rdfs:label "Fix typo in Attean::Plan::Service POD (#146)." ], [ a dcs:Addition ; rdfs:label "Added Attean::API::Model->evaluate convenience method (#149, #150)." ] ] . my:v_0-025 a :Version ; dc:issued "2019-10-25"^^xsd:date ; :revision "0.025" ; dcterms:replaces my:v_0-024 ; dcs:changeset [ dcs:item [ a dcs:Update ; rdfs:label "Fix Moo::Role/Role::Tiny imports (#141, #142 from @haarg)." ] ] . my:v_0-024 a :Version ; dc:issued "2019-09-22"^^xsd:date ; :revision "0.024" ; dcterms:replaces my:v_0-023 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Add attribute in AbbreviatingSerializer to omit base declaration to have all relative URIs (#135 from @kjetilk)." ], [ a dcs:Update ; rdfs:label "Updates to use namespace types, available in Types::Attean (#129, #137 from @kjetilk)." ], [ a dcs:Update ; rdfs:label "Fixed bug in AtteanX::API::Lexer that caused infinite recursion when finding EOF in the middle of an escape sequence." ], [ a dcs:Update ; rdfs:label "Added ground_blanks attribute to Attean::SimpleQueryEvaluator." ] ] . my:v_0-023 a :Version ; dc:issued "2019-04-30"^^xsd:date ; :revision "0.024" ; dcterms:replaces my:v_0-022 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Add a simple factory for temporary models (#132 from @kjetilk)." ], [ a dcs:Update ; rdfs:label "Document how to check whether a term looks like the head of an rdf:List (#133 from @kjetilk)." ], [ a dcs:Update ; rdfs:label "Removed the deprecated parse_term_from_string method from NTuples and Turtle parsers (#131)." ] ] . my:v_0-022 a :Version ; dc:issued "2019-03-21"^^xsd:date ; :revision "0.022" ; dcterms:replaces my:v_0-021 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Added statement matching functionality for iterators." ], [ a dcs:Addition ; rdfs:label "Add Attean::API::TermOrVariable->is_bound method (#129 from @kjetilk)." ] ] . my:v_0-021 a :Version ; dc:issued "2019-02-12"^^xsd:date ; :revision "0.021" ; dcterms:replaces my:v_0-020 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Added Attean::API::Model->algebra_holds method." ] ] . my:v_0-020 a :Version ; dc:issued "2019-01-09"^^xsd:date ; :revision "0.020" ; dcterms:replaces my:v_0-019 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Added bgp export function in Attean::RDF with associated tests (#125 from @kjetilk)." ], [ a dcs:Addition ; rdfs:label "Add holds handle to Model (from @kjetilk)." ], [ a dcs:Update ; rdfs:label "Make count_quad_estimate accessible from TripleModel (#124 from @kjetilk)." ], [ a dcs:Update ; rdfs:label "Expose count_quads_estimate method at the model level." ], [ a dcs:Update ; rdfs:label "Export using Exporter::Tiny instead of Exporter.pm (#122 from @tobyink)." ] ] . my:v_0-019 a :Version ; dc:issued "2018-02-04"^^xsd:date ; :revision "0.019" ; dcterms:replaces my:v_0-018 ; dcs:changeset [ dcs:item [ a dcs:Update ; rdfs:label "Fix incorrect URI for langString (#119 from @kjetilk)." ], [ a dcs:Update ; rdfs:label "Documentation updates (#120, #121 from @kjetilk)." ] ] . my:v_0-018 a :Version ; dc:issued "2018-01-06"^^xsd:date ; :revision "0.018" ; dcterms:replaces my:v_0-017 ; dcs:changeset [ dcs:item [ a dcs:Update ; rdfs:label "Use Moo::Role instead of namespace::clean to cleanup namespaces (#112 from @baby-gnu)." ], [ a dcs:Update ; rdfs:label "Updated Makefile.PL for perl 5.26." ], [ a dcs:Update ; rdfs:label "Improve code coverage for Attean::TermMap (#107 from @Varadinsky)." ], [ a dcs:Update ; rdfs:label "Documentation fixes (#105 from @Varadinsky)." ], [ a dcs:Update ; rdfs:label "Allow UUIDs to have lowercase hex digits (#102)." ], [ a dcs:Update ; rdfs:label "Added tests for turtle parser escape handling (#55)." ], [ a dcs:Update ; rdfs:label "Fixed as_string serialization of CONSTRUCT algebras (#97)." ], [ a dcs:Update ; rdfs:label "Improvements to HashJoin query planning (#103 from @KjetilK)." ], [ a dcs:Update ; rdfs:label "Updated required version of IRI (#118)." ], [ a dcs:Update ; rdfs:label "Removed LICENSE file and updated licensing statement in individual modules (#116)." ] ] . my:v_0-017 a :Version ; dc:issued "2016-06-09"^^xsd:date ; :revision "0.017" ; dcterms:replaces my:v_0-016 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Port SPARQL-JSON serializer to Attean (#20, #101 from @cakirke)." ], [ a dcs:Update ; rdfs:label "Improved test coverage." ], [ a dcs:Update ; rdfs:label "Fix Construct plan string serialization." ], [ a dcs:Update ; rdfs:label "Fix declared arity of various algebra classes." ], [ a dcs:Update ; rdfs:label "Updated SPARQL parser to produce Attean::Algebra::Reduced algebra objects for REDUCED queries." ], [ a dcs:Update ; rdfs:label "Updated required versions of Moo and Test::Modern." ], [ a dcs:Update ; rdfs:label "Changed use of binmode to `use open` in attean_parse and attean_query." ], [ a dcs:Update ; rdfs:label "Add a .gitignore file (#99 from @cakirke)." ], [ a dcs:Update ; rdfs:label "Improved use of Travis CI (#100 from @cakirke)." ], [ a dcs:Update ; rdfs:label "Fixed documentation in Attean::QueryPlanner." ], [ a dcs:Update ; rdfs:label "Improved handling of unexpected EOF in AtteanX::Parser::SPARQL." ], [ a dcs:Update ; rdfs:label "Removed default implementation of Attean::API::Plan->plan_as_string." ], [ a dcs:Update ; rdfs:label "Fixed bug in handling of restricted available named graphs during query planning." ], [ a dcs:Update ; rdfs:label "Make parse_term_from_string deprecations noisy." ] ] . my:v_0-016 a :Version ; dc:issued "2016-05-04"^^xsd:date ; :revision "0.016" ; dcterms:replaces my:v_0-015 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Ported RDF::Trine::Serializer::RDFXML to AtteanX::Serializer::RDFXML (#22)." ], [ a dcs:Update ; rdfs:label "Fixes to POD, test, and metadata issues reported by jonassmedegaard (#93, #94, #95, #96)." ], [ a dcs:Update ; rdfs:label "Removed AtteanX::RDFQueryTranslator (split into a new package) and all other references to RDF::Query." ], [ a dcs:Update ; rdfs:label "Improved test suite (includes #92 from KjetilK, #53)." ], [ a dcs:Update ; rdfs:label "Changed Attean::TriplePattern->as_quadpattern to delegate to Attean::API::TriplePattern->as_quad_pattern." ], [ a dcs:Update ; rdfs:label "Removed default implementation of Attean::API::Term->ebv (now required of consumers)." ], [ a dcs:Update ; rdfs:label "Improve Attean::SimpleQueryEvaluator to handle updated algebra classes and iterator API." ], [ a dcs:Update ; rdfs:label "Fixed bug in SPARQL parsing of NIL tokens." ], [ a dcs:Update ; rdfs:label "Added Test::Attean::StoreCleanup role and added store cleanup to store tests." ], [ a dcs:Update ; rdfs:label "Added Test::Attean::QuadStore->cleanup_store method." ], [ a dcs:Update ; rdfs:label "Updated Attean::API::AbbreviatingParser->base definition to be a consumer of Attean::API::IRI." ], [ a dcs:Update ; rdfs:label "Fix overly aggressive code that attempted to turn IRIs into prefix names during Turtle serialization." ], [ a dcs:Update ; rdfs:label "Serialize SPARQL and Turtle namespace declarations in a stable order." ], [ a dcs:Update ; rdfs:label "Add serialization of SPARQL PREFIX declarations and prefixnames when namespaces are set (#53)." ], [ a dcs:Update ; rdfs:label "Updated Attean::API::SPARQLSerializable->as_sparql to return a unicode string, not bytes." ] ] . my:v_0-015 a :Version ; dc:issued "2016-04-09"^^xsd:date ; :revision "0.015" ; dcterms:replaces my:v_0-014 ; dcs:changeset [ dcs:item [ a dcs:Update ; rdfs:label "Fixed metadata used to generate README files." ] ] . my:v_0-014 a :Version ; dc:issued "2016-04-09"^^xsd:date ; :revision "0.014" ; dcterms:replaces my:v_0-013 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Added Attean::Plan::Iterator for cases where there is too much data for Attean::Plan::Table (#88)." ], [ a dcs:Addition ; rdfs:label "Add a size estimate attribute to Attean::Plan::Iterator (#90 from KjetilK)." ], [ a dcs:Update ; rdfs:label "Add ability for parsers to construct lazy IRIs." ], [ a dcs:Update ; rdfs:label "Added Attean::ListIterator->size method (#89)." ], [ a dcs:Update ; rdfs:label "Fix cases where result iterators were constructed without a variables list." ], [ a dcs:Update ; rdfs:label "Add type checking to serialize_iter_* methods." ], [ a dcs:Update ; rdfs:label "Improve error message generated for some SPARQL syntax errors." ], [ a dcs:Update ; rdfs:label "Update Attean::FunctionExpression to canonicalize ISURI to ISIRI." ] ] . my:v_0-013 a :Version ; dc:issued "2016-03-19"^^xsd:date ; :revision "0.013" ; dcterms:replaces my:v_0-012 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Added Attean::Algebra::Query to indicate a full query trees and aid in serialization (#67)." ], [ a dcs:Addition ; rdfs:label "Added Attean::API::TripleOrQuadPattern->parse and AtteanX::Parser::SPARQL->parse_nodes methods (#82)." ], [ a dcs:Addition ; rdfs:label "Added parsing, algebra, planning, and test support for SPARQL 1.1 Updates." ], [ a dcs:Addition ; rdfs:label "Added Attean::API::BulkUpdatableStore role." ], [ a dcs:Addition ; rdfs:label "Added Attean::API::MutableModel->load_urls_into_graph method." ], [ a dcs:Addition ; rdfs:label "Added AtteanX::SPARQL::Token->integer constructor." ], [ a dcs:Addition ; rdfs:label "Added Attean::API::QuadPattern->as_triple_pattern method." ], [ a dcs:Update ; rdfs:label "Improved error message in query planners (#76 from KjetilK)." ], [ a dcs:Update ; rdfs:label "Check types of invocant and model objects in calls to cost_for_plan planning method (#77)." ], [ a dcs:Update ; rdfs:label "Fix lost in-scope variables in aggregation algebra and plans (#78)." ], [ a dcs:Update ; rdfs:label "Refactored SPARQL 1.1 test harness into a testing role (#80)." ], [ a dcs:Update ; rdfs:label "Improve errors and logging in SPARQL parser (#84 from KjetilK)." ], [ a dcs:Update ; rdfs:label "Fix Attean::Algebra::Update->blank_nodes (#70)." ], [ a dcs:Update ; rdfs:label "Fix Attean::QueryPlanner active_graphs argument during recursive call to plans_for_algebra." ], [ a dcs:Update ; rdfs:label "Fixed bug in Attean::Literal that was returning rdf:string instead of rdf:langString for language literals." ], [ a dcs:Update ; rdfs:label "Improve temporary variable names in aggregates generated during parsing." ], [ a dcs:Update ; rdfs:label "Fix Attean::API::IDPJoinPlanner->cost_for_plan to pass the planner object in calls to the model." ], [ a dcs:Update ; rdfs:label "Improved Attean::Plan::Union to handle plans with zero children." ], [ a dcs:Update ; rdfs:label "Improve error messages in Attean::CodeIterator and Attean::API::Binding." ], [ a dcs:Update ; rdfs:label "Pass tree depth as argument to algebra_as_string." ], [ a dcs:Update ; rdfs:label "Add and use Attean::Algebra::Query->subquery flag when appropriate and stop generating needless unary join algebras." ], [ a dcs:Update ; rdfs:label "Add child accessor to Attean::API::UnaryQueryTree." ], [ a dcs:Update ; rdfs:label "Fix sparql_tokens generation for quad patterns to use SPARQL GRAPH syntax, not N-Quads syntax." ], [ a dcs:Update ; rdfs:label "Fix result iterator generation for quad patterns to keep associated variable names." ], [ a dcs:Update ; rdfs:label "Update bin/attean_query to allow dryruns to avoid generating query plans when appropriate." ], [ a dcs:Update ; rdfs:label "Allow producing short blank node labels in attean_query results." ], [ a dcs:Update ; rdfs:label "Updated attean_query to allow updates." ], [ a dcs:Update ; rdfs:label "Improve handling of utf8 encoding in SPARQL/XML, algebra, and plan serializations." ], [ a dcs:Update ; rdfs:label "Fix serialization of SILENT flag on Service queries." ], [ a dcs:Update ; rdfs:label "Added CONTRIBUTING file." ] ] . my:v_0-012 a :Version ; dc:issued "2016-02-04"^^xsd:date ; :revision "0.012" ; dcterms:replaces my:v_0-011 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Added AtteanX::Store::SimpleTripleStore." ], [ a dcs:Addition ; rdfs:label "Added Attean::API::TermOrVariable->apply_binding method." ], [ a dcs:Update ; rdfs:label "Add type checking to store get_triples and get_quads methods (#61)." ], [ a dcs:Update ; rdfs:label "Improved triple model classes to allow adding and droping triple store graphs." ], [ a dcs:Update ; rdfs:label "Update SPARQL/HTML serializer to implement AbbreviatingSerializer (#54, #63 from Zoran Varadinsky)." ], [ a dcs:Update ; rdfs:label "Merge code paths for canonical NTriples serializer." ], [ a dcs:Update ; rdfs:label "Update SPARQL parser to die on unimplemented Update syntax." ], [ a dcs:Update ; rdfs:label "Serialize SPARQL/XML bindings in a stable order." ], [ a dcs:Update ; rdfs:label "Improve use of SPARQL and Turtle token objects." ], [ a dcs:Update ; rdfs:label "Update turtle serializer to consume Attean::API::AppendableSerializer." ], [ a dcs:Update ; rdfs:label "Simplify cost estimation code for hash joins in Attean::API::QueryPlanner (#59 from KjetilK)." ], [ a dcs:Update ; rdfs:label "Add planning support for DESCRIBE queries (#45)." ], [ a dcs:Update ; rdfs:label "Added logging in QueryPlanner and TreeRewriter (#64 from KjetilK)." ], [ a dcs:Update ; rdfs:label "Preserve in-scope variables in result iterators." ], [ a dcs:Update ; rdfs:label "Improve attean_parse and attean_parse including preservation of prefix declarations where possible." ], [ a dcs:Update ; rdfs:label "Fix bug in Attean::Plan::Aggregate handling of COUNT(*) queries." ], [ a dcs:Update ; rdfs:label "Fix bugs in SPARQL CSV and TSV serializers." ], [ a dcs:Update ; rdfs:label "Fix AtteanX::Parser::RDFXML to properly use caller-supplied base IRI." ], [ a dcs:Update ; rdfs:label "Fix Attean::CodeIterator type checking to handle non-blessed items properly." ], [ a dcs:Update ; rdfs:label "Fix sparql_tokens generation for integer and datatyped literals." ], [ a dcs:Update ; rdfs:label "Fixed AtteanX::Parser::SPARQL to maintain its URI::NamespaceMap on prefix declarations." ], [ a dcs:Update ; rdfs:label "Fix algebra generation for describe queries in SPARQL parser." ], [ a dcs:Update ; rdfs:label "Avoid attempting to parse empty XML documents when passed in as a scalar (#60)." ], [ a dcs:Update ; rdfs:label "Updated prerequisites in Makefile.PL and .travis.yml." ], [ a dcs:Update ; rdfs:label "Improve POD and test coverage (#55; #61 from KjetilK)." ], [ a dcs:Update ; rdfs:label "Improve regex escaping in t/algebra.t to silence warnings in perl 5.22." ], [ a dcs:Update ; rdfs:label "Use Test::Modern." ], [ a dcs:Update ; rdfs:label " Fixed Attean::Algebra::Table to consume Attean::API::NullaryQueryTree instead of Attean::API::UnaryQueryTree." ], [ a dcs:Update ; rdfs:label " Die on attempts to add non-ground triples/quads to stores (#66)." ], [ a dcs:Update ; rdfs:label " Fixed type checks performed when ATTEAN_TYPECHECK is set." ], [ a dcs:Update ; rdfs:label " Throwing an error when Triple or Quad objects gets passed a variable (#65 from KjetilK)." ], [ a dcs:Update ; rdfs:label " Improve error reporting for unexpected EOF in AtteanX::Parser::SPARQL." ] ] . my:v_0-011 a :Version ; dc:issued "2016-01-16"^^xsd:date ; :revision "0.011" ; dcterms:replaces my:v_0-010 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Add initial implementation for Attean::MutableTripleModel." ], [ a dcs:Addition ; rdfs:label "Added Attean::API::Plan->children_are_variable_connected." ], [ a dcs:Addition ; rdfs:label "Added Attean::API::Plan->subplans_of_type_are_variable_connected method." ], [ a dcs:Addition ; rdfs:label "Added Turtle serializer." ], [ a dcs:Addition ; rdfs:label "Added RDF/XML parser tests." ], [ a dcs:Addition ; rdfs:label "Add logging of costs to query planner (#56 from KjetilK)." ], [ a dcs:Addition ; rdfs:label "Added AtteanX::Parser::SPARQL->parse convenience method." ], [ a dcs:Addition ; rdfs:label "Added tests for get_sequence model accessor method (#3)." ], [ a dcs:Addition ; rdfs:label "Added exportable quadpattern constructor." ], [ a dcs:Addition ; rdfs:label "Add use of MooX::Log::Any (from KjetilK)." ], [ a dcs:Update ; rdfs:label "Fix use of blank and variable shortcut constructors (#57 from KjetilK)." ], [ a dcs:Update ; rdfs:label "Updated copyright years." ], [ a dcs:Update ; rdfs:label "Make regexes used for prefixname parsing publicly accessibly." ], [ a dcs:Update ; rdfs:label "Merged shared constants for Turtle and SPARQL tokens." ], [ a dcs:Update ; rdfs:label "Improve cost estimation for cartesian joins in Attean::API::QueryPlanner." ], [ a dcs:Update ; rdfs:label "Improved error handling in Attean::ListIterator->BUILD." ], [ a dcs:Update ; rdfs:label "Update AtteanX::Parser::RDFXML to populate a namespace map during parsing." ], [ a dcs:Update ; rdfs:label "Renamed parse_term_from_string methods to parse_term_from_bytes (adding delegating methods that should be decprecated in the future)." ], [ a dcs:Update ; rdfs:label "Change API for Attean::API::CostPlanner->cost_for_plan to pass in the query planner." ], [ a dcs:Update ; rdfs:label "Moved subpatterns_of_type from Attean::API::Algebra to Attean::API::DirectedAcyclicGraph." ], [ a dcs:Update ; rdfs:label "Fixed bug in AtteanX::Serializer::SPARQLHTML->serialize_iter_to_bytes." ], [ a dcs:Update ; rdfs:label "Improved recognition of invalid aggregation queries." ], [ a dcs:Update ; rdfs:label "Fix bug in handling unbound join variables in hash join evaluation." ], [ a dcs:Update ; rdfs:label "Silence XML::Parser warnings on empty input documents." ], [ a dcs:Update ; rdfs:label "Improve Attean::ExistsExpression->as_string." ], [ a dcs:Update ; rdfs:label "Updated Attean::API::CanonicalizingBindingSet to produce the same type of object as are input." ], [ a dcs:Update ; rdfs:label "Implementation of canonicalize method for triple and quad patterns (#43 from KjetilK)." ], [ a dcs:Update ; rdfs:label "Improved SPARQL serialization of algebra and expression trees (including #51)." ] ] . my:v_0-010 a :Version ; dc:issued "2015-12-22"^^xsd:date ; :revision "0.010" ; dcterms:replaces my:v_0-009 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Add INVOKE function expression to allow representing IRI-defined functions." ], [ a dcs:Addition ; rdfs:label "Added Attean::Algebra::Sequence class." ], [ a dcs:Addition ; rdfs:label "Added Attean::API::SimpleCostPlanner." ], [ a dcs:Addition ; rdfs:label "Added AtteanX::API::JoinRotatingPlanner role." ], [ a dcs:Addition ; rdfs:label "Added Attean::API::UnionScopeVariablesPlan role to handle common computation of in-scope variables (Github issue #38)." ], [ a dcs:Addition ; rdfs:label "Added simple SPARQL serializer implementation (Github issue #36)." ], [ a dcs:Addition ; rdfs:label "Added SPARQL parsing support for RANK operator (Github issue #35)." ], [ a dcs:Addition ; rdfs:label "Added initial algebra and plan support for group ranking (Github issue #34)." ], [ a dcs:Addition ; rdfs:label "Added simple SPARQL HTML serializer (ported from RDF::Endpoint; Github issue #27)." ], [ a dcs:Addition ; rdfs:label "Added Attean::API::Algebra methods blank_nodes and subpatterns_of_type." ], [ a dcs:Update ; rdfs:label "Improve serializer negotiation to support multiple classes that handle the same media type." ], [ a dcs:Update ; rdfs:label "Ensure query plan costs are integers, fixing a bug when running on perl with long doubles (#42)." ], [ a dcs:Update ; rdfs:label "Improve error messages in query planning code (manual patch from #41)." ], [ a dcs:Update ; rdfs:label "Renamed Attean::API::Planner to Attean::API::QueryPlanner and re-organized planning code." ], [ a dcs:Update ; rdfs:label "Refactored query planner to separate IDP code from the core planning code." ], [ a dcs:Update ; rdfs:label "Fixed mis-named method call in AtteanX::Store::Memory." ], [ a dcs:Update ; rdfs:label "Added ability to turn some query algebras into SPARQL token interators." ], [ a dcs:Update ; rdfs:label "Fixed bug in t/http-negotiation.t that caused false failures when negotiation led to the Canonical NTriples serializer." ], [ a dcs:Update ; rdfs:label "Compute in-scope variables in Attean::Plan::Quad instead of relying on calling code (Github issue #39)." ], [ a dcs:Update ; rdfs:label "Updated attean_query to use the native SPARQL parser." ], [ a dcs:Update ; rdfs:label "Fixed bug in Attean::Algebra::Project->in_scope_variables." ], [ a dcs:Update ; rdfs:label "Fixed attean_query to support custom output serializers." ], [ a dcs:Update ; rdfs:label "Update Changes metadata handling to use Module::Instal::DOAPChangeSets (Github issue #25)." ], [ a dcs:Update ; rdfs:label "Ported RDF::Query SPARQL parser to Attean." ], [ a dcs:Update ; rdfs:label "Updated Attean::Algebra::Join to be n-ary, not binary." ] ] . my:v_0-009 a :Version ; dc:issued "2015-11-04"^^xsd:date ; :revision "0.009" ; dcterms:replaces my:v_0-008 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Added Attean::API::Result->shared_domain method." ], [ a dcs:Update ; rdfs:label "Improve query planner and plan implementations to support SPARQL 1.1 test suite." ], [ a dcs:Update ; rdfs:label "Removed HeapSort plan implementation and use of Array::Heap due to packaging concerns (issue #32)." ], [ a dcs:Update ; rdfs:label "Improve handling on unicode data in SPARQL TSV parser." ] ] . my:v_0-008 a :Version ; dc:issued "2015-08-18"^^xsd:date ; :revision "0.008" ; dcterms:replaces my:v_0-007 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Added heap sort plan implementation." ], [ a dcs:Addition ; rdfs:label "Added Attean::API::Plan::Join role." ], [ a dcs:Addition ; rdfs:label "Added apply_triple and apply_quad methods to triple and quad pattern classes to produce Result objects." ], [ a dcs:Update ; rdfs:label "Moved computation of in_scope_variables from calling code to to Plan class BUILDARGS." ], [ a dcs:Update ; rdfs:label "Consolidated BUILDARGS handling in Attean::API::TripleOrQuadPattern." ], [ a dcs:Update ; rdfs:label "Attean::API::TripleOrQuadPattern constructors accept non-existent parameters (#13)." ] ] . my:v_0-007 a :Version ; dc:issued "2015-07-16"^^xsd:date ; :revision "0.007" ; dcterms:replaces my:v_0-006 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Added Attean::API::Binding->apply_bindings to bind additional variables." ], [ a dcs:Addition ; rdfs:label "Added Attean::API::Binding->is_ground." ], [ a dcs:Addition ; rdfs:label "Added Attean::API::TriplePattern->as_triple, Attean::API::QuadPattern->as_quad." ], [ a dcs:Update ; rdfs:label "Fix Attean plugin loading to allow non-plugins nested below the plugin namespace." ], [ a dcs:Update ; rdfs:label "Added evaluation support for REGEX functions." ], [ a dcs:Update ; rdfs:label "Improve SPARQL serialization for IRIs and triple patterns." ], [ a dcs:Update ; rdfs:label "Improve SPARQL serialization of OPTIONAL and boolean literals." ], [ a dcs:Update ; rdfs:label "POD improvements (PR #15 from Kjetil Kjernsmo)." ] ] . my:v_0-006 a :Version ; dc:issued "2015-06-30"^^xsd:date ; :revision "0.006" ; dcterms:replaces my:v_0-005 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Added Attean->acceptable_parsers method (GH issue #11)." ], [ a dcs:Addition ; rdfs:label "Added methods to test terms and variables for common term role consumption." ], [ a dcs:Addition ; rdfs:label "Added Attean::API::DirectedAcyclicGraph->has_only_subtree_types method." ], [ a dcs:Update ; rdfs:label "Added documentation (patches from Kjetil Kjernsmo)." ], [ a dcs:Update ; rdfs:label "Fixed handling of blank nodes in BGPs in Attean::IDPQueryPlanner." ], [ a dcs:Update ; rdfs:label "Updated Attean::IDPQueryPlanner->join_plans API to allow easier extensibility." ], [ a dcs:Update ; rdfs:label "Updated attean_query to use the IDPQueryPlanner." ], [ a dcs:Update ; rdfs:label "Added HSP heuristics to Attean::IDPQueryPlanner (patch from Kjetil Kjernsmo)." ], [ a dcs:Update ; rdfs:label "Disable stable sortint in Attean::IDPQueryPlanner where it is unnecessary (patch from Kjetil Kjernsmo)." ] ] . my:v_0-005 a :Version ; dc:issued "2015-05-27"^^xsd:date ; :revision "0.005" ; dcterms:replaces my:v_0-004 ; dcs:changeset [ dcs:item [ a dcs:Update ; rdfs:label "Improved query planning." ], [ a dcs:Update ; rdfs:label "Split handling of BGP and GGP join planning in Attean::IDPQueryPlanner for easier subclass overriding." ], [ a dcs:Update ; rdfs:label "Improve propagation of distinct and ordered attributes during query planning." ], [ a dcs:Update ; rdfs:label "Added query planning tests." ], [ a dcs:Update ; rdfs:label "Updated IDP query planner to produce correct plans for empty BGPs." ], [ a dcs:Update ; rdfs:label "Fixed bug in IDPQueryPlanner->cost_for_plan to reflect recently changed Attean::Plan::Quad API." ], [ a dcs:Update ; rdfs:label "Add initial code to support interesting orders in Attean::IDPQueryPlanner." ], [ a dcs:Update ; rdfs:label "Simplified implementation of Attean::Plan::Unique." ], [ a dcs:Update ; rdfs:label "Updated Attean::Plan::Quad to consume Attean::API::QuadPattern." ], [ a dcs:Update ; rdfs:label "Added POD description of each Attean::Plan class." ], [ a dcs:Update ; rdfs:label "Added planning support for Unique plans for DISTINCT queries which are already ordered." ], [ a dcs:Update ; rdfs:label "Added planning support for Extend and Ask algebra operations." ], [ a dcs:Update ; rdfs:label "Allow store-planning of more than just BGPs in Attean::TripleModel." ], [ a dcs:Update ; rdfs:label "Added Attean::Plan::Unique class." ], [ a dcs:Update ; rdfs:label "Change use of ListIterator to CodeIterator in plan classes that can be pipelined." ], [ a dcs:Update ; rdfs:label "Renamed Attean::Plan::Filter to Attean::Plan::EBVFilter." ], [ a dcs:Update ; rdfs:label "Added evaluation support for type checking functions (ISIRI, ISLITERAL, etc.)." ], [ a dcs:Update ; rdfs:label "Changed Attean::Plan::Filter to check the EBV of a single, named variable binding." ], [ a dcs:Update ; rdfs:label "Rename Attean::Plan::Distinct to Attean::Plan::HashDistinct (making room for different implementation strategies)." ], [ a dcs:Update ; rdfs:label "Added use Set::Scalar in lib/Attean/Algebra.pm." ], [ a dcs:Update ; rdfs:label "Removed unused/unnecessary code and comments." ], [ a dcs:Update ; rdfs:label "Removed references to Attean::QueryEvaluator (obviated by $plan->evaluate)." ] ] . my:v_0-004 a :Version ; dc:issued "2015-05-18"^^xsd:date ; :revision "0.004" ; dcterms:replaces my:v_0-003 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Added SPARQL CSV and XML serializers." ], [ a dcs:Addition ; rdfs:label "Add initial implementation of Attean::TripleModel." ], [ a dcs:Addition ; rdfs:label "Added an IDP-based query planner and associated classes and roles." ], [ a dcs:Addition ; rdfs:label "Added Test::Attean roles for caching quadstores." ], [ a dcs:Addition ; rdfs:label "Added Test::Attean::MutableTripleStore." ], [ a dcs:Addition ; rdfs:label "Added initial support for representing, translating, and evaluating SERVICE patterns." ], [ a dcs:Addition ; rdfs:label "Added Attean::API::Binding->values_consuming_role method." ], [ a dcs:Addition ; rdfs:label "Added Attean::TriplePattern->as_quadpattern method." ], [ a dcs:Addition ; rdfs:label "Add Attean::ValueExpression->in_scope_variables method." ], [ a dcs:Update ; rdfs:label "Fixed serialization bug in Attean::FunctionExpression->as_sparql." ], [ a dcs:Update ; rdfs:label "Updated Memory store matching methods to accept node arrays for any quad pattern position." ], [ a dcs:Update ; rdfs:label "Updated AtteanX::Store::Memory to conform to both etag and time caching roles." ], [ a dcs:Update ; rdfs:label "Add variables to result iterators." ], [ a dcs:Update ; rdfs:label "Improve SPARQL serialization for projection, slicing, ordering, and distinct/reduced modifiers." ], [ a dcs:Update ; rdfs:label "Update Attean::API::Expression to consume Attean::API::UnionScopeVariables." ], [ a dcs:Update ; rdfs:label "Add SPARQL serialization support for Expression classes." ], [ a dcs:Update ; rdfs:label "Improve SPARQL serialization of algebra trees." ], [ a dcs:Update ; rdfs:label "Fixed Attean->get_parser to accept media types with parameters." ], [ a dcs:Update ; rdfs:label "Add algebra_as_string methods for some algebra classes missing an implementation." ], [ a dcs:Update ; rdfs:label "Added missing use statements." ], [ a dcs:Update ; rdfs:label "Fixed required version of perl in store test roles to be v5.14." ], [ a dcs:Update ; rdfs:label "Added Math::Cartesian::Product to prerequisite list." ], [ a dcs:Update ; rdfs:label "Added Test::Roo-based store tests." ], [ a dcs:Update ; rdfs:label "Fix documentation of serialize_iter_to_io method." ], [ a dcs:Update ; rdfs:label "Added comments about handling of graphs in Test::Attean::MutableQuadStore." ] ] . my:v_0-003 a :Version ; dc:issued "2015-02-19"^^xsd:date ; :revision "0.003" ; dcterms:replaces my:v_0-002 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Added count estimate methods to TripleStore QuadStore roles (in lieu of github pull request #6)." ], [ a dcs:Addition ; rdfs:label "Added missing algebra_as_string impelementations in Attean::API::Query and Attean::Algebra." ], [ a dcs:Addition ; rdfs:label "Added tree_attributes methods to tree classes." ], [ a dcs:Addition ; rdfs:label "Added Attean::TreeRewriter class." ], [ a dcs:Update ; rdfs:label "Split Cacheable roles into ETagCacheable and TimeCacheable variants." ], [ a dcs:Update ; rdfs:label "Fixed method name typo in Attean::API::TimeCacheableTripleStore." ] ] . my:v_0-002 a :Version ; dc:issued "2014-10-15"^^xsd:date ; :revision "0.002" ; dcterms:replaces my:v_0-001 ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Added POD for many classes and roles." ], [ a dcs:Addition ; rdfs:label "Added Attean->negotiate_serializer method." ], [ a dcs:Update ; rdfs:label "Wrap mutating methods in a single bulk-update." ], [ a dcs:Update ; rdfs:label "Moved RDF::Query algebra translator to AtteanX::RDFQueryTranslator." ], [ a dcs:Update ; rdfs:label "Updated Attean->get_serializer to support media_type argument." ], [ a dcs:Update ; rdfs:label "Changed media_type attributes to class methods in Serializer classes." ], [ a dcs:Update ; rdfs:label "Switched from Sub::Name to Sub::Util (github issue #5)." ] ] . my:v_0-001 a :Version ; dc:issued "2014-09-27"^^xsd:date ; :revision "0.001" ; dcs:changeset [ dcs:item [ a dcs:Addition ; rdfs:label "Initial release." ] ] . my:developer a foaf:Person ; foaf:name "Gregory Todd Williams" ; foaf:homepage ; foaf:page , ; foaf:page ; foaf:mbox ; ; . Attean-0.034/bin/attean_query000755 000765 000024 00000007137 14632645502 016241 0ustar00gregstaff000000 000000 #!/usr/bin/env perl use v5.14; use warnings; no warnings 'once'; use autodie; use File::Slurp; use Scalar::Util qw(blessed); use Attean; use Attean::RDF; use AtteanX::Functions::CompositeMaps; use AtteanX::Functions::CompositeLists; use Data::Dumper; use Getopt::Long; use Try::Tiny; use open ':std', ':encoding(utf8)'; BEGIN { $Error::TypeTiny::StackTrace = 1; } if (scalar(@ARGV) < 1) { print STDERR <<"END"; Usage: $0 query.rq [data.ttl ...] Parses the supplied SPARQL query to an Attean::Algebra object, and executes it against a model containing the RDF data parsed from the data file(s) using Attean::SimpleQueryEvaluator. END exit(0); } AtteanX::Functions::CompositeMaps->register(); AtteanX::Functions::CompositeLists->register(); my $dryrun = 0; my $check_syntax = 0; my $verbose = 0; my $debug = 0; my $benchmark = 0; my $print_sparql = 0; my $print_plan = 0; my $print_algebra = 0; my $update = 0; my $out_format = ''; my $short = 0; my $result = GetOptions( "verbose" => \$verbose, "debug" => \$debug, "update" => \$update, "benchmark" => \$benchmark, 'algebra' => \$print_algebra, 'plan' => \$print_plan, "q" => \$print_sparql, 'n' => \$dryrun, 'c' => \$check_syntax, 'short' => \$short, 'output=s' => \$out_format, ); my $qfile = shift; try { warn "Constructing model...\n" if ($verbose); my $store = Attean->get_store('Memory')->new(); my $model = Attean::MutableQuadModel->new( store => $store ); my $graph = Attean::IRI->new('http://default-graph/'); my $map = URI::NamespaceMap->new(); while (my $data = shift(@ARGV)) { my $base = Attean::IRI->new('file://' . File::Spec->rel2abs($data)); open(my $fh, '<:encoding(UTF-8)', $data); warn "Parsing data from $data...\n" if ($verbose); my $pclass = Attean->get_parser( filename => $data ) // 'AtteanX::Parser::Turtle'; my $parser = $pclass->new(base => $base, namespaces => $map); my $iter = $parser->parse_iter_from_io($fh); my $quads = $iter->as_quads($graph); $model->add_iter($quads); } if ($debug) { my $iter = $model->get_quads(); while (my $q = $iter->next) { say $q->as_string; } } warn "Parsing query...\n" if ($verbose); my $base = Attean::IRI->new('file://' . File::Spec->rel2abs($qfile)); my $s = Attean->get_parser('SPARQL')->new(base => $base, namespaces => $map); if ($update) { $s->update(1); } open(my $fh, '<:utf8', $qfile) or die $!; my $algebra; eval { ($algebra) = $s->parse_list_from_io($fh); }; if ($@) { die "Failed to parse query $qfile: $@"; } if ($print_algebra) { print "# Algebra:\n" . $algebra->as_string . "\n"; } if ($check_syntax) { print "Syntax OK: $qfile\n"; exit(0); } if ($print_sparql) { print "# SPARQL:\n"; print $algebra->as_sparql; print "\n"; } if (not($dryrun) or $print_plan) { my $default_graphs = [$graph]; my $planner = Attean::IDPQueryPlanner->new(); my $plan = $planner->plan_for_algebra($algebra, $model, $default_graphs); if ($print_plan) { print "# Plan:\n" . $plan->as_string . "\n"; } unless ($dryrun) { my $mapper = $short ? Attean::TermMap->short_blank_map : undef; my $bmapper = $short ? $mapper->binding_mapper : undef; my $iter = $plan->evaluate($model); if ($bmapper) { $iter = $iter->map($bmapper); } my $count = 1; my $class = Attean->get_serializer($out_format); if ($out_format and $class) { my $s = $class->new(namespaces => $map); $s->serialize_iter_to_io(\*STDOUT, $iter); } else { while (my $r = $iter->next) { printf("%3d %s\n", $count++, $r->as_string); } } } } } catch { my $exception = $_; warn "Caught error: $exception"; exit(1); }; Attean-0.034/bin/canonicalize_bgp.pl000755 000765 000024 00000003152 13054666511 017432 0ustar00gregstaff000000 000000 #!/usr/bin/env perl use v5.14; use warnings; no warnings 'once'; use autodie; use File::Slurp; use Scalar::Util qw(blessed); use Attean; use Attean::RDF; use Attean::SimpleQueryEvaluator; use Data::Dumper; use Getopt::Long; use Try::Tiny; use Digest::SHA qw(sha1_hex); if (scalar(@ARGV) < 1) { print STDERR <<"END"; Usage: $0 query.rq Parses the supplied SPARQL query consisting of a simple BGP, canonicalizes the BGP and emits a new query including a hash key for the canonicalized query form and projection back to the original variable names. END exit; } my $verbose = 0; my $debug = 0; my $result = GetOptions ("verbose" => \$verbose, "debug" => \$debug); my $qfile = shift; $Error::TypeTiny::StackTrace = 1; try { warn "Parsing query...\n" if ($verbose); my $sparql = read_file($qfile); my $a = Attean->get_parser('SPARQL')->parse($sparql); if ($debug) { warn "Walking algebra:\n"; $a->walk( prefix => sub { my $a = shift; warn "- $a\n" }); } my ($bgp) = $a->subpatterns_of_type('Attean::Algebra::BGP'); die "Query must be a simple BGP" unless ($bgp->isa('Attean::Algebra::BGP')); my ($canon, $mapping) = $bgp->canonical_bgp_with_mapping(); my $hash = sha1_hex( join("\n", map { $_->tuples_string } (@{$canon->triples}) ) ); my @proj = sort map { sprintf("(?%s AS $_)", $mapping->{$_}{id}) } grep { $mapping->{$_}{type} eq 'variable' } (keys %$mapping); say "# Hash key: $hash"; say "SELECT " . join(' ', @proj) . " WHERE {"; foreach my $t (@{$canon->triples}) { say "\t" . $t->tuples_string; } say "}"; } catch { my $exception = $_; warn "Caught error: $exception"; warn $exception->stack_trace; }; Attean-0.034/bin/attean_parse000755 000765 000024 00000011527 14437773023 016207 0ustar00gregstaff000000 000000 #!/usr/bin/env perl use v5.14; use autodie; use strict; use warnings; use Getopt::Long; use Scalar::Util qw(blessed); use Time::HiRes qw(gettimeofday tv_interval); use Attean; use Try::Tiny; use open ':std', ':encoding(utf8)'; unless (@ARGV) { print <<"END"; Usage: $0 -list $0 -i IN_FORMAT [-o OUT_FORMAT] FILENAME END exit; } my $verbose = 0; my $pull = 0; my $push = 0; my $list = 0; my $block_size = 25; my $short = 0; my $number_rows = 0; my %namespaces; my $in_format = 'GUESS'; my $out_format = 'TextTable'; my $result = GetOptions ("number" => \$number_rows, "short" => \$short, "list" => \$list, "verbose" => \$verbose, "block=i" => \$block_size, "pull" => \$pull, "push" => \$push, "in=s" => \$in_format, "out=s" => \$out_format, "define=s" => \%namespaces, "D=s" => \%namespaces); if ($list) { say "Parsers:"; say sprintf("- %s", s/^.*://r) for (sort Attean->list_parsers); say "\nSerializers:"; say sprintf("- %s", s/^.*://r) for (sort Attean->list_serializers); say ''; exit; } my $mapper = $short ? Attean::TermMap->short_blank_map : undef; my $bmapper = $short ? $mapper->binding_mapper : undef; unless (@ARGV) { push(@ARGV, '-') } while (defined(my $file = shift)) { my $in = $in_format; my $out = $out_format; my $fh; my $base; if ($file eq '-') { $fh = \*STDIN; $base = Attean::IRI->new('file:///dev/stdin'); } else { open( $fh, '<:encoding(UTF-8)', $file ) or die $!; $base = Attean::IRI->new('file://' . File::Spec->rel2abs($file)); } my $out_io = \*STDOUT; $| = 1; my $parser; my $map = URI::NamespaceMap->new( \%namespaces ); if ($in eq 'GUESS') { my $class = Attean->get_parser( filename => $file ) // 'AtteanX::Parser::NTriples'; $parser = $class->new( base => $base, namespaces => $map ); } else { $parser = Attean->get_parser($in)->new(namespaces => $map); } if (uc($out) eq 'STRING') { parse_to_string($parser, $fh); } else { my $sclass = Attean->get_serializer($out) || die "*** No serializer found for format $out\n"; my $serializer = $sclass->new(namespaces => $map, number_rows => $number_rows); try { if ($pull) { warn "# Forced pull parsing\n" if ($verbose); pull_transcode($parser, $serializer, $fh, $out_io); } elsif ($push) { warn "# Forced push parsing\n" if ($verbose); push_transcode($parser, $serializer, $fh, $out_io); } elsif ($parser->does('Attean::API::PullParser')) { warn "# Pull parsing\n" if ($verbose); pull_transcode($parser, $serializer, $fh, $out_io); } elsif ($parser->does('Attean::API::PushParser')) { warn "# Push parsing\n" if ($verbose); push_transcode($parser, $serializer, $fh, $out_io); } else { warn "# All-at-once parsing\n" if ($verbose); pull_transcode($parser, $serializer, $fh, $out_io); } } catch { my $e = $_; if (blessed($e) and $e->isa('Error::TypeTiny::Assertion')) { my $type = $e->type; my $value = $e->value; my $class = ref($value); $class =~ s/^.*:://; if ($type->isa('Type::Tiny::Role')) { my $role = ($type->role =~ s/^.*:://r); die "*** Cannot serialize a $class as a $role\n"; } die "*** Failed to serialize a $class with parser $sclass\n"; } die "$e\n"; }; } } sub fix_iter { my $iter = shift; if ($bmapper) { $iter = $iter->map($bmapper); } return $iter; } sub parse_to_string { my $parser = shift; my $fh = shift; my $iter = fix_iter($parser->parse_iter_from_io($fh)); while (my $item = $iter->next) { say $item->as_string; } } sub pull_transcode { my $parser = shift; my $serializer = shift; my $fh = shift; my $out_io = shift; warn "Pull parser\n" if ($verbose); my $iter = fix_iter($parser->parse_iter_from_io($fh)); $serializer->serialize_iter_to_io($out_io, $iter); } sub push_transcode { my $parser = shift; my $serializer = shift; my $fh = shift; my $out_io = shift; warn "Push parser\n" if ($verbose); if ($serializer->does('Attean::API::AppendableSerializer')) { warn "- serializer is appendable\n" if ($verbose); my $count = 0; my $start = [gettimeofday]; my @queue; my $handler = sub { my $triple = shift; if ($mapper) { $triple = $triple->apply_map($mapper); } $count++; print STDERR "\r" if ($verbose); push(@queue, $triple); if (scalar(@queue) > 1000) { $serializer->serialize_list_to_io($out_io, @queue); @queue = (); } if ($verbose and $count % $block_size == 0) { my $elapsed = tv_interval($start); my $tps = $count / $elapsed; print STDERR sprintf("%6d (%9.1f T/s)", $count, $tps); } }; $parser->handler($handler); $parser->parse_cb_from_io($fh); # finish $serializer->serialize_list_to_io($out_io, @queue); my $elapsed = tv_interval($start); my $tps = $count / $elapsed; if ($verbose) { print STDERR sprintf("\r%6d (%9.1f T/s)\n", $count, $tps); } } else { pull_transcode($parser, $serializer, $fh, $out_io); } } Attean-0.034/inc/Module/000755 000765 000024 00000000000 14636711137 015032 5ustar00gregstaff000000 000000 Attean-0.034/inc/Module/Install/000755 000765 000024 00000000000 14636711137 016440 5ustar00gregstaff000000 000000 Attean-0.034/inc/Module/Install.pm000644 000765 000024 00000027145 14636711131 017001 0ustar00gregstaff000000 000000 #line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.006; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.21'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::getcwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::getcwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $base_path = VMS::Filespec::unixify($base_path) if $^O eq 'VMS'; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( {no_chdir => 1, wanted => sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($File::Find::name); my $in_pod = 0; foreach ( split /\n/, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }}, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; binmode FH; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; binmode FH; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. Attean-0.034/inc/Module/Install/Fetch.pm000644 000765 000024 00000004627 14636711132 020033 0ustar00gregstaff000000 000000 #line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.21'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Attean-0.034/inc/Module/Install/Metadata.pm000644 000765 000024 00000043437 14636711131 020523 0ustar00gregstaff000000 000000 #line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.21'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) [\s|;]* /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', artistic => 'http://opensource.org/licenses/artistic-license.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, # these are not actually allowed in meta-spec v1.4 but are left here for compatibility: apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashes delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; Attean-0.034/inc/Module/Install/AuthorTests.pm000644 000765 000024 00000002215 14636711131 021255 0ustar00gregstaff000000 000000 #line 1 package Module::Install::AuthorTests; use 5.005; use strict; use Module::Install::Base; use Carp (); #line 16 use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.002'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } #line 42 sub author_tests { my ($self, @dirs) = @_; _add_author_tests($self, \@dirs, 0); } #line 56 sub recursive_author_tests { my ($self, @dirs) = @_; _add_author_tests($self, \@dirs, 1); } sub _wanted { my $href = shift; sub { /\.t$/ and -f $_ and $href->{$File::Find::dir} = 1 } } sub _add_author_tests { my ($self, $dirs, $recurse) = @_; return unless $Module::Install::AUTHOR; my @tests = $self->tests ? (split / /, $self->tests) : 't/*.t'; # XXX: pick a default, later -- rjbs, 2008-02-24 my @dirs = @$dirs ? @$dirs : Carp::confess "no dirs given to author_tests"; @dirs = grep { -d } @dirs; if ($recurse) { require File::Find; my %test_dir; File::Find::find(_wanted(\%test_dir), @dirs); $self->tests( join ' ', @tests, map { "$_/*.t" } sort keys %test_dir ); } else { $self->tests( join ' ', @tests, map { "$_/*.t" } sort @dirs ); } } #line 107 1; Attean-0.034/inc/Module/Install/Win32.pm000644 000765 000024 00000003403 14636711132 017673 0ustar00gregstaff000000 000000 #line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.21'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Attean-0.034/inc/Module/Install/DOAPChangeSets.pm000644 000765 000024 00000000616 14636711131 021463 0ustar00gregstaff000000 000000 #line 1 package Module::Install::DOAPChangeSets; use 5.008; use parent qw(Module::Install::Base); use strict; our $VERSION = '0.206'; our $AUTHOR_ONLY = 1; sub write_doap_changes { my $self = shift; $self->admin->write_doap_changes(@_) if $self->is_admin; } sub write_doap_changes_xml { my $self = shift; $self->admin->write_doap_changes_xml(@_) if $self->is_admin; } 1; __END__ #line 84 Attean-0.034/inc/Module/Install/WriteAll.pm000644 000765 000024 00000002376 14636711132 020524 0ustar00gregstaff000000 000000 #line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.21'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; Attean-0.034/inc/Module/Install/Can.pm000644 000765 000024 00000006405 14636711132 017477 0ustar00gregstaff000000 000000 #line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.21'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; if ($^O eq 'VMS') { require ExtUtils::CBuilder; my $builder = ExtUtils::CBuilder->new( quiet => 1, ); return $builder->have_compiler; } my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 245 Attean-0.034/inc/Module/Install/Makefile.pm000644 000765 000024 00000027437 14636711131 020522 0ustar00gregstaff000000 000000 #line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.21'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-separated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 Attean-0.034/inc/Module/Install/Scripts.pm000644 000765 000024 00000001011 14636711131 020410 0ustar00gregstaff000000 000000 #line 1 package Module::Install::Scripts; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.21'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub install_script { my $self = shift; my $args = $self->makemaker_args; my $exe = $args->{EXE_FILES} ||= []; foreach ( @_ ) { if ( -f $_ ) { push @$exe, $_; } elsif ( -d 'script' and -f "script/$_" ) { push @$exe, "script/$_"; } else { die("Cannot find script '$_'"); } } } 1; Attean-0.034/inc/Module/Install/Base.pm000644 000765 000024 00000002147 14636711131 017646 0ustar00gregstaff000000 000000 #line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.21'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159