view release on metacpan or  search on metacpan

plugins/tools/GrinderCaptureConverter.pl  view on Meta::CPAN

      push (@urlArray, $url);
      push (@dataArray, $postData);
      $user = undef;
      $password = undef;
      $written = 1;
    }

    # De nieuwe url bepalen
    my $pos = index($l, "=") + 1;
    $url = substr($l, $pos);
    $postType = 'GET';
    $postData = '<NIHIL>';
    $written  = 0;
  } elsif ($l =~ /.parameter.header.If-Modified-Since=/) {
    $postType = 'GET';
    $written  = 0;
  } elsif ($l =~ /.parameter.header.Content-Type=/) {
    $postType = 'POST';
    $written  = 0;
  } elsif ($l =~ /.parameter.post=/) {
    my $pos = index($l, "=") + 1;
    open (POSTFILE, $directory . substr($l, $pos)) || die ("Could not open post file");
    $postData = <POSTFILE>;
    close (POSTFILE);
  } elsif ($l =~ /.basicAuthenticationUser=/) {
    my $pos = index($l, "=") + 1;
    $user = substr($l, $pos);
    $written = 0;
  } elsif ($l =~ /.basicAuthenticationPassword=/) {
    my $pos = index($l, "=") + 1;
    $password = substr($l, $pos);
    $written = 0;
  }
}

if (! $written) {
  $url =~ s|^(http[s]*://)|$1$user\:$password\@| if(defined $user && defined $password);
  push (@urlArray, $url);
  push (@postArray, $postType);
  push (@dataArray, $postData);
  $user = undef;
  $password = undef;
  $written = 1;   
}

if ($format eq "W") {
  output_webtransact();
} else {
  output_list();
}

exit(0);

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub output_webtransact() {
  open (OUTFILE, ">$outfile") || die ("Could not open webtransact output file");
  print OUTFILE "\@URLS = (\n";

  for(my $c = 0, my $t = 1; $c < @urlArray; $c++) {
    if (! ($urlArray[$c] =~ /(\.(gif|jpg|png|css|ico|js|bmp)|(robots\.txt))$/i) ) {
	  my($tUrl, $tParams)   = split(/\?/, $urlArray[$c]);  
	  my(undef, $tFilename) = $tUrl =~ m/(.*\/)(.*)$/;
      my $Qs_fixed = '';

      if (defined $tParams && $tParams ne '') {
        my @tArray = split(/&/, $tParams);
        $Qs_fixed .= build_QS_fixed(\@tArray);
      }
		 
      if($postArray[$c] eq 'POST') {
        $Qs_fixed .= ", " if($Qs_fixed ne ''); 

        if ( defined $dataArray[$c] and  $dataArray[$c] ne '') {
		  my @tArray = split(/&/, $dataArray[$c]);
          $Qs_fixed .= build_QS_fixed(\@tArray);
        }
      }
		 
      print OUTFILE "  { Method => '" . $postArray[$c] . "', Url => \"" . URLDecode(PERLDecode($tUrl)) . "\", Qs_var => [], Qs_fixed => [$Qs_fixed], Exp => '<NIHIL>', Exp_Fault => EXP_FAULT, Msg => '$tFilename', Msg_Fault => MSG_FAULT, Perfdata_Label...
    }
  }

  print OUTFILE ");\n\n";
  close (OUTFILE);
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub build_QS_fixed($) {
  my $tArray   = shift;

  my $Qs_fixed = '';

  if ( defined @$tArray ) {
	foreach my $line (@$tArray) {
	  my ($name, $value) = split(/=/, $line);

      if (! defined $value) { $value = ''; }
      $Qs_fixed .= ", " if($Qs_fixed ne '');
      $Qs_fixed .= "'" . URLDecode($name) . "'" . " => " . "'" . URLDecode($value) . "'";
	}
  }  

  return $Qs_fixed;
}
  
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  
sub URLDecode {
    my $theURL = $_[0];
    $theURL =~ tr/+/ /;
    $theURL =~ s/%([a-fA-F0-9]{2,2})/chr(hex($1))/eg;
    $theURL =~ s/<!--(.|\n)*-->//g;
    return $theURL;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub PERLDecode {
	my $theURL = $_[0];
	$theURL =~ s|\@|\\@|g;
	return $theURL;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub output_list() {
  open (OUTFILE, ">$outfile") || die ("Could not open list output file");

  for(my $c = 0; $c < @urlArray; $c++) {
    if (! ($urlArray[$c] =~ /(\.(gif|jpg|png|css|ico|js|bmp)|(robots\.txt))$/i) ) {
	  my $tUrl = URLDecode($urlArray[$c]);

      if($postArray[$c] eq "POST") {
	  	if ( defined $dataArray[$c] and  $dataArray[$c] ne '') {
	      print OUTFILE "$postArray[$c]" . " - " . $tUrl . ( ($tUrl =~ /\?/) ? '&' : '?' ) . URLDecode($dataArray[$c]) . "\n";
		} else {
		  print OUTFILE "$postArray[$c]" . " - " . $tUrl . "\n";
		}
      } else {
        print OUTFILE "$postArray[$c]" . "  - " . $tUrl . "\n";
      }
    }
  }

  close (OUTFILE);
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub print_usage() {
  print "Usage: $PROGNAME \n        -i <input-file> \n        -o <output-file> \n       [-f L|W], W default \n       [-v version] \n       [-h help]\n\n";
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub print_revision() {
  print "\nThis is $PROGNAME, v$version\n";
  print "Copyright (c) 2004-2007 Yves Van den Hove\n\n";
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub print_help() {
  print_revision();
  print_usage();
  print "Send an email to yvdhove\@users.sourceforge.net if you have any questions regarding the use of this software.\n";
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -