view release on metacpan or  search on metacpan

lib/ASNMTAP/Asnmtap/Applications.pm  view on Meta::CPAN

    $Tdebug = 3;
  } elsif ($debug eq 'A') {
    $Tdebug = 4;
  } elsif ($debug eq 'S') {
    $Tdebug = 5;
  } else {
    $Tdebug = $debug;
  }

  my $cgipathFilename = ($cgipath eq '') ? "$filename" : "$cgipath/$filename";

  if ( -e "$cgipathFilename" ) {
    my $rvOpen = open(CGISESSION, "$cgipathFilename");

    if ($rvOpen) {
      while (<CGISESSION>) {
        chomp;
        $cgisession .= $_;
      }

      close(CGISESSION);
    } else {
      print "\nCannot open cgisess '$cgipathFilename'!\n" if ($Tdebug);
      return (0, ());
    }
  } else {
    print "\ncgisess '$cgipathFilename' doesn't exist!\n" if ($Tdebug);
    return (0, ());
  }

  unless ( defined $cgisession ) {
    print "\nEmpty cgisess file '$cgipathFilename'!\n" if ($Tdebug);
    return (0, ());
  }

  print "$cgisession\n\n" if ($Tdebug == 2);

  (undef, $cgisession) = map { split (/^\$D = {/) } split (/};;\$D$/, $cgisession);
  $cgisession =~ s/["']//g;

  my %session = map { my ($key, $value) = split (/ => /) } split (/,/, $cgisession);

  if ($Tdebug == 2) {
    print "Session param\n";
    print "_SESSION_ID          : ", $session{_SESSION_ID}, "\n" if (defined $session{_SESSION_ID});
    print "_SESSION_REMOTE_ADDR : ", $session{_SESSION_REMOTE_ADDR}, "\n" if (defined $session{_SESSION_REMOTE_ADDR});
    print "_SESSION_CTIME       : ", $session{_SESSION_CTIME}, "\n" if (defined $session{_SESSION_CTIME});
    print "_SESSION_ATIME       : ", $session{_SESSION_ATIME}, "\n" if (defined $session{_SESSION_ATIME});
    print "_SESSION_ETIME       : ", $session{_SESSION_ETIME}, "\n" if (defined $session{_SESSION_ETIME});
    print "_SESSION_EXPIRE_LIST : ", $session{_SESSION_EXPIRE_LIST}, "\n" if (defined $session{_SESSION_EXPIRE_LIST});
    print "ASNMTAP              : ", $session{ASNMTAP}, "\n" if (defined $session{ASNMTAP});
    print "~login-trials        : ", $session{'~login-trials'}, "\n" if (defined $session{'~login-trials'});
    print "~logged-in           : ", $session{'~logged-in'}, "\n" if (defined $session{'~logged-in'});
    print "remoteUser           : ", $session{remoteUser}, "\n" if (defined $session{remoteUser});
    print "remoteAddr           : ", $session{remoteAddr}, "\n" if (defined $session{remoteAddr});
    print "remoteNetmask        : ", $session{remoteNetmask}, "\n" if (defined $session{remoteNetmask});
    print "givenName            : ", $session{givenName}, "\n" if (defined $session{givenName});
    print "familyName           : ", $session{familyName}, "\n" if (defined $session{familyName});
    print "email                : ", $session{email}, "\n" if (defined $session{email});
    print "keyLanguage          : ", $session{keyLanguage}, "\n" if (defined $session{keyLanguage});
    print "password             : ", $session{password}, "\n" if (defined $session{password});
    print "userType             : ", $session{userType}, "\n" if (defined $session{userType});
    print "pagedir              : ", $session{pagedir}, "\n" if (defined $session{pagedir});
    print "activated            : ", $session{activated}, "\n" if (defined $session{activated});
    print "iconAdd              : ", $session{iconAdd}, "\n" if (defined $session{iconAdd});
    print "iconDetails          : ", $session{iconDetails}, "\n" if (defined $session{iconDetails});
    print "iconEdit             : ", $session{iconEdit}, "\n" if (defined $session{iconEdit});
    print "iconDelete           : ", $session{iconDelete}, "\n" if (defined $session{iconDelete});
    print "iconQuery            : ", $session{iconQuery}, "\n" if (defined $session{iconQuery});
    print "iconTable            : ", $session{iconTable}, "\n" if (defined $session{iconTable});
  }

  if (defined $session{_SESSION_ID} and $session{_SESSION_ID} eq $sessionID) {
    print "\n-> cgisess '$cgipathFilename' correct sessionID: $sessionID!\n" if ($Tdebug);
    return (1, %session);
  } else {
    print "\n-> cgisess '$cgipathFilename' wrong sessionID: $sessionID!\n" if ($Tdebug);
    return (0, ());
  }
}

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

sub get_trendline_from_test {
  my ($test) = @_;

  my ($pos, $posFrom);
  my $trendline = 0;

  if (($pos = index $test, " -t ") ne -1) {
    $posFrom = $pos + 4;
  } elsif (($pos = index $test, " --trendline=") ne -1) {
    $posFrom = $pos + 13;
  }

  if (defined $posFrom) {
    $trendline = substr($test, $posFrom);
    $trendline =~ s/(\d+)[ |\n][\D|\d]*/$1/g;
  }

  return $trendline;
}

# = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =

sub _in_cyclus {
  my ($what, $cyclus, $min, $max) = @_;

  my @a = split(/,/, $cyclus);
  my @b = ();
  my ($x, $i);

  map {
    if (/^\*\/(\d+)$/) {                                          # */n
      if ($1) {
        for $i ($min..$max) { push (@b, $i) if ((($i-$min) % $1) == 0); };
      }
    } elsif (/^\*$/) {                                            # *
      push (@b, $min..$max);
    } elsif (/^(\d+)-(\d+)\/(\d+)$/) {					          # x-y/n
      if ($3) {