trunk/clients/perl/OpenXPKI-Client-HTML-Mason/t/common.pl

   1
   2 use strict;
   3 use warnings;
   4
   5 ## configure test environment
   6
   7 my $base = 't/instance';
   8 our %config = (
   9     server_dir         => $base,
  10     config_dir         => "$base/etc/openxpki",
  11     var_dir            => "$base/var/openxpki",
  12     config_file        => "$base/etc/openxpki/config.xml",
  13     socket_file        => "/var/tmp/openxpki-client-test.socket",
  14     debug              => 0,
  15 );
  16 if ($ENV{DEBUG}) {
  17     $config{debug} = 1;
  18 }
  19
  20 our $PWD      = `pwd`;
  21     $PWD      =~ s/\n//g;
  22 our $INSTANCE = "$PWD/t/tc1";
  23 our $CONFIG   = "openxpki.conf";
  24 our $OUTPUT   = "t/html_output";
  25
  26 $INSTANCE   = $ENV{INSTANCE}   if (exists $ENV{INSTANCE});
  27
  28 $ENV{DOCUMENT_ROOT}        = "$PWD/htdocs"; ## comp_path
  29 $ENV{OPENXPKI_SOCKET_FILE} = "$PWD/t/tc1/var/openxpki/openxpki.socket";
  30
  31 ## this is for the caching itself
  32 use XML::Simple;
  33 use XML::Parser;
  34 $XML::Simple::PREFERRED_PARSER = "XML::Parser";
  35
  36 our $XS = XML::Simple->new (ForceArray    => 1,
  37                             ForceContent  => 1,
  38                             SuppressEmpty => undef,
  39                             KeyAttr       => [],
  40                             KeepRoot      => 1);
  41
  42 sub check_html
  43 {
  44     my $keys  = shift;
  45     my $path  = $keys->{PATH};
  46     my $page  = $keys->{PAGE};
  47
  48     my @list = split "\/", $path;
  49     my @path = ();
  50     foreach my $item (@list)
  51     {
  52         push @path, [ split ":", $item ];
  53     }
  54     my $count = 1;
  55     foreach my $item (@path)
  56     {
  57         return  $count if (not exists $page->{$item->[0]});
  58         $page = $page->{$item->[0]};
  59         if (defined $item->[1])
  60         {
  61             return -$count if (not exists $page->[$item->[1]]);
  62             $page = $page->[$item->[1]];
  63         }
  64         $count++;
  65     }
  66     if (exists $keys->{VALUE})
  67     {
  68         return $count if (ref $page);
  69         return -$count if ($keys->{VALUE} ne $page);
  70     }
  71     if (exists $keys->{REGEX})
  72     {
  73         return $count if (ref $page);
  74         return -$count if ($page !~ /^.*$keys->{REGEX}.*$/);
  75     }
  76     return 0;
  77 }
  78
  79 sub check_session_id
  80 {
  81     my $page = shift;
  82     return 1 if (not exists $page->{html}->[0]->{body}->[0]->{div}->[0]->{div}->[1]->{form}->[0]->{input}->[0]);
  83     $page = $page->{html}->[0]->{body}->[0]->{div}->[0]->{div}->[1]->{form}->[0]->{input}->[0];
  84     return 2 if ($page->{type} ne "hidden");
  85     return 3 if ($page->{name} ne "__session_id");
  86     return 4 if (length $page->{value} < 16);
  87     return 0;
  88 }
  89
  90 sub get_session_id
  91 {
  92     my $page = shift;
  93     return undef if (0 != check_session_id($page));
  94     return $page->{html}->[0]->{body}->[0]->{div}->[0]->{div}->[1]->{form}->[0]->{input}->[0]->{value};
  95 }
  96
  97 sub dump_page
  98 {
  99     my $page = shift;
 100     use Data::Dumper;
 101     print STDERR Dumper($page);
 102 }
 103
 104 sub write_html
 105 {
 106     my $keys     = shift;
 107     my $filename = $keys->{FILENAME};
 108     my $data     = $keys->{DATA};
 109
 110     ## strip off http header
 111     $data =~ s/^.*\r\n\r\n//s;
 112
 113     return 1 if (not open FD, ">$OUTPUT/$filename");
 114     return 2 if (not print FD $data);
 115     return 3 if (not close FD);
 116     return 0;
 117 }
 118
 119 sub get_parsed_xml
 120 {
 121     my $filename = shift;
 122     return $XS->XMLin ("$OUTPUT/$filename");
 123 }
 124
 125 1;