CSS-DOM-0.16/000755 000767 000024 00000000000 12626673241 013217 5ustar00sproutstaff000000 000000 CSS-DOM-0.16/Changes000644 000767 000024 00000025452 12626673027 014524 0ustar00sproutstaff000000 000000 Revision history for CSS::DOM 0.16 29 November, 2015 • Work around an incompatible change in Encode 2.77 (RT #107221, #107043). • Specify Encoding in POD. Thanks to Gregor Herrmann for the patch (RT #85955). 0.15 21 October, 2012 • compute_style no longer produces an uninitialized warning if the element’s own style attribute has a property for which there is no applicable property with the same name in the style sheets (RT #79855). • A minor backtracking bug in CSS::DOM::PropertyParser has been fixed. If a format for a list property can still match after backtracking past a capturing group, then extra items (from the pre-backtracking matches) will end up in the list. This can happen with property formats like ‘[(foo) | (foo),]+’. Any such format would be more efficient when written as ‘[(foo),?]+’, which does not exhibit the bug. 0.14 12 December, 2010 • The full text of the licence is now included in the distribu- tion. Thanks to Ville Skyttä for providing it (RT #60770). • A few pod syntax errors have been corrected, thanks to Nicho- las Bamber (RT #63388). • CSS::DOM::PropertyParser has been fixed to work with perl 5.13.8 and higher. • New getStringValue method of CSS::DOM::Value::Primitive 0.13 22 August, 2010 Oops. Fix another problem, introduced in 0.12. I forgot to add a file to MANIFEST. (I *thought* I had run make disttest.) 0.12 22 August, 2010  Fix dependency problem introduced in 0.11. (I tried to remove the dependency on constant::lexical, gave up and reverted my changes, but forgot to add it back to Makefile.PL. Oh well.) 0.11 15 August, 2010 • setStringValue and setFloatValue are now listed in CSS::DOM::Interface. • CSS::DOM::Style’s opacity property is now listed in CSS::DOM::Interface. (This is a temporary workaround for a design flaw.) 0.10 28 March, 2010 • New setFloatValue and setStringValue methods of CSS::DOM::Val- ue::Primitive • Bug fix: CSS::DOM::Value::Primitive’s cssText did not set the value when passed an argument if the existing value was a string and there was no existing serialisation recorded (as happens if you call the constructor directly without provid- ing the css argument). • Bug fix: Sub-value objects of a list value used to become ‘unowned’ if their type changed (via cssText assignment), mak- ing further modification attempts fail. 0.09 21 February, 2010 • The property parser no longer gets confused in cygwin’s perl 5.10.0@34065 (maint; aka ee8a906) when an rgb() colour comes after something else in a property value. This bug also pro- duced warnings. • The property parser in cygwin’s perl no longer gets offsets muddled up when a shorthand property’s format contains within a parenthetical group, the is not the first thing in the group (e.g., ‘( )’), and a value assigned has a colour in hex format (e.g., ‘honey #bee’, which would cause just ‘#bee’, not ‘honey #bee’ to be assigned to the subproperty). • The property parser used to produces warnings and create CSS_CUSTOM value objects instead of ‘primitives’ when a short- hand property was assigned to that had named properties [RT #54809]. This only occurred in perl 5.10.0. It turns out that this perl version’s $^N is more buggy than I realised and it’s not just cygwin’s maint snapshot that needs special treatment. • CSS::DOM::Style’s length method no longer dies if no proper- ties have been added [RT #54810]. 0.08 22 November, 2009 • Incompatible change: CSS::DOM::Value’s and CSS::DOM::Value:: Primitive’s constructors’ interfaces have changed. They now take hash-style arguments. • CSSPrimitiveValue objects for colours are now supported. • %CSS::DOM::Constants::SuffixToConst, mapping dimension suf- fixes to constants • CSS::DOM::Value::Primitive now implements the Rect and RGB- Color interfaces. • CSS::DOM::Value::List has been added. It implements the CSSValueList interface. • CSS::DOM::Value::Primitive no longer inherits from CSS::DOM:: Value, but claims that it DOES it. • getPropertyCSSValue now works with list properties. • CSS::DOM::Style’s property_parser method • CSS::DOM::Value::Primitive’s primitiveType and getFloatValue methods • CSS::DOM::Primitive’s and CSS::DOM::Value’s cssText methods are now writable. • Assigning to a shorthand property (like border-top) a value (like 'inset') that causes some sub-properties to have their initial values now deletes any implied sub-properties that do not have default values (like border-top-color). (If that makes no sense to you, see the tests at the end of property-parser.t.) • Fixed to be compatible with 5.10.0@34065 (maint; aka ee8a906), which is included with cygwin. 0.07 16 August, 2009 • Support for specifications that describe which properties are supported and also the syntax of shorthand proper- ties (CSS::DOM::PropertyParser was added; CSS::DOM and CSS::DOM::Style constructors now take more args) • Incompatible change: CSS::DOM::Value is no longer used with- out a property spec. • CSS::DOM has two new methods, url_fetcher and property_parser, which return what was passed to the constructor. • Bug fix (broken in 0.06): Assigning to a property an empty string or a string beginning with whitespace or a CSS comment no longer causes an error. • Bug fix: Assigning whitespace to a property now deletes it. • Bug fix: getPropertyCSSValue used to return the same as getPropertyValue the *second* time it was called for a given property, due to a weird caching problem. • compute_style now considers user-agent !important rules more important that user and author normal rules. CSS 2.1 doesn’t say what to do with those, but I just found that CSS 2 speci- fies it clearly. 0.06 8 April, 2009 • The CSSCharsetRule interface has been added. • There is a new module named CSS::DOM::Util, which, so far, provides functions for dealing with CSS escapes and string and URL tokens. • The CSSStyleDeclaration interface is now complete (CSS::DOM::Style’s getPropertyCSSValue, removeProperty, getPropertyPriority, length and item methods have been added). • Property priorities (i.e., the !important thingy) • CSS::DOM::Style’s setProperty method now dies when passed an invalid value. • The CSSValue interface has been completed. (CSS::DOM::Value’s constructor actually works [it only applies to CSS_INHERIT and CSS_CUSTOM value types] and the interface methods have been added.) • CSS::DOM::Value::Primitive now supports counters, attr values and rects. • New module: CSS::Constants, where all the DOM constants have been moved • Highly-experimental compute_style function 0.05 2 September, 2008 • CSS::DOM now detects the encoding of CSS files and decodes them (if you ask it to). • CSS::DOM::Style has a non-standard (i.e., non-DOM) modification_handler method that allows the assignment of a handler that is called whenever the style object is modified or one of its sub-objects. 0.04 20 August, 2008 • CSS::DOM::Style’s setProperty method now works when ::Style is loaded before ::Parser. • The CSSFontFaceRule interface has been added. 0.03 19 August, 2008 • CSS.pm is no longer used. The parsing interface has changed. None of the CSS.pm-specific methods can be used any more (read_string, etc.). Use CSS::DOM::parse and CSS::DOM::Style::parse instead (actually, these are con- structors so you should normally use these instead of ‘new’). • CSS rules no longer overload stringification. That was some- thing inherited from CSS.pm’s CSS::Style. If anyone wants me to add it back, I can. • CSS::DOM::Rule’s constructor’s interface has changed, and now accepts the parent rule or style sheet as the only argument. (It used to inherit a constructor from CSS::Style). • CSS::DOM::Rule::Style has its selectorText method, so the CSSStyleRule interface is complete. • CSS::DOM::Rule now has its parentRule and parentStyleSheet methods, so the CSSRule interface is complete. • Started the CSSValue class. So far the constants and a con- structor (doesn’t work yet) exist. • Started the CSSPrimitiveValue class. So far the constants, the constructor and the cssText method (currently read-only) have been implemented. Counters, rects, and rgb() colors are not yet supported. This is not actually used by the other modules yet, but you can play with it. It’s quite buggy. • The CSSMediaRule, CSSPageRule and CSSImportRule interfaces have been added. • CSS::DOM’s ownerRule and parentStyleSheet methods are actually capable of return useful values now that CSSImportRule is implemented. • The CSS::DOM::StyleDecl module has been renamed to ::Style. • The CSS::DOM constructor now accepts the named argument ‘url_fetcher’, which can be passed a coderef that will be called by @import rules. • CSS::DOM’s ownerNode now returns an empty list in list context instead of (undef), if there is no owner. 0.02 19 May, 2008 • CSS::DOM now has its title and media methods (so the StyleSheet interface has been completed) and its ownerRule, insertRule and deleteRule methods (the CSSStyleSheet inter- face is now complete). • CSS::DOM::MediaList and CSS::DOM::StyleSheetList have been added. • CSS::DOM::Rule now has type and cssText methods (the CSSRule interface is complete). 0.01 23 December, 2007 First release CSS-DOM-0.16/lib/000755 000767 000024 00000000000 12626673241 013765 5ustar00sproutstaff000000 000000 CSS-DOM-0.16/LICENSE000644 000767 000024 00000047366 11500351704 014227 0ustar00sproutstaff000000 000000 Terms of Perl itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" ---------------------------------------------------------------------------- The General Public License (GPL) Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, USA. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS ---------------------------------------------------------------------------- The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End CSS-DOM-0.16/Makefile.PL000644 000767 000024 00000002166 11500351704 015161 0ustar00sproutstaff000000 000000 BEGIN { require 5.008002 } # In 5.8.1, sub {} means sub {@_} use strict; use ExtUtils::MakeMaker; my %prq = ( Carp => 1.01, # @CARP_NOT Clone => .09, # coderefs constant => 1.03, # multiple at once Encode => 2.1, # LEAVE_SRC Exporter => 5.57, # use Exporter 'import'; overload => 0, re => 0, 'Scalar::Util' => 0, strict => 0, warnings => 0, # for testing only: 'Scalar::Util' => 1.09, # refaddr 'Test::More' => 0, ); WriteMakefile( NAME => 'CSS::DOM', AUTHOR => 'Father Chrysostomos ', VERSION_FROM => 'lib/CSS/DOM.pm', ABSTRACT_FROM => 'lib/CSS/DOM.pm', LICENSE => 'perl', PL_FILES => {}, PREREQ_PM => \%prq, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', TAR => 'COPYFILE_DISABLE=1 tar' }, clean => { FILES => 'CSS-DOM-*' }, ); CSS-DOM-0.16/MANIFEST000644 000767 000024 00000002504 12626673241 014351 0ustar00sproutstaff000000 000000 Changes lib/CSS/DOM.pm lib/CSS/DOM/Array.pm lib/CSS/DOM/Constants.pm lib/CSS/DOM/Exception.pm lib/CSS/DOM/Interface.pm lib/CSS/DOM/MediaList.pm lib/CSS/DOM/Parser.pm lib/CSS/DOM/PropertyParser.pm lib/CSS/DOM/Rule/Charset.pm lib/CSS/DOM/Rule/FontFace.pm lib/CSS/DOM/Rule/Import.pm lib/CSS/DOM/Rule/Media.pm lib/CSS/DOM/Rule/Page.pm lib/CSS/DOM/Rule/Style.pm lib/CSS/DOM/Rule.pm lib/CSS/DOM/RuleList.pm lib/CSS/DOM/Style.pm lib/CSS/DOM/StyleSheetList.pm lib/CSS/DOM/Util.pm lib/CSS/DOM/Value.pm lib/CSS/DOM/Value/List.pm lib/CSS/DOM/Value/Primitive/colours.pl lib/CSS/DOM/Value/Primitive.pm LICENSE Makefile.PL MANIFEST README t/charset.t t/css-dom-interface.t t/css-dom-style.t t/css-dom-util.t t/css-dom.t t/CSS2Properties.t t/CSSCharsetRule.t t/CSSFontFaceRule.t t/CSSImportRule.t t/CSSMediaRule.t t/CSSPageRule.t t/CSSPrimitiveValue.t t/CSSRule.t t/CSSRuleList.t t/CSSStyleDeclaration-setProperty.t t/CSSStyleDeclaration.t t/CSSStyleRule.t t/CSSStyleSheet-insertRule.t t/CSSStyleSheet.t t/CSSValue-prim-cssText.t t/CSSValue.t t/CSSValueList.t t/hasFeature.t t/MediaList.t t/parser-rules.t t/parser-tokens.t t/property-parser.t t/Rect.t t/RGBColor.t t/StyleSheet.t t/StyleSheetList.t META.yml Module meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) CSS-DOM-0.16/META.json000644 000767 000024 00000002266 12626673241 014646 0ustar00sproutstaff000000 000000 { "abstract" : "Document Object Model for Cascading Style Sheets", "author" : [ "Father Chrysostomos " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "CSS-DOM", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Carp" : "1.01", "Clone" : "0.09", "Encode" : "2.1", "Exporter" : "5.57", "Scalar::Util" : "1.09", "Test::More" : "0", "constant" : "1.03", "overload" : "0", "re" : "0", "strict" : "0", "warnings" : "0" } } }, "release_status" : "stable", "version" : "0.16" } CSS-DOM-0.16/META.yml000644 000767 000024 00000001260 12626673241 014467 0ustar00sproutstaff000000 000000 --- abstract: 'Document Object Model for Cascading Style Sheets' author: - 'Father Chrysostomos ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: CSS-DOM no_index: directory: - t - inc requires: Carp: '1.01' Clone: '0.09' Encode: '2.1' Exporter: '5.57' Scalar::Util: '1.09' Test::More: '0' constant: '1.03' overload: '0' re: '0' strict: '0' warnings: '0' version: '0.16' CSS-DOM-0.16/README000644 000767 000024 00000003367 12626673125 014111 0ustar00sproutstaff000000 000000 CSS::DOM, version 0.16 This module implements a CSS-specific subset of the interfaces described in the W3C DOM specification. RECENT CHANGES 0.016 ----- • Work around an incompatible change in Encode 2.77 (RT #107221, #107043). • Specify Encoding in POD. Thanks to Gregor Herrmann for the patch (RT #85955). 0.015 ----- • compute_style no longer produces an uninitialized warning under some circumstances (RT #79855). • A minor backtracking bug in CSS::DOM::PropertyParser has been fixed. 0.014 ----- • The full text of the licence is now included in the distribution. Thanks to Ville Skyttä for providing it (RT #60770). • A few pod syntax errors have been corrected, thanks to Nicholas Bam- ber (RT #63388). • CSS::DOM::PropertyParser has been fixed to work with perl 5.13.8 and higher. • New getStringValue method of CSS::DOM::Value::Primitive INSTALLATION The easiest way to install this module is to use the CPAN module or the cpan script: perl -MCPAN -e "install CSS::DOM" cpan CSS::DOM Or you can use the following: perl Makefile.PL make make test [sudo] make install DEPENDENCIES This module requires perl 5.8.2 or later, and the following modules: • Exporter 5.57 or later • Encode 2.10 or later • Clone 0.09 or later DOCUMENTATION After installing, you can find documentation for these modules with the perldoc command. perldoc CSS::DOM Or try using man (it's faster, in my experience): man CSS::DOM COPYRIGHT AND LICENCE Copyright (C) 2007-15 Father Chrysostomos This program is free software; you may redistribute it and/or modify it under the same terms as perl. The full text of the license can be found in the LICENSE file included with this module. CSS-DOM-0.16/t/000755 000767 000024 00000000000 12626673241 013462 5ustar00sproutstaff000000 000000 CSS-DOM-0.16/t/charset.t000644 000767 000024 00000011716 11057302245 015274 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; no warnings qw 'utf8 parenthesis'; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use utf8; use CSS::DOM; use tests 4; # options like CSS::DOM::parse qq|\@charset "utf-8"; {font:'\xc3\xb0'}| =>->cssRules->[1]->style->font, qr/\xc3\xb0/, 'no decode/encoding_hint param assumes unicode'; like CSS::DOM::parse "{font:'\xc3\xb0'}", decode => 1 =>->cssRules->[0]->cssText, qr/\xf0/, 'decode => 1 assumes utf-8 in the absence of encoding info'; like CSS::DOM::parse "{font:'\xc3\xb0'}", encoding_hint => 'iso-8859-7' =>->cssRules->[0]->cssText, qr/\x{393}\260/, 'encoding_hint implies decode => 1'; like CSS::DOM::parse "{font:'\xc3\xb0'}", decode => 1, encoding_hint => 'iso-8859-7' =>->cssRules->[0]->cssText,qr/\x{393}\260/, 'decode => 1 uses encoding_hint in the absence of bom or @charset'; use tests 18; # sniffing for( # ['test name', # qq[stylesheet], # rule_number_to_test => qr/.../], ['utf-8 bom and explicit charset', qq[\xef\xbb\xbf\@charset "utf-8"; {font:'\xc3\xb0'}], 1 => qr/\xf0/], ['utf-8 bomb', qq[\xef\xbb\xbf {font:'\xc3\xb0'}], 0 => qr/\xf0/], ['utf-16be bomb + @charset', qq[\xfe\xff\0\@\0c\0h\0a\0r\0s\0e\0t\0 \0"\0u\0t\0f\0-\0001] .qq[\0006\0"\0;\0 \0{\0f\0o\0n\0t\0:\0'\xab\xcd\0'\0}], 1 => qr/\x{abcd}/], ['apparent utf-16be with @charset', qq[\0\@\0c\0h\0a\0r\0s\0e\0t\0 \0"\0u\0t\0f\0-\0001\0006\0"] .qq[\0;\0 \0{\0f\0o\0n\0t\0:\0'\xab\xcd\0'\0}], 1 => qr/\x{abcd}/], ['utf-16le bomb + @charset', qq[\xff\xfe\@\0c\0h\0a\0r\0s\0e\0t\0 \0"\0u\0t\0f\0-\0001] .qq[\0006\0"\0;\0 \0{\0f\0o\0n\0t\0:\0'\0\xab\xcd'\0}\0], 1 => qr/\x{cdab}/], ['apparent utf-16le with @charset', qq[\@\0c\0h\0a\0r\0s\0e\0t\0 \0"\0u\0t\0f\0-\0001\0006\0"\0] .qq[;\0 \0{\0f\0o\0n\0t\0:\0'\0\xab\xcd'\0}\0], 1 => qr/\x{cdab}/], ['utf-32be bomb + @charset', qq[\0\0\xfe\xff\0\0\0\@\0\0\0c\0\0\0h\0\0\0a\0\0\0r\0\0\0s] .qq[\0\0\0e\0\0\0t\0\0\0 \0\0\0"\0\0\0u\0\0\0t\0\0\0f\0\0\0-] .qq[\0\0\0003\0\0\0002\0\0\0"] .qq[\0\0\0;\0\0\0 \0\0\0{\0\0\0f\0\0\0o\0\0\0n\0\0\0t\0\0\0:] .qq[\0\0\0'\0\x10\xab\xcd\0\0\0'\0\0\0}], 1 => qr/\x{10abcd}/], ['apparent utf-32be with @charset', qq[\0\0\0\@\0\0\0c\0\0\0h\0\0\0a\0\0\0r\0\0\0s] .qq[\0\0\0e\0\0\0t\0\0\0 \0\0\0"\0\0\0u\0\0\0t\0\0\0f\0\0\0-] .qq[\0\0\0003\0\0\0002\0\0\0"] .qq[\0\0\0;\0\0\0 \0\0\0{\0\0\0f\0\0\0o\0\0\0n\0\0\0t\0\0\0:] .qq[\0\0\0'\0\x10\xab\xcd\0\0\0'\0\0\0}], 1 => qr/\x{10abcd}/], ['utf-32le bomb + @charset', qq[\xff\xfe\0\0\@\0\0\0c\0\0\0h\0\0\0a\0\0\0r\0\0\0s] .qq[\0\0\0e\0\0\0t\0\0\0 \0\0\0"\0\0\0u\0\0\0t\0\0\0f\0\0\0-] .qq[\0\0\0003\0\0\0002\0\0\0"] .qq[\0\0\0;\0\0\0 \0\0\0{\0\0\0f\0\0\0o\0\0\0n\0\0\0t\0\0\0:] .qq[\0\0\0'\0\0\0\x10\xab\x0d\0'\0\0\0}\0\0\0], 1 => qr/\x{dab10}/], ['apparent utf-32le with @charset', qq[\@\0\0\0c\0\0\0h\0\0\0a\0\0\0r\0\0\0s] .qq[\0\0\0e\0\0\0t\0\0\0 \0\0\0"\0\0\0u\0\0\0t\0\0\0f\0\0\0-] .qq[\0\0\0003\0\0\0002\0\0\0"] .qq[\0\0\0;\0\0\0 \0\0\0{\0\0\0f\0\0\0o\0\0\0n\0\0\0t\0\0\0:] .qq[\0\0\0'\0\0\0\x10\xab\x0d\0'\0\0\0}\0\0\0], 1 => qr/\x{dab10}/], ['utf-32be bom', qq[\0\0\xfe\xff\0\0\0{\0\0\0f\0\0\0o\0\0\0n\0\0\0t\0\0\0:] .qq[\0\0\0'\0\x10\xab\xcd\0\0\0'\0\0\0}], 0 => qr/\x{10abcd}/], ['utf-32le bom', qq[\xff\xfe\0\0{\0\0\0f\0\0\0o\0\0\0n\0\0\0t\0\0\0:] .qq[\0\0\0'\0\0\0\x10\xab\x0d\0'\0\0\0}\0\0\0], 0 => qr/\x{dab10}/], ['utf-16be bom', qq[\xfe\xff\0{\0f\0o\0n\0t\0:\0'\xab\xcd\0'\0}], 0 => qr/\x{abcd}/], ['utf-16le bom', qq[\xff\xfe{\0f\0o\0n\0t\0:\0'\0\xab\xcd'\0}\0], 0 => qr/\x{cdab}/], ['ebcdic @charset "cp37";', qq[\x7c\x83\x88\x81\x99\xa2\x85\xa3\x40\x7f\x83\x97\xf3\xf7\x7f] .qq[\x5e\x40\xc0\x83\x96\x95\xa3\x85\x95\xa3\x7a\x40\x7f\x95\x81] .qq[\x57\xa5\x85\xa3\x51\x7f\xd0], 1 => qr/naïveté/], ['ebcdic @charset "cp875";', qq[\x7c\x83\x88\x81\x99\xa2\x85\xa3\x40\x7f\x83\x97\xf8\xf7\xf5] .qq[\x7f\x5e\x40\xc0\x83\x96\x95\xa3\x85\x95\xa3\x7a\x40\x7f\x65] .qq[\xae\xbc\xaf\xb6\xaf\xbb\xac\x9f\xac\xba\x7d\xd0], 1 => qr/Χρυσόστομος/], ['IBM1026', qq[\xae\x83\x88\x81\x99\xa2\x85\xa3\x40\xfc\x83\x97\xf1\xf0\xf2] .qq[\xf6\xfc\x5e\x40\x48\x83\x96\x95\xa3\x85\x95\xa3\x7a\x40\xfc] .qq[\x95\x81\x57\xa5\x85\xa3\x51\xfc\x8c], 1 => qr/naïveté/], ['GSM 0338', qq[\0charset "gsm0338"; \e(content: "saut\5"\e)], 1 => qr/sauté/], ){ my $ss = CSS::DOM::parse $$_[1], decode => 1; #use Data::Dumper; ++$Data::Dumper::Useqq; # diag Dumper $@ if $@; diag $@ if $@; like $ss->cssRules->[$$_[2]]->cssText, $$_[3], $$_[0];# or diag Dumper $ss->cssRules->[$$_[2]]->cssText; } # ~~~ We need tests for sniffing failures, e.g.: # (in ASCII) @charset "utf-16"; use tests 1; # url_fetcher { (my $ss = new CSS::DOM url_fetcher => sub {return "a { foo: \xc3\xb0}", decode => 1 } )->insertRule('@Import "foo.css"',0); like $ss->cssRules->[0]->styleSheet->cssRules->[0]->cssText, qr/\xf0/, 'url_fetcher'; } CSS-DOM-0.16/t/css-dom-interface.t000644 000767 000024 00000006756 11500356533 017160 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T # ~~~ This could be rewritten to load the modules and check that the # methods it finds are listed in ::Interface. And vice versa. use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use CSS::DOM::Interface ":all"; use tests 2; ok *CSS::DOM::Interface{HASH}, 'the hash is there'; ok exists $CSS::DOM::Interface{CSSStyleSheet}, 'CSSStyleSheet',; # I almost missed this. use tests 9; # changes in 0.02 ok exists $CSS::DOM::Interface{CSSStyleSheet}{title},'CSSStyleSheet title'; ok exists $CSS::DOM::Interface{CSSStyleSheet}{media},'CSSStyleSheet media'; ok exists $CSS::DOM::Interface{CSSStyleSheet}{ownerRule}, 'CSSStyleSheet ownerRule'; ok exists $CSS::DOM::Interface{CSSStyleSheet}{insertRule}, 'CSSStyleSheet insertRule'; ok exists $CSS::DOM::Interface{CSSStyleSheet}{deleteRule}, 'CSSStyleSheet deleteRule'; ok exists $CSS::DOM::Interface{MediaList}{mediaText}, 'MediaList'; ok exists $CSS::DOM::Interface{StyleSheetList}{length}, 'StyleSheetList'; ok exists $CSS::DOM::Interface{CSSRule}{type}, 'CSSRule.type'; ok exists $CSS::DOM::Interface{CSSRule}{cssText}, 'CSSRule.cssText'; use tests 14; # changes in 0.03 ok exists $CSS::DOM::Interface{CSSStyleRule}{selectorText}, 'CSSStyleRule.selectorText'; ok exists $CSS::DOM::Interface{CSSRule}{parentRule}, 'CSSRule.parentRule'; ok exists $CSS::DOM::Interface{CSSRule}{parentStyleSheet}, 'CSSRule.parentStyleSheet'; ok exists $CSS::DOM::Interface{CSSValue}, 'CSSValue'; ok exists $CSS::DOM::Interface{CSSPrimitiveValue}, 'CSSPrimitiveValue'; ok exists $CSS::DOM::Interface{CSSMediaRule}{$_}, "CSSMediaRule.$_" for qw 'media cssRules insertRule deleteRule'; ok exists $CSS::DOM::Interface{CSSImportRule}{$_}, "CSSImportRule.$_" for qw 'href media styleSheet'; ok !exists $CSS::DOM::Interface{'CSS::DOM::Rule::Unknown'}, 'CSS::DOM::Rule::Unknown is gone'; is $CSS::DOM::Interface{'CSS::DOM::Rule'}, 'CSSRule'; use tests 1; # changes in 0.04 ok exists $CSS::DOM::Interface{'CSSFontFaceRule'}, 'CSSFontFaceRule'; use tests 7; # changes in 0.06 ok exists $CSS::DOM::Interface{'CSSCharsetRule'}, 'CSSCharsetRule'; ok exists $CSS::DOM::Interface{CSSStyleDeclaration}{getPropertyCSSValue}, 'getPropertyCSSValue'; ok exists $CSS::DOM::Interface{CSSStyleDeclaration}{removeProperty}, 'removeProperty'; ok exists $CSS::DOM::Interface{CSSStyleDeclaration}{getPropertyPriority}, 'getPropertyPriority'; ok exists $CSS::DOM::Interface{CSSStyleDeclaration}{length}, 'Style->length'; ok exists $CSS::DOM::Interface{CSSValue}{cssValueType}, 'cssValueType'; ok exists $CSS::DOM::Interface{CSSValue}{cssText}, 'Value->cssText'; use tests 13; # changes in 0.08 ok exists $CSS::DOM::Interface{CSSPrimitiveValue}{$_}, "primitive value ->$_" for qw< top right bottom left red green blue alpha primitiveType >; is $CSS::DOM::Interface{CSSPrimitiveValue}{getFloatValue}, METHOD | NUM, 'getFloatValue'; ok exists $CSS::DOM::Interface{CSSValueList}{$_}, "list value ->$_" for ; ok $CSS::DOM::Interface{CSSValueList}{_array}; use tests 2; # changes in 0.11 (that should have been made in 0.10) ok exists $CSS::DOM::Interface{CSSPrimitiveValue}{setFloatValue}, 'setFloatValue'; ok exists $CSS::DOM::Interface{CSSPrimitiveValue}{setStringValue}, 'setStringValue';; use tests 1; # another change in 0.11 ok exists $CSS::DOM::Interface{CSSStyleDeclaration}{opacity}, 'opacity'; use tests 1; # a change in 0.14 ok exists $CSS::DOM::Interface{CSSPrimitiveValue}{getStringValue}; CSS-DOM-0.16/t/css-dom-style.t000644 000767 000024 00000001606 11347033505 016345 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T # This file contains tests for CSS::DOM::Style’s methods that are not part # of the CSSStyleDeclaration interface. use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use tests 4; # modification_handler require CSS::DOM::Style; my $style = CSS::DOM::Style'parse('margin-top: 2px'); $style->modification_handler(sub { ++$}; ${{} .= shift}); $style->cssText('margin-bottom: 600%'); is $}, 1, 'cssText triggers mod hander'; is ${{}, $style, '$style is passed to the handler'; $style->setProperty('foo' => 'bar'); is $}, 2, 'setProperty triggers th ohnadler'; $style->fooBar('baz'); is $}, 3, 'AUTOLOAD triggers the handler'; # ~~~ We also needs tests for modification_handler triggered by: # • removeProperty # • modifications to CSSValue objects and their sub-objects (RGBColor etc CSS-DOM-0.16/t/css-dom-util.t000644 000767 000024 00000005247 11077020332 016161 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; no warnings qw 'utf8 parenthesis'; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use CSS::DOM::Util ':all'; use tests 7; # escape is escape(join('', map chr, 0..256), qq'["\x80]'), "\0\01\02\03\04\05\06\07\ch\ci\\a\ck\\c\\d\cn\co" . join('',map chr, 0x10..0x1f) . ' !\"#$%&\'()*+,-./' . join('', map chr, ord 0 ... 0x7f) . '\80' . join('',map chr, 0x81..0x100), 'escape with second arg'; is escape("abcde", "a"), '\61 bcde', 'escape puts a space after an escape that has a hex digit after it'; is escape("\x{10f008}bcde",qr/\W/), '\10f008bcde', 'but doesn’t bother with that space if the escape is long enough'; is escape("abcde", "e"), 'abcd\65 ', 'escape puts a space after an escape that occurs at end of string'; is escape("a bcde", "a"), '\61 bcde', 'escape puts a space after an escape that is followed by a space'; is escape("a bcde", "a"), '\61 bcde', 'escape puts a space after an escape that is followed by a tab'; is escape(" \t", "[ \t]"), '\ \9 ', 'escape adds no space after \.. if the following char will be escaped'; use tests 1; #unesacpe is unescape "\\20\\10fFfff-_abcABC\\}\\7d\\7d \\7d\t\\7d\r\n\\7d\n" . "\\7d\r\\7d\f\xff\x{2003}\x{100}\\\t", " \x{10ffff}f-_abcABC}}}}}}}}\xff\x{2003}\x{100}\t", 'unescape'; use tests 5; # escape_ident is escape_ident(join '', map chr, 0..256), '\0\1\2\3\4\5\6\7\8\9\a\b\c\d\e\f' . '\10\11\12\13\14\15\16\17\18\19\1a\1b\1c\1d\1e\1f' . '\ \!\"\#\$\%\&\\\'\(\)\*\+\,-\.\/' . '0123456789\:\;\<\=\>\?' . '\@ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\\\\\]\^_' . '\`abcdefghijklmnopqrstuvwxyz\{\|\}\~\7f' . join('',map chr, 0x80..0x100), 'escape_ident'; is escape_ident('-01'), '-\30 1', 'escape_ident "-..."'; is escape_ident('_01'), '_01', 'escape_ident "_..."'; is escape_ident('1ab'), '\31 ab', 'escape_ident "..."'; is escape_ident('1-b'), '\31-b', 'escape_ident "-..."'; use tests 3; # unescape_url is unescape_url "url( \f\t \\)()\\20 \n\r )", ")() ", 'unescape_url with ws but no quotes'; is unescape_url "url( \f\t '\\)()\\20\\'' \n\r )", ")() '", 'unescape_url with single quotes'; is unescape_url qq'url( \f\t "\\)()\\20\\"" \n\r )', ')() "', 'unescape_url with double quotes'; use tests 1; # escape_str is escape_str(join '', map chr, 0..256), "'\0\1\2\3\4\5\6\7\b\t\\a\ck\\c\\d" . join('',map chr, 14..ord("'")-1) . "\\'" . join('', map chr, ord("'")+1..256) . "'", 'escape_str'; use tests 2; # unescape_str is unescape_str q|'"\'\20'|, q|"' |, 'unescape_str with single quotes'; is unescape_str q|"'\"\20"|, q|'" |, 'unesacpe_srt with double quotes'; CSS-DOM-0.16/t/css-dom.t000644 000767 000024 00000002102 12037560617 015205 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use tests 2; require CSS::DOM; my $u = \'u'; my $p = \'p'; my $sheet = new CSS::DOM url_fetcher => $u, property_parser => $p; is $sheet->url_fetcher, $u, 'url_fetcher'; is $sheet->property_parser, $p, 'property_parser'; use tests 1; # compute_style { # compute_style actually expects an HTML::DOM::Element, but HTML::DOM # depends on CSS::DOM, so we cannot easily test it without a recursive # dependency. So we use a dummy class. package MyElem; AUTOLOAD { $_[0]{(our $AUTOLOAD =~ /.*::(.*)/)[0]} } } { my $w; local $SIG{__WARN__} = sub { $w .= shift }; require CSS::DOM::Style; my $elem = bless{ style => CSS'DOM'Style'parse('color:red'), tagName => 'p', }, MyElem=>; CSS::DOM::compute_style(element => $elem); is $w, undef, 'no warnings for style belonging to element itself'; # This warning used to occur (before 0.15) if no applicable property with # the same name was to be found in the style sheets. } CSS-DOM-0.16/t/CSS2Properties.t000644 000767 000024 00000005771 11206765061 016443 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; sub tests'import { $tests += pop if @_ > 1 }; use Test::More; plan tests => $tests; BEGIN { our @props = qw /azimuth background background-attachment background-color background-image background-position background-repeat border border-bottom border-bottom-color border-bottom-style border-bottom-width border-collapse border-color border-left border-left-color border-left-style border-left-width border-right border-right-color border-right-style border-right-width border-spacing border-style border-top border-top-color border-top-style border-top-width border-width bottom caption-side clear clip color content counter-increment counter-reset cue cue-after cue-before cursor direction display elevation empty-cells float font font-family font-size font-size-adjust font-stretch font-style font-variant font-weight height left letter-spacing line-height list-style list-style-image list-style-position list-style-type margin margin-bottom margin-left margin-right margin-top marker-offset marks max-height max-width min-height min-width orphans outline outline-color outline-style outline-width overflow padding padding-bottom padding-left padding-right padding-top page page-break-after page-break-before page-break-inside pause pause-after pause-before pitch pitch-range play-during position quotes richness right size speak speak-header speak-numeral speak-punctuation speech-rate stress table-layout text-align text-decoration text-indent text-shadow text-transform top unicode-bidi vertical-align visibility voice-family volume white-space widows width word-spacing z-index/; } require CSS::DOM::Style; my $decl = CSS::DOM::Style::parse ( join('', map"$_: 65;", our @props) ); use tests +4 * our @props; # normal CSS property methods for (@props) { (my $meth = $_) =~ s/-(.)/\u$1/g; is $decl->$meth, '65', "get $meth"; is $decl->$meth('right'), '65', "get/set $meth"; is $decl->getPropertyValue($_), 'right', "result of setting $meth"; is $decl->$meth, 'right', "get $meth again"; } use tests 4; # cssFloat: the weird case is $decl->cssFloat, 'right', "get cssFloat"; # it was set by the float meth is $decl->cssFloat('left'), 'right', "get/set cssFloat"; is $decl->getPropertyValue('float'), 'left', "result of setting cssFloat"; is $decl->cssFloat, 'left', "get cssFloat again"; use tests 8; # assigning '', ' ', ' foo' (bug in 0.06) is eval {$decl->cssFloat(''); 1}, 1,'empty string assignment doesn\'t die'; is $decl->cssFloat, '', 'empty string assignment works'; $decl->cssFloat('foo'); is eval {$decl->cssFloat(' '); 1},1,'whitespace assignment doesn\'t die'; is $decl->cssFloat, '', 'whitespace assignment works'; $decl->cssFloat('foo'); is eval{$decl->cssFloat('/*foo*/'); 1},1,'comment assignment doesn\'t die'; is $decl->cssFloat, '', 'comment assignment works'; is eval{$decl->cssFloat(' foo'); 1},1,'" foo" assignment doesn\'t die'; is $decl->cssFloat, ' foo', 'assignment with initial whitespace works'; CSS-DOM-0.16/t/CSSCharsetRule.t000644 000767 000024 00000003014 11062067446 016434 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use tests 1; # use use_ok 'CSS::DOM::Rule::Charset',; require CSS::DOM; my $rule = ( my $ss = CSS::DOM'parse( '@charset "utf-8";' ) )-> cssRules->[0]; use tests 1; # isa isa_ok $rule, 'CSS::DOM::Rule::Charset'; diag $@ if $@; use tests 7; #constructor { (my $ss = new CSS::DOM)->insertRule('@import "stuff"',0); my $rule = $ss->cssRules->[0]; my $empty_rule = new CSS::DOM::Rule::Charset $rule; isa_ok $empty_rule,'CSS::DOM::Rule::Charset', 'result of new CSS::DOM::Rule::Charset (empty rule)'; is $empty_rule->parentRule, $rule, 'parentRule of empty rule'; is $empty_rule->parentStyleSheet, $ss, 'parentStyleSheet of empty rule'; is $empty_rule->type, &CSS::DOM::Rule::CHARSET_RULE, 'type of empty rule'; $empty_rule = new CSS::DOM::Rule::Charset $ss; isa_ok $empty_rule, 'CSS::DOM::Rule::Charset', 'empty rule with no parent rule'; is +()=$empty_rule->parentRule, 0, 'parentRule of empty rule without parent rule'; is $empty_rule->parentStyleSheet, $ss, 'parentStyleSheet of empty rule w/no parent rule'; } use tests 5; # encoding is encoding $rule, 'utf-8', 'encoding'; is $rule->encoding('"'), 'utf-8', 'get/set encoding'; is encoding $rule, '"', 'get encoding again'; is $rule->cssText, "\@charset \"\\\"\";\n", 'cssText after setting encoding'; $rule->cssText('@charset "utf\-8";'); is encoding $rule, 'utf-8', 'the encoding name is unescaped'; CSS-DOM-0.16/t/CSSFontFaceRule.t000644 000767 000024 00000002625 11210277347 016535 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use tests 1; # use use_ok 'CSS::DOM::Rule::FontFace',; require CSS::DOM; my $rule = ( my $ss = CSS::DOM'parse( '@font-face { font-family: "foo";src:url(bar) }' ) )-> cssRules->[0]; warn $@ if $@; use tests 1; # isa isa_ok $rule, 'CSS::DOM::Rule::FontFace'; use tests 7; #constructor { (my $ss = new CSS::DOM)->insertRule('@media screen{}',0); my $rule = $ss->cssRules->[0]; my $empty_rule = new CSS::DOM::Rule::FontFace $rule; isa_ok $empty_rule,'CSS::DOM::Rule::FontFace', 'result of new CSS::DOM::Rule::FontFace (empty rule)'; is $empty_rule->parentRule, $rule, 'parentRule of empty rule'; is $empty_rule->parentStyleSheet, $ss, 'parentStyleSheet of empty rule'; is $empty_rule->type, &CSS::DOM::Rule::FONT_FACE_RULE, 'type of empty rule'; $empty_rule = new CSS::DOM::Rule::FontFace $ss; isa_ok $empty_rule, 'CSS::DOM::Rule::FontFace', 'empty rule with no parent rule'; is +()=$empty_rule->parentRule, 0, 'parentRule of empty rule without parent rule'; is $empty_rule->parentStyleSheet, $ss, 'parentStyleSheet of empty rule w/no parent rule'; } use tests 2; # style isa_ok style $rule, 'CSS::DOM::Style', 'ret val of style'; is style $rule ->fontFamily, '"foo"', 'the style decl does have the css stuff, so it’s the right one'; CSS-DOM-0.16/t/CSSImportRule.t000644 000767 000024 00000005544 11040040257 016312 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use CSS::DOM::Exception; use tests 1; # use use_ok 'CSS::DOM::Rule::Import'; require CSS::DOM; my $rule = ( my $ss = CSS::DOM'parse( '@import "foo.css" tv, screen' ) )-> cssRules->[0]; use tests 1; # isa isa_ok $rule, 'CSS::DOM::Rule::Import'; use tests 7; #constructor { (my $ss = new CSS::DOM)->insertRule('@Import "print"',0); my $rule = $ss->cssRules->[0]; my $empty_rule = new CSS::DOM::Rule::Import $rule; isa_ok $empty_rule,'CSS::DOM::Rule::Import', 'result of new CSS::DOM::Rule::Import (empty rule)'; is $empty_rule->parentRule, $rule, 'parentRule of empty rule'; is $empty_rule->parentStyleSheet, $ss, 'parentStyleSheet of empty rule'; is $empty_rule->type, &CSS::DOM::Rule::IMPORT_RULE, 'type of empty rule'; $empty_rule = new CSS::DOM::Rule::Import $ss; isa_ok $empty_rule, 'CSS::DOM::Rule::Import', 'empty rule with no parent rule'; is +()=$empty_rule->parentRule, 0, 'parentRule of empty rule without parent rule'; is $empty_rule->parentStyleSheet, $ss, 'parentStyleSheet of empty rule w/no parent rule'; } use tests 2; # href { (my $ss =new CSS::DOM)->insertRule('@Import "foo.css"',0); my $rule = $ss->cssRules->[0]; is $rule->href, "foo.css", 'href when its a string in the source'; ($ss =new CSS::DOM)->insertRule('@Import url("har.css")',0); $rule = $ss->cssRules->[0]; is $rule->href, "har.css", 'href when its a url in the source'; } use tests 2; # media { isa_ok $rule->media, 'CSS::DOM::MediaList'; $rule->media->mediaText('tv, screen'); is_deeply [$rule->media], [tv=>screen=>], 'media in list context'; } use tests 5; # styleSheet { (my $ss = new CSS::DOM) ->insertRule('@Import "foo.css"',0); my $rule = $ss->cssRules->[0]; is +()=$rule->styleSheet, 0, 'null styleSheet'; ($ss = new CSS::DOM url_fetcher => sub {return "a { color:red}" } )->insertRule('@Import "foo.css"',0); $rule = $ss->cssRules->[0]; isa_ok $rule->styleSheet, 'CSS::DOM', 'styleSheet'; is join('', map $_->cssText, $rule->styleSheet->cssRules), "a { color: red }\n", 'seralised styleSheet'; ($ss = new CSS::DOM url_fetcher => sub { }) ->insertRule('@Import "foo.css"',0); $rule = $ss->cssRules->[0]; $rule->styleSheet; # keep this line here; multiple calls to # styleSheet were making it return (0) in list # context instead of () is +()=$rule->styleSheet, 0, 'null styleSheet when callback returns undef'; my %urls = ( 'foo.css' => '@import "bar.css"', 'bar.css' => 'a { color: blue }', ); is CSS'DOM'parse('@import "foo.css',url_fetcher=>sub{$urls{$_[0]}}) ->cssRules->[0]->styleSheet ->cssRules->[0]->styleSheet ->cssRules->[0]->style->color, 'blue', 'styleSheet of a recursive/nested @import, whatever you call it'; } CSS-DOM-0.16/t/CSSMediaRule.t000644 000767 000024 00000007057 11052627014 016065 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use CSS::DOM::Exception; use tests 1; # use use_ok 'CSS::DOM::Rule::Media'; require CSS::DOM; my $rule = ( my $ss = CSS::DOM'parse( '@media print { body { background: none } }' ) )-> cssRules->[0]; use tests 1; # isa isa_ok $rule, 'CSS::DOM::Rule::Media'; use tests 7; #constructor { (my $ss = new CSS::DOM)->insertRule('@media print {}',0); my $rule = $ss->cssRules->[0]; my $empty_rule = new CSS::DOM::Rule::Media $rule; isa_ok $empty_rule,'CSS::DOM::Rule::Media', 'result of new CSS::DOM::Rule::Media (empty rule)'; is $empty_rule->parentRule, $rule, 'parentRule of empty rule'; is $empty_rule->parentStyleSheet, $ss, 'parentStyleSheet of empty rule'; is $empty_rule->type, &CSS::DOM::Rule::MEDIA_RULE, 'type of empty rule'; $empty_rule = new CSS::DOM::Rule::Media $ss; isa_ok $empty_rule, 'CSS::DOM::Rule::Media', 'empty rule with no parent rule'; is +()=$empty_rule->parentRule, 0, 'parentRule of empty rule without parent rule'; is $empty_rule->parentStyleSheet, $ss, 'parentStyleSheet of empty rule w/no parent rule'; } use tests 2; # media { isa_ok $rule->media, 'CSS::DOM::MediaList'; $rule->media->mediaText('screen, printer'); is_deeply [$rule->media], [screen=>printer=>], 'media in list context'; } use tests 2; # cssRules { my $rule = ( CSS::DOM::parse( '@media print { a{text-decoration: none} p { margin: 0 } }' ) )-> cssRules->[0]; is +()=$rule->cssRules, 2, 'cssRules in list context'; isa_ok my $rules = cssRules $rule, 'CSS::DOM::RuleList', 'cssRules in scalar context'; } use tests 13; # insertRule { my $rule = ( my $ss = CSS::DOM::parse( '@media print { a{text-decoration: none} p { margin: 0 } }' ) )-> cssRules->[0]; is $rule->insertRule('b { font-weight: bold }', 0), 0, 'retval of insertRule'; is_deeply [map $_->selectorText, $rule->cssRules], [qw/ b a p /], 'result of insertRule with 0 for the index'; is $rule->cssRules->[0]->style->cssText, 'font-weight: bold', 'Are the contents of insertRule\'s new rule present?'; isa_ok $rule->cssRules->[0], 'CSS::DOM::Rule'; is $rule->insertRule('i {}', -1), 2, 'retval of insertRule with negative index'; is_deeply [map $_->selectorText, $rule->cssRules], [qw/ b a i p /], 'result of insertRule with negative index'; { local $SIG{__WARN__} = sub{}; is $rule->insertRule('u {}', 27), 4, 'retval of insertRule with large index'; } is_deeply [map $_->selectorText, $rule->cssRules], [qw/ b a i p u /], 'result of insertRule with large index'; is +()=eval{$rule->insertRule(' two{} rules{}',0)}, 0, 'insertRule fails with two rules'; isa_ok $@, 'CSS::DOM::Exception','$@'; cmp_ok $@, '==', CSS::DOM::Exception::SYNTAX_ERR, '$@ is a SYNTAX_ERR'; my $subrule = $rule->cssRules->[ $rule->insertRule('foo{bar:baz}',0) ]; is $subrule->parentStyleSheet, $ss, 'parentStyleSheet is set by insertRule'; is $subrule->parentRule, $rule, 'insertRule sets teh parentRule'; } use tests 4; # deleteRule { my $rule = ( CSS::DOM::parse( '@media print { a{text-decoration: none} p { margin: 0 } i {} }' ) )-> cssRules->[0]; is +()=$rule->deleteRule(1), 0, 'retval of deleteRule'; is_deeply [map $_->selectorText, $rule->cssRules], [qw/ a i /], 'result of deleteRule'; eval { $rule->deleteRule(79); }; isa_ok $@, 'CSS::DOM::Exception', 'exception thrown by deleteRule'; cmp_ok $@, '==', CSS::DOM::Exception::INDEX_SIZE_ERR, 'error raised by deleteRule'; }CSS-DOM-0.16/t/CSSPageRule.t000644 000767 000024 00000003433 11062021536 015712 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use tests 1; # use use_ok 'CSS::DOM::Rule::Page',; require CSS::DOM; my $rule = ( my $ss = CSS::DOM'parse( '@page:first{ margin-top: 3in }') )-> cssRules->[0]; use tests 1; # isa isa_ok $rule, 'CSS::DOM::Rule::Page'; use tests 7; #constructor { (my $ss = new CSS::DOM)->insertRule('@media screen{}',0); my $rule = $ss->cssRules->[0]; my $empty_rule = new CSS::DOM::Rule::Page $rule; isa_ok $empty_rule,'CSS::DOM::Rule::Page', 'result of new CSS::DOM::Rule::Page (empty rule)'; is $empty_rule->parentRule, $rule, 'parentRule of empty rule'; is $empty_rule->parentStyleSheet, $ss, 'parentStyleSheet of empty rule'; is $empty_rule->type, &CSS::DOM::Rule::PAGE_RULE, 'type of empty rule'; $empty_rule = new CSS::DOM::Rule::Page $ss; isa_ok $empty_rule, 'CSS::DOM::Rule::Page', 'empty rule with no parent rule'; is +()=$empty_rule->parentRule, 0, 'parentRule of empty rule without parent rule'; is $empty_rule->parentStyleSheet, $ss, 'parentStyleSheet of empty rule w/no parent rule'; } use tests 5; # selectorText { $ss->insertRule('@page:first{}', 0); is +(my $rule = $ss->cssRules->[0])->selectorText, '@page:first', 'selectorText'; is $rule->selectorText('@page'), '@page:first', 'get/set selectorText'; is $rule->selectorText, '@page', 'get selectorText again'; ok !eval{$rule->selectorText('body');1}, 'setting selectorText to something other than @page... dies'; cmp_ok $@, '==', &CSS::DOM::Exception::SYNTAX_ERR; } use tests 2; # style isa_ok style $rule, 'CSS::DOM::Style', 'ret val of style'; is style $rule ->marginTop, '3in', 'the style decl does have the css stuff, so it’s the right one'; CSS-DOM-0.16/t/CSSPrimitiveValue.t000644 000767 000024 00000062016 11500356435 017163 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; no warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; sub tests'import { $tests += pop if @_ > 1 }; use Test::More; plan tests => $tests; use tests 1; # use use_ok 'CSS::DOM::Value::Primitive', ':all'; use tests 26; # constants { my $x; for (qw/ UNKNOWN NUMBER PERCENTAGE EMS EXS PX CM MM IN PT PC DEG RAD GRAD MS S HZ KHZ DIMENSION STRING URI IDENT ATTR COUNTER RECT RGBCOLOR /) { eval "is CSS_$_, " . $x++ . ", '$_'"; } } use CSS::DOM; #use tests 1; # unknown # ~~~ How do we get an unknown primitive value? If we have a value that is # unrecognised, what determines whether it becomes a custom value or # an unknown primitive value? What should I test for? # This sub runs two tests sub test_isa { isa_ok $_[0], 'CSS::DOM::Value::Primitive', $_[1]; ok $_[0]->DOES('CSS::DOM::Value'), "$_[1] DOES CSS::DOM::Value"; } # ------------------------------------- # Tests for isa, primitiveType and get* use tests 7; # numbers for(CSS::DOM::Value::Primitive->new(type => &CSS_NUMBER, value => 73)) { test_isa $_, 'number value'; is $_->primitiveType, &CSS_NUMBER, 'number->primitiveType'; is $_->getFloatValue, 73, 'number->getFloatValue'; ok !eval{ $_->getStringValue;1}, 'number->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after number->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after number->getStringValue dies'; } use tests 7; # % for( CSS::DOM::Value::Primitive->new(type => &CSS_PERCENTAGE, value => 73) ) { test_isa $_, '% value'; is $_->primitiveType, &CSS_PERCENTAGE, '%->primitiveType'; is $_->getFloatValue, 73, '%->getFloatValue'; ok !eval{ $_->getStringValue;1}, '%->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after %->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after %->getStringValue dies'; } use tests 7; # M for(CSS::DOM::Value::Primitive->new(type => &CSS_EMS, value => 73)) { test_isa $_, 'em value'; is $_->primitiveType, &CSS_EMS, 'em->primitiveType'; is $_->getFloatValue, 73, 'em->getFloatValue'; ok !eval{ $_->getStringValue;1}, 'em->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after em->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after em->getStringValue dies'; } use tests 7; # X for(CSS::DOM::Value::Primitive->new(type => &CSS_EXS, value => 73)) { test_isa $_, 'ex value'; is $_->primitiveType, &CSS_EXS, 'ex->primitiveType'; is $_->getFloatValue, 73, 'ex>getFloatValue'; ok !eval{ $_->getStringValue;1}, 'ex->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after ex->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after ex->getStringValue dies'; } use tests 7; # pixies for(CSS::DOM::Value::Primitive->new(type => &CSS_PX, value => 73)) { test_isa $_, 'pixel value'; is $_->primitiveType, &CSS_PX, 'pixel->primitiveType'; is $_->getFloatValue, 73, 'px->getFloatValue'; ok !eval{ $_->getStringValue;1}, 'pixel->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after pixel->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after pixel->getStringValue dies'; } use tests 7; # cm for(CSS::DOM::Value::Primitive->new(type => &CSS_CM, value => 73)) { test_isa $_, 'cm value'; is $_->primitiveType, &CSS_CM, 'cm->primitiveType'; is $_->getFloatValue, 73, 'cm->getFloatValue'; ok !eval{ $_->getStringValue;1}, 'cm->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after cm->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after cm->getStringValue dies'; } use tests 7; # mm for(CSS::DOM::Value::Primitive->new(type => &CSS_MM, value => 73)) { test_isa $_, 'millimetre value'; is $_->primitiveType, &CSS_MM, 'mm->primitiveType'; is $_->getFloatValue, 73, 'mm->getFloatValue'; ok !eval{ $_->getStringValue;1}, 'mm->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after mm->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after mm->getStringValue dies'; } use tests 7; # inch for(CSS::DOM::Value::Primitive->new(type => &CSS_IN, value => 73)) { test_isa $_, 'inch value'; is $_->primitiveType, &CSS_IN, 'inch->primitiveType'; is $_->getFloatValue, 73, 'inch->getFloatValue'; ok !eval{ $_->getStringValue;1}, 'inch->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after inch->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after inch->getStringValue dies'; } use tests 7; # points for(CSS::DOM::Value::Primitive->new(type => &CSS_PT, value => 73)) { test_isa $_, 'pointy value'; is $_->primitiveType, &CSS_PT, 'pointy->primitiveType'; is $_->getFloatValue, 73, 'pointy->getFloatValue'; ok !eval{ $_->getStringValue;1}, 'pointy->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after pointy->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after pointy->getStringValue dies'; } use tests 7; # pica for(CSS::DOM::Value::Primitive->new(type => &CSS_PC, value => 73)) { test_isa $_, 'pica value'; is $_->primitiveType, &CSS_PC, 'pica->primitiveType'; is $_->getFloatValue, 73, 'pica->getFloatValue'; ok !eval{ $_->getStringValue;1}, 'pica->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after pica->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after pica->getStringValue dies'; } use tests 7; # degrease for(CSS::DOM::Value::Primitive->new(type => &CSS_DEG, value => 73)) { test_isa $_, 'degree value'; is $_->primitiveType, &CSS_DEG, 'degree->primitiveType'; is $_->getFloatValue, 73, 'degree->getFloatValue'; ok !eval{ $_->getStringValue;1}, 'degree->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after degree->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after degree->getStringValue dies'; } use tests 7; # radians for(CSS::DOM::Value::Primitive->new(type => &CSS_RAD, value => 73)) { test_isa $_, 'radian value'; is $_->primitiveType, &CSS_RAD, 'radian->primitiveType'; is $_->getFloatValue, 73, 'radian->getFloatValue'; ok !eval{ $_->getStringValue;1}, 'radian->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after radian->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after radian->getStringValue dies'; } use tests 7; # grad for(CSS::DOM::Value::Primitive->new(type => &CSS_GRAD, value => 73)) { test_isa $_, 'grad value'; is $_->primitiveType, &CSS_GRAD, 'grad->primitiveType'; is $_->getFloatValue, 73, 'grad->getFloatValue'; ok !eval{ $_->getStringValue;1}, 'grad->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after grad->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after grad->getStringValue dies'; } use tests 7; # seconds for(CSS::DOM::Value::Primitive->new(type => &CSS_S, value => 73)) { test_isa $_, 'sec. value'; is $_->primitiveType, &CSS_S, 'sec.->primitiveType'; is $_->getFloatValue, 73, 'sec.->getFloatValue'; ok !eval{ $_->getStringValue;1}, 'sec.->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after sec.->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after sec.->getStringValue dies'; } use tests 7; # ms for(CSS::DOM::Value::Primitive->new(type => &CSS_MS, value => 73)) { test_isa $_, 'ms value'; is $_->primitiveType, &CSS_MS, 'ms->primitiveType'; is $_->getFloatValue, 73, 'ms->getFloatValue'; ok !eval{ $_->getStringValue;1}, 'ms->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after ms->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after ms->getStringValue dies'; } use tests 7; # hurts for(CSS::DOM::Value::Primitive->new(type => &CSS_HZ, value => 73)) { test_isa $_, 'hurts value'; is $_->primitiveType, &CSS_HZ, 'hurts->primitiveType'; is $_->getFloatValue, 73, 'hurts->getFloatValue'; ok !eval{ $_->getStringValue;1}, 'hurts->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after hurts->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after hurts->getStringValue dies'; } use tests 7; # killer hurts for(CSS::DOM::Value::Primitive->new(type => &CSS_KHZ, value => 73)) { test_isa $_, 'killer hurts value'; is $_->primitiveType, &CSS_KHZ, 'killer hurts->primitiveType'; is $_->getFloatValue, 73, 'killer hurts->getFloatValue'; ok !eval{ $_->getStringValue;1}, 'killer hurts->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after killer hurts->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after killer hurts->getStringValue dies'; } use tests 7; # misc dim for( CSS::DOM::Value::Primitive->new( type => &CSS_DIMENSION, value => [73, 'things'] ) ) { test_isa $_, 'misc dim value'; is $_->primitiveType, &CSS_DIMENSION, 'misc dim->primitiveType'; is $_->getFloatValue, 73, 'misc dim->getFloatValue'; ok !eval{ $_->getStringValue;1}, 'misc dim->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after misc dim->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after misc dim->getStringValue dies'; } use tests 7; # string for(CSS::DOM::Value::Primitive->new(type => &CSS_STRING, value => 73)) { test_isa $_, 'string value'; is $_->primitiveType, &CSS_STRING, 'string->primitiveType'; ok !eval{ $_->getFloatValue;1}, 'string->getFloatValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after string->getFloatValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after string->getFloatValue dies'; is $_->getStringValue, 73, 'string->getStringValue'; } use tests 7; # url for(CSS::DOM::Value::Primitive->new(type => &CSS_URI, value => 73)) { test_isa $_, 'uri value'; is $_->primitiveType, &CSS_URI, 'uri->primitiveType'; ok !eval{ $_->getFloatValue;1}, 'uri->getFloatValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after uri->getFloatValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after uri->getFloatValue dies'; is $_->getStringValue, 73, 'url->getStringValue'; } use tests 7; # identifier for(CSS::DOM::Value::Primitive->new(type => &CSS_IDENT, value => 73)) { test_isa $_, 'identifier value'; is $_->primitiveType, &CSS_IDENT, 'identifier->primitiveType'; ok !eval{ $_->getFloatValue;1}, 'identifier->getFloatValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after identifier->getFloatValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after identifier->getFloatValue dies'; is $_->getStringValue, 73, 'identifier->getStringValue'; } use tests 7; # attr for(CSS::DOM::Value::Primitive->new(type => &CSS_ATTR, value => 73)) { test_isa $_, 'attr value'; is $_->primitiveType, &CSS_ATTR, 'attr->primitiveType'; ok !eval{ $_->getFloatValue;1}, 'attr->getFloatValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after attr->getFloatValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after attr->getFloatValue dies'; is $_->getStringValue, 73, 'attr->getStringValue'; } use tests 9; # counter for(CSS::DOM::Value::Primitive->new(type => &CSS_COUNTER, value => [73])) { test_isa $_, 'counter value'; is $_->primitiveType, &CSS_COUNTER, 'counter->primitiveType'; ok !eval{ $_->getFloatValue;1}, 'counter->getFloatValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after counter->getFloatValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after counter->getFloatValue dies'; ok !eval{ $_->getStringValue;1}, 'counter->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after counter->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after counter->getStringValue dies'; } use tests 9; # counters for(CSS::DOM::Value::Primitive->new( type => &CSS_COUNTER, value => [73,'breen'] )) { test_isa $_, 'counters value'; is $_->primitiveType, &CSS_COUNTER, 'counters->primitiveType'; ok !eval{ $_->getFloatValue;1}, 'counters->getFloatValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after counters->getFloatValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after counters->getFloatValue dies'; ok !eval{ $_->getStringValue;1}, 'counters->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after counters->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after counters->getStringValue dies'; } use tests 9; # rectangle for(CSS::DOM::Value::Primitive->new( type => &CSS_RECT, value => [ [type => &CSS_PX, value => 20], [type => &CSS_PERCENTAGE, value => 50], [type => &CSS_PERCENTAGE, value => 50], [type => &CSS_PX, value => 50], ] )) { test_isa $_, 'rectangle value'; is $_->primitiveType, &CSS_RECT, 'rectangle->primitiveType'; ok !eval{ $_->getFloatValue;1}, 'rectangle->getFloatValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after rectangle->getFloatValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after rectangle->getFloatValue dies'; ok !eval{ $_->getStringValue;1}, 'rectangle->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after rectangle->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after rectangle->getStringValue dies'; } use tests 9; #bed colour for(CSS::DOM::Value::Primitive->new( type => &CSS_RGBCOLOR, value => '#bed', )) { test_isa $_, '#bed colour value'; is $_->primitiveType, &CSS_RGBCOLOR, '#bed colour->primitiveType'; ok !eval{ $_->getFloatValue;1}, '#bed colour->getFloatValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after #bed colour->getFloatValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after #bed colour->getFloatValue dies'; ok !eval{ $_->getStringValue;1}, '#bee colour->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after #bee colour->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after #bee colour->getStringValue dies'; } use tests 9; #c0ffee colour for(CSS::DOM::Value::Primitive->new( type => &CSS_RGBCOLOR, value => '#c0ffee', )) { test_isa $_, '#c0ffee colour value'; is $_->primitiveType, &CSS_RGBCOLOR, '#c0ffee colour->primitiveType'; ok !eval{ $_->getFloatValue;1}, '#c0ffee colour->getFloatValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after #c0ffee colour->getFloatValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after #c0ffee colour->getFloatValue dies'; ok !eval{ $_->getStringValue;1}, '#c0ffee->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after #c0ffee->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after #c0ffee->getStringValue dies'; } use tests 9; # rgb colour for(CSS::DOM::Value::Primitive->new( type => &CSS_RGBCOLOR, value => [ ([type => &CSS_NUMBER, value => 0])x3 ] )) { test_isa $_, 'rgb value'; is $_->primitiveType, &CSS_RGBCOLOR, 'rgb->primitiveType'; ok !eval{ $_->getFloatValue;1}, 'rgb->getFloatValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after rgb->getFloatValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after rgb->getFloatValue dies'; ok !eval{ $_->getStringValue;1}, 'rgb->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after rgb->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after rgb->getStringValue dies'; } use tests 9; # rgba colour for(CSS::DOM::Value::Primitive->new( type => &CSS_RGBCOLOR, value => [ ([type => &CSS_NUMBER, value => 0])x4 ] )) { test_isa $_, 'rgba value'; is $_->primitiveType, &CSS_RGBCOLOR, 'rgba->primitiveType'; ok !eval{ $_->getFloatValue;1}, 'rgba->getFloatValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after rgba->getFloatValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after rgba->getFloatValue dies'; ok !eval{ $_->getStringValue;1}, 'rgba->getStringValue dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after rgba->getStringValue dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, 'error code after rgba->getStringValue dies'; } # ------------------------------------------ # Tests for setFloatValue and setStringValue use CSS'DOM'Style; require CSS::DOM::PropertyParser; my $s = new CSS'DOM'Style property_parser => $CSS::DOM::PropertyParser::Default; for my $meth ('setFloatValue' ,'setStringValue'){ use tests 6; # read-only properties my $v = new CSS::DOM::Value::Primitive type => &CSS::DOM::Value::Primitive::CSS_NUMBER, value => 43; ok !eval{ $v->$meth(&CSS_IN, 1); 1 }, qq'calling $meth on an unowned primitive value object dies'; isa_ok $@, 'CSS::DOM::Exception', qq'class of error after primitive->$meth dies'; cmp_ok $@, '==', &CSS::DOM::Exception::NO_MODIFICATION_ALLOWED_ERR, qq'and the right type of error, too (after primitive->$meth dies)'; use tests +26*3*2; # errors for invalid types $s->backgroundImage('url(scrat)'); $v = $s->getPropertyCSSValue('background-image'); for(qw) { ok !eval{ $v->$meth(eval"CSS_$_", 1); 1 }, qq '$meth(CSS_$_) dies when the property does not support it'; isa_ok $@, 'CSS::DOM::Exception', qq'class of error after primitive->$meth(&CSS_$_) dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, qq'and the right type of error, too (after $meth(&CSS_$_) dies)'; } $s->backgroundColor('#bad'); $v = $s->getPropertyCSSValue('background-color'); ok !eval{ $v->$meth(&CSS_URI, 1); 1 }, qq'setFloatValue(CSS_URI) dies when the property does not support it'; isa_ok $@, 'CSS::DOM::Exception', qq'class of error after primitive->$meth(&CSS_URI) dies'; cmp_ok $@, '==', &CSS::DOM::Exception::INVALID_ACCESS_ERR, qq'and the right type of error, too (after $meth(&CSS_URI) dies)'; use tests 4; # retval and CSS_NUMBER $s->marginTop('4px'); is +()=$s->getPropertyCSSValue('margin-top')->$meth(&CSS_NUMBER, 0), 0, "$meth returns nothing"; is $s->marginTop, 0, "successful $meth(CSS_NUMBER)"; use tests 2; # CSS_PERCENTAGE $s->height('4px'); ($v = $s->getPropertyCSSValue('height'))->$meth(&CSS_PERCENTAGE, 50); is $s->height, '50%', "successful $meth(CSS_PERCENTAGE)"; use tests 2; # CSS_EMS $v->$meth(&CSS_EMS, 50); is $s->height, '50em', "successful $meth(CSS_EMS)"; use tests 2; # CSS_EXS $v->$meth(&CSS_EXS, 50); is $s->height, '50ex', "successful $meth(CSS_EXS)"; use tests 2; # CSS_PX $v->$meth(&CSS_PX, 50); is $s->height, '50px', "successful $meth(CSS_PX)"; use tests 2; # CSS_CM $v->$meth(&CSS_CM, 50); is $s->height, '50cm', "successful $meth(CSS_CM)"; use tests 2; # CSS_MM $v->$meth(&CSS_MM, 50); is $s->height, '50mm', "successful $meth(CSS_MM)"; use tests 2; # CSS_IN $v->$meth(&CSS_IN, 50); is $s->height, '50in', "successful $meth(CSS_IN)"; use tests 2; # CSS_PT $v->$meth(&CSS_PT, 50); is $s->height, '50pt', "successful $meth(CSS_PT)"; use tests 2; # CSS_PC $v->$meth(&CSS_PC, 50); is $s->height, '50pc', "successful $meth(CSS_PC)"; use tests 2; # CSS_DEG $s->azimuth('5rad'); ($v = $s->getPropertyCSSValue('azimuth'))->$meth(&CSS_DEG, 50); is $s->azimuth, '50deg', "successful $meth(CSS_DEG)"; use tests 2; # CSS_RAD $v->$meth(&CSS_RAD, 50); is $s->azimuth, '50rad', "successful $meth(CSS_RAD)"; use tests 2; # CSS_GRAD $v->$meth(&CSS_GRAD, 50); is $s->azimuth, '50grad', "successful $meth(CSS_GRAD)"; use tests 2; # CSS_MS $s->pauseAfter('5s'); ($v = $s->getPropertyCSSValue('pause-after'))->$meth(&CSS_MS, 50); is $s->pauseAfter, '50ms', "successful $meth(CSS_MS)"; use tests 2; # CSS_S $v->$meth(&CSS_S, 50); is $s->pauseAfter, '50s', "successful $meth(CSS_S)"; use tests 2; # CSS_HZ $s->pitch('5khz'); ($v = $s->getPropertyCSSValue('pitch'))->$meth(&CSS_HZ, 50); is lc $s->pitch, '50hz', "successful $meth(CSS_HZ)"; use tests 2; # CSS_KHZ $v->$meth(&CSS_KHZ, 30); is lc $s->pitch, '30khz', "successful $meth(CSS_KHZ)"; use tests 2; # CSS_STRING $s->quotes('"‘" "’"'); $s->getPropertyCSSValue('quotes')->[0]->$meth(&CSS_STRING, 50); like $s->quotes, qr/^(['"])50\1\s+(['"])’\2\z/, "successful $meth(CSS_STRING)"; use tests 2; # CSS_URI $s->content('""'); ($v = $s->getPropertyCSSValue('content')->[0])->$meth(&CSS_URI, 50); is $s->content, 'url(50)', "successful $meth(CSS_URI)"; use tests 2; # CSS_IDENT # This test also checks that sub-values of a list do not lose their inter- # nal owner attribute when they change type (bug in 0.08 and 0.09). $v->$meth(&CSS_IDENT, 'open-quote'); is $s->content, 'open-quote', "successful $meth(CSS_IDENT)"; use tests 2; # CSS_ATTR $v->$meth(&CSS_ATTR, 'open-quote'); is $s->content, 'attr(open-quote)', "successful $meth(CSS_attr)"; } __END__ ~~~ I need to finish converting the rest of these tests $s->backgroundImage('url(dwow)'); $v = $s->getPropertyCSSValue('background-image'); is $v->cssText('none'), 'url(dwow)', 'setting cssText returns the old value'; is $s->backgroundImage, 'none', 'prim_value->cssText("...") sets the owner CSS property'; is $v->primitiveType, &CSS::DOM::Value::Primitive::CSS_IDENT, ' prim->cssText sets the “primitive” type'; is $v->cssText, 'none', ' prim->cssText sets the value object\'s own cssText'; # We re-use the same value on purpose, to make sure the change in type did # not discard the internal owner attribute. $v->cssText('inherit'); is $s->backgroundImage, 'inherit', 'setting the cssText of a primitive value to inherit changes the prop'; is $v->cssText, 'inherit', 'setting the cssText of a prim val to inherit changes its cssText'; is $v->cssValueType, &CSS_INHERIT, 'value type after setting a primitive value to inherit'; isa_ok $v, "CSS::DOM::Value", 'object class after setting a primitive value to inherit'; $s->clip('rect(0,0,0,0)'); $v = $s->getPropertyCSSValue('clip')->top; $v->cssText('red'); is $v->cssText, 0, 'setting cssText on a sub-value of a rect to a colour does nothing'; $v->cssText(50); is $v->cssText, 0, 'setting cssText on a rect’s sub-value to a non-zero num does nothing'; $v->cssText('5px'); is $v->cssText, '5px', 'setting cssText on a sub-value of a rect to 5px works'; is $v->primitiveType, &CSS::DOM::Value::Primitive::CSS_PX, 'setting cssText on a sub-value of a rect to 5px changes the prim type'; like $s->clip, qr/^rect\(5px,\s*0,\s*0,\s*0\)\z/, 'setting cssText on a sub-value of a rect changes the prop that owns it'; $v->cssText('auto'); is $v->cssText, 'auto', 'rect sub-values can be set to auto'; $v->cssText('bdelp'); is $v->cssText, 'auto', 'but not to any other identifier'; $s->color('#c0ffee'); $v = (my $clr = $s->getPropertyCSSValue('color'))->red; $v->cssText('red'); is $v->cssText, 192, 'setting cssText on a sub-value of a colour to a colour does nothing'; $v->cssText('255'); is $v->cssText, '255', 'setting cssText on a sub-value of a colour to 255 works'; is $clr->cssText, '#ffffee', 'changing a colour’s sub-value sets the colour’s cssText'; $v->cssText('50%'); is $v->cssText, '50%', 'setting cssText on a sub-value of a colour to 50% works'; is $v->primitiveType, &CSS::DOM::Value::Primitive::CSS_PERCENTAGE, 'changing the cssText of a colour’s sub-value changes the prim type'; like $clr->cssText, qr/^rgb\(127.5,\s*255,\s*238\)\z/, 'the colour’s cssText after making the subvalues mixed numbers & %’s'; $v = $clr->alpha; $v->cssText('50%'); is $v->cssText, 1, 'alpha values ignore assignments of percentage values to cssText'; $v->cssText(.5); is $v->cssText, .5, 'but number assignments (to alpha values’ cssText) work'; like $clr->cssText, qr/^rgba\(127.5,\s*255,\s*238,\s*0.5\)\z/, 'the colour’s cssText after making the subvalues mixed numbers & %’s'; $v = $s->getPropertyCSSValue('color'); $v->cssText('activeborder');; is $v->primitiveType, &CSS::DOM::Value::Primitive::CSS_IDENT, 'setting a colour property’s cssText to a sys. colour makes it an ident'; $s->backgroundColor('red'); my $called; $s->modification_handler(sub { ++$called }); $s->getPropertyCSSValue('background-color')->cssText('white'); is $called, 1, "modification_handler is called when a ‘primitive’ value changes"; } # Methods that still need testing: # ~~~ getCounterValue getRectValue getRGBColorValue CSS-DOM-0.16/t/CSSRule.t000644 000767 000024 00000015060 11062021641 015111 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use CSS::DOM::Exception; use tests 1; # use use_ok 'CSS::DOM::Rule', ':all'; use tests 7; # constants { my $x; for (qw/ UNKNOWN_RULE STYLE_RULE CHARSET_RULE IMPORT_RULE MEDIA_RULE FONT_FACE_RULE PAGE_RULE /) { eval "is $_, " . $x++ . ", '$_'"; } } require CSS::DOM; my $ss = CSS::DOM'parse( 'a{text-decoration: none} p { margin: 0 }'); my $rule = cssRules $ss ->[0]; use tests 1; # isa isa_ok $rule, 'CSS::DOM::Rule'; use tests 2; #constructor { my $rule = new CSS::DOM::Rule $rule; isa_ok $rule, 'CSS::DOM::Rule', 'isa after constructor'; is type $rule, &UNKNOWN_RULE, 'type after constructor'; } use tests 7; # type $ss->insertRule('@shingly blonged;', 0); is $ss->cssRules->[0]->type, &UNKNOWN_RULE, 'type of unknown rule'; $ss->insertRule('a{}', 0); is $ss->cssRules->[0]->type, &STYLE_RULE, 'type of style rule'; $ss->insertRule('@media print {}', 0); is $ss->cssRules->[0]->type, &MEDIA_RULE, 'type of @media rule'; $ss->insertRule('@font-face {}', 0); is $ss->cssRules->[0]->type, &FONT_FACE_RULE, 'type of @font-face rule'; $ss->insertRule('@page {}', 0); is $ss->cssRules->[0]->type, &PAGE_RULE, 'type of @page rule'; $ss->insertRule('@import "', 0); is $ss->cssRules->[0]->type, &IMPORT_RULE, 'type of @import rule'; $ss->insertRule('@charset "utf-7";', 0); is $ss->cssRules->[0]->type, &CHARSET_RULE, 'type of @charset rule'; use tests 38; # cssText { my $rule; $ss->insertRule('@shlumggom malunga clin drimp.', 0); $rule = $ss->cssRules->[0]; is $rule->cssText, "\@shlumggom malunga clin drimp.;\n", 'get cssText'; is $rule->cssText("\@wisto{et [f ee( ( 'eee"), "\@shlumggom malunga clin drimp.;\n", 'get/set cssText'; is $rule->cssText, "\@wisto{et [f ee( ( 'eee'))]}\n", 'get cssText again (and bracket closure)'; $rule->cssText('@\}'); is $rule->cssText, "\@\\};\n", 'serialisation of unknown rule ending with \}'; $rule->cssText('@\;'); is $rule->cssText, "\@\\;;\n", 'serialisation of unknown rule ending with \;'; ok !eval{$rule->cssText('@media canvas {}');1}, '$unwistrule->cssText dies when set to @media...'; cmp_ok $@, '==', CSS::DOM::Exception::INVALID_MODIFICATION_ERR, '$@ is the correct type'; $ss->insertRule('b{font-family: Monaco}', 0); $rule = $ss->cssRules->[0]; is $rule->cssText, "b { font-family: Monaco }\n", 'get cssText (ruleset)'; is $rule->cssText("a{color: blue}"), "b { font-family: Monaco }\n", 'get/set cssText (ruleset)'; is $rule->cssText, "a { color: blue }\n", 'get cssText again (ruleset)'; $rule->cssText('{ foo: bar }'); is $rule->cssText, "{ foo: bar }\n", 'serialised ruleset with universal selector'; # We don’t want it to have an initial space. ok !eval{$rule->cssText('@media canvas {}');1}, '$stylerule->cssText dies when set to @media...'; cmp_ok $@, '==', CSS::DOM::Exception::INVALID_MODIFICATION_ERR, '$@ is the correct type'; $ss->insertRule('@media print,screen{b{font-family: Monaco}}', 0); $rule = $ss->cssRules->[0]; is $rule->cssText, "\@media print, screen {\n\tb { font-family: Monaco }\n}\n", 'get cssText (@media)'; is $rule->cssText("\@media screen { }"), "\@media print, screen {\n\tb { font-family: Monaco }\n}\n", 'get/set cssText (@media)'; is $rule->cssText, "\@media screen {\n}\n", 'get cssText again (@media)'; ok !eval{$rule->cssText('a { text-decoration: none }');1}, '$mediarule->cssText dies when set to a{...}'; cmp_ok $@, '==', CSS::DOM::Exception::INVALID_MODIFICATION_ERR, '$@ is the correct type after cssText <- a {...}'; $ss->insertRule('@page :left{margin-right:1.5in}', 0); $rule = $ss->cssRules->[0]; is $rule->cssText, "\@page :left { margin-right: 1.5in }\n", 'get cssText (@page)'; is $rule->cssText("\@page { margin: 1in }"), "\@page :left { margin-right: 1.5in }\n", 'get/set cssText (@page)'; is $rule->cssText, "\@page { margin: 1in }\n", 'get cssText again (@page)'; ok !eval{$rule->cssText('a { text-decoration: none }');1}, '$pagerule->cssText dies when set to a{...}'; cmp_ok $@, '==', CSS::DOM::Exception::INVALID_MODIFICATION_ERR, '$@ is the correct type after setting cssText on @page'; $ss->insertRule('@import "\a\2000 foo bar" \70rint, screen', 0); $rule = $ss->cssRules->[0]; is $rule->cssText, '@import "\a\2000 foo bar" print, screen;' . "\n", 'get cssText (@import)'; is $rule->cssText('@import url( foo.css\)'), '@import "\a\2000 foo bar" print, screen;' . "\n", 'get/set cssText (@import)'; is $rule->cssText, "\@import url( foo.css\\));\n", 'get cssText again (@import with url)'; ok !eval{$rule->cssText('a { text-decoration: none }');1}, '$importrule->cssText dies when set to a{...}'; cmp_ok $@, '==', CSS::DOM::Exception::INVALID_MODIFICATION_ERR, '$@ is the correct type after setting cssText on @import'; $ss->insertRule('@font-face{font-family: "ww"; src: url(.t)}', 0); $rule = $ss->cssRules->[0]; is $rule->cssText, "\@font-face { font-family: \"ww\"; src: url(.t) }\n", 'get cssText (@font-face)'; is $rule->cssText("\@font-face { margin: 1in }"), "\@font-face { font-family: \"ww\"; src: url(.t) }\n", 'get/set cssText (@font-face)'; is $rule->cssText, "\@font-face { margin: 1in }\n", 'get cssText again (@font-face)'; ok !eval{$rule->cssText('a { text-decoration: none }');1}, '$fontrule->cssText dies when set to a{...}'; cmp_ok $@, '==', CSS::DOM::Exception::INVALID_MODIFICATION_ERR, '$@ is correct type after setting cssText on @font-face'; $ss->insertRule('@charset "utf-7";', 0); $rule = $ss->cssRules->[0]; is $rule->cssText, "\@charset \"utf-7\";\n", 'get cssText (@charset)'; is $rule->cssText("\@charset \"\\\"\";"), "\@charset \"utf-7\";\n", 'get/set cssText (@charset)'; is $rule->cssText, "\@charset \"\\\"\";\n", 'get cssText again (@charset)'; ok !eval{$rule->cssText('a { text-decoration: none }');1}, '$charsetrule->cssText dies when set to a{...}'; cmp_ok $@, '==', CSS::DOM::Exception::INVALID_MODIFICATION_ERR, '$@ is correct type after setting cssText on @charset'; } use tests 4; # parentStyleSheet and parentRule { is +()=$rule->parentRule, 0, 'null parentRule'; is $rule->parentStyleSheet, $ss, 'parentStyleSheet'; $ss->insertRule('@media print { body {background: none}}',0); my $media_rule = $ss->cssRules->[0]; is $media_rule->cssRules->[0]->parentRule, $media_rule, 'parentRule of child of @media rule'; is $media_rule->cssRules->[0]->parentStyleSheet, $ss, 'parentRule of child of @media rule'; } CSS-DOM-0.16/t/CSSRuleList.t000644 000767 000024 00000001021 11036437062 015746 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use tests 1; # use use_ok 'CSS::DOM::RuleList'; require CSS::DOM; my $ss = CSS::DOM::parse('a{text-decoration: none} p { margin: 0 }'); my $list = cssRules $ss; use tests 1; # isa isa_ok $list, 'CSS::DOM::RuleList'; use tests 1; # length is $list->length, @$list, 'length'; use tests 2; # item is $list->item($_), $list->[$_], 'item ' . 'again' x $_ for 0..1; CSS-DOM-0.16/t/CSSStyleDeclaration-setProperty.t000644 000767 000024 00000000765 11053176041 022021 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T # This test is in its own file, because it checks to make sure that a cer- # tain method does a ‘require’. We can’t test it if some other method has # already done it. use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use CSS::DOM::Style; use tests 1; my $s = new CSS::DOM::Style; ok eval{$s->setProperty('foo'=>1);1}, 'setProperty works with ::Style is loaded before ::Parser'; CSS-DOM-0.16/t/CSSStyleDeclaration.t000644 000767 000024 00000011133 11340161766 017461 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; no warnings qw 'utf8 parenthesis regexp once qw'; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use tests 1; # use use_ok 'CSS::DOM::Style',; use tests 3; # first make sure we can use it without loading CSS::DOM { my $owner = bless [], 'bext'; sub bext::parentStyleSheet{} my $decl = new CSS::DOM::Style $owner; is $decl->parentRule, $owner, 'constructor sets the parentRule'; undef $owner; is $decl->parentRule, undef, 'holds a weak ref to its parent'; $decl->cssText('margin-top: 76in'); # Wow, what a big margin! is $decl->marginTop, '76in', 'seems to be working orphanedly'; } require CSS::DOM; my $ss = CSS::DOM'parse ('a{text-decoration: none} p { margin: 0 }'); my $rule = cssRules $ss ->[0]; my $decl = $rule->style; use tests 1; # isa isa_ok $decl, 'CSS::DOM::Style'; use tests 3; # cssText (there are more tests below under setProperty) is $decl->cssText, 'text-decoration: none', 'get cssText'; is $decl->cssText('text-decoration: underline'), 'text-decoration: none', 'get/set cssText'; is $decl->cssText, 'text-decoration: underline', 'get cssText again'; use tests 1; # getPropertyValue is $decl->getPropertyValue('text-decoration'), 'underline', 'getPropertyValue'; use tests 6; # getPropertyCSSValue and property_parser is +()=$decl->getPropertyCSSValue('text-decoration'), '0', 'retval of getPropertyCSSValue when prop parser is not in use'; { require CSS::DOM::PropertyParser; my $decl = CSS::DOM::Style::parse( 'text-decoration: underline', property_parser =>$CSS::DOM::PropertyParser::Default ); is $decl->property_parser, $CSS::DOM::PropertyParser::Default, 'property_parser'; ok $decl->getPropertyCSSValue('text-decoration')->DOES('CSS::DOM::Value'), 'retval of getPropertyCSSValue with property parser'; ok $decl->getPropertyCSSValue('text-decoration')->DOES('CSS::DOM::Value'), 'retval of getPropertyCSSValue (2nd time)'; # weird caching bug in 0.06 is +()=$decl->getPropertyCSSValue('background-color'), '0', 'retval of getPropertyCSSValue when the prop doesn\'t exist'; $decl->font(" bold 13px Times "); is +()=$decl->getPropertyCSSValue('font'), 0, 'getPropertyCSSValue always returns null for shorthand properties'; } use tests 3; # removeProperty is $decl->removeProperty('azimuth'), '', 'removal of a non-existent property returns the empty string'; is $decl->removeProperty('text-decorAtion'), 'underline', 'removeProperty returns the property’s value'; unlike $decl->cssText, qr/text-decoration/i, 'removeProperty actually removes the property'; use tests 3; # getPropertyPriority { my $decl = CSS::DOM::Style::parse('color: red !\69mportant'); is $decl->getPropertyPriority('color'), important => 'getPropertyPriority'; $decl = CSS::DOM::Style::parse("color: red ! imp0rtant"); is $decl->getPropertyPriority('color'), imp0rtant => 'priority parsing when there is a space after the !'; is $decl->getPropertyPriority('colour'), '' => 'getPropertyPriority when the property does not exist'; } use tests 8; # setProperty is +()=$decl->setProperty('color', 'red'), 0, 'setProperty ret val'; is $decl->getPropertyValue('color'), 'red', 'effect of setProperty'; ok!eval{$decl->setProperty('color', '}');1}, 'setProperty chokes on }'; cmp_ok $@,'==',&CSS::DOM::Exception::SYNTAX_ERR, 'setProperty throws the right error'; $decl->setProperty('cOlOr', 'blue'); is $decl->color, 'blue', 'setProperty lcs the property names'; $decl->setProperty('color','red','important'); like $decl->cssText, qr/color: red !important/, 'setting property priority'; $decl->setProperty('cOlOr', 'blue'); unlike $decl->cssText, qr/color: red !important/, 'setProperty without a priority arg deletes the pri'; $decl->setProperty('color','blue','very important'); like $decl->cssText, qr/color: blue !very\\ important/, 'setProperty with space in the priority (and cssText afterwards)'; use tests 4; # length { my $decl = new CSS'DOM'Style; is eval { $decl->length }, 0, # This used to die [RT #54810] 'length when no properties have been added'; # (fixed in 0.09). $decl = CSS::DOM::Style::parse( 'color: red !\69mportant; foo:bar' ); is $decl->length, 2, 'length'; $decl->baz('nslv'); is $decl->length, 3, 'length changes when a property is added'; $decl->removeProperty('baz'); is $decl->length, 2, ' and when one is removed'; use tests 3; # item is $decl->item(0), 'color', 'item'; is $decl->item(1), 'foo', 'item again'; is $decl->item(2), '', 'nonexistent item'; } use tests 1; # parentRule use Scalar::Util 'refaddr'; is refaddr $rule, refaddr $decl->parentRule, 'parentRule'; CSS-DOM-0.16/t/CSSStyleRule.t000644 000767 000024 00000004376 11037040304 016141 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use tests 1; # use use_ok 'CSS::DOM::Rule::Style',; require CSS::DOM; my $rule = ( my $ss = CSS::DOM'parse('a{text-decoration: none} p { margin: 0 }') )-> cssRules->[0]; use tests 1; # isa isa_ok $rule, 'CSS::DOM::Rule::Style'; use tests 7; #constructor { (my $ss = new CSS::DOM)->insertRule('a{}',0); my $rule = $ss->cssRules->[0]; my $empty_rule = new CSS::DOM::Rule::Style $rule; isa_ok $empty_rule,'CSS::DOM::Rule::Style', 'result of new CSS::DOM::Rule::Style (empty rule)'; is $empty_rule->parentRule, $rule, 'parentRule of empty rule'; is $empty_rule->parentStyleSheet, $ss, 'parentStyleSheet of empty rule'; is $empty_rule->type, &CSS::DOM::Rule::STYLE_RULE, 'type of empty rule'; $empty_rule = new CSS::DOM::Rule::Style $ss; isa_ok $empty_rule, 'CSS::DOM::Rule::Style', 'empty rule with no parent rule'; is +()=$empty_rule->parentRule, 0, 'parentRule of empty rule without parent rule'; is $empty_rule->parentStyleSheet, $ss, 'parentStyleSheet of empty rule w/no parent rule'; } use tests 3; # selectorText { $ss->insertRule('*, a, b i, p > ul, div:first-child, a:link, a:visited, a:active, a:hover, a:focus, em:lang(en), tr+td, html[version], body[style="margin: 0"], table[class~=\'foo\'], strong[lang|="en"], a.bbbb, .ed, img#foo, #bar{}', 0); is +(my $rule = $ss->cssRules->[0])->selectorText, '*, a, b i, p > ul, div:first-child, a:link, a:visited, a:active, a:hover, a:focus, em:lang(en), tr+td, html[version], body[style="margin: 0"], table[class~=\'foo\'], strong[lang|="en"], a.bbbb, .ed, img#foo, #bar', 'selectorText'; is $rule->selectorText('address'), '*, a, b i, p > ul, div:first-child, a:link, a:visited, a:active, a:hover, a:focus, em:lang(en), tr+td, html[version], body[style="margin: 0"], table[class~=\'foo\'], strong[lang|="en"], a.bbbb, .ed, img#foo, #bar', 'get/set selectorText'; is $rule->selectorText, 'address', 'get selectorText again'; } use tests 2; # style isa_ok style $rule, 'CSS::DOM::Style', 'ret val of style'; is style $rule ->textDecoration, 'none', 'the style decl does have the css stuff, so it’s the right one'; CSS-DOM-0.16/t/CSSStyleSheet-insertRule.t000644 000767 000024 00000001174 11034761005 020432 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T # This test is in its own file, because it checks to make sure that a cer- # tain method does a ‘require’. We can’t test it if some other method has # already done it. use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use CSS::DOM; use tests 1; # insertRule my $ss = new CSS::DOM; ok eval{$ss->insertRule('a{ color: red }',0);1}, 'insertRule on empty style sheet doesn\'t die'; # At one point during development, it did die because it was call- # ing methods on CSS::DOM::RuleParser which hadn’t been loaded. CSS-DOM-0.16/t/CSSStyleSheet.t000644 000767 000024 00000004625 11052624374 016313 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use CSS::DOM::Exception; use tests 1; # use use_ok 'CSS::DOM'; use tests 1; # constructor isa_ok my $ss = new CSS::DOM, 'CSS::DOM'; use tests 3; # (_set_)ownerRule { my $foo = []; $ss->_set_ownerRule($foo); is $ss->ownerRule, $foo, 'ownerRule'; undef $foo; is $ss->ownerRule, undef, 'ownerRule is a weak refeerenc'; my $ss = CSS::DOM::parse('@import ""', url_fetcher => sub {'a{}'}); is $ss->cssRules->[0]->styleSheet->ownerRule, $ss->cssRules->[0], 'ownerRule of @import\'s style sheet'; } use tests 2; # cssRules { $ss = CSS::DOM'parse( 'a{text-decoration: none} p { margin: 0 }'); is +()=$ss->cssRules, 2, 'cssRules in list context'; isa_ok my $rules = cssRules $ss, 'CSS::DOM::RuleList', 'cssRules in scalar context'; } use tests 11; # insertRule { $ss = CSS::DOM'parse ('a{text-decoration: none} p { margin: 0 }'); is $ss->insertRule('b { font-weight: bold }', 0), 0, 'retval of insertRule'; is_deeply [map $_->selectorText, $ss->cssRules], [qw/ b a p /], 'result of insertRule with 0 for the index'; is $ss->cssRules->[0]->style->cssText, 'font-weight: bold', 'Are the contents of insertRule\'s new rule present?'; isa_ok $ss->cssRules->[0], 'CSS::DOM::Rule'; is $ss->insertRule('i {}', -1), 2, 'retval of insertRule with negative index'; is_deeply [map $_->selectorText, $ss->cssRules], [qw/ b a i p /], 'result of insertRule with negative index'; { local $SIG{__WARN__} = sub{}; is $ss->insertRule('u {}', 27), 4, 'retval of insertRule with large index'; } is_deeply [map $_->selectorText, $ss->cssRules], [qw/ b a i p u /], 'result of insertRule with large index'; is +()=eval{$ss->insertRule(' two{} rules{}',0)}, 0, 'insertRule fails with two rules'; isa_ok $@, 'CSS::DOM::Exception','$@' =>|| diag $@; cmp_ok $@, '==', CSS::DOM::Exception::SYNTAX_ERR, '$@ is a SYNTAX_ERR'; } use tests 4; # deleteRule { $ss = CSS::DOM'parse ('a{text-decoration: none} p { margin: 0 } i {}'); is +()=$ss->deleteRule(1), 0, 'retval of deleteRule'; is_deeply [map $_->selectorText, $ss->cssRules], [qw/ a i /], 'result of deleteRule'; eval { $ss->deleteRule(79); }; isa_ok $@, 'CSS::DOM::Exception', 'exception thrown by deleteRule'; cmp_ok $@, '==', CSS::DOM::Exception::INDEX_SIZE_ERR, 'error raised by deleteRule'; }CSS-DOM-0.16/t/CSSValue-prim-cssText.t000644 000767 000024 00000001106 11275455505 017672 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T # This is in a separate file to make sure that CSS::DOM::Value::Primitive # remembers to require CSS::DOM::Exception. use strict; use warnings; no warnings qw 'qw regexp once utf8 parenthesis'; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use tests 1; use CSS::DOM::Value::Primitive ':all'; eval{ new CSS::DOM::Value::Primitive type=>CSS_STRING, value=>'drare' =>->cssText("foo") }; isa_ok $@, 'CSS::DOM::Exception', 'CSS::DOM::Value::Primitive ->cssText loads CSS::DOM::Exception'; CSS-DOM-0.16/t/CSSValue.t000644 000767 000024 00000034670 11354027150 015273 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; no warnings qw 'qw regexp once utf8 parenthesis'; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use tests 1; # use use_ok 'CSS::DOM::Value', ':all'; require CSS::DOM::Value::List; require CSS::DOM::Value::Primitive; use tests 4; # constants { my $x; for (qw/ CSS_INHERIT CSS_PRIMITIVE_VALUE CSS_VALUE_LIST CSS_CUSTOM /) { eval "is $_, " . $x++ . ", '$_'"; } } use tests 2; # constructor & isa isa_ok +CSS::DOM::Value->new(type => &CSS_INHERIT), 'CSS::DOM::Value'; isa_ok +CSS::DOM::Value->new(type => &CSS_CUSTOM, value => "top left"), 'CSS::DOM::Value'; # --- cssText and cssValueType --- # # Each subclass implements them itself, so I have to test each case. And I # also have to make sure that getPropertyCSSValue produces the right # thing, too. require CSS::DOM::Style; require CSS::DOM::PropertyParser; my $s = new CSS'DOM'Style property_parser => my $spec = $CSS::DOM::PropertyParser::Default; # The default parser has no properties with a simple string, attr or # counter value. They all take a list. So we add a few just to make test- # ing easier: $spec->add_property(s => { format => '', }); $spec->add_property(a => { format => '', }); $spec->add_property(c => { format => '', }); # This runs 4 tests if the $property is specified and accepts $valstr. # It runs 2 otherwise. sub test_value { my($s,$property,$class,$args,$valstr,$type,$name) = @_; my $donefirst; $s->setProperty($property, $valstr) if $property; for my $val ( "CSS::DOM::Value$class"->new( @$args ), $property ? $s->getPropertyCSSValue($property) : () ) { $name .= " (from getPCV)" x $donefirst++; is $val->cssText, $valstr, "$name ->cssText"; is $val->cssValueType, $type, "$name ->cssValueType"; } } use tests 8; test_value $s,"top","", [type => &CSS_INHERIT], 'inherit', &CSS_INHERIT, 'inherit'; test_value $s,"background-position", "", [type=>&CSS_CUSTOM,value=>"top left"], 'top left', &CSS_CUSTOM, 'custom value'; use tests 130; my $css_num = &CSS::DOM::Value::Primitive::CSS_NUMBER; for( #constant constructor val arg prop css str test name [ number => '73' , 'z-index', '73' , 'number' ], [ percentage => '73' , 'top' , '73%' , '%' ], [ ems => '73' , 'top' , '73em' , 'em' ], [ exs => '73' , 'top' , '73ex' , 'ex' ], [ px => '73' , 'top' , '73px' , 'px' ], [ cm => '73' , 'top' , '73cm' , 'cm' ], [ mm => '73' , 'top' , '73mm' , 'mm' ], [ in => '73' , 'top' , '73in' , 'inch' ], [ pt => '73' , 'top' , '73pt' , 'point' ], [ pc => '73' , 'top' , '73pc' , 'pica' ], [ deg => '73' , 'azimuth', '73deg' , 'degree' ], [ rad => '73' , 'azimuth', '73rad' , 'radian' ], [ grad => '73' , 'azimuth', '73grad' , 'grad' ], [ s => '73' , 'pause-after', '73s' , 'second' ], [ ms => '73' , 'pause-after', '73ms' , 'ms' ], [ Hz => '73' , 'pitch' , '73Hz' , 'hertz' ], [ kHz => '73' , 'pitch' , '73kHz' , 'kHertz' ], [ dimension => ['73', 'wob' ], '' , '73wob' , 'misc dim' ], [ string => '73' , 's' , "'73'" , 'string' ], [ uri => '73' , 'cue-after', "url(73)", 'URI' ], [ ident => 'red' , 'color' , "red" , 'ident' ], [ attr => 'red' , 'a' , "attr(red)", 'attr' ], [ counter => ['red' ], 'c' , 'counter(red)', 'counter' ], [ counter => ['red',undef,'lower-roman'], 'c', 'counter(red, lower-roman)', 'counter with style'], [ counter => ['red','. '], 'c', "counters(red, '. ')", 'counters'], [ counter => ['red','. ','upper-latin'], 'c', "counters(red, '. ', upper-latin)", 'counters with style'], [ rect => [ [type=>&CSS::DOM::Value::Primitive::CSS_PX,value=>1], [type=>&CSS::DOM::Value::Primitive::CSS_EMS,value=>2], [type=>&CSS::DOM::Value::Primitive::CSS_IDENT,value=>'auto'], [type=>&CSS::DOM::Value::Primitive::CSS_CM,value=>4], ], 'clip', "rect(1px, 2em, auto, 4cm)", 'rect'], [ rgbcolor => 'red' , 'color' , 'red' , 'colour (ident)'], [ rgbcolor => '#fff' , 'color' , '#fff', 'colour (#hhh)' ], [ rgbcolor => '#abcdef' , 'color', '#abcdef', 'colour (#hhhhhh)'], [ rgbcolor => [ [type=>$css_num,value=>255], [type=>$css_num,value=>0], [type=>$css_num,value=>0] ], 'color', 'rgb(255, 0, 0)', 'colour (rgb)'], [ rgbcolor => [ [type=>$css_num,value=>255], [type=>$css_num,value=>0], [type=>$css_num,value=>0], [type=>$css_num,value=>.5] ], 'color', 'rgba(255, 0, 0, 0.5)', 'colour (rgba)'], [ ident => 'activeborder' , 'color', 'activeborder', 'system colour'], ) { test_value $s, $$_[2], "::Primitive", [ type => &{\&{"CSS::DOM::Value::Primitive::CSS_\U$$_[0]"}}, value => $$_[1], ], $$_[3], &CSS_PRIMITIVE_VALUE, $$_[4] } use tests 20; test_value $s,"counter-increment","::List", [ separator => ' ', values => [ [type => &CSS::DOM::Value::Primitive::CSS_IDENT, value => 'open-quote'], [type => &CSS::DOM::Value::Primitive::CSS_NUMBER, value => '8'], ] ], "open-quote 8", &CSS_VALUE_LIST, 'space-separated list'; test_value $s,"cursor","::List", [ separator => ', ', values => [ [type => &CSS::DOM::Value::Primitive::CSS_URI, value => 'frew'], [type => &CSS::DOM::Value::Primitive::CSS_IDENT, value => 'crosshair'], ] ], "url(frew), crosshair", &CSS_VALUE_LIST, 'comma-separated list'; test_value $s,"content","::List", [ separator => ', ', values => [ [type => &CSS::DOM::Value::Primitive::CSS_URI, value => 'cror'], ] ], "url(cror)", &CSS_VALUE_LIST, 'single-valued list'; test_value $s,"font-family","::List", [ separator => ', ', values => [ [type => &CSS::DOM::Value::Primitive::CSS_STRING, value => 'dat drin', css => 'dat drin'], ] ], "dat drin", &CSS_VALUE_LIST, 'single-valued nominally comma-separated list'; test_value $s,"counter-reset","::List", [ separator => ' ', values => [] ], 'none', &CSS_VALUE_LIST, 'empty list'; use tests 14; # writing cssText on inherit/custom values { my $v = new CSS::DOM::Value type => &CSS_INHERIT; ok !eval{ $v->cssText('aaa'); 1 }, 'setting cssText on an unowned css value object dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after cssText dies'; cmp_ok $@, '==', &CSS::DOM::Exception::NO_MODIFICATION_ALLOWED_ERR, 'and the right type of error, too (after cssText dies)'; $v = new CSS::DOM::Value type => &CSS_INHERIT, owner => $s; ok !eval{ $v->cssText('aaa'); 1 }, 'setting cssText on a css value object with no property dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after cssText dies (val with no prop)'; cmp_ok $@, '==', &CSS::DOM::Exception::NO_MODIFICATION_ALLOWED_ERR, 'and the right type of error, too (after cssText dies [val w/no prop])'; $s->backgroundPosition('inherit'); $v = $s->getPropertyCSSValue('background-position'); $v->cssText('top left'); # We write it twice on purpose, to make sure the $v->cssText('top left'); # change in type did not discard the is $s->backgroundPosition, 'top left', # internal owner attribute. 'value->cssText("top left") sets the owner CSS property'; is $v->cssValueType, &CSS_CUSTOM, ' and the value type'; is $v->cssText, 'top left', ' and the value object\'s own cssText'; $s->backgroundColor('inherit'); $v = $s->getPropertyCSSValue('background-color'); $v->cssText('red'); is $s->backgroundColor, 'red', 'setting the cssText of an inherit value to a colour changes the prop'; is $v->cssText, 'red', 'setting the cssText of an inherit value changes the cssText thereof'; is $v->cssValueType, &CSS_PRIMITIVE_VALUE, 'value type after setting an inherit value to a colour'; isa_ok $v, "CSS::DOM::Value::Primitive", 'object class after setting an inherit value to a colour'; $s->backgroundColor('inherit'); my $called; $s->modification_handler(sub { ++$called }); $s->getPropertyCSSValue('background-color')->cssText('red'); is $called, 1, 'modification_handler is called when a CSS::DOM::Value changes'; } use tests 30; # writing cssText on ‘primitive’ values { my $v = new CSS::DOM::Value::Primitive type => &CSS::DOM::Value::Primitive::CSS_NUMBER, value => 43; ok !eval{ $v->cssText('aaa'); 1 }, 'setting cssText on an unowned primitive value object dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after primitive->cssText dies'; cmp_ok $@, '==', &CSS::DOM::Exception::NO_MODIFICATION_ALLOWED_ERR, 'and the right type of error, too (after primitive->cssText dies)'; $s->backgroundImage('url(dwow)'); $v = $s->getPropertyCSSValue('background-image'); is $v->cssText('none'), 'url(dwow)', 'setting cssText returns the old value'; is $s->backgroundImage, 'none', 'prim_value->cssText("...") sets the owner CSS property'; is $v->primitiveType, &CSS::DOM::Value::Primitive::CSS_IDENT, ' prim->cssText sets the “primitive” type'; is $v->cssText, 'none', ' prim->cssText sets the value object\'s own cssText'; # We re-use the same value on purpose, to make sure the change in type did # not discard the internal owner attribute. $v->cssText('inherit'); is $s->backgroundImage, 'inherit', 'setting the cssText of a primitive value to inherit changes the prop'; is $v->cssText, 'inherit', 'setting the cssText of a prim val to inherit changes its cssText'; is $v->cssValueType, &CSS_INHERIT, 'value type after setting a primitive value to inherit'; isa_ok $v, "CSS::DOM::Value", 'object class after setting a primitive value to inherit'; $s->clip('rect(0,0,0,0)'); $v = $s->getPropertyCSSValue('clip')->top; $v->cssText('red'); is $v->cssText, 0, 'setting cssText on a sub-value of a rect to a colour does nothing'; $v->cssText(50); is $v->cssText, 0, 'setting cssText on a rect’s sub-value to a non-zero num does nothing'; $v->cssText('5px'); is $v->cssText, '5px', 'setting cssText on a sub-value of a rect to 5px works'; is $v->primitiveType, &CSS::DOM::Value::Primitive::CSS_PX, 'setting cssText on a sub-value of a rect to 5px changes the prim type'; like $s->clip, qr/^rect\(5px,\s*0,\s*0,\s*0\)\z/, 'setting cssText on a sub-value of a rect changes the prop that owns it'; $v->cssText('auto'); is $v->cssText, 'auto', 'rect sub-values can be set to auto'; $v->cssText('bdelp'); is $v->cssText, 'auto', 'but not to any other identifier'; $s->color('#c0ffee'); $v = (my $clr = $s->getPropertyCSSValue('color'))->red; $v->cssText('red'); is $v->cssText, 192, 'setting cssText on a sub-value of a colour to a colour does nothing'; $v->cssText('255'); is $v->cssText, '255', 'setting cssText on a sub-value of a colour to 255 works'; is $clr->cssText, '#ffffee', 'changing a colour’s sub-value sets the colour’s cssText'; $v->cssText('50%'); is $v->cssText, '50%', 'setting cssText on a sub-value of a colour to 50% works'; is $v->primitiveType, &CSS::DOM::Value::Primitive::CSS_PERCENTAGE, 'changing the cssText of a colour’s sub-value changes the prim type'; like $clr->cssText, qr/^rgb\(127.5,\s*255,\s*238\)\z/, 'the colour’s cssText after making the subvalues mixed numbers & %’s'; $v = $clr->alpha; $v->cssText('50%'); is $v->cssText, 1, 'alpha values ignore assignments of percentage values to cssText'; $v->cssText(.5); is $v->cssText, .5, 'but number assignments (to alpha values’ cssText) work'; like $clr->cssText, qr/^rgba\(127.5,\s*255,\s*238,\s*0.5\)\z/, 'the colour’s cssText after making the subvalues mixed numbers & %’s'; $v = $s->getPropertyCSSValue('color'); $v->cssText('activeborder');; is $v->primitiveType, &CSS::DOM::Value::Primitive::CSS_IDENT, 'setting a colour property’s cssText to a sys. colour makes it an ident'; $s->backgroundColor('red'); my $called; $s->modification_handler(sub { ++$called }); $s->getPropertyCSSValue('background-color')->cssText('white'); is $called, 1, "modification_handler is called when a ‘primitive’ value changes"; # Bug in 0.08 and 0.09: non-void context causes cssText not to write # anything if the existing value is a string and there is no existing # serialisation recorded. $v = new CSS::DOM::Value::Primitive:: type => &CSS::DOM::Value::Primitive::CSS_STRING, value => 'nin', owner => $s, property => 's', ; scalar $v->cssText("'squow'"); is $v->cssText, "'squow'", 'prim->cssText(...) in non-void cx sets the val if existing val is str' # ~~~ We also need a test for list sub-values retaining their owner attri- # bute when they change type } use tests 10; # writing cssText on list values { my $v = new CSS::DOM::Value::List values => []; ok !eval{ $v->cssText('aaa'); 1 }, 'setting cssText on an unowned css list value object dies'; isa_ok $@,'CSS::DOM::Exception', 'class of error when list->cssText dies'; cmp_ok $@, '==', &CSS::DOM::Exception::NO_MODIFICATION_ALLOWED_ERR, 'and the right type of error, too (after list->cssText dies)'; $v = new CSS::DOM::Value::List values => [], owner => $s; ok !eval{ $v->cssText('aaa'); 1 }, 'setting cssText on a css value list object with no property dies'; isa_ok $@, 'CSS::DOM::Exception', 'class of error after cssText dies (val list with no prop)'; cmp_ok $@, '==', &CSS::DOM::Exception::NO_MODIFICATION_ALLOWED_ERR, 'error code when cssText dies (val list w/no prop)'; $s->fontFamily('ching'); $v = $s->getPropertyCSSValue('font-family'); $v->cssText('breck, chon'); is $s->fontFamily, 'breck, chon', 'setting the cssText of a value list changes the prop'; is $v->cssText, 'breck, chon', 'setting the cssText of a value list changes the cssText thereof'; $v->[0]->cssText('phrext'); is $v->cssText, 'phrext, chon', 'setting the cssText of a list’s sub-value sets the cssText of the list'; my $called; $s->modification_handler(sub { ++$called }); $s->getPropertyCSSValue('font-family')->cssText('red'); is $called, 1, 'modification_handler is called when a CSS::DOM::Value::List changes'; } CSS-DOM-0.16/t/CSSValueList.t000644 000767 000024 00000001626 11275730222 016125 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use CSS'DOM'Constants ':primitive'; use CSS'DOM'Value'List; use tests 1; # DOES ok +CSS'DOM'Value'List->DOES('CSS::DOM::Value'), 'DOES'; my $v = new CSS'DOM'Value'List values => [ [ type => CSS_STRING, value => 'sphed' ], [ type => CSS_STRING, value => 'flit' ], ]; use tests 3; # item isa_ok $v->item(0), "CSS::DOM::Value::Primitive", "retval of item"; like $v->item(0)->cssText, qr/^(['"])sphed\1\z/, 'which item item(0) returns'; like $v->item(1)->cssText, qr/^(['"])flit\1\z/, 'which item item(1) returns'; use tests 1; # length is $v->length, 2, 'length'; use tests 3; # @{} is @$v, 2, '@{ value list }'; like $v->[0]->cssText, qr/^(['"])sphed\1\z/, 'value list ->[0]'; like $v->[01]->cssText, qr/^(['"])flit\1\z/, 'value list ->[1]'; CSS-DOM-0.16/t/hasFeature.t000644 000767 000024 00000001101 11013734021 015706 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; use Test::More tests => 24; use CSS::DOM; my $o = new CSS::DOM; my $c = 'CSS::DOM'; for (qw/css2 cSs2 stylesheets stYleSHeEts/) { ok!$c->hasFeature($_ => '1.0'), qq'class->hasFeature("$_","1.0")'; ok $c->hasFeature($_ => '2.0'), qq'class->hasFeature("$_","2.0")'; ok $c->hasFeature($_), qq'class->hasFeature("$_")'; ok!$o->hasFeature($_ => '1.0'), qq'\$obj->hasFeature("$_","1.0")'; ok $o->hasFeature($_ => '2.0'), qq'\$obj->hasFeature("$_","2.0")'; ok $o->hasFeature($_), qq'\$obj->hasFeature("$_")'; } CSS-DOM-0.16/t/MediaList.t000644 000767 000024 00000002745 11013733324 015516 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use tests 1; # use use_ok 'CSS::DOM::MediaList'; use tests 2; # constructor isa_ok +(my $ml = new CSS::DOM::MediaList 'print', 'screen'), 'CSS::DOM::MediaList'; is_deeply [@$ml], ['print' ,'screen'], 'constructor args'; use tests 3; # mediaText is mediaText $ml, 'print, screen', 'initial value of mediaText'; is +(mediaText $ml " \nscReen (big one),\xa0hologram-101 "), 'print, screen', 'ret val of mediaText with args'; is_deeply [@$ml], ['scReen', 'hologram-101'], 'result of setting mediaText'; use tests 1; # length is $ml->length, 2, 'length'; use tests 1; # item is +(item $ml 1), 'hologram-101', 'item'; use tests 4; # deleteMedium is +()=$ml->deleteMedium('hologram-101'), 0, 'ret val of deleteMedium'; is_deeply [@$ml], ['scReen'], 'effect of deleteMedium'; eval { deleteMedium $ml 'foo' }; isa_ok $@, 'CSS::DOM::Exception', '$@ (after deleteMedium)'; cmp_ok $@, '==', &CSS::DOM::Exception::NOT_FOUND_ERR, 'deleteMedium throws a "not found" error'; use tests 3; # appendMedium @$ml = qw[ foo bar baz ]; is +()=$ml->appendMedium('bop'), 0, 'ret val of appendMedium'; is_deeply [@$ml], [qw [ foo bar baz bop ]], 'effect thereof'; $ml->appendMedium('bar'); is_deeply [@$ml], [qw[ foo baz bop bar ]], 'appendMedium deletes the item first'; # What do you call a psychic midget escaped from prison? # A small medium at large. CSS-DOM-0.16/t/parser-rules.t000644 000767 000024 00000074530 11062124464 016273 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T # Note: The serialisation tests in the script are not strictly normative. # If the implementation changes, they can be tweaked. The point is to make # sure that the parser provides the rule object with all the info it needs, # without omitting anything. use strict; use warnings; no warnings qw 'utf8 parenthesis'; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use utf8; use CSS::DOM; use CSS::DOM::Rule ':all'; use CSS::DOM::Style; use tests 2; # miscellaneous CSS::DOM::parse stuff { # not sure if it belongs in this test script my $x; styleSheet $_ # styleSheet triggers the url fetch for CSS::DOM::parse '@import ""; @import ""', url_fetcher => sub{++$x;''} =>-> cssRules; is $x, 2, 'parser passes args to new CSS::DOM'; $x = 0; local $SIG{__WARN__} = sub { ++ $x; }; CSS::DOM::parse(''); is $x, 0, 'empty stylesheet doesn\'t cause warnings'; } use tests 7; # { my $sheet = CSS'DOM'parse ' /* /**/ @at-rule {/* { style/*-->*/: rule } --> '; CSS'DOM'parse 'a { --> }'; ok $@, 'invalid -->'; CSS'DOM'parse 'a { a { }');1}, 'invalid --> before statement'; ok !eval{$sheet->insertRule('');1}, 'invalid --> after statement'; ok !eval{$sheet->insertRule('a { } { my $sheet = CSS'DOM'parse ' @media print{}'; is join('',map cssText$_,cssRules$sheet), "{ name: value }\n\@media print {\n}\n", 'ignored '; is CSS'DOM'parse"{}{name: value; n:v}" =>-> cssRules->length, 1, 'invalid -->'; ok $@, '$@ after invalid -->'; is CSS'DOM'Style'parse"name:'",->name, "''", ' in a string'; } use tests 1; # miscellaneous tokens { my $sheet = CSS'DOM'parse '@foo ()[~=:,./+-]{[("\"'; is $sheet->cssRules->[0]->cssText, '@foo ()[~=:,./+-]{[("\"")]}'. "\n", 'miscellaneous tokens' } CSS-DOM-0.16/t/property-parser.t000644 000767 000024 00000125760 12040027030 017013 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -Tw use strict; use warnings; no warnings qw 'utf8 parenthesis regexp once qw'; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; # --------------- Object API ---------------- # use tests 1; # use use_ok 'CSS::DOM::PropertyParser'; use tests 1; # constructor isa_ok my $parser = CSS::DOM::PropertyParser->new, 'CSS::DOM::PropertyParser'; use tests 4; # clone my $clone = (my $css21 = $CSS::DOM::PropertyParser::CSS21)->clone; isn't $clone, $css21, 'clone at the first level'; isn't $clone->get_property('background-position'), $css21->get_property('background-position'), 'clone clones individual property specs'; isn't $clone->get_property('border-color')->{properties} {'border-top-color'}, $css21->get_property('border-color')->{properties} {'border-top-color'}, 'clone clones deeply'; is_deeply $clone->get_property('border-color')->{properties} {'border-top-color'}, $css21->get_property('border-color')->{properties} {'border-top-color'}, 'the values within the clone are still identical'; use tests 3; # add/get/delete_property $parser->add_property("foo", my $prop = {}); is $parser->get_property("foo"), $prop, 'add/get_property'; is $parser->delete_property("foo"), $prop, 'delete_property retval'; is $parser->get_property("foo"), undef, 'effect of delete_property'; use tests 1; # property_names $parser->add_property($_,{}) for reverse "a".."f"; is_deeply [$parser->property_names], ["a".."f"], 'property_names'; # ------------------------- CSS::DOM::Style ------------------------ # require CSS::DOM::Style; use tests 2; # invalid properties in parsing my $s = CSS::DOM::Style::parse( 'azimuth: 0; azimuth: blue', property_parser => $css21 ); is $s->azimuth, '0', 'invalid property values are ignored in parsing (CSS::DOM::Style::parse)'; $s->cssText(''); $s->cssText('azimuth: 0; azimuth: blue'), is $s->azimuth, 0, 'style->cssText ignores invalid values'; # ------------------------- CSS 2.1 tests ------------------------ # use tests 28; # azimuth for(qw/ left-side far-left left center-left center center-right right far-right right-insidE behInd leftwards rightwards 0 0deg 80deg 60rad 38grad -0 +0 -80deg +80deg inherit /, 'left behind', 'behind center') { $s->azimuth($_); like $s->azimuth, qr/^\Q$_\E\z/i, "azimuth value: \L$_" } $s->azimuth('left'); for(qw/ 38 38cm upwards /, "center leftwards") { $s->azimuth($_); is $s->azimuth, 'left', "invalid azimuth value: $_"; } use tests 3; # background-attachment for(qw/ scroll fixed /) { $s->backgroundAttachment($_); is $s->backgroundAttachment, $_, "background-attachment value: \L$_" } $s->backgroundAttachment('38'); is $s->backgroundAttachment, 'fixed', "invalid bg-attachment value: 38"; use tests 197; # background-color for(qw/ #abc #abcdef rgb(1,2,3) rgb(1%,2%,3%) rgba(1,2,3,4) rgba(1%,2%,3%,4) transparent Aliceblue antiquewhitE aqua aquamarine azure beige bisque black blanchedalmond blue blueviolet brown burlywood cadetblue chartreuse chocolate coral cornflowerblue cornsilk crimson cyan darkblue darkcyan darkgoldenrod darkgray darkgreen darkgrey darkkhaki darkmagenta darkolivegreen darkorange darkorchid darkred darksalmon darkseagreen darkslateblue darkslategray darkslategrey darkturquoise darkviolet deeppink deepskyblue dimgray dimgrey dodgerblue firebrick floralwhite forestgreen fuchsia gainsboro ghostwhite gold goldenrod gray green greenyellow grey honeydew hotpink indianred indigo ivory khaki lavender lavenderblush lawngreen lemonchiffon lightblue lightcoral lightcyan lightgoldenrodyellow lightgray lightgreen lightgrey lightpink lightsalmon lightseagreen lightskyblue lightslategray lightslategrey lightsteelblue lightyellow lime limegreen linen magenta maroon mediumaquamarine mediumblue mediumorchid mediumpurple mediumseagreen mediumslateblue mediumspringgreen mediumturquoise mediumvioletred midnightblue mintcream mistyrose moccasin navajowhite navy oldlace olive olivedrab orange orangered orchid palegoldenrod palegreen paleturquoise palevioletred papayawhip peachpuff peru pink plum powderblue purple red rosybrown royalblue saddlebrown salmon sandybrown seagreen seashell sienna silver skyblue slateblue slategray slategrey snow springgreen steelblue tan teal thistle tomato turquoise violet wheat white whitesmoke yellow yellowgreen activeborder activecaption appworkspace background buttonface buttonhighlight buttonshadow buttontext captiontext graytext highlight highlighttext inactiveborder inactivecaption incativecaptiontext infobackground infotext menu menutext scrollbar threeddarkshadow threedface threedhighlight threedlightshadow threedshadow window windowframe windowtext rgb(-5%,-6%,-7%) rgb(+5%,+6%,+7%) rgb(-5,-6,-7) rgb(+5,+6,+7) rgba(-5%,-6%,-0%,-1) rgba(+5%,+6%,+7%,+5) rgba(-5,-6,-0,-1) rgba(+5,+6,+7,+5)/) { $s->backgroundColor($_); my $__ = $s->backgroundColor; for($__) { s/ //g if /,/; } is $__, $_, "background-color value: \L$_" } $s->backgroundColor('white'); for(qw/ #1234 #defghi rgb(1%,2,3) rgb(1,2,3,4) rgba(1%,2,3,4) rgba(1,2%,3%,4) SaladDressing /) { $s->backgroundColor($_); my $__ = $s->backgroundColor; for($__) { s/ //g if /,/; } is $__, 'white', "invalid bg-color value: $_"; } use tests 3; # background-image for(qw/ none url(foo) /) { $s->backgroundImage($_); is $s->backgroundImage, $_, "background-image value: \L$_" } $s->backgroundImage('38'); is $s->backgroundImage, 'url(foo)', "invalid bg-image value: 38"; use tests 57; # background-position for('5%','-5%','+5%', '5% 5%', '5% 5px', '5% top', '5% bottom','5% center', '5% bottom', '5em', '5ex', '5px', '5in', '5cm', '5mm', '5pt', '5pc', 0, '-5px','-0','+0','+5px','5px 5%', '5px 5px', '5px top', '5px center', '5px bottom','left','left 5%','left 5px','left top','left center', 'left bottom','center','center 5%','center 5px','center top', 'center center','center bottom','right','right 5%','right 5px', 'right top','right center','right bottom','top','top left', 'top center','top right','center left','center right','bottom', 'bottom left', 'bottom center', 'bottom right') { $s->backgroundPosition($_); is $s->backgroundPosition, $_, "background-position value: \L$_" } $s->backgroundPosition('left'); for("top bottom", "5% 5") { $s->backgroundPosition($_); is $s->backgroundPosition, 'left', "invalid bg-position value: $_"; } use tests 6; # background-repeat for(qw 'repeat repeat-x repeat-y no-repeat') { $s->backgroundRepeat($_); is $s-> backgroundRepeat, $_, "background-repeat value: \L$_" } $s-> backgroundRepeat('no-repeat'); for(qw "top 5") { $s-> backgroundRepeat($_); is $s-> backgroundRepeat, 'no-repeat', "invalid bg-repeat value: $_"; } use tests 23; # background { my $props = sub { return join ",", map $s->getPropertyValue("background-$_"), qw(color image repeat attachment position) }; $s->background('white'); is $s->background, 'white', 'background: colour'; is &$props, 'white,none,repeat,scroll,0% 0%', 'other sub-properties after setting background to colour'; is # bug fixed in 0.09, that only occurred in 5.10.0 [RT #54809] $s->getPropertyCSSValue('background-color')->cssValueType, 1, # CSS_PRIMITIVE_VALUE 'value types of named subprops of shorthand props after sh. assignment'; $s->background('url(foo)'); is $s->background, 'url(foo)', 'background: url'; is &$props, 'transparent,url(foo),repeat,scroll,0% 0%', 'other sub-properties after setting background to url'; $s->background('no-repeat'); is $s->background, 'no-repeat', 'background: repeat'; is &$props, 'transparent,none,no-repeat,scroll,0% 0%', 'other sub-properties after setting background to repeat'; $s->background('fixed'); is $s->background, 'fixed', 'background: attachment'; is &$props, 'transparent,none,repeat,fixed,0% 0%', 'other sub-properties after setting background to attachment'; $s->background('top'); is $s->background, 'top', 'background: position (single keyword)'; is &$props, 'transparent,none,repeat,scroll,top', 'other sub-properties after setting background to position (single)'; $s->background('top left'); is $s->background, 'top left', 'background: position (two words)'; is &$props, 'transparent,none,repeat,scroll,top left', 'other sub-properties after setting background to position'; $s->background('red url("foo") no-repeat center center fixed'); is $s->background, 'red url("foo") no-repeat fixed center center', 'background with five values'; is &$props, 'red,url("foo"),no-repeat,fixed,center center', 'bg subprops after setting all at once'; $s->background('bottom scroll repeat-y none #00f'); is $s->background, '#00f repeat-y bottom', 'background with five values in reverse order'; is &$props, '#00f,none,repeat-y,scroll,bottom', 'bg subprops after setting backwards'; $s->background(''); is $s->background, '', 'setting background to nothing ...'; is &$props, ',,,,', ' ... resets all its sub-properties'; $s->background('blue'); $s->backgroundAttachment(""); is $s->background, '', 'background is blank if not all sub-properties are specified'; $s->background('transparent none repeat scroll 0% 0%'); is $s->background, 'none', 'background is none when all sub-properties are set to initial values'; } $s->background('red'); $s->background("top red left"); is $s->background, 'red', "invalid background value: top red left"; $s->background("0"); is $s->background, "0", 'setting background to 0'; use tests 3; # border-collapse for(qw 'collapse separate') { $s->borderCollapse($_); is $s->borderCollapse, $_, "border-collapse value: \L$_" } $s->borderCollapse('collapse'); $s->borderCollapse('no-repeat'); is $s->borderCollapse, 'collapse', "invalid border-claps val: no-repeat"; use tests 15; # border-color { my $props = sub { return join ",", map $s->getPropertyValue("border-$_-color"), qw(top right bottom left) }; $s->borderColor('red'); is $s->borderColor, 'red', 'setting border-color to one value'; is &$props, 'red,red,red,red', 'result of setting border-color to one value'; $s->borderColor('red green'); is $s->borderColor, 'red green', 'setting border-color to two values'; is &$props, 'red,green,red,green', 'result of setting border-color to two values'; $s->borderColor('red green blue'); is $s->borderColor, 'red green blue', 'setting border-color to three values'; is &$props, 'red,green,blue,green', 'result of setting border-color to three values'; $s->borderColor('red green blue #f0f'); is $s->borderColor, 'red green blue #f0f', 'setting border-color to fourvalues'; is &$props, 'red,green,blue,#f0f', 'result of setting border-color to four values'; $s->borderColor('red red blue #f0f'); is $s->borderColor, 'red red blue #f0f', 'setting border-color to four values, the 1st 2 the same'; is &$props, 'red,red,blue,#f0f', 'result of setting border-color to four values, the 1st 2 the same'; $s->borderColor('rgb(255, 0, 0) rgb(0, 255, 0) rgb(0, 0, 255) rgb(0, 0, 0)'); is $s->borderColor, 'rgb(255, 0, 0) rgb(0, 255, 0) rgb(0, 0, 255) rgb(0, 0, 0)', # bug in 0.08 (fixed in 0.09) 'setting border-color to four rgb() values'; # that only affected # cygwin perl $s->borderColor(''); is $s->borderColor, '', 'setting border-color to nothing ...'; is &$props, ',,,', ' ... resets all its sub-properties'; $s->borderColor('blue'); $s->borderTopColor(""); is $s->borderColor, '', 'borderColor is blank if not all sub-properties are specified'; } $s->borderColor('red'); $s->borderColor("poiple"); is $s->borderColor, 'red', "invalid border-color value"; use tests 4; # border-spacing for(0, '0cm', '5cm 4em') { $s->borderSpacing($_); is $s->borderSpacing, $_, "border-spacing value: \L$_" } $s->borderSpacing('0'); $s->borderSpacing('1'); is $s->borderSpacing, '0', "invalid border-spacing val"; use tests 29; # border-style { my $props = sub { return join ",", map $s->getPropertyValue("border-$_-style"), qw(top right bottom left) }; $s->borderStyle('none'); is $s->borderStyle, 'none', 'setting border-style to one value'; is &$props, 'none,none,none,none', 'result of setting border-style to one value'; $s->borderStyle('hidden none'); is $s->borderStyle, 'hidden none', 'setting border-style to two values'; is &$props, 'hidden,none,hidden,none', 'result of setting border-style to two values'; $s->borderStyle('dotted hidden none'); is $s->borderStyle, 'dotted hidden none', 'setting border-style to three values'; is &$props, 'dotted,hidden,none,hidden', 'result of setting border-style to three values'; $s->borderStyle('dashed dotted hidden none'); is $s->borderStyle, 'dashed dotted hidden none', 'setting border-style to four values: dashed dotted hidden none'; is &$props, 'dashed,dotted,hidden,none', 'result of setting border-style to dashed dotted hidden none'; $s->borderStyle('solid dashed dotted hidden'); is $s->borderStyle, 'solid dashed dotted hidden', 'setting border-style to four values: solid dashed dotted hidden'; is &$props, 'solid,dashed,dotted,hidden', 'result of setting border-style to solid dashed dotted hidden'; $s->borderStyle('double solid dashed dotted'); is $s->borderStyle, 'double solid dashed dotted', 'setting border-style to four values: double solid dashed dotted'; is &$props, 'double,solid,dashed,dotted', 'result of setting border-style to double solid dashed dotted'; $s->borderStyle('groove double solid dashed'); is $s->borderStyle, 'groove double solid dashed', 'setting border-style to four values: groove double solid dashed'; is &$props, 'groove,double,solid,dashed', 'result of setting border-style to groove double solid dashed'; $s->borderStyle('ridge groove double solid'); is $s->borderStyle, 'ridge groove double solid', 'setting border-style to four values: ridge groove double solid'; is &$props, 'ridge,groove,double,solid', 'result of setting border-style to ridge groove double solid'; $s->borderStyle('inset ridge groove double'); is $s->borderStyle, 'inset ridge groove double', 'setting border-style to four values: inset ridge groove double'; is &$props, 'inset,ridge,groove,double', 'result of setting border-style to inset ridge groove double'; $s->borderStyle('outset inset ridge groove'); is $s->borderStyle, 'outset inset ridge groove', 'setting border-style to four values: outset inset ridge groove'; is &$props, 'outset,inset,ridge,groove', 'result of setting border-style to outset inset ridge groove'; $s->borderStyle('none outset inset ridge'); is $s->borderStyle, 'none outset inset ridge', 'setting border-style to four values: none outset inset ridge'; is &$props, 'none,outset,inset,ridge', 'result of setting border-style to none outset inset ridge'; $s->borderStyle('none none outset inset'); is $s->borderStyle, 'none none outset inset', 'setting border-style to four values: none none outset inset'; is &$props, 'none,none,outset,inset', 'result of setting border-style to none none outset inset'; $s->borderStyle('none none none outset'); is $s->borderStyle, 'none none none outset', 'setting border-style to four values: none none none outset'; is &$props, 'none,none,none,outset', 'result of setting border-style to none none none outset'; $s->borderStyle(''); is $s->borderStyle, '', 'setting border-style to nothing ...'; is &$props, ',,,', ' ... resets all its sub-properties'; $s->borderStyle('inset'); $s->borderTopStyle(""); is $s->borderStyle, '', 'border-style is blank if not all sub-properties are specified'; } use tests 40; # border-top/left/right/bottom for my $side(qw/ top right left bottom /) { my $meth = "border\u$side"; my $prop = "border-$side"; my $props = sub { return join ",", map $s->getPropertyValue("$prop-$_"), qw(width style color) }; $s->$meth('white'); is $s->$meth, 'white', "$prop: colour"; is &$props, 'medium,none,white', "other sub-properties after setting $prop to colour"; $s->$meth('inset'); is $s->$meth, '', "$prop: style"; is &$props, 'medium,inset,', "other sub-properties after setting $prop to style"; $s->$meth('thick'); is $s->$meth, '', "$prop: weight"; is &$props, 'thick,none,', "other sub-properties after setting $prop to a style value"; $s->$meth('solid 1px red'); is $s->$meth, '1px solid red', "$prop with three values"; is &$props, '1px,solid,red', "$prop subprops after setting all at once"; $s->$meth(''); is $s->$meth, '', "setting $prop to nothing ..."; is &$props, ',,', " ... resets all its sub-properties"; } use tests 8; # border-*-color for(qw/ top right bottom left /) { my $meth = "border\u${_}Color"; $s->$meth('green'); is $s->$meth, 'green', "border-$_-color"; $s->$meth('bloo'); is $s->$meth, 'green', "border-$_-color with invalid value"; } use tests 40; # border-*-style for(qw/ top right bottom left/) { my $meth = "border\u${_}Style"; my $prop = "border-$_-style"; for(qw/none hidden dotted dashed solid double groove ridge inset outset/){ $s->$meth($_); is $s->$meth, $_, "setting $prop to $_"; } } use tests 16; # border-*-width for(qw/ top right bottom left/) { my $meth = "border\u${_}Width"; my $prop = "border-$_-width"; for(qw/5em thin thick medium/){ $s->$meth($_); is $s->$meth, $_, "setting $prop to $_"; } } use tests 19; # border-width { my $props = sub { return join ",", map $s->getPropertyValue("border-$_-width"), qw(top right bottom left) }; $s->borderWidth('4em'); is $s->borderWidth, '4em', 'setting border-width to one value'; is &$props, '4em,4em,4em,4em', 'result of setting border-width to one value'; $s->borderWidth('thin 5em'); is $s->borderWidth, 'thin 5em', 'setting border-width to two values'; is &$props, 'thin,5em,thin,5em', 'result of setting border-width to two values'; $s->borderWidth('thick thin 5em'); is $s->borderWidth, 'thick thin 5em', 'setting border-width to three values'; is &$props, 'thick,thin,5em,thin', 'result of setting border-width to three values'; $s->borderWidth('medium thick thin 5em'); is $s->borderWidth, 'medium thick thin 5em', 'setting border-width to four values: medium thick thin 5em'; is &$props, 'medium,thick,thin,5em', 'result of setting border-width to medium thick thin 5em'; $s->borderWidth('0 medium thick thin'); is $s->borderWidth, '0 medium thick thin', 'setting border-width to four values: 0 medium thick thin'; is &$props, '0,medium,thick,thin', 'result of setting border-width to 0 medium thick thin'; $s->borderWidth('1px 0 medium thick'); is $s->borderWidth, '1px 0 medium thick', 'setting border-width to four values: 1px 0 medium thick'; is &$props, '1px,0,medium,thick', 'result of setting border-width to 1px 0 medium thick'; $s->borderWidth('2in 1px 0 medium'); is $s->borderWidth, '2in 1px 0 medium', 'setting border-width to four values: 2in 1px 0 medium'; is &$props, '2in,1px,0,medium', 'result of setting border-width to 2in 1px 0 medium'; $s->borderWidth('0 0 0 5px'); is $s->borderWidth, '0 0 0 5px', 'setting border-width to four values: 0 0 0 5px'; is &$props, '0,0,0,5px', 'result of setting border-width to 0 0 0 5px'; $s->borderWidth(''); is $s->borderWidth, '', 'setting border-width to nothing ...'; is &$props, ',,,', ' ... resets all its sub-properties'; $s->borderWidth('medium'); $s->borderTopWidth(""); is $s->borderWidth, '', 'border-width is blank if not all sub-properties are specified'; } use tests 23; # border { my $props = sub { return join ",", map $s->getPropertyValue("border-$_"), map +("top-$_", "left-$_", "right-$_", "bottom-$_"), qw(width style color) }; $s->border('white'); is $s->border, 'white', "border: colour"; is &$props, 'medium,'x4 .'none,none,none,none,white,white,white,white', "other sub-properties after setting border to a colour"; for(qw( none hidden dotted dashed solid double groove ridge inset outset)) { $s->border("$_"); is &$props, 'medium,'x4 ."$_,"x4 .',,,', "setting border to $_"; } for(qw( thin thick medium 5px)) { $s->border("$_"); is &$props, "$_,"x4 ."none,"x4 .',,,', "setting border to $_"; } $s->border('solid 1px red'); is $s->border, '1px solid red', "border with three values"; is &$props, '1px,'x4 .'solid,'x4 .'red,red,red,red', "border subprops after setting all at once"; $s->borderTopColor('green'); is $s->border, '', 'border is blank when not all colour values are equal'; $s->border('solid 1px red'); $s->borderRightStyle('inset'); is $s->border, '', 'border is blank when not all style values are equal'; $s->border('solid 1px red'); $s->borderBottomWidth('2px'); is $s->border, '', 'border is blank when not all width values are equal'; $s->border(''); is $s->border, '', "setting border to nothing ..."; is &$props, ',,,,,,,,,,,', " ... resets all its sub-properties"; } use tests 3; # bottom for(qw( 5em 5% auto )) { $s->bottom($_); is $s->bottom, $_, "bottom value: \L$_" } use tests 2; # caption-side for(qw( top bottom )) { $s->captionSide($_); is $s->captionSide, $_, "caption-side value: \L$_" } use tests 4; # clear for(qw( none left right both )) { $s->clear($_); is $s->clear, $_, "clear value: \L$_" } use tests 3; # clip for('rect(0 auto 5px -7em)', 'rect(0, auto, 5px, -7em)', 'auto') { $s->clip($_); is $s->clip, $_, "clip value: \L$_" } use tests 2; # color for('black', 'rgb(0, 0, 0)') { $s->color($_); is $s->color, $_, "color value: \L$_" } use tests 19; # content for(qw/ normal none open-quote close-quote no-open-quote no-close-quote "foo" 'bar' url(foo) counter(foo)/, 'counter(foo, disc)', 'counters(foo, "bar")', 'counters(foo, "bar", circle)', 'attr(bexieiehehtett)', 'normal none', 'none open-quote close-quote', 'open-quote close-quote no-open-quote no-close-quote', 'close-quote no-open-quote no-close-quote "strine" url(url)', "no-open-quote no-close-quote 'oetd' url(eeudon\\)) counter(udux)" ." attr(x)", ) { $s->content($_); is $s->content, $_, "content value: \L$_" } use tests 10; # counter-increment and -reset for my $prop('increment','reset') { my $meth = "counter\u$prop"; for('tahi', 'rua toru', 'wha 4 rima 5', 'ono whitu 7', 'waru 8 iwa 9', ) { $s->$meth($_); is $s->$meth, $_, "counter-$prop value: \L$_" } } use tests 4; # cue-after and -before for my $prop('after','before') { my $meth = "cue\u$prop"; for(qw/ none url(foo) /) { $s->$meth($_); is $s->$meth, $_, "cue-$prop value: \L$_" } } use tests 9; # cue { my $props = sub { return join ",", map $s->getPropertyValue("cue-$_"), qw(before after) }; $s->cue('url(po)'); is $s->cue, 'url(po)', 'setting cue to one value'; is &$props, 'url(po),url(po)', 'result of setting cue to one value'; $s->cue('none url(sto)'); is $s->cue, 'none url(sto)', 'setting cue to two values'; is &$props, 'none,url(sto)', 'result of setting cue to two values'; $s->cue('none none'); is $s->cue, 'none', 'setting cue to none none'; is &$props, 'none,none', 'result of setting cue to none none'; $s->cue(''); is $s->cue, '', 'setting cue to nothing ...'; is &$props, ',', ' ... resets all its sub-properties'; $s->cue('none'); $s->cueAfter(""); is $s->cue, '', 'cue is blank if not all sub-properties are specified'; } use tests 17; # cursor for('url(lous), auto', 'url(os), crosshair', 'url(exe), default', 'url(eelthe), pointer', 'url(oit), move', 'url(ou), e-resize', 'url(ampe), ne-resize', 'url(lon), nw-resize', 'url(ose), n-resize', 'url(rgat), se-resize', 'url(aike), sw-resize', 'url(ryx), s-resize', 'url(ate), w-resize', 'url(tonte), text', 'url(san), wait', 'url(ast), help', 'url(264), url(ech), progress', ) { $s->cursor($_); is $s->cursor, $_, "cursor value: \L$_" } use tests 2; # direction for(qw/ ltr rtl /) { $s->direction($_); is $s->direction, $_, "direction value: \L$_" } use tests 16; # display for(qw/ inline block list-item run-in inline-block table inline-table table-row-group table-header-group table-footer-group table-row table-column-group table-column table-cell table-caption none /) { $s->display($_); is $s->display, $_, "display value: \L$_" } use tests 6; # elevation for(qw/ 70deg below level above higher lower /) { $s->elevation($_); is $s->elevation, $_, "elevation value: \L$_" } use tests 2; # empty-cells for(qw/ show hide /) { $s->emptyCells($_); is $s->emptyCells, $_, "empty-cells value: \L$_" } use tests 3; # float for(qw/ left right none /) { $s->float($_); is $s->float, $_, "float value: \L$_" } use tests 10; # font-family for(qw/ serif sans-serif cursive fantasy monospace "Times" Times /, 'Lucida Grande', 'serif, sans-serif, Lucida Grande', 'Lucida Grande, Times, fantasy', ) { $s->fontFamily($_); is $s->fontFamily, $_, "font-family value: \L$_" } use tests 11; # font-size for(qw/ xx-small x-small small medium large x-large xx-large larger smaller 5px 5% /) { $s->fontSize($_); is $s->fontSize, $_, "font-size value: \L$_" } use tests 2; # font-variant for(qw/ normal small-caps /) { $s->fontVariant($_); is $s->fontVariant, $_, "font-variant value: \L$_" } use tests 13; # font-weight for(qw/ normal bold bolder lighter 100 200 300 400 500 600 700 800 900 /) { $s->fontWeight($_); is $s->fontWeight, $_, "font-weight value: \L$_" } use tests 25; # font { my $props = sub { return join ",", map $s->getPropertyValue($_), qw( font-style font-variant font-weight font-size line-height font-family ) }; $s->font('13px my font'); is $s->font, '13px my font', "font: size typeface"; is &$props, 'normal,normal,normal,13px,normal,my font', "other sub-properties after setting font to size/typeface"; $s->font('italic medium medium'); is $s->font, 'italic medium medium', "font: style size typeface"; is &$props, 'italic,normal,normal,medium,normal,medium', "other sub-properties after setting font to style/size/typeface"; $s->font('small-caps medium "quoted font"'); is $s->font, 'small-caps medium "quoted font"', "font: variant size typeface"; is &$props, 'normal,small-caps,normal,medium,normal,"quoted font"', "other sub-properties after setting font to variant/size/typeface"; $s->font('100 medium foo'); is $s->font, '100 medium foo', "font: weight size typeface"; is &$props, 'normal,normal,100,medium,normal,foo', "other sub-properties after setting font to weight/size/typeface"; $s->font('medium/13px foo'); is $s->font, 'medium/13px foo', "font: size/leading typeface"; is &$props, 'normal,normal,normal,medium,13px,foo', "other sub-properties after setting font to size/leading/typeface"; $s->font('normal bold italic 0 foo'); is $s->font, 'italic bold 0 foo', "font with first three sub-props out of order and normal variant"; is &$props, 'italic,normal,bold,0,normal,foo', "result of setting font with normal variant & props out of order"; $s->font('small-caps normal 0 foo'); is $s->font, 'small-caps 0 foo', "font with first 2/3 sub-props & explicit variant (normal applies to 2)"; is &$props, 'normal,small-caps,normal,0,normal,foo', "result of setting font with small-caps normal"; $s->font('bold italic small-caps 0/5px Times, serif'); is $s->font, 'italic small-caps bold 0/5px Times, serif', "font with all sub props and comma in typeface"; is &$props, 'italic,small-caps,bold,0,5px,Times, serif', "result of setting font with all sub-props"; $s->font('caption'); is &$props, 'normal,normal,normal,13px,normal,Lucida Grande, sans-serif', "sub-props after setting font to caption"; $s->font('');$s->font('icon'); is &$props, 'normal,normal,normal,13px,normal,Lucida Grande, sans-serif', "sub-props after setting font to icon"; $s->font('');$s->font('menu'); is &$props, 'normal,normal,normal,13px,normal,Lucida Grande, sans-serif', "sub-props after setting font to menu"; $s->font('');$s->font('message-box'); is &$props, 'normal,normal,normal,13px,normal,Lucida Grande, sans-serif', "sub-props after setting font to message-box"; $s->font('');$s->font('small-caption'); is &$props, 'normal,normal,normal,11px,normal,Lucida Grande, sans-serif', "sub-props after setting font to small-caption"; $s->font('');$s->font('status-bar'); is &$props, 'normal,normal,normal,10px,normal,Lucida Grande, sans-serif', "sub-props after setting font to status-bar"; $s->lineHeight(''); is $s->font, '', 'font is blank when not all sub-props are specified'; $s->font(''); is $s->font, '', "setting font to nothing ..."; is &$props, ',,,,,', " ... resets all its sub-properties"; } use tests 3; # height for(qw( 5em 5% auto )) { $s->height($_); is $s->height, $_, "height value: \L$_" } use tests 3; # left for(qw( 5em 5% auto )) { $s->left($_); is $s->left, $_, "left value: \L$_" } use tests 2; # letter-spacing for(qw( 5em normal )) { $s->letterSpacing($_); is $s->letterSpacing, $_, "letter-spacing value: \L$_" } use tests 4; # line-height for(qw( 5em 5% 5 normal )) { $s->lineHeight($_); is $s->lineHeight, $_, "line-height value: \L$_" } use tests 2; # list-style-image for(qw/ none url(foo) /) { $s->listStyleImage($_); is $s->listStyleImage, $_, "list-style-image value: \L$_" } use tests 2; # list-style-position for(qw/ inside outside /) { $s->listStylePosition($_); is $s->listStylePosition, $_, "list-style-position value: \L$_" } use tests 14; # list-style-type for(qw/ disc circle square decimal decimal-leading-zero lower-roman upper-roman lower-greek lower-latin upper-latin armenian georgian lower-alpha upper-alpha /) { $s->listStyleType($_); is $s->listStyleType, $_, "list-style-type value: \L$_" } use tests 11; # list-style { my $props = sub { return join ",", map $s->getPropertyValue("list-style-$_"), qw(type position image) }; $s->listStyle('circle'); is $s->listStyle, 'circle', "list-style: type"; is &$props, 'circle,outside,none', "other sub-properties after setting list-style to type"; $s->listStyle('inside'); is $s->listStyle, 'inside', "list-style: position"; is &$props, 'disc,inside,none', "other sub-properties after setting list-style to position"; $s->listStyle('url(foo)'); is $s->listStyle, 'url(foo)', "list-style: image"; is &$props, 'disc,outside,url(foo)', "other sub-properties after setting list-style to an image url"; $s->listStyle('inside url(oo) square'); is $s->listStyle, 'square inside url(oo)', "list-style with three values"; is &$props, 'square,inside,url(oo)', "list-style subprops after setting all at once"; $s->listStyleType(''); is $s->listStyle, '', 'list-style is blank if not all sub-props are set'; $s->listStyle(''); is $s->listStyle, '', "setting list-style to nothing ..."; is &$props, ',,', " ... resets all its sub-properties"; } use tests 12; # margin-* for(qw/ top right bottom left/) { my $meth = "margin\u${_}"; my $prop = "margin-$_"; for(qw/5em 5% auto/){ $s->$meth($_); is $s->$meth, $_, "setting $prop to $_"; } } use tests 15; # margin { my $props = sub { return join ",", map $s->getPropertyValue("margin-$_"), qw(top right bottom left) }; $s->margin('4em'); is $s->margin, '4em', 'setting margin to one value'; is &$props, '4em,4em,4em,4em', 'result of setting margin to one value'; $s->margin('5% 5em'); is $s->margin, '5% 5em', 'setting margin to two values'; is &$props, '5%,5em,5%,5em', 'result of setting margin to two values'; $s->margin('auto 5% 5em'); is $s->margin, 'auto 5% 5em', 'setting margin to three values'; is &$props, 'auto,5%,5em,5%', 'result of setting margin to three values'; $s->margin('6em auto 5% 5em'); is $s->margin, '6em auto 5% 5em', 'setting margin to four values: 6em auto 5% 5em'; is &$props, '6em,auto,5%,5em', 'result of setting margin to 6em auto 5% 5em'; $s->margin('6% 6em auto 5%'); is $s->margin, '6% 6em auto 5%', 'setting margin to four values: 6% 6em auto 5%'; is &$props, '6%,6em,auto,5%', 'result of setting margin to 6% 6em auto 5%'; $s->margin('auto 6% 6em auto'); is $s->margin, 'auto 6% 6em auto', 'setting margin to four values: auto 6% 6em auto'; is &$props, 'auto,6%,6em,auto', 'result of setting margin to auto 6% 6em auto'; $s->margin(''); is $s->margin, '', 'setting margin to nothing ...'; is &$props, ',,,', ' ... resets all its sub-properties'; $s->margin('medium'); $s->marginTop(""); is $s->margin, '', 'margin is blank if not all sub-properties are specified'; } use tests 12; # min/max-width/height for my $prop (qw/ max-height max-width min-height min-width /) { (my $meth = $prop) =~ s/-(.)/\u$1/g; for(qw/5em 5% none/){ $s->$meth($_); is $s->$meth, $_, "setting $prop to $_"; } } use tests 1; # orphans $s->orphans(5); is $s->orphans, 5, "orphans"; use tests 2; # outline-color for(qw/green invert/){ $s->outlineColor($_); is $s->outlineColor, $_, "setting outline-color to $_"; } use tests 10; # outline-style for(qw/ none hidden dotted dashed solid double groove ridge inset outset/){ $s->outlineStyle($_); is $s->outlineStyle, $_, "setting outline-style to $_"; } use tests 4; # outline-width for(qw/ 3px thin thick medium /){ $s->outlineWidth($_); is $s->outlineWidth, $_, "setting outline-width to $_"; } use tests 11; # outline { my $props = sub { return join ",", map $s->getPropertyValue("outline-$_"), qw(color style width) }; $s->outline('thick'); is $s->outline, 'thick', "outline: weight"; is &$props, 'invert,none,thick', "other sub-properties after setting outline to weight"; $s->outline('inset'); is $s->outline, 'inset', "outline: style"; is &$props, 'invert,inset,medium', "other sub-properties after setting outline to style"; $s->outline('white'); is $s->outline, 'white', "outline: colour"; is &$props, 'white,none,medium', "other sub-properties after setting outline to a colour"; $s->outline('solid red 1px'); is $s->outline, 'red solid 1px', "outline with three values"; is &$props, 'red,solid,1px', "outline subprops after setting all at once"; $s->outlineWidth(''); is $s->outline,'', 'outline is blank if not all sub-props are set'; $s->outline(''); is $s->outline, '', "setting outline to nothing ..."; is &$props, ',,', " ... resets all its sub-properties"; } use tests 4; # overflow for(qw/ visible hidden scroll auto /){ $s->overflow($_); is $s->overflow, $_, "setting overflow to $_"; } use tests 8; # padding-* for(qw/ top right bottom left/) { my $meth = "padding\u${_}"; my $prop = "padding-$_"; for(qw/5em 5%/){ $s->$meth($_); is $s->$meth, $_, "setting $prop to $_"; } } use tests 13; # padding { my $props = sub { return join ",", map $s->getPropertyValue("padding-$_"), qw(top right bottom left) }; $s->padding('4em'); is $s->padding, '4em', 'setting padding to one value'; is &$props, '4em,4em,4em,4em', 'result of setting padding to one value'; $s->padding('5% 5em'); is $s->padding, '5% 5em', 'setting padding to two values'; is &$props, '5%,5em,5%,5em', 'result of setting padding to two values'; $s->padding('6px 5% 5em'); is $s->padding, '6px 5% 5em', 'setting padding to three values'; is &$props, '6px,5%,5em,5%', 'result of setting padding to three values'; $s->padding('6% 6px 5% 5em'); is $s->padding, '6% 6px 5% 5em', 'setting padding to four values: 6% 6px 5% 5em'; is &$props, '6%,6px,5%,5em', 'result of setting padding to 6% 6px 5% 5em'; $s->padding('6% 6px 5% 7%'); is $s->padding, '6% 6px 5% 7%', 'setting padding to four values: 6% 6px 5% 7%'; is &$props, '6%,6px,5%,7%', 'result of setting padding to 6% 6px 5% 7%'; $s->padding(''); is $s->padding, '', 'setting padding to nothing ...'; is &$props, ',,,', ' ... resets all its sub-properties'; $s->padding('medium'); $s->paddingTop(""); is $s->padding, '', 'padding is blank if not all sub-properties are specified'; } use tests 10; # page-break-before/after for(qw/ before after/) { my $meth = "pageBreak\u${_}"; my $prop = "page-break-$_"; for(qw/auto always avoid left right/){ $s->$meth($_); is $s->$meth, $_, "setting page-break-$prop to $_"; } } use tests 2; # page-break-inside for(qw/ avoid auto /){ $s->pageBreakInside($_); is $s->pageBreakInside, $_, "setting page-break-inside to $_"; } use tests 4; # pause-* for(qw/ before after/) { my $meth = "pause\u${_}"; my $prop = "pause-$_"; for(qw/ 3s 3% /){ $s->$meth($_); is $s->$meth, $_, "setting $prop to $_"; } } use tests 1; # pitch-range $s->pitchRange(5); is $s->pitchRange, 5, "pitch-range"; use tests 10; # pitch for(qw/ -0 +0 70hz 80khz +70hz x-low low medium high x-high /){ $s->pitch($_); is $s->pitch, $_, "setting pitch to $_"; } use tests 7; # play-during for( 'url(foo)', 'url(bar) mix', 'url(baz) repeat', 'url(log) mix repeat', 'url(ose) repeat mix', 'auto', 'none', ){ $s->playDuring($_); is $s->playDuring, $_, "setting play-during to $_"; } use tests 4; # position for(qw/ static relative absolute fixed /){ $s->position($_); is $s->position, $_, "setting position to $_"; } use tests 4; # quotes for( "'foo' 'bar'", "'‘' '’' '“' '”'", '"‘" "’" "“" "“" "«" "»"', 'none', ){ $s->quotes($_); is $s->quotes, $_, "setting quotes to $_"; } use tests 1; # richness $s->richness(5); is $s->richness, 5, "richness"; use tests 3; # right for(qw( 5em 5% auto )) { $s->right($_); is $s->right, $_, "right value: \L$_" } use tests 2; # speak-header for(qw( once always )) { $s->speakHeader($_); is $s->speakHeader, $_, "speak-header value: \L$_" } use tests 2; # speak-numeral for(qw( digits continuous )) { $s->speakNumeral($_); is $s->speakNumeral, $_, "speak-numeral value: \L$_" } use tests 2; # speak-punctuation for(qw( code none )) { $s->speakPunctuation($_); is $s->speakPunctuation, $_, "speak-punctuation value: \L$_" } use tests 3; # speak for(qw( normal none spell-out )) { $s->speak($_); is $s->speak, $_, "speak value: \L$_" } use tests 8; # speech-rate for(qw( 3 x-slow slow medium fast x-fast faster slower )) { $s->speechRate($_); is $s->speechRate, $_, "speech-rate value: \L$_" } use tests 1; # stress $s->stress(5); is $s->stress, 5, "stress"; use tests 2; # table-layout for(qw( auto fixed )) { $s->tableLayout($_); is $s->tableLayout, $_, "table-layout value: \L$_" } use tests 5; # text-align for(qw( left right center justify auto )) { $s->textAlign($_); is $s->textAlign, $_, "text-align value: \L$_" } use tests 7; # text-decoration for( "none", "underline", 'overline', 'line-through', 'blink', 'underline overline line-through blink', 'overline blink underline line-through', ){ $s->textDecoration($_); is $s->textDecoration, $_, "setting text-decoration to $_"; } use tests 2; # text-indent for(qw/5em 5%/){ $s->textIndent($_); is $s->textIndent, $_, "setting text-indent to $_"; } use tests 4; # text-transform for(qw( capitalize uppercase lowercase none )) { $s->textTransform($_); is $s->textTransform, $_, "text-transform value: \L$_" } use tests 3; # top for(qw/5em 5% auto/){ $s->top($_); is $s->top, $_, "setting top to $_"; } use tests 3; # unicode-bidi for(qw/normal embed bidi-override/){ $s->unicodeBidi($_); is $s->unicodeBidi, $_, "setting unicode-bidi to $_"; } use tests 10; # vertical-align for(qw/ baseline sub super top text-top middle bottom text-bottom 5% 5em/){ $s->verticalAlign($_); is $s->verticalAlign, $_, "setting vertical-align to $_"; } use tests 3; # visibility for(qw/ visible hidden collapse /){ $s->visibility($_); is $s->visibility, $_, "setting visibility to $_"; } use tests 8; # voice-family for(qw/ male female child "Times" Times /, 'Lucida Grande', 'male, female, Lucida Grande', 'Lucida Grande, Times, child', ) { $s->voiceFamily($_); is $s->voiceFamily, $_, "voice-family value: \L$_" } use tests 10; # volume for(qw/ soft medium 5% 5 silent x-soft soft medium loud x-loud /){ $s->volume($_); is $s->volume, $_, "setting volume to $_"; } use tests 1; # widows $s->widows(5); is $s->widows, 5, "widows"; use tests 3; # width for(qw/5em 5% auto/){ $s->width($_); is $s->width, $_, "setting width to $_"; } use tests 2; # word-spacing for(qw/ normal 51em /){ $s->wordSpacing($_); is $s->wordSpacing, $_, "setting word-spacing to $_"; } use tests 2; # z-index for(qw/ auto 5 /){ $s->zIndex($_); is $s->zIndex, $_, "setting z-index to $_"; } # ------------- CSS::DOM’s part of the interface ---------- # require CSS::DOM; use tests 3; my $sheet = CSS::DOM::parse( '* {azimuth: 0; azimuth: blue}', property_parser => $css21 ); is $sheet->cssRules->[0]->style->azimuth, '0', 'CSS::DOM::parse ..., property_parser => ...'; is $sheet->property_parser, $css21, 'sheet->property_parser'; $sheet = new CSS::DOM property_parser => $css21; $sheet -> insertRule('* {azimuth: 0; azimuth: blue}',0); is $sheet->cssRules->[0]->style->azimuth, '0', 'new CSS::DOM property_parser => ...'; # ------------- Miscellaneous Bug Fixes ------------- # use tests 4; { # Note: These fixes rely on border-top-color not having a default value. # That may change, in which case we will have to create our own property # specs for the tests’ sake. $s->cssText('border-top-color: white; border-top: inset'); is $s->borderTopColor, "", 'assignment to shorthand properties initiated by the parser deletes a' .' subproperty whose default value is blank'; is +()=$s->getPropertyCSSValue("border-top-color"), 0, ' and that assignment causes getPropertyCSSValue to return nothing'; $s->borderTopColor('white'); $s->borderTop('inset'); is $s->borderTopColor, "", 'direct assignment to shorthand properties deletes a' .' subproperty whose default value is blank'; is +()=$s->getPropertyCSSValue("border-top-color"), 0, ' and *that* assignment causes getPropertyCSSValue to return nothing'; } use tests 2; # parsing colours { # Tests for problems with colours in cygwin’s perl (broken in 0.08; fixed # in 0.09) and for bugs temporarily introduced while those problems were # being addressed. my $p = new CSS'DOM'PropertyParser; $p->add_property( 'colours' => { format => '+', }, ); my $s = CSS'DOM'Style'parse( "colours: rgb(0,0,0) rgb(1,1,1)", property_parser => $p ); use CSS'DOM'Constants 'CSS_CUSTOM'; is $s->getPropertyCSSValue('colours')->cssValueType, CSS_CUSTOM, 'quantified s'; $p->add_property( "agent" => { format => '( )', properties => { "agent-name" => [1] } } ); $s->agent("honey #bee"); is $s->agentName, "honey #bee", '#colour within paren group and not at the start of the group'; } use tests 1; # backtracking with list properties { # This bug, fixed in 0.15, was discovered as a result of perl change # 3da9985538. See . # When I wrote PropertyParser.pm, I thought that local @{$whatever} # would localise the entire contents of the array, just as # local ${$whatever}[0] localises one element. But it actually # replaces the array temporarily with a new one, which cannot # work with references. my $p = new CSS'DOM'PropertyParser; $p->add_property( 'foo' => { format => '[(foo)|(foo),]+', # [(foo),?]+ does not trigger the bug list => 1, }, ); my $s = CSS'DOM'Style'parse( "foo: foo, foo", property_parser => $p ); use CSS'DOM'Constants 'CSS_VALUE_LIST'; is_deeply [map cssText $_, @{$s->getPropertyCSSValue('foo')}],[('foo')x2], 'backtracking does not preserve existing captures'; } CSS-DOM-0.16/t/Rect.t000644 000767 000024 00000001261 11267227317 014543 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use CSS::DOM::Value::Primitive ':all'; my $prim = "CSS::DOM::Value::Primitive"; use tests 4; { my $v = new $prim type => CSS_RECT, value => [ [type=>CSS_PX,value=>1], [type=>CSS_EMS,value=>2], [type=>CSS_IDENT,value=>'auto'], [type=>CSS_CM,value=>4], ]; is $v->top->cssText, '1px', 'top'; is $v->right->cssText, '2em', 'right'; is $v->bottom->cssText, 'auto', 'bottom'; is $v->left->cssText, '4cm', 'left'; } # ~~~ test for modifications of the cssText propertyCSS-DOM-0.16/t/RGBColor.t000644 000767 000024 00000005723 11277604201 015256 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use CSS::DOM::Value::Primitive ; my $prim = "CSS::DOM::Value::Primitive"; use tests 4; #bad { my $v = new $prim type => CSS_RGBCOLOR, value => '#bad'; is $v->red->cssText, 0xbb, 'red (#bad)'; is $v->green->cssText, 0xaa, 'green (#bad)'; is $v->blue->cssText, 0xdd, 'blue (#bad)'; is $v->alpha->cssText, 1, 'alpha (#bad)'; } use tests 4; #c0ffee { my $v = new $prim type => CSS_RGBCOLOR, value => '#c0ffee'; is $v->red->cssText, 0xc0, 'red (#c0ffee)'; is $v->green->cssText, 255, 'green (#c0ffee)'; is $v->blue->cssText, 0xee, 'blue (#c0ffee)'; is $v->alpha->cssText, 1, 'alpha (#c0ffee)'; } use tests 4; # rgb with numbers { my $v = new $prim type => CSS_RGBCOLOR, value => [ [type=>CSS_NUMBER,value=>1], [type=>CSS_NUMBER,value=>2], [type=>CSS_NUMBER,value=>27], ]; is $v->red->cssText, 1, 'red (rgb with nums)'; is $v->green->cssText, 2, 'green (rgb with nums)'; is $v->blue->cssText, 27, 'blue (rgb with nums)'; is $v->alpha->cssText, 1, 'alpha (rgb with nums)'; } use tests 4; # rgb with % { my $v = new $prim type => CSS_RGBCOLOR, value => [ [type=>CSS_PERCENTAGE,value=>1], [type=>CSS_PERCENTAGE,value=>2], [type=>CSS_PERCENTAGE,value=>27], ]; is $v->red->cssText, '1%', 'red (rgb with %)'; is $v->green->cssText, '2%', 'green (rgb with %)'; is $v->blue->cssText, '27%', 'blue (rgb with %)'; is $v->alpha->cssText, 1, 'alpha (rgb with %)'; } use tests 4; # rgba with numbers { my $v = new $prim type => CSS_RGBCOLOR, value => [ [type=>CSS_NUMBER,value=>1], [type=>CSS_NUMBER,value=>2], [type=>CSS_NUMBER,value=>27], [type=>CSS_NUMBER,value=>.7], ]; is $v->red->cssText, 1, 'red (rgba with nums)'; is $v->green->cssText, 2, 'green (rgba with nums)'; is $v->blue->cssText, 27, 'blue (rgba with nums)'; is $v->alpha->cssText, .7, 'alpha (rgba with nums)'; } use tests 4; # rgba with % { my $v = new $prim type => CSS_RGBCOLOR, value => [ [type=>CSS_PERCENTAGE,value=>1], [type=>CSS_PERCENTAGE,value=>2], [type=>CSS_PERCENTAGE,value=>27], [type=>CSS_NUMBER,value=>.2], ]; is $v->red->cssText, '1%', 'red (rgba with %)'; is $v->green->cssText, '2%', 'green (rgba with %)'; is $v->blue->cssText, '27%', 'blue (rgba with %)'; is $v->alpha->cssText, 0.2, 'alpha (rgba with %)'; } use tests 5; # named colours { my $v = new $prim type => CSS_RGBCOLOR, value => 'DarkoLiveGreen'; is $v->red->cssText, 85, 'red (named colour)'; is $v->green->cssText, 107, 'green (named colour)'; is $v->blue->cssText, 47, 'blue (named colour)'; is $v->alpha->cssText, 1, 'alpha (named colour)'; is $v->cssText, 'DarkoLiveGreen', 'cssText still returns the same when subvalues have been accessed'; } CSS-DOM-0.16/t/StyleSheet.t000644 000767 000024 00000003221 11040272477 015731 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use tests 1; # use use_ok 'CSS::DOM'; use tests 1; # constructor isa_ok my $ss = new CSS::DOM, 'CSS::DOM'; use tests 1; # type is $ss->type, 'text/css', 'type'; use tests 3; # disabled ok!$ss->disabled , 'get disabled'; ok!$ss->disabled(1), , 'set/get disabled'; ok $ss->disabled , 'get disabled again'; $ss->disabled(0); use tests 4; # (set_)ownerNode { is +()=ownerNode $ss, 0, 'null ownerNode in list context'; my $foo = []; $ss->set_ownerNode($foo); is $ss->ownerNode, $foo, 'ownerNode'; undef $foo; is $ss->ownerNode, undef, 'ownerNode is a weak refeerenc'; (my $ss = CSS::DOM::parse('@import "',url_fetcher=>sub{''})) ->set_ownerNode(my $thing = []); is +()=$ss->cssRules->[0]->styleSheet->ownerNode, 0, 'ownerNode of @import\' style sheet'; } use tests 2; # parentStyleSheet { is +()=$ss->parentStyleSheet, 0, 'parentStyleSheet'; my $ss = CSS::DOM::parse('@import "', url_fetcher=>sub{''}); is $ss->cssRules->[0]->styleSheet->parentStyleSheet, $ss, 'parentStyleSheet of @import rule\'s sheet'; } use tests 1; # (set_)href { $ss->set_href('eouvoenth'); is $ss->href, 'eouvoenth', 'href'; } use tests 1; # title { sub foo'attr { return shift->{+shift} } $ss->set_ownerNode(my $foo = bless {title => 'tilde'}, 'foo'); is $ss->title, 'tilde', 'title'; } use tests 2; # media { isa_ok $ss->media, 'CSS::DOM::MediaList'; $ss->media->mediaText('screen, printer'); is_deeply [$ss->media], [screen=>printer=>], 'media in list context'; } CSS-DOM-0.16/t/StyleSheetList.t000644 000767 000024 00000000737 11013236760 016571 0ustar00sproutstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; our $tests; BEGIN { ++$INC{'tests.pm'} } sub tests'VERSION { $tests += pop }; use Test::More; plan tests => $tests; use tests 1; # use use_ok 'CSS::DOM::StyleSheetList'; use tests 1; # constructor isa_ok my $list = CSS::DOM::StyleSheetList->new(1,2,3), 'CSS::DOM::StyleSheetList'; use tests 1; # length is $list->length, @$list, 'length'; use tests 3; # item is $list->item($_), $list->[$_], 'item ' . 'again' x $_ for 0..2; CSS-DOM-0.16/lib/CSS/000755 000767 000024 00000000000 12626673241 014415 5ustar00sproutstaff000000 000000 CSS-DOM-0.16/lib/CSS/DOM/000755 000767 000024 00000000000 12626673241 015034 5ustar00sproutstaff000000 000000 CSS-DOM-0.16/lib/CSS/DOM.pm000644 000767 000024 00000050626 12626673165 015410 0ustar00sproutstaff000000 000000 package CSS::DOM; use 5.008002; $VERSION = '0.16'; use # to keep CPANTS happy :-) strict; use # same here warnings; use CSS::DOM::Exception 'SYNTAX_ERR' ,'HIERARCHY_REQUEST_ERR', 'INDEX_SIZE_ERR'; use CSS::DOM::Constants 'STYLE_RULE'; use Scalar::Util 'weaken'; require CSS::DOM::RuleList; use constant 1.03 our $_constants = { ruls => 0, ownr => 1, # owner rule node => 2, # owner node dsbl => 3, hrfe => 4, medi => 5, fetc => 6, # url fetcher prsh => 7, # parent sheet prpp => 8, # property parser }; { no strict; delete @CSS::DOM::{_constants => keys %{our $_constants}} } # NON-DOM METHODS # classy method sub new { my $self = bless[],shift; my %args = @_; if(defined(my $arg = delete $args{url_fetcher})) { $self->[fetc] = $arg; } $self->[prpp] = delete $args{property_parser}; $self; } # objectionable methods sub url_fetcher { my $old = (my$ self = shift)->[fetc]; $ self -> [ fetc ] = shift if @ _ ; $old } sub property_parser { shift->[prpp] } # FUNCTIONS sub parse { require CSS::DOM::Parser; goto &CSS::DOM::Parser::parse; } sub compute_style { my %args = @_; # ~~~ for now we just ignore medium/height/width/ppi. We need to # support those, too. require CSS::DOM::Style; my $style = new CSS::DOM::Style; my $elem = delete $args{element}; my $pseudo = delete $args{pseudo}; $pseudo && $pseudo =~ s/^::?//; # The specificity returned by the style rule is a three-character # string representing the number of id, attr, and elem selector # components (e.g., li.red.level gives "\0\2\1"). We prefix that # with two more chars, to make: # XXXXX # ||||`-- element # |||`-- attribute # ||`-- id # |`-- style attribute # `-- style sheet # ‘Style attribute’ is \1 or \0, indicating whether the CSS proper- # ties originate from a style attribute. ‘Style sheet’ is # as follows: # "\0") user agent normal declarations # "\1") user normal declarations # "\2") author normal " # "\3") user agent !important declarations # "\4") author !important " # "\5") user " " # The individual properties are sorted according to this scheme. # ~~~ This isn’t the most efficient algorithm. Perhaps we can cache # some of this. my %specificity; # per property my @normal_spec; my @important_spec; my @sheets; if(defined $args{ua_sheet}) { push @normal_spec, chr 0; push @important_spec, chr 3; push @sheets, delete $args{ua_sheet}; } if(defined $args{user_sheet}) { push @normal_spec, chr 1; push @important_spec, chr 5; push @sheets, delete $args{user_sheet}; } if(defined $args{author_sheets}) { my $s = delete $args{author_sheets}; push @normal_spec, (chr 2) x @$s; push @important_spec, (chr 4) x @$s; push @sheets, @$s; } while(@sheets) { my $n = shift @normal_spec; my $i = shift @important_spec; my $s = shift @sheets; my @rules = $s->cssRules; while(@rules) { my $r = shift @rules; my $type = $r->type; if($type == STYLE_RULE) { next unless my $specificity = $r->_selector_matches( $elem, $pseudo ); my $sty = $r->style; for(0..$sty->length-1) { my $p = $sty->item($_); my $spec = ( $sty->getPropertyPriority($p) =~ /^important\z/i ? $i : $n ) . "\0$specificity"; no warnings 'uninitialized'; $spec ge $specificity{$p} and $style->setProperty( $p, $sty->getPropertyValue($p) ), $specificity{$p} = $spec; } } } } my $sty = $elem->style; for(0..$sty->length-1) { my $p = $sty->item($_); my $spec = ( $sty->getPropertyPriority($p) =~ /^important\z/i ? "\4" : "\3" ) . "\1\0\0\0"; no warnings 'uninitialized'; $spec ge $specificity{$p} and $style->setProperty( $p, $sty->getPropertyValue($p) ), $specificity{$p} = $spec; } return $style; } # DOM STUFF: # StyleSheet interface: sub type { 'text/css' } sub disabled { my $old = (my $self = shift) ->[dsbl]; @_ and $self->[dsbl] = shift; $old }; sub ownerNode { defined $_[0][node]?$_[0][node]:() } sub set_ownerNode { weaken($_[0]->[node] = $_[1]) } sub parentStyleSheet { shift->[prsh]||() } sub _set_parentStyleSheet { weaken($_[0]->[prsh] = $_[1]) } sub href { shift->[hrfe] } sub set_href { $_[0]->[hrfe] = $_[1] } sub title { no warnings 'uninitialized'; ''.(shift->ownerNode || return)->attr('title') } # If you find a bug in here, Media.pm’s method probably also needs fixing. sub media { wantarray ? @{$_[0]->[medi]||return} : ($_[0]->[medi] ||= ( require CSS::DOM::MediaList, CSS::DOM::MediaList->new )) } # CSSStyleSheet interface: sub ownerRule { shift->[ownr] || () } sub _set_ownerRule { weaken($_[0]->[ownr] = $_[1]); } # If you find a bug in the following three methods, Media.pm’s methods # probably also need fixing. sub cssRules { wantarray ? @{shift->[ruls]||return} : (shift->[ruls]||=new CSS::DOM::RuleList); } sub insertRule { # This is supposed to raise an HIERARCHY_REQUEST_ERR if # the rule cannot be inserted at the specified index; # e.g., if an @import rule is inserted after a stan- # dard rule. But we don’t do that, in order to maintain # future compatibility. my ($self, $rule_string, $index) = @_; require CSS::DOM::Parser; my ($at,$rule); { local *@; $rule = CSS::DOM::Parser::parse_statement( $rule_string,$self ); $at = $@ } $at and die new CSS::DOM::Exception SYNTAX_ERR, $at; # $rule->_set_parentStyleSheet($self); my $list = $self->cssRules; # cssRules takes care of ||= splice @$list, $index, 0, $rule; $index < 0 ? $#$list + $index : $index <= $#$list ? $index : $#$list } sub deleteRule { my ($self,$index) = @_; my $list = $self->[ruls]; $index > $#$list and die CSS::DOM::Exception->new( INDEX_SIZE_ERR, "The index passed to deleteRule ($index) is too large" ); splice @$list, $index, 1; return # nothing; } my %features = ( stylesheets => { '2.0' => 1 }, # css => { '2.0' => 1 }, css2 => { '2.0' => 1 }, ); sub hasFeature { my($feature,$v) = (lc $_[1], $_[2]); exists $features{$feature} and !defined $v || exists $features{$feature}{$v}; } !()__END__()! =encoding utf8 =head1 NAME CSS::DOM - Document Object Model for Cascading Style Sheets =head1 VERSION Version 0.16 This is an alpha version. The API is still subject to change. Many features have not been implemented yet (but patches would be welcome :-). The interface for feeding CSS code to CSS::DOM changed incompatibly in version 0.03. =for comment This is an alpha version. If you could please test it and report any bugs (via e-mail), I would be grateful. =head1 SYNOPSIS use CSS::DOM; my $sheet = CSS::DOM::parse( $css_source ); use CSS::DOM::Style; my $style = CSS::DOM::Style::parse( 'background: red; font-size: large' ); my $other_sheet = new CSS::DOM; # empty $other_sheet->insertRule( 'a{ text-decoration: none }', $other_sheet->cssRules->length, ); # etc. # access DOM properties $other_sheet->cssRules->[0]->selectorText('p'); # change it $style->fontSize; # returns 'large' $style->fontSize('small'); # change it =head1 DESCRIPTION This set of modules provides the CSS-specific interfaces described in the W3C DOM recommendation. The CSS::DOM class itself implements the StyleSheet and CSSStyleSheet DOM interfaces. This set of modules has two modes: =over =item 1 It can validate property values, ignoring those that are invalid (just like a real web browser), and support shorthand properties. This means you can set font to '13px/15px My Font' and have the font-size, line-height, and font-family properties (among others) set automatically. Also, C will assign 'green' to the color property, 'kakariki' not being a recognised color value. =item 2 It can blithely accept all property assignments as being valid. In the case of C, 'kakariki' will be assigned, since it overrides the previous assignment. =back These two modes are controlled by the C option to the constructors. =head1 CONSTRUCTORS =over 4 =item CSS::DOM::parse( $string ) This method parses the C<$string> and returns a style sheet object. If you just have a CSS style declaration, e.g., from an HTML C