[prev in list] [next in list] [prev in thread] [next in thread] 

List:       bricolage-commits
Subject:    [6102] adding this contrib script which prints a tree
From:       slanning () bricolage ! cc
Date:       2004-12-17 10:23:39
Message-ID: 20041217102339.22070.qmail () x1 ! develooper ! com
[Download RAW message or body]

Revision: 6102
Author:   slanning
Date:     2004-12-17 02:23:37 -0800 (Fri, 17 Dec 2004)
ViewCVS:  http://viewsvn.bricolage.cc/?rev=6102&view=rev

Log Message:
-----------
adding this contrib script which prints a tree
of elements and their subelements and fields

Added Files:
-----------
    bricolage/branches/rev_1_8/contrib/show_element_tree/
    bricolage/branches/rev_1_8/contrib/show_element_tree/README
    bricolage/branches/rev_1_8/contrib/show_element_tree/element_tree.pl



["r6102-slanning.diff" (r6102-slanning.diff)]

Added: bricolage/branches/rev_1_8/contrib/show_element_tree/README
===================================================================
--- bricolage/branches/rev_1_8/contrib/show_element_tree/README	2004-12-16 19:11:11 \
                UTC (rev 6101)
+++ bricolage/branches/rev_1_8/contrib/show_element_tree/README	2004-12-17 10:23:37 \
UTC (rev 6102) @@ -0,0 +1,16 @@
+Description:
+  Prints out elements and their subelements and custom fields
+  using the output from `bric_soap element export`.
+
+Usage:
+  $ bric_soap element list_ids | bric_soap element export - > elements.xml
+  $ ./element-tree.pl elements.xml
+  See also the comments in the script.
+
+Todo:
+  Show output channels for top-level elements.
+  Maybe show the description.
+  Maybe not show isolated non-top-level elements, like utility templates.
+
+Author:
+  o  Scott Lanning, 2004-12-17

Added: bricolage/branches/rev_1_8/contrib/show_element_tree/element_tree.pl
===================================================================
--- bricolage/branches/rev_1_8/contrib/show_element_tree/element_tree.pl	2004-12-16 \
                19:11:11 UTC (rev 6101)
+++ bricolage/branches/rev_1_8/contrib/show_element_tree/element_tree.pl	2004-12-17 \
10:23:37 UTC (rev 6102) @@ -0,0 +1,114 @@
+#!/usr/bin/perl
+# print a tree of elements and their subelements,
+# using a bric_soap export of elements
+# $ bric_soap element list_ids | bric_soap element export - > elements.xml
+# $ ./element-tree.pl elements.xml
+# Handles 1.6 or 1.8 version of bric_soap. Has the option to
+# not display the fields (see $WITHFIELDS).
+
+use strict;
+use warnings;
+use XML::Twig;
+
+my $CHILDMARKER = '. ';   # what's in front of subelements
+my $WITHFIELDS = 1;       # whether to display fields
+my %ELEMENT;
+
+main();
+
+sub main {
+    $|++;
+    parse_xml_elements();
+    get_parent_info();
+    print_parents();
+}
+
+# get all elements with their subelements, and fields;
+# put this in %ELEMENT
+sub parse_xml_elements {
+    my $xmlfile = shift(@ARGV) || 'elements.xml';
+    XML::Twig->new(
+        twig_roots => {'assets/element' => \&get_element_info}
+    )->parsefile($xmlfile);
+}
+
+# twig handler
+sub get_element_info {
+    my ($t, $node) = @_;
+
+    my $name = $node->first_child_text('key_name');
+    # (before 1.8 we didn't have key_name)
+    $name = $node->first_child_text('name') unless $name;
+    die "wtf version of bricolage are you running?" unless $name;
+
+    # subelements
+    my @children = sort $node->first_child('subelements')->children_text;
+    $ELEMENT{$name}{children} = [@children];
+
+    # fields
+    my @fields = $node->first_child('fields')->children('field');
+    my @fieldnames = ();
+    foreach my $field (@fields) {
+        my $fieldname = $field->first_child_text('key_name');
+        # (before 1.8 we had name instead of key_name)
+        $fieldname = $field->first_child_text('name') unless $fieldname;
+        push @fieldnames, $fieldname;
+    }
+    $ELEMENT{$name}{fields} = [sort @fieldnames];
+}
+
+# determine each element's parent (if it has one)
+sub get_parent_info {
+    foreach my $element (keys %ELEMENT) {
+        foreach my $child (@{ $ELEMENT{$element}{children} }) {
+            if (exists $ELEMENT{$child}) {
+                $ELEMENT{$child}{parent} = $element;
+            } else {
+                # should never happen
+                die "element=$element, child=$child\n";
+            }
+        }
+    }
+}
+
+# recursively print subelements
+sub print_children {
+    my ($element, $parents) = @_;
+
+    CHILD: foreach my $child (@{ $ELEMENT{$element}{children} }) {
+        print $CHILDMARKER x @$parents, $child;
+        print_fields($child);
+
+        # (prevent infinite recursion)
+        foreach my $parent (@$parents) {
+            if ($parent eq $child) {
+                print " ...\n";
+                next CHILD;
+            }
+        }
+        print $/;
+
+        push @$parents, $child;
+        print_children($child, $parents);
+        pop @$parents;
+    }
+}
+
+sub print_fields {
+    my $element = shift;
+    print ' (', join(', ', @{ $ELEMENT{$element}{fields} }), ')'
+      if $WITHFIELDS;
+}
+
+# display parent-less elements and recursively their subelements
+sub print_parents {
+    my @parents = grep {!exists $ELEMENT{$_}{parent}}
+      sort {lc($a) cmp lc($b)} keys %ELEMENT;
+    foreach my $element (@parents) {
+        print "\n$element";
+        print_fields($element);
+        print $/;
+        my @parentstack = ($element);
+        print_children($element, \@parentstack);
+    }
+}



[prev in list] [next in list] [prev in thread] [next in thread]