deprecated/buildtools/buildsystemtools/lib/XML/XQL/Debug.pm
author kelvzhu
Wed, 27 Oct 2010 16:03:51 +0800
changeset 662 60be34e1b006
parent 655 3f65fd25dfd4
permissions -rw-r--r--
Merge
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
655
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     1
package XML::XQL::Debug;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     2
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     3
# Replaces the filepath separator if necessary (i.e for Macs and Windows/DOS)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     4
sub filename
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     5
{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     6
    my $name = shift;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     7
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     8
    if ((defined $^O and
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     9
	 $^O =~ /MSWin32/i ||
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    10
	 $^O =~ /Windows_95/i ||
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    11
	 $^O =~ /Windows_NT/i) ||
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    12
	(defined $ENV{OS} and
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    13
	 $ENV{OS} =~ /MSWin32/i ||
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    14
	 $ENV{OS} =~ /Windows_95/i ||
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    15
	 $ENV{OS} =~ /Windows_NT/i))
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    16
    {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    17
	$name =~ s!/!\\!g;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    18
    }
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    19
    elsif  ((defined $^O and $^O =~ /MacOS/i) ||
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    20
	    (defined $ENV{OS} and $ENV{OS} =~ /MacOS/i))
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    21
    {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    22
	$name =~ s!/!:!g;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    23
	$name = ":$name";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    24
    }
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    25
    $name;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    26
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    27
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    28
sub dump
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    29
{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    30
    new XML::XQL::Debug::Dump->pr (@_);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    31
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    32
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    33
sub str
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    34
{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    35
    my $dump = new XML::XQL::Debug::Dump;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    36
    $dump->pr (@_);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    37
    $dump->{Str} =~ tr/\012/\n/;	# for MacOS where '\012' != '\n'
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    38
    $dump->{Str};
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    39
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    40
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    41
package XML::XQL::Debug::Dump;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    42
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    43
sub new
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    44
{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    45
    my ($class, %args) = @_;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    46
    $args{Indent} = 0;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    47
    $args{Str} = "";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    48
    bless \%args, $class;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    49
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    50
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    51
sub indent
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    52
{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    53
    $_[0]->p ("  " x $_[0]->{Indent});
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    54
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    55
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    56
sub ip
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    57
{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    58
    my $self = shift;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    59
    $self->indent;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    60
    $self->p (@_);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    61
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    62
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    63
sub pr
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    64
{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    65
    my ($self, $x) = @_;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    66
    if (ref($x))
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    67
    {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    68
	if (ref($x) eq "ARRAY")
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    69
	{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    70
	    if (@$x == 0)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    71
	    {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    72
		$self->ip ("<array/>\n");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    73
		return;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    74
	    }
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    75
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    76
	    $self->ip ("<array>\n");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    77
	    $self->{Indent}++;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    78
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    79
	    for (my $i = 0; $i < @$x; $i++)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    80
	    {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    81
		$self->ip ("<item index='$i'>\n");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    82
		$self->{Indent}++;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    83
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    84
		$self->pr ($x->[$i]);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    85
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    86
		$self->{Indent}--;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    87
		$self->ip ("</item>\n");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    88
	    }
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    89
	    $self->{Indent}--;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    90
	    $self->ip ("</array>\n");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    91
	}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    92
	else
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    93
	{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    94
	    $self->ip ("<obj type='" . ref($x) . "'>");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    95
	    
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    96
	    if ($x->isa ('XML::XQL::PrimitiveType'))
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    97
	    {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    98
		$self->p ($x->xql_toString);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    99
	    }
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   100
	    else
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   101
	    {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   102
		$self->p ("\n");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   103
		$self->{Indent}++;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   104
		
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   105
		if ($x->isa ("XML::DOM::Node"))
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   106
		{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   107
		    # print node plus subnodes as XML
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   108
		    $self->p ($x->toString);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   109
		}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   110
		$self->p ("\n");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   111
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   112
		$self->{Indent}--;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   113
		$self->indent;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   114
	    }
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   115
	    $self->p ("</obj>\n");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   116
	}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   117
    }
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   118
    elsif (defined $x)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   119
    {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   120
	$self->indent;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   121
	$self->p ("<str>$x<str/>\n");	
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   122
    }
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   123
    else
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   124
    {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   125
	$self->indent;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   126
	$self->p ("<undef/>\n");
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   127
    }
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   128
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   129
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   130
sub p
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   131
{
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   132
    my $self = shift;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   133
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   134
    if ($self->{Dump})
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   135
    {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   136
	print @;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   137
    }
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   138
    else
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   139
    {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   140
	$self->{Str} .= join ("", @_);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   141
    }
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   142
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   143
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   144
1;