complicate hash

@data=@values=();
$recordCount=0;
while(($resultSetObj->MoveNext()) == 1) {
$data=$resultSetObj->GetAllColumnValues(0);
#print "DATA:\"".join("\",\"",@$data)."\"
";
if($lastRecord && ($lastRecord ne $$data[$j]))
{
#print "COMPARE:$lastRecord $$data[1]
";
for($i=0;$i<@fields;$i++)
{
$value=join(',',sort keys(%{$results{$fields[$i]}}));
push(@values,$value);
#push(@values,";");
}
#print "VALUES:@values

";
push(@data,[@values]);
$recordCount++;
undef @values;
undef %results;
}
for($i=0;$i<@$data;$i+=2)
{
$results{$$data[$i]}{$$data[$i+1]}++;
}
#print "RESULT:".Dumper(\%results)."
";
$j=0;
while($$data[$j] ne "id")
{
$j++;
}
$j++;
$lastRecord=$$data[$j];
}
if ($lastRecord){
for($i=0;$i<@fields;$i++)
{
$value=join(',',sort keys(%{$results{$fields[$i]}}));
push(@values,$value);
}
$recordCount++;
push(@data,[@values]);
undef @values;
undef %results;
}

checkout

#!/usr/bin/perl


#base reference directory
#note -- these directories & files MUST BE ALL LOWERCASE :)

#############
# These two directories need to be created under this directory:
# data/
# history/
# and need to be reflected in the names below

#The Data Directory. ("data" -> data/)
$based="/usr/local/apache2/htdocs/checkout-3.18/data";

#The History Directory ("history" -> history/)
$save="/usr/local/apache2/htdocs/checkout-3.18/history";

#set the path to your images (to be accessed like $images/cisco_logo.gif)
$images="/images";

#what directory are we in?
#$mydir="/home/httpd/checkout-sj";
$mydir="/usr/local/apache2/htdocs/checkout-3.18";

#if you want a background, set it here:

##bg scheme 1
#$background="bgcolor=#d0d0d0 background=$images/bkgnd.jpg";
#$eback=" bgcolor=lightgrey ";
#$ebacknofill=" bgcolor=lightgrey ";
#$heading=" bgcolor=#f9f9ea ";

##bg scheme #2
$background=" bgcolor=white ";
$eback=" bgcolor=#dcdcff ";
$ebacknofill=" bgcolor=lightgrey ";
$heading=" bgcolor=#f9f9e0 ";



#################
# Theoretically, nothing below this line needs to be changed...
#################
#
#
#
# Lab Equipment Reservation Program
# Checkout Page Cisco Systems
#
# Author: Steve Padgett -- stpadget@cisco.com
#
# History:
# 13-Dec-1999 - tgage - Added code to protect '<', '>', and '"' in
# edit mode. Also expanded field lengths for
# name & type to allow imbedded HTML.
#
# 20-May-1999 - tgage - Changed problem reports footer to send
# email to checkout@cisco.com, also changed data
# file pointers to point at the checkout page's
# new home.
# Feb 1999, Version 3 Released
# * Lab support
# * Layout redesign
# Jan 1998, Version 2 Released
# * Flat file database structure
# * Paging support
# * File locking
# Pre 1998 (?)
#
# The current maintainer of this script is Tim Gage or Steve Padgett
# (when he returns), Please send any bugs, wish lists, etc, to
# checkout@cisco.com so that the appropriate person can help you.
#


$VERSION="VER 3.18";


@wdate=('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
@day=('U','M','T','W','R','F','S');

&Handle_Path;
&Get_Input;


if ($ARGV[0] eq "pager") {
chdir("$mydir");
&do_find_pageable;
exit(0);
}


%USER=&read_info_file("$save/$ENV{'REMOTE_ADDR'}.hist");


if (defined $FORM{'doredir'}) {
&print_redirect($FORM{'redirto'});
}


if (defined $FORM{'available'}) {
$USER{'available'}=$FORM{'available'};
&write_info_file("$save/$ENV{'REMOTE_ADDR'}.hist",%USER);
}


if ($FORM{'lab'} eq "pager") {
&paging_service($FORM{'user'});
exit(0);
}

#short-circuit the validation process
if (($labvalid=&valid_lab($FORM{'lab'})) && ($groupvalid=&valid_group($FORM{'lab'},$FORM{'group'})))
{ $zonevalid=&valid_zone($FORM{'lab'},$FORM{'group'},$FORM{'zone'}); }
if ((!defined $labvalid) || (!$labvalid)) { undef $labvalid; undef $FORM{'lab'}; }
if ((!defined $groupvalid) || (!$groupvalid)) { undef $groupvalid; undef $FORM{'group'}; }
if ((!defined $zonevalid) || (!$zonevalid)) { undef $zonevalid; undef $FORM{'zone'}; }

#
# handle stats processing
#
if (defined $FORM{'stats'}) {
&show_stats($FORM{'lab'},$FORM{'group'},$FORM{'zone'});
exit(0);
}

#
# handle searches
#
if (($FORM{'stext'} ne "")) {
$msg="";
$|=1; #do this, makes it (look) faster on searches
$msg=&save_checkout if (defined $FORM{'checkout'});


&do_search($msg);
exit(0);
}


#
# handle the pop-up boxes
#
if (defined $FORM{'short'}) {
&print_short;
exit(0);
}

#
#handle checkouts/in, edits, purges, and creates
#
$editmode=1 if (defined $FORM{'editz'});
&save_data if (defined $FORM{'save'});
&purge_zones if (defined $FORM{'purge'});
&create_itm if (defined $FORM{'create'});


#
#Is it a valid lab?
#
if (($FORM{'lab'} eq "") || (!defined $labvalid)) {
&read_and_show_labs;
exit(0);
}
# $labvalid=1;


#
#Is it a valid group?
#
if (($FORM{'group'} eq "") || (!defined $groupvalid)) {
&read_and_show_groups($FORM{'lab'});
exit(0);
}
# $groupvalid=1;

#
#handle new zone creation (new commserver)
#
&create_new_zone("$based/$FORM{'lab'}/$FORM{'group'}") if (defined $FORM{'newzone'});


#
# Is it a valid zone?
#
if (($FORM{'zone'} ne "") && (defined $zonevalid)) {
# $zonevalid=1;
$msg="";
$msg=&save_checkout if (defined $FORM{'checkout'});


#
# Is it a valid machine?
#
if (($FORM{'machine'} ne "") && (&valid_machine($FORM{'lab'},$FORM{'group'},$FORM{'zone'},$FORM{'machine'}))) {
$machinevalid=1;
&show_machine($FORM{'lab'},$FORM{'group'},$FORM{'zone'},$FORM{'machine'});
exit(0);
}

$editmode=2 if (defined $FORM{'editz'});
%zones=&read_zone_file($FORM{'lab'},$FORM{'group'},$FORM{'zone'});
&show_zones($FORM{'lab'},$FORM{'group'},$msg,%zones);
exit(0);
}


#
#otherwise, we're here...
#
# if (($FORM{'zone'} eq "")) {
$msg="";
$msg=&save_checkout if (defined $FORM{'checkout'});
%zones=&read_zones("$FORM{'lab'}","$FORM{'group'}");
&show_zones($FORM{'lab'},$FORM{'group'},$msg,%zones);
exit(0);
# }


print "Content-type: text/plain\n\n";
&print_env;



#
#is the lab name valid?
#
sub valid_lab {
my($lab)=@_;
#not valid if any character OTHER THAN A-Z,a-z,0-9,-,_,.,=,+
return 0 if (!&valid_name($lab));
return 0 if (! -d "$based/$lab");
return 1;
}


#
#just test to see if the name characters are valid.
#
sub valid_name {
my($lab)=@_;
return 0 if ((!defined $lab) || ($lab =~ /[^A-Za-z0-9 \-\_\+\=\.]/) || ($lab =~ /^\./) || ($lab eq ""));
return 1;
}


#
#is the group name valid?
#
sub valid_group {
my($lab,$group)=@_;
#not valid if any character OTHER THAN A-Z,a-z,0-9,-,_,.,=,+
return 0 if (!&valid_name($group));
return 0 if (! -d "$based/$lab/$group");
return 1;
}


#
#is the zone name valid?
#
sub valid_zone {
my($lab,$group,$zone)=@_;
#not valid if any character OTHER THAN A-Z,a-z,0-9,-,_,.,=,+
return 0 if (!&valid_name($zone));
return 0 if (! -d "$based/$lab/$group/$zone");
return 1;
}


#
#is the machine name valid?
#
sub valid_machine {
my($lab,$group,$zone,$machine)=@_;
#not valid if any character OTHER THAN A-Z,a-z,0-9,-,_,.,=,+
return 0 if (!&valid_name($machine));
return 0 if (! -e "$based/$lab/$group/$zone/$machine.eq");
return 1;
}



#
#log message to file
#
sub log_msg {
my($path,$message)=@_;
my($nowtime);
$nowtime=localtime();
open(DATA,">>$path");
print DATA "$nowtime($ENV{'REMOTE_ADDR'}-".time()."): $message\n";
close(DATA);
}




#
#write out the file supplied to it as a name=value pair
#
sub write_info_file {
my($infofile,%INFO)=@_;
my($line,$itm);
$line="";

#put it into a buffer
foreach $itm (sort keys %INFO) {
$line.="$itm=$INFO{$itm}\n"
}

#write it out
system("/usr/bin/lockfile $infofile.lock");
open(DATA,">$infofile");
print DATA $line;
close(DATA);
unlink("$infofile.lock");
}




#
#read out the info file passed into it, and return it as hashes
#
sub read_info_file {
my(@if)=@_;
my($infofile,%INFO);
foreach $infofile (@if) {
# print "opening file $infofile\n" if ($infofile =~ /info$/);
if (open(DATA,"$infofile")) {
while () {
chomp;
next if ((/^#/) || (!/^(.*?)\=(.*)/));
$INFO{$1}=$2;
}
close(DATA);
}
}
return %INFO;
}


#
#read and return just one zone.
#
sub read_zone_file {
my($lab,$group,$file)=@_;
my(%INF);
%{$INF{$file}}=&read_info_file("$based/$lab/$group/$file/.info");
%{$INF{$file}{'equ'}}=&read_equipment("$based/$lab/$group/$file");
delete $INF{$file}{'equ'} if (defined $INF{$file}{'equ'}{'a!a'});
return %INF;
}


#
#read the zones file out of the directory
#
sub read_zones {
my($lab,$group)=@_;
my(%INF);
opendir(DIR,"$based/$lab/$group");
@files=readdir(DIR);
closedir(DIR);
undef %INF;
foreach $file (@files) {
next if (($file =~ /^\./) || (! -d "$based/$lab/$group/$file"));
%{$INF{$file}}=&read_info_file("$based/$lab/$group/$file/.info");
%{$INF{$file}{'equ'}}=&read_equipment("$based/$lab/$group/$file");
delete $INF{$file}{'equ'} if (defined $INF{$file}{'equ'}{'a!a'});
}
return %INF;
}



#
#read in the .eq files from the directory.
#
sub read_equipment {
my($dir)=@_;
my(@files,%INF,$file,$st,$found);
$found=0;
opendir(DIR,$dir);
@files=grep(/\.eq$/,readdir(DIR));
closedir(DIR);
foreach $file (@files) {
%{$INF{$file}}=&read_info_file("$dir/$file");

#process the searching stuff
$st="${1}[0-9][0-9]" if ($FORM{'stext'} =~ /(.*)00$/);
if (($FORM{'stext'} ne "")
&& ($INF{$file}{'name'} !~ /$FORM{'stext'}/i)
&& ($INF{$file}{'checkout-login'} !~ /$FORM{'stext'}/i)
&& ($INF{$file}{'type'} !~ /$FORM{'stext'}/i)
&& ((!defined $st) || ($INF{$file}{'type'} !~ /$st/i))
&& ($INF{$file}{'checkout-comment'} !~ /$FORM{'stext'}/i)) {
delete $INF{$file};
} elsif (($FORM{'stext'} ne "") && (defined $FORM{'short'}) && (uc($INF{$file}{'checkout-login'}) ne uc($FORM{'stext'}))) {
delete $INF{$file};
} else { $found++; }
#end search processing

}
return %INF if ($found > 0);

#return this special thing to notify the calling function that it didn't find anything
return ('a!a' => 1);

}




#
#convert a unix time to a date/time, significant figures determined by the units passed to it
#
sub str_time {
my($mtime,$units)=@_;
my(@d,$buf,$day);
$day=int($mtime/(60*60*24));
if ($day < 1) {
$buf=sprintf "%d:%02d hrs",($mtime/(60*60)),($mtime/60)%60;
} elsif ($day < 3000) {
$buf=sprintf "%d day%s %d:%02d hrs",$day,($day != 1)?"s":"",($mtime/(60*60))%24,($mtime/60)%60;
} else {
@d=localtime($mtime);
$buf=sprintf "%s %d-%d-%02d",$wdate[$d[6]],$d[4]+1,$d[3],$d[5]%100;
if ($units eq "hours") {
$buf.=sprintf " %d:00",$d[2]+1; #yes, weird, but this is how we perceive it... right?
} elsif ($units eq "minutes") {
$buf.=sprintf " %d:%02d",$d[2],$d[1];
}
}
return $buf;
}




#
#print out the ".banner" file in the directory
#
sub print_banner {
my($dir,$editm)=@_;
return if ((! -e "$dir/.banner") && (!defined $editm));
if ($editm==2) {
print "
HTML FORMATTED-BANNER, optional
"; <br /> } else { <br /> print "<br>"; <br /> } <br /> if (open(DATA,"$dir/.banner")) { <br /> while (<DATA>) { <br /> print $_; <br /> } <br /> close(DATA); <br /> } <br /> print "\n" if ($editm==2);
}






#
#send out a HTTP redirect
#
sub print_redirect {
my($urlto)=@_;
my($port)="";
$port=":$ENV{'SERVER_PORT'}" if ($ENV{'SERVER_PORT'} ne 80);
if ($ENV{'REQUEST_URI'} eq $urlto) {
if ($urlto =~ /\?$/) { $urlto=substr($urlto,0,-1); } else { $urlto.="?"; }
}
print <
It's moved to here.



You would be taken there automatically without ever seeing this message, but your browser didn't like the redirect... hmm.
EOM
exit(0);
}



#
#a searchin' we shall go... a searchin' we shall go... hi ho 'la 'dar-i-o a searching we shall go.
#
sub print_search_bar {
my($lab,$group,$zone,$labt,$groupt,$zonet)=@_;
my(%SEL);
print <


EOM

if ($labt ne "") {
print "
EOM
}
print "

just $zonet\n" if ($zonet ne ""); print " all of $groupt\n" if ($groupt ne ""); print " all of $labt\n" if ($labt ne ""); print <everywhere

\n";

}




#
#print out the checkout box to the screen
#
sub print_checkout_box {
my($gr,$max,$savegr,$mult,$i,$grinc,@d,$days);
$i=localtime();
print <
Depending on the individual group setup, checkout times may be truncated to the max-checkout-time.
Leave the Login field blank to check in
\n$i





EOM
$max=-1;
#compute how long we can check stuff out for.
foreach $gr (keys %GI) {
# print "$gr $GI{$gr} , $GI{$gr}{'max-checkout-time'}\n";
$mult=24*60;
$grinc=24*60*60;
if ($GI{$gr}{'checkout-increment-units'} eq "minutes") { $mult=1; }
elsif ($GI{$gr}{'checkout-increment-units'} eq "hours") { $mult=60; }
if ($max < $mult*$GI{$gr}{'max-checkout-time'}) {
$max=$mult*$GI{$gr}{'max-checkout-time'};
$savegr=$gr;
$grinc=$mult*60;
}
}
if (($GI{$savegr}{'checkout-increment-multiple'} == 0) || ($GI{$savegr}{'max-checkout-time'} == 0) || (($GI{$savegr}{'max-checkout-time'}/$GI{$savegr}{'checkout-increment-multiple'}) > 31)) {
if ($GI{$savegr}{'checkout-increment-units'} == "days") {
@d=localtime(); $day=$d[6];
printf "\n"; }

} else {
$nowtime=time();
print "

Login Name:

Reason:

", $day[($day+1)%7], $day[($day+2)%7], $day[($day+3)%7], $day[($day+4)%7], $day[($day+5)%7]; } print " Days: 1-%s | 2-%s | 3-%s | 4-%s | 5-%s For the next: $GI{$savegr}{'checkout-increment-units'}\n"; if ($GI{$savegr}{'checkout-increment-units'} == "days") { print "

Check Back In After:

%s\n",&str_time($nowtime,$GI{$savegr}{'checkout-increment-units'}); $nowtime+=$grinc*$GI{$savegr}{'checkout-increment-multiple'}; } print "\n"; } print <

EOM
}





#
#print out the history bar on the screen
#
sub print_history_bar {
my($ip)=@_;
my(%HISTI,@histi,$itm);
%HISTI=&read_info_file("$save/$ip.hist");
@hist=grep(/^HIST/,keys %HISTI);
return if ($#hist < 0); #don't display anything if the history dosen't exist

print <

History:

$HISTI{$itm}\n"; } print <

EOM
}






#
# Toggle paging for the user
#
sub paging_service {
my($user)=@_;
my(%USERS);
&print_header("Paging Services","Paging Services");
%USERS=&read_info_file("$save/nopage.users");
if (defined $FORM{'paging-off'}) {
$USERS{$FORM{'for'}}=1;
&write_info_file("$save/nopage.users",%USERS);
} elsif (defined $FORM{'paging-on'}) {
delete $USERS{$FORM{'for'}};
&write_info_file("$save/nopage.users",%USERS);
}

print <

Paging Service for username:

EOM
if ($user ne "") {
if ($USERS{$user} ne "") {
print <

Paging service is currently: OFF

EOM
} else {
print <

Paging service is currently: ON

EOM
}
}
print "Back\n";
&print_trailer;
}




#
#actually print out the equipment...
#this is pretty much the guts of the display
#
sub print_equipment_list {
my($lab,$group,%ZONES)=@_;
my($zone,%ZM,$equ,$tel,$nexttime,@nowtime,$nowtime,$citime,$cotime,$newitm,$itmon,$mx,$pr);

#global GROUP INFORMATION variable
%{$GI{$group}}=&read_info_file("$based/.info","$based/$lab/.info","$based/$lab/$group/.info") if (!defined $GI{$group});
$pr=0;
#compute the time-at-the-next-increment-unit ;)

@nowtime=localtime();
$nowtime=time();
if ($GI{$group}{'checkout-increment-units'} eq "minutes") {
$mx=60;
$nexttime=$nowtime-$nowtime[0]; #+59
} elsif ($GI{$group}{'checkout-increment-units'} eq "hours") {
$nexttime=$nowtime -($nowtime[0]) - ($nowtime[1])*60; #+59+59*60
$mx=60*60;
} else {
# } elsif ($GI{$group}{'checkout-increment-units'} eq "days") {
#default of days
$nexttime=$nowtime-$nowtime[0]-($nowtime[1]+($nowtime[2])*60)*60; #+59+59*60+23*60*60
$mx=60*60*24;
}

$mx*=$GI{$group}{'max-checkout-time'}; #we want the max checkout time in mx

foreach $zone (sort {uc($ZONES{$a}{'name'}) cmp uc($ZONES{$b}{'name'})} keys %ZONES) {
#skip it if there's nothing to print & we're not in editmode
next if ((!defined $ZONES{$zone}{'equ'}) && (!defined $editmode) && (($FORM{'zone'} ne $zone) || ($FORM{'stext'} ne "")));


if (!defined $ZONES{$zone}{'equ'}) {
$ZONES{$zone}{'empty'}=1;
}

if ($ZONES{$zone}{'ip'}) {
$tel="telnet://$ZONES{$zone}{'ip'}"; #can telnet
$name="$ZONES{$zone}{'name'}";
} else {
$name="$ZONES{$zone}{'name'}";
$tel=""; #no telnet
}
$pr++;
#$aa=localtime($nexttime);
#print "$aa $nexttime";
if ($editmode==2) {
print <

\n";
if ($ZO{'static'} ne "yes") {
print "";
} else {
print "\n";
}

if (($ZO{'port'} ne "") && ($ZO{'port'} !~ /^\d+$/)) { #not a number
print " \n";
} elsif (($tel ne "") && ($ZO{'port'} ne "")) {
print " \n";
} else {
print " \n";
}
print " \n";
if ($ZO{'static'} ne "yes") {
#ok, it's not static. let's play.
if (($ZO{'checkout-login'} ne "") && ($ZO{'checkout-to'} > $nexttime)) {
#ooh, we're checked out
$cotime=&str_time($ZO{'checkout-from'},$ciu);
$citime=&str_time($ZO{'checkout-to'},$ciu);
print <



EOM
} else {
if ($ZO{'checkout-login'} ne "") {
#lets... check it in!
# print "\n";
&do_check("$lab/$group/$zone/$equ","automatically checked IN on page load");
}
#not checked out
print "";
}
} else {
printf " \n",$ZO{'static-text'}||"Static";
}
$equ=$1 if ($equ =~ /(.*)\.eq$/);
$equ=&webify($equ);
print "\n";

}





#
#The function to print out the equipment in 'short' format (no login or from fields, but a port field)
#
sub print_table_column_short {
my($lab,$group,$zone,$equ,$tel,$ciu,$mx,$nexttime,%ZO)=@_;
print "\n";

if (($tel ne "") && ($ZO{'port'} ne "")) {
print " \n";
} else {
print " \n";
}
print " \n";
if ($ZO{'static'} ne "yes") {
#ok, it's not static. let's play.
if (($ZO{'checkout-login'} ne "") && ($ZO{'checkout-to'} > $nexttime)) {
#ooh, we're checked out
$citime=&str_time($ZO{'checkout-to'},$ciu);
print <

EOM
} else {
if ($ZO{'checkout-login'} ne "") {
#lets... check it in!
# print "\n";
&do_check("$lab/$group/$zone/$equ","automatically checked IN on page load");
}
#not checked out
print "";
}
} else {
printf " \n",$ZO{'static-text'}||"Static";
}
$equ=$1 if ($equ =~ /(.*)\.eq$/);
print "\n";

}







#
#print out the data in "editor" format
#
sub print_table_column_edit {
my($lab,$group,$zone,$equ,$ciu,$tel,%ZO)=@_;
my $tmpname;
my $tmpstat;
my $tmptype;

# Added code to protect '<', '>', and '"'.
# Also expanded field lengths for name & type to allow imbedded
# HTMl info. tgage - 13-Dec-1999

$tmpname = $ZO{'name'};
$tmpname =~ s/\/\&gt\;/g;
$tmpname =~ s/\"/\&quot\;/g;

$tmpstat = $ZO{'static-text'};
$tmpstat =~ s/\/\&gt\;/g;
$tmpstat =~ s/\"/\&quot\;/g;

$tmptype = $ZO{'type'};
$tmptype =~ s/\/\&gt\;/g;
$tmptype =~ s/\"/\&quot\;/g;

print "\n";


printf "",$lab,$group,$zone,$equ,($ZO{'static'} eq "yes")?"":"CHECKED";

print <




EOM
}





#
#actually performs the file stuff (for checkin,checkouts)
#
sub do_check {
my($path,$logmsg,$login,$reason,$time,$maxtime)=@_;
my(%INF,$t,$msg,$grpath,%GRP);
$grpath=$1 if ($path=~/^(.*)\//);
if ($maxtime%(60*60*24)==0) { $t="days"; } elsif ($maxtime%3600) { $t="hours"; } else {$t="minutes"; }

$time=$maxtime if (($time > $maxtime) && ($maxtime > 0));
%INF=&read_info_file("$based/$path");
$INF{'checkout-comment'}=$reason;
$INF{'checkout-login'}=$login;
$INF{'checkout-from'}=time();
$INF{'checkout-to'}=$time+time();
%GRP=&read_info_file("$based/$grpath/.info");
&write_info_file("$based/$path",%INF);
if ($login ne "") {
&log_msg("$based/$path.log",sprintf "%s %s by \"%s\" for \"%s\" until %s",$INF{'name'},$logmsg,$login,$reason,&str_time($time+time(),$t));
if ($GRP{'ip'} ne "") {
$msg="

$INF{'name'} checked out until ".&str_time($time+time(),(defined $GRP{'checkout-increment-units'})?$GRP{'checkout-increment-units'}:"days")."\n";
} else {
$msg="

$INF{'name'} checked out until ".&str_time($time+time(),"minutes")."\n";
}
} else {
&log_msg("$based/$path.log","$INF{'name'} $logmsg");
$msg="

$INF{'name'} checked in\n";
}

return $msg;
}




#
#oooh... now for the checkout.
#let's do it!
#
sub save_checkout {
my($itm,$path,$msg);
$msg="";
#let's step through the items...
foreach $itm (grep(/^ck\-/,keys %FORM)) {
$path=$1 if ($itm =~ /^ck\-(.*)/);
if ($FORM{'checkout-user'} eq "") { #checkIN
$msg.=&do_check($path,"manually checked IN");
} else { #checkOUT
$msg.=&do_check($path,"checked OUT",$FORM{'checkout-user'},$FORM{'checkout-reason'},($FORM{'checkout-time'})*$FORM{'checkout-mult'},$FORM{$itm});
}
}
return $msg;
}





#
#let's do the save dance... the save dance... the save dance...
#put your left foot in... your left foot out... your left foot in... and shake it all about...
#
sub save_data {
my($itm,$itm2,%SAVE,%AD,$itml,$num,$num1);
#we need to go through the %FORM stuff to see what we need _to_ save.
foreach $itm (grep(/^save~/,keys %FORM)) {
$SAVE{$2}{$1}=$FORM{$itm} if ($itm =~ /^save~(.+?)~(.+)/);
}
#ok, now let's write the stuff out...
foreach $itm (keys %SAVE) {
next if ($itm =~ /\/\.\./);
if ($SAVE{$itm}{'banner'} ne "") {
#ok, I know this is bad. I feel bad writing it. I really do. >:-)
open(DATA,">$itm");
print DATA $SAVE{$itm}{'banner'};
close(DATA);
} elsif (($SAVE{$itm}{'banner'} eq "") && (defined $SAVE{$itm}{'banner'})) {
unlink("$itm"); #that's really bad...
} elsif ($SAVE{$itm}{'name'} eq "") {
unlink("$based/$itm");
} else {
#read in the old values, so if we don't have all the values (ie checkout data) we don't overwrite something or erase it
undef %AD;
%AD=&read_info_file("$based/$itm");
foreach $itm2 (keys %{$SAVE{$itm}}) {
&log_msg("$based/$itm.log","UPDATE: \"$itm2\" set to \"$SAVE{$itm}{$itm2}\" from \"$AD{$itm2}\"") if ($AD{$itm2} ne $SAVE{$itm}{$itm2});
$AD{$itm2}=$SAVE{$itm}{$itm2};
}

if ($itm =~ /\@Z(.*)Z\@/) {
$itml=lc($SAVE{$itm}{'name'});
$itml=~s/[^a-z\-\_\.]//g;
$num=$itm;
$num=~s/\@Z(\d+)Z\@/$1/g;
if ($itml ne "") {
$num1=$itm;
$num1=~s/\@Z(\d+)Z\@/$itml/g;
if ( -e "$based/$num1") {
$itm=$num;
} else { $itm=$num1; }
} else { $itm=$num; }
}
&write_info_file("$based/$itm",%AD);
}
}
#and, the finale!
}
#ok, so the finale was more of an anticlimax..




#
#purge the unused stuff out...
#
sub purge_zones {
my($aa,$bb,$itm,$now);
#
#we need to go through the %FORM stuff to see what we need _to_ purge.
#
$now=time();
foreach $itm (grep(/^purge~/,keys %FORM)) {
if ($itm =~ /^purge~(.*?)~(.*)/) {
$aa=$1; $bb=$2;
next if (($aa ne ".") && (($aa =~ /\/\.\./) || ($aa eq "") || ($aa =~ /^\./)));
#
#we're not actually deleteing it, just renaming it
#
rename("$based/$aa/$bb","$based/$aa/.$bb.purged.$now");
}
}
}




#
#create a new object
#
sub create_itm {
my($itm,%WH,$fn,$ln);

foreach $itm (grep(/^create~/,keys %FORM)) {
$WH{$1}=$FORM{$itm} if ($itm =~ /^create~(.*)/);
}
$fn=lc("$WH{'name'}");
$fn=~s/[^a-z\-\_0-9\.]//g;
$ln=lc("$WH{'dir'}");
$ln=~s/[^a-z\-\_0-9\.]//g;
return if (($fn eq "") || ($ln eq ""));
mkdir("$based/$ln/$fn",511);

&write_info_file("$based/$ln/$fn/.info",%WH);

}



#
#create a new zone... start at zone0000 and work our way up...
#
sub create_new_zone {
my($dir)=@_;
my($name)="0000";
while (-e "$dir/zone$name") { $name=sprintf "%04d",$name+1; }
mkdir("$dir/zone$name",511);
open(DATA,">$dir/zone$name/.info");
print DATA "name=Unnamed Zone $name\n";
close(DATA);
}




#
#prints out the text that can be used in configuring a commserver
#
sub generate_commserver_text {
my($lab,$group,$zone)=@_;
my(%zones,$mach,%EMAIL);
print "Content-type: text/plain\n\n";
%zones=&read_zone_file($lab,$group,$zone);
foreach $mach (keys %{$zones{$zone}{'equ'}}) {
printf "ip host %s %s %s\n",lc($zones{$zone}{'equ'}{$mach}{'name'}),$zones{$zone}{'equ'}{$mach}{'port'},$zones{$zone}{'ip'};
}

print "\nbanner exec ^\n";
printf " Connected through %s (%s):\n",$zones{$zone}{'name'}||$zone,$zones{$zone}{'ip'};
foreach $mach (sort {$zones{$zone}{'equ'}{$a} cmp $zones{$zone}{'equ'}{$b}} keys %{$zones{$zone}{'equ'}}) {
printf " * %-15s %-12s %4s\n",uc($zones{$zone}{'equ'}{$mach}{'name'}),$zones{$zone}{'equ'}{$mach}{'type'},$zones{$zone}{'equ'}{$mach}{'port'};
$EMAIL{$zones{$zone}{'equ'}{$mach}{'checkout-login'}}++;
}
print "^\n\nprivilege exec level 0 clear line\nprivilege exec level 0 clear\n";
printf "\nbanner incoming ^\nYou are connected through %s (%s)\n^\n",$zones{$zone}{'name'}||$zone,$zones{$zone}{'ip'};

print "! Below are email addresses of people who have this equipment checked out\n";
foreach $mach (sort keys %EMAIL) {
print "$mach\n" if ($mach ne "");
}

}




#
# Print out the top of the page (below EDITOR MODE) when we're in editor mode...
#
sub show_editor_head {
my($dir,%GRP)=@_;
my(%SEL,$inf);
$SEL{$GRP{'checkout-increment-units'}}="SELECTED";
$inf="CHECKED" if ($GRP{'hidden'} eq "");

print <

Name: IP: EOM } else { #not edit mode print < EOM #if we're editmode, edit it... if ($editmode==2) { print "\n"; foreach $equ (sort {uc($ZONES{$zone}{'equ'}{$a}{'name'}) cmp uc($ZONES{$zone}{'equ'}{$b}{'name'})} keys %{$ZONES{$zone}{'equ'}}) { &print_table_column_edit($lab,$group,$zone,$equ,$tel,$GI{$group}{'checkout-increment-units'},%{$ZONES{$zone}{'equ'}{$equ}}); } $newitm=0; $itmon="00000"; while ($newitm < 6) { if (!defined $ZONES{$zone}{'equ'}{"$itmon.eq"}) { $newitm++; &print_table_column_edit($lab,$group,$zone,"\@Z${itmon}Z\@.eq",$tel,$GI{$group}{'checkout-increment-units'}); } $itmon=sprintf "%05d",$itmon+1; } } else { #otherwise do it normally if (!defined $FORM{'short'}) { print "\n"; foreach $equ (sort {uc($ZONES{$zone}{'equ'}{$a}{'name'}) cmp uc($ZONES{$zone}{'equ'}{$b}{'name'})} keys %{$ZONES{$zone}{'equ'}}) { &print_table_column_standard($lab,$group,$zone,$equ,$tel,$GI{$group}{'checkout-increment-units'},$mx,$nexttime,%{$ZONES{$zone}{'equ'}{$equ}}); } } else { #short mode print "\n"; foreach $equ (sort {uc($ZONES{$zone}{'equ'}{$a}{'name'}) cmp uc($ZONES{$zone}{'equ'}{$b}{'name'})} keys %{$ZONES{$zone}{'equ'}}) { &print_table_column_short($lab,$group,$zone,$equ,$tel,$GI{$group}{'checkout-increment-units'},$mx,$nexttime,%{$ZONES{$zone}{'equ'}{$equ}}); } } } print " $name EOM } if ($FORM{'zone'} eq $zone) { if (defined $editmode) { print "[ View Zone | ] \n Delete the name of the device to remove it. Enter new devices in blank spaces below. Delete all devices to delete zone (commserver). Save changes before viewing zone."; } } else { if (defined $editmode) { print "(edit)\n" if (!defined $FORM{'short'}); } else { print "(zoom)\n" if (!defined $FORM{'short'}); } } &print_banner("$based/$lab/$group/$zone",$editmode); print < Static? Name Type Port/IP Static Description Name Type Login From To Comments Name Type Port To Comments \n"; } #return the number of zones we saw & displayed return $pr; } #ok, that's a long function. # #The function to print out a piece of equipment in "standard" format # sub print_table_column_standard { my($lab,$group,$zone,$equ,$tel,$ciu,$mx,$nexttime,%ZO)=@_; next if (($USER{'available'} != 0) && (($ZO{'static'} eq "yes") || (($ZO{'checkout-login'} ne "") && ($ZO{'checkout-to'} > $nexttime)))); print "

$ZO{'name'}

$ZO{'name'}

$ZO{'name'}

$ZO{'type'}

$ZO{'checkout-login'}

$cotime

$citime

$ZO{'checkout-comment'}

$based/$lab/$group/$zone/$equ

%s

Zoom

$ZO{'name'}

$ZO{'name'}

$ZO{'type'}

$ZO{'port'}

$citime

$ZO{'checkout-comment'}

$based/$lab/$group/$zone/$equ

%s

Zoom

Y: ",$lab,$group,$zone,$equ,($ZO{'static'} ne "yes")?"":"CHECKED"; printf "N:

Name:
Refresh Time:	seconds
Contact Name & Email:	Name: Email:
Page Hidden:	NO YES Making the page hidden will remove it from all lists and searches.
Checkout Time:	In Multiples of dayshoursminutes, up to total. Every 2 hours, up to 48 would mean that you could check out the equipment up until 2 days, in multiples of 2 hour blocks.
Check-In Notification:	Send pages at (HHMM) for equipment that expires within the next hours. Example: Page at 1400 for equipment that expires within 10 hours would page at 2PM for equipment that expires up until midnight.
Paging/Email	EOM printf < EOM printf < EOM print < EOM printf < EOM printf < EOM print < Sun Mon Tue Wed Thu Fri Sat Days Paging Disabled: Days Paging Enabled: Days Email Disabled: Days Email Enabled:

EOM
}





#
#print out what we just did...
#
sub print_did_box {
my($msg)=@_;
if ($msg ne "") {
print <
EOM
}
print <

Actions Performed EOM if ($FORM{'checkout-user'} ne "") { print <Show Me
$msg

EOM
}
}




#
#print out the zone(s) on the screen.
#
sub show_zones {
my($lab,$group,$msg,%ZONES)=@_;
my($zone,%GRP,%SEL,%RST,$owner);
%RST=&read_info_file("$based/.info","$based/$lab/.info");
%GRP=&read_info_file("$based/$lab/$group/.info");
$GRP{'name'}=$GRP{'name'}||"$group";
foreach $zone (keys %RST) {
$GRP{$zone}=$RST{$zone} if (!defined $GRP{$zone});
}

if ((defined $FORM{'commgen'}) && (defined $zonevalid)) {
&generate_commserver_text("$lab","$group","$FORM{'zone'}");
exit(0);
}

&print_header("Zone Selection -- $GRP{'name'}","Zone Selection for $GRP{'name'}");
if ((defined $editmode) && (!defined $zonevalid)) {
&show_editor_head("$lab/$group",%GRP);
}
&print_banner("$based/$lab/$group",($editmode==1)?2:0);

if ((defined $editmode) && (!defined $zonevalid)) {
print <

EOM
foreach $zone (keys %ZONES) {
# print "\n-$ZONES{$zone}{'equ'}-\n";
next if ((defined $ZONES{$zone}{'equ'}));
# && (%{$ZONES{$zone}{'equ'}} > 0));
print "\n";
}
}
&print_did_box($msg);


&print_equipment_list($lab,$group,%ZONES);

if ((!defined $editmode) && (!defined $FORM{'short'})) {
&print_checkout_box;
$owner="This equipment maintained by $GRP{'contact-name'}
" if ($GRP{'contact-name'} ne "");
print <

$owner Edit Mode Pop-Up Window

Toggle My Paging Checkout Stats EOM print " Generate Commserver/Mail Information\n" if ((defined $zonevalid) && ($ZONES{$FORM{'zone'}}{'ip'} =~ /\./)); print "

\n";
}


&print_trailer;
}





#
#print out the zone(s) on the screen.
#
sub show_machine {
my($lab,$group,$zone,$machine)=@_;
my(%INFO,@lines,$i,$lines,$status,%GRP,@nowtime,$nowtime,$nexttime,$mx,%LOC,$location,$notes,$confstr);
%INFO=&read_info_file("$based/$lab/$group/$zone/$machine.eq");
%GRP=&read_info_file("$based/.info","$based/$lab/.info","$based/$lab/$group/.info");
%LOC=&read_info_file("$based/$lab/$group/$zone/.info");
$INFO{'name'}=$INFO{'name'}||"$machine";

if (defined $FORM{'savenotes'}) {
&log_msg("$based/$lab/$group/$zone/$machine.eq.log","Notes Updated");
open(DATA,">$based/$lab/$group/$zone/$machine.eq.notes");
print DATA "$FORM{'notes'}";
close(DATA);
&print_redirect("$ENV{'SCRIPT_NAME'}/$lab/$group/$zone/$machine");
exit(0);
}

&print_header("Equipment View -- $INFO{'name'}","Equipment View");

if (open(DATA,"$based/$lab/$group/$zone/$machine.eq.notes")) {
while () { $notes.=$_; }
close(DATA);
}


if (open(DATA,"$based/$lab/$group/$zone/$machine.eq.log")) {
while () { push @lines,$_; }
close(DATA);
}
for ($i=$#lines;(($i >= 0) && (($i >= $#lines - 19) || (defined $FORM{'logall'})));$i--) {
$lines=sprintf "%d. %s%s",$i+1,$lines[$i],$lines;
}
chomp $lines;
if ($INFO{'static'} ne "yes") {
$status="Not currently checked out";


#### compute nexttime
@nowtime=localtime();
$nowtime=time();
if ($GRP{'checkout-increment-units'} eq "minutes") {
$nexttime=$nowtime-$nowtime[0]; #+59
$mx=60;
} elsif ($GRP{'checkout-increment-units'} eq "hours") {
$nexttime=$nowtime -($nowtime[0]) - ($nowtime[1])*60; #+59+59*60
$mx=60*60;
} else {
#default of days
$nexttime=$nowtime-$nowtime[0]-($nowtime[1]+($nowtime[2])*60)*60; #+59+59*60+23*60*60
$mx=60*60*24;
}
###########

$mx*=$GRP{'max-checkout-time'}; #we want the max checkout time in mx

if (($INFO{'checkout-login'} ne "") && ($INFO{'checkout-to'} > $nexttime)) {

$status=sprintf "Checked out from %s to %s by %s for \"%s\"",
&str_time($INFO{'checkout-from'},$GRP{'checkout-increment-units'}),&str_time($INFO{'checkout-to'},$GRP{'checkout-increment-units'}),$INFO{'checkout-login'},$INFO{'checkout-comment'};
}
} else {
$status="Static: $INFO{'static-text'}";
}
$location=sprintf "%s in %s", $LOC{'name'}||$zone,$GRP{'name'}||$group;
if (($LOC{'ip'} ne "") && ($INFO{'port'} ne "")) {
$location=sprintf "%s (%s) on port %s in %s -- Connect",$LOC{'name'}||$zone,$LOC{'ip'},$INFO{'port'},$GRP{'name'}||$group,$LOC{'ip'},$INFO{'port'};
$confstr=sprintf "Configuration (IOS only):
[Reconfigure]
[View Running Config]",
&webify($INFO{'name'}),&webify($INFO{'port'}),&webify($LOC{'ip'}),
&webify($INFO{'name'}),&webify($INFO{'port'}),&webify($LOC{'ip'});
}


print <





$confstr

Equipment Name:	$INFO{'name'}	Type:	$INFO{'type'}
Location:	$location
Status:	$status

EOM


if (!defined $FORM{'updnotes'}) {
print <

Machine Notes (Update)
$notes

EOM
} else {
print <

Machine Notes
$notes

EOM
}

print <

Log File EOM if (defined $FORM{'logall'}) { print "(everything)"; } else { print "(most recent 20 events) [show all]"; } print <

$lines

EOM
$GI{$group}={%GRP};
&print_checkout_box if ($INFO{'static'} ne "yes");
&print_trailer;
}






#
#save the history to the file -- rotating out old entries and bumping up new ones...
#
sub save_history {
my($ip,$path,$lab,$group,$zone,$mach)=@_;
my(%HISTI,@save,$itm,$max);
$max=4;
$lab="$1..." if ((length($lab) > 8) && ($lab =~ /^(.....)/));
$group="$1..." if ((length($group) > 9) && ($group =~ /^(......)/));
%HISTI=&read_info_file("$save/$ip.hist");
$HISTI{'accesses'}++;
$path=$1 if ($path =~ /^(.*)\/$/);
push @savep,$path;
push @save,sprintf "%s:%s%s%s",$lab,$group,($zone ne "")?":$zone":"",(($zone ne "") && ($mach ne ""))?":$mach":"";
foreach $itm (sort grep(/^HIST/,keys %HISTI)) {
if ($path ne $HISTI{"P$itm"}) {
push @save,$HISTI{$itm};
push @savep,$HISTI{"P$itm"};
last if ($max-- == 0);
}
}
#now delete the entries out of HISTI
foreach $itm (sort grep(/^HIST/,keys %HISTI)) {
delete $HISTI{$itm};
delete $HISTI{"P$itm"};
}
#and save the new ones
$max=0;
foreach $itm (@save) {
$HISTI{"HIST$max"}=$itm;
$HISTI{"PHIST$max"}=$savep[$max];
$max++;
}
&write_info_file("$save/$ip.hist",%HISTI);
}




#
# Read in groups from the directory
#
sub read_groups {
my($labdir,$all)=@_;
my($group,%GROUPS,%INFO);
foreach $group (&read_dir("$labdir")) {
%INFO=&read_info_file("$labdir/$group/.info");
if ((($INFO{'hidden'} eq "") || (defined $all)) || (defined $FORM{'short'})) {
$GROUPS{$group}=$INFO{'name'}||$group;
}
}
return %GROUPS;
}



#
#read in the labs from the directory
#
sub read_labs {
my($labdir,$all)=@_;
#
#does the same thing, why rewrite it now?
#
return &read_groups($labdir,$all);
}




#
#read in the name of the groups from the lab and show them.
#
sub read_and_show_groups {
my($lab)=@_;
my($group,%GROUPS,$zone,@files,%INFO,$col,%INF,$inf,$cnt);
$col=0;

%INFO=&read_info_file("$based/$lab/.info");
$INFO{'name'}=$INFO{'name'}||$lab;
&print_header("Group Selection -- $INFO{'name'}","Group Selection");

if (defined $editmode) {
&show_editor_head("$lab/$group",%INFO);
print <

New Group Name:

EOM
}

&print_banner("$based/$lab",(defined $editmode)?2:0);

#
#get a listing of all the groups
#
%GROUPS=&read_groups("$based/$lab");

undef %INFO;
print "

\n\n"; # print ""; foreach $group (sort {uc($GROUPS{$a}) cmp uc($GROUPS{$b})} keys %GROUPS) { next if (! -d "$based/$lab/$group"); print "" if (($col%2)==0); print " \n \n"; # print "\n"; print "" if ((($col++)%2)==1); } print "" if ($col%2 != 0); print " $GROUPS{$group} "; $printblank=0; opendir(DIR,"$based/$lab/$group"); @files=readdir(DIR); closedir(DIR); undef %INF; undef %INFO; foreach $file (@files) { next if (($file =~ /^\./) || (! -d "$based/$lab/$group/$file")); %{$INF{$file}}=&read_info_file("$based/$lab/$group/$file/.info"); $INFO{$file}=$INF{$file}{'name'}; } $cnt=0; foreach $zone (sort {uc($INFO{$a}) cmp uc($INFO{$b})} keys %INFO) { if ($printblank--<=0) { $printblank=2; print " \n"; } # if ($printblank==0) { # $printblank=1; # } else { # print " \n"; # } # print "\n"; print " \n"; if ($printblank < 1) { print " \n"; } $cnt++; } if ($printblank >= 1) { print " \n"; } if ($cnt==0) { print " \n"; if (defined $editmode) { print "\n"; } } print " $GROUPS{$group} $INFO{$zone} $INFO{$zone} No zones found \n \n"; # print "

\n";
if (!defined $editmode) {
print "Edit Mode\n";
}
&print_trailer;
}




#
#Print out the "short" screen -- nothing but the top, search box, and trailer
#
sub print_short {
&print_header("Personal Screen","Enter your Username");
&print_trailer;
}



#
#read the names of the valid labs and print the on the screen!
#
sub read_and_show_labs {
my(%LABS,$lab,$printblank,%GROUPS,$col,%INFO,$cnt);
$col=0;

#get a listing of all the labs
%LABS=&read_labs("$based");
&print_header("Lab Selection","Lab Selection");
if (defined $editmode) {
print <

New Lab Name:

EOM
}
&print_banner("$based",(defined $editmode)?2:0);
print "

\n\n"; foreach $lab (sort {uc($LABS{$a}) cmp uc($LABS{$b})} keys %LABS) { next if (! -d "$based/$lab"); print " " if (($col%2)==0); print " \n"; print " " if ((($col++)%2)==2); } print " " if ($col%2 != 0); print " \n \n"; $printblank=0; %GROUPS=&read_groups("$based/$lab"); $cnt=0; foreach $group (sort {uc($GROUPS{$a}) cmp uc($GROUPS{$b})} keys %GROUPS) { if ($printblank--<=0) { $printblank=2; print " \n"; } print " \n"; if ($printblank < 1) { print " \n"; } $cnt++; } if ($printblank >= 1) { print " \n"; } if ($cnt==0) { print " \n"; if (defined $editmode) { print "\n"; } } print " $LABS{$lab} $GROUPS{$group} No groups found \n

\n";
if (!defined $editmode) {
print "Edit Mode\n";
}
&print_trailer;
}





#
#the trailer
#
sub print_trailer {
my(@d);

#get the last modify time, yes this is y2k compliant
@d=stat($ENV{'SCRIPT_FILENAME'});
@d=localtime($d[9]); $d[4]++; $d[5]+=1900;

#print it out

print <

---

Last modified on $d[4]-$d[3]-$d[5] - $VERSION - Send complaints/requests to ADI-AUTOMATION-TEAM mailing-list
EOM

}



#
#the header.
#pretty straightfoward.
#
sub print_header {
my($title,$top)=@_;
my($nowtime,%INFO,$sb,$groupt,$labt,$zonet,$refresh,$machinet,$which);
$nowtime=localtime();
$title=" -- $title" if ($title ne "");
$sb="$ENV{'SCRIPT_NAME'}"||"/";
if (!defined $editmode) {
if ((defined $labvalid) && (defined $groupvalid)) {
%INFO=&read_info_file("$based/.info","$based/$FORM{'lab'}/.info","$based/$FORM{'lab'}/$FORM{'group'}/.info");
$refresh="Refresh: $INFO{'default-refresh-seconds'}" if ($INFO{'default-refresh-seconds'} > 0);
} else {
$refresh="Refresh: 600";
}
}

if (defined $FORM{'short'}) {
&print_short_header($title,$top);
} else {
print <

Checkout Page Home EOM if (defined $labvalid) { $sb="" if ($sb eq "/"); %INFO=&read_info_file("$based/$FORM{'lab'}/.info"); $sb.="/$FORM{'lab'}"; $labt=$INFO{'name'}||$FORM{'lab'}; printf ": %s\n",$sb,$labt; if (defined $groupvalid) { %INFO=&read_info_file("$based/$FORM{'lab'}/$FORM{'group'}/.info"); $sb.="/$FORM{'group'}"; $groupt=$INFO{'name'}||$FORM{'group'}; printf ": %s",$sb,$groupt; if (defined $zonevalid) { %INFO=&read_info_file("$based/$FORM{'lab'}/$FORM{'group'}/$FORM{'zone'}/.info"); $sb.="/$FORM{'zone'}"; $zonet=$INFO{'name'}||$FORM{'zone'}; printf ": %s",$sb,$zonet; if (defined $machinevalid) { %INFO=&read_info_file("$based/$FORM{'lab'}/$FORM{'group'}/$FORM{'zone'}/$FORM{'machine'}.eq"); $sb.="/$FORM{'machine'}"; $machinet=$INFO{'name'}||$FORM{'machine'}; printf ": %s",$sb,$machinet; } } } } if ((!defined $machinevalid) && (defined $labvalid)) { if ($USER{'available'} != 0) { $which="Show All Machines - "; } else { $which="Hide Unavailable Machines - "; } } print <

$top $which$nowtime

EOM &print_search_bar($FORM{'lab'},$FORM{'group'},$FORM{'zone'},$labt,$groupt,$zonet); print "

\n"; &print_history_bar($ENV{'REMOTE_ADDR'}); print "

\n";
if ((defined $labvalid) && (defined $groupvalid)) {
&save_history($ENV{'REMOTE_ADDR'},$sb,$labt,$groupt,(defined $zonevalid)?$zonet:"",(defined $machinevalid)?$machinet:"");
}

if (defined $editmode) {
print <

EDITOR MODE DO NOT EDIT WITHOUT PRIOR AUTHORIZATION

EOM
}
}

}






#
# The short header -- take away the home:where:i:am stuff
#
sub print_short_header {
my($title,$top)=@_;
$title=" for $FORM{'stext'}" if ($FORM{'stext'} ne "");
print <

Checkout Page Refresh - Close EOM print <

$top $nowtime

EOM


&print_search_bar;

}



#
# perform the actual search -- both for search & for the stats
#
sub find_all_groups {
#hmm, how should we do this....
#wow, i'm hungry.
#i can't think when i'm hungry.
#uhh oh.
#maybe this will work...
my($cat)=@_;
my(%LABS,$dir,$lab,%LR,%GR);

if ($cat eq "3") {
$LABS{$FORM{'lab'}}{$FORM{'group'}}=[$FORM{'zone'}];
} elsif ($cat eq "2") {
$LABS{$FORM{'lab'}}{$FORM{'group'}}= [ &read_dir("$based/$FORM{'lab'}/$FORM{'group'}") ];
} elsif ($cat eq "1") {
foreach $dir (&read_dir("$based/$FORM{'lab'}")) {
$LABS{$FORM{'lab'}}{$dir}=[ &read_dir("$based/$FORM{'lab'}/$dir") ];
}
} else {
%LR=&read_labs("$based");
foreach $lab (keys %LR) {
%GR=&read_groups("$based/$lab");
foreach $dir (keys %GR) {
$LABS{$lab}{$dir}= [ &read_dir("$based/$lab/$dir") ];
}
}
}
#hopefully that will work.
#:)
return %LABS;
}



#
#find pager stuff
#
sub do_find_pageable {
my(%LR,%GR,@zones,$zone,$group,$lab,%zones,@d,$day,$mach,$nowtime,@nowtime,$person,@mch);
@d=localtime();
$day="day-$day[$d[6]]";
%LR=&read_labs("$based",1);
foreach $lab (keys %LR) {
%GR=&read_groups("$based/$lab",1);
foreach $group (keys %GR) {
@zones= &read_dir("$based/$lab/$group") ;
# if (-e "$based/$lab/$group/.info") {
# %INFO=&read_info_file("$based/$lab/$group/.info");
# } elsif (-e "$based/$lab/.info") {
# %INFO=&read_info_file("$based/$lab/.info");
# } else {
%INFO=&read_info_file("$based/.info","$based/$lab/.info","$based/$lab/$group/.info");
# }
$pagenow=0; $emailnow=0;
@status=stat("$based/$lab/$group/.notified");
# print "[$INFO{'name'} -- $INFO{'page-time'} $day] \n";
if (($status[9] <= time()-21*60*60) && ($d[2]*100+$d[1] >= $INFO{'page-time'})) {
# print "got $INFO{'page-$day'} and $INFO{'email-$day'}\n";
if ($INFO{"page-$day"} ne "") {
$pagenow=$INFO{'page-time-within'}*60*60;
}
if ($INFO{"email-$day"} ne "") {
$emailnow=$INFO{'page-time-within'}*60*60;
}
open(DATA,">$based/$lab/$group/.notified");
printf DATA "Lucyyyyyyyyyyyyyy, I'm home! (%d)\n",$d[2]*100+$d[1];
close(DATA);
}
#### compute nexttime
@nowtime=localtime();
$nowtime=time();
if ($INFO{'checkout-increment-units'} eq "minutes") {
$nexttime=$nowtime-$nowtime[0]; #+59
$mx=60;
} elsif ($INFO{'checkout-increment-units'} eq "hours") {
$nexttime=$nowtime -($nowtime[0]) - ($nowtime[1])*60; #+59+59*60
$mx=60*60;
} else {
#default of days
$nexttime=$nowtime-$nowtime[0]-($nowtime[1]+($nowtime[2])*60)*60; #+59+$
$mx=60*60*24;
}
###########



foreach $zone (@zones) {
%zones=&read_zone_file($lab,$group,$zone);
foreach $mach (keys %{$zones{$zone}{'equ'}}) {
# print "$lab $group $zone - $mach\n";
next if (($zones{$zone}{'equ'}{$mach}{'checkout-login'} eq "") || ($zones{$zone}{'equ'}{$mach}{'checkout-to'} < $nexttime));
# print " -- checked out by $zones{$zone}{'equ'}{$mach}{'checkout-login'} (pagenow: $pagenow, checkoutto: $zones{$zone}{'equ'}{$mach}{'checkout-to'})\n";
#it is checked out
if (($pagenow) && ($zones{$zone}{'equ'}{$mach}{'checkout-to'}-$pagenow < time())) {
$PER{$zones{$zone}{'equ'}{$mach}{'checkout-login'}}{'page'}++;
# print " going to page owner\n";
# [($LR{$lab},$GR{$group},$zones{$zone}{'name'}|$zone,$zones{$zone}{'equ'}{$mach}{'name'}||$mach,$zones{$zone}{'equ'}{$mach}{'checkout-comment'},&str_time($zones{$zone}{'equ'}{$mach}{'checkout-to'},$INFO{'checkout-increment-units'}))];
}
if (($emailnow) && ($zones{$zone}{'equ'}{$mach}{'checkout-to'}-$emailnow < time())) {
# print " going to email owner\n";
$PER{$zones{$zone}{'equ'}{$mach}{'checkout-login'}}{'emailcnt'}++;
push @{$PER{$zones{$zone}{'equ'}{$mach}{'checkout-login'}}{'email'}},
[($LR{$lab},$GR{$group},$zones{$zone}{'name'}||$zone,$zones{$zone}{'equ'}{$mach}{'name'}||$mach,$zones{$zone}{'equ'}{$mach}{'checkout-comment'},&str_time($zones{$zone}{'equ'}{$mach}{'checkout-to'},$INFO{'checkout-increment-units'}))];
} else {
push @{$PER{$zones{$zone}{'equ'}{$mach}{'checkout-login'}}{'all'}},
[($LR{$lab},$GR{$group},$zones{$zone}{'name'}||$zone,$zones{$zone}{'equ'}{$mach}{'name'}||$mach,$zones{$zone}{'equ'}{$mach}{'checkout-comment'},&str_time($zones{$zone}{'equ'}{$mach}{'checkout-to'},$INFO{'checkout-increment-units'}))];
}
$PER{$zones{$zone}{'equ'}{$mach}{'checkout-login'}}{'allcnt'}++;
}
}
}
}

%NOPAGE=&read_info_file("$save/nopage.users");

foreach $person (keys %PER) {
if ((!$NOPAGE{$person}) && ($PER{$person}{'page'} > 0)) {
&send_email("", sprintf("%d item%s expiring today from the checkout page.",$PER{$person}{'page'},($PER{$person}{'page'}>1)?"s are":" is"), "$person\@epage.cisco.com");
}
if ($PER{$person}{'emailcnt'} > 0) {
$list="You have reserved equipment on the Checkout Page.\nCurrently, $PER{$person}{'emailcnt'} of $PER{$person}{'allcnt'} item(s) you have checked out are scheduled for\nautomatic check-in. These items include:\n\n-------------Items Expiring\n";
foreach $mach (@{$PER{$person}{'email'}}) {
@mch=@{$mach};
$list.=sprintf " %s located in %s:%s:%s\n for %s -- will be checked in after %s\n",$mch[3],$mch[0],$mch[1],$mch[2],$mch[4],$mch[5];
}
$list.="\n-------------Items not Expiring (as of this email)\n";
foreach $mach (@{$PER{$person}{'all'}}) {

@mch=@{$mach};
$list.=sprintf " %s located in %s:%s:%s\n for %s -- will be checked in after %s\n",$mch[3],$mch[0],$mch[1],$mch[2],$mch[4],$mch[5];
# $list.=sprintf " %s located in %s:%s:%s for %s\n -- will be checked in after %s\n",$mch[3],$mch[0],$mch[1],$mch[2],$mch[4],$mch[5];
}
$list.="\n-------------\n\nVisit the checkout page to stop receiving pages regarding your\nchecked out lab equipment. Please send comments to checkout\@cisco.com\n";
&send_email("Checkout Page - Expire Notification",$list,"$person\@cisco.com");
}
}

}




#
# send email to a person
#
sub send_email {
my($subject,$body,$to)=@_;
open(DATA,"|/usr/lib/sendmail \"$to\"");
# open(DATA,"|/usr/lib/sendmail \"checkout\@cisco.com\"");
print DATA <

No Equipment Located

\n";
} else {
&print_checkout_box if (!defined $FORM{'short'});
}
&print_trailer;

}




#
#show the stats for an area
#
sub show_stats {
my($lab,$group,$zone)=@_;
my($outat,$tme,$status,$tmeout,@files,$rlab,$rgroup,$rzone,$rmach,%zones,%sby,$firsttime);
&print_header("Stats","Stats");

print <

EQUIPMENT STATISTICS

Over The Last	Sort By
1 Day7 Days1 Month3 Months1 Year6 Months	Equipment TypeEquipment Name

EOM

if (defined $FORM{'statsgo'}) {
$firsttime=time()-$FORM{'s.from'};
$on=0;
if (defined $labvalid) { $on++;
if (defined $groupvalid) { $on++;
if (defined $zonevalid) { $on++; }
}
}
%LABS=&find_all_groups($on);
foreach $rlab (keys %LABS) {
foreach $rgroup (keys %{$LABS{$rlab}}) {
foreach $rzone (@{$LABS{$rlab}{$rgroup}}) {
%zones=&read_zone_file($rlab,$rgroup,$rzone);
foreach $rmach (keys %{$zones{$rzone}{'equ'}}) {
$tmeout=0; $status=0; $outat=0;
if (open(DATA,"$based/$rlab/$rgroup/$rzone/$rmach.log")) {
$sby{$zones{$rzone}{'equ'}{$rmach}{$FORM{'s.sort'}||$rmach}}{'cnt'}++;
while () {
if (/\d+\-(\d+)\): /) {
$tme=$1;
if ((/checked OUT /) && ($status==0)) {
$status=1; $outat=$tme;
} elsif ((/checked IN /) && ($status==1)) {
$status=0;
if ($tme > $firsttime) {
$tmeout+=$tme-(($outat >= $firsttime)?$outat:$firsttime);
}
}
}
}
$tmeout+=time()-(($outat >= $firsttime)?$outat:$firsttime) if ($status==1);
# $tmeout+=time()-$outat if ($status==1);
close(DATA);
}
#now this is one _hell_ of a hash reference.
$sby{$zones{$rzone}{'equ'}{$rmach}{$FORM{'s.sort'}||$rmach}}{'tme'}+=$tmeout;
# print "$rlab - $rgroup - $rzone - $rmach $zones{$rzone}{'equ'}{$rmach}{'type'} - $tmeout ($outat $firsttime) $tme
\n";
}
}
}
print "\n";
foreach $rmach (sort keys %sby) {
# print "\n";
next if ($sby{$rmach}{'cnt'} == 0);
$sby{$rmach}{'tme'}=$sby{$rmach}{'tme'}/$sby{$rmach}{'cnt'};
printf "\n",$rmach,&str_time($sby{$rmach}{'tme'},"hours"),
($FORM{'s.from'} > 0)?($sby{$rmach}{'tme'}*100/($FORM{'s.from'})):0,
($FORM{'s.from'} > 0)?($sby{$rmach}{'tme'}*200/($FORM{'s.from'})):1,
$sby{$rmach}{'cnt'};
}
print "

Equipment	Total Time Out	Percentage (based on total time available)		Count (of this equipment)
$sby{$rmach}{'cnt'} -- $sby{$rmach}{'tme'}
%s	%s	%2.2f%%		%d

\n";
}
}


&print_trailer;
}



#
#read files out of a directory, ignoring the .files
#
sub read_dir {
my($dir)=@_;
my(@d);
opendir(RDIR,"$dir");
@d=grep(!/^\./,readdir(RDIR));
closedir(RDIR);
return @d;
}




#
#print out the environment, for debugging purposes
#
sub print_env {
my($env);
foreach $env (keys %ENV) {
print "$env = $ENV{$env}\n";
}
print "\n---------\n\n";
foreach $env (keys %FORM) {
print "$env = $FORM{$env}\n";
}
}


sub webify {
my($what)=@_;
$what=~tr/ /+/;
$what=~s/\%/%25/g;
$what=~s/\&/%26/g;
$what=~s/\=/%30/g;
return $what;
}




#
#translate the buffer (which looks something like q=27&f=34) to a hash
#
sub Get_CGI {
my($buffer)=@_;
my(@pairs);
foreach $pair (split(/&/,$buffer)) {
$pair =~ tr/+/ /;
$pair =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/egs;
($name, $value) = ($1,$2) if ($pair =~ /^(.*?)=(.*)/s);
#split(/=/, $pair);
$FORM{$name}=$value;
}
}



#
#translate the ?string and the post data to a hash
#
sub Get_Input {
my($buffer);
if ( $ENV{'QUERY_STRING'} ne "") {
&Get_CGI($ENV{'QUERY_STRING'});
}
if ( $ENV{'REQUEST_METHOD'} eq "POST" ) {
read(STDIN,$buffer,$ENV{'CONTENT_LENGTH'});
&Get_CGI($buffer);
}
}



#
#handle the /lab/group/zone stuff
#
sub Handle_Path {
my($str1,$on);
$on=0;
return if (($ENV{'PATH_INFO'} eq "") || ($ENV{'PATH_INFO'} =~ /\/\.\./));
foreach $str1 (split(/\//,$ENV{'PATH_INFO'})) {
next if ($str1 eq "");

$str1 =~ tr/+/ /;
$str1 =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/egs;
if ($on==0) {
$FORM{'lab'}=lc($str1);
} elsif ($on==1) {
$FORM{'group'}=lc($str1);
} elsif ($on==2) {
$FORM{'zone'}=lc($str1);
} elsif ($on==3) {
$FORM{'machine'}=lc($str1);
} else { last; }
$on++;
}
}

clearcase batch

##############################

##
###For CleaCase checkin#########
################################
my $cmds = qq{ /ap/local/SunOS_sparc/bin/zsh -c '/usr/atria/bin/cleartool setview -exec "/usr/atria/bin/cleartool checkout -nc /vobs/esam/build/fulltests/COMMON/$tag$file" Tracker_Tool'};
my @arrs = `$cmds 2>&1`;
print LO "CO: @arrs\n";
my @content = `cat $file_name`;
open(SIH, ">/view/Tracker_Tool/vobs/esam/build/fulltests/COMMON/$tag$file");# or print LO "Cannot open the file $!";
print SIH "@content";print LO "CONTENT: @content\n";
close SIH;
my $cmds1 = qq{/ap/local/SunOS_sparc/bin/zsh -c '/usr/atria/bin/cleartool setview -exec "/usr/atria/bin/cleartool checkin -nc /vobs/esam/build/fulltests/COMMON/$tag$file" Tracker_Tool'};
my @arrs1 = `$cmds1 2>&1`;
if(grep/Unable to check in/, @arrs1){
my $unco = qq{/ap/local/SunOS_sparc/bin/zsh -c '/usr/atria/bin/cleartool setview -exec "/usr/atria/bin/cleartool uncheckout -rm /vobs/esam/build/fulltests/COMMON/$tag$file" Tracker_Tool'};
my @arrs2 = `$unco 2>&1`;
# print "ARRS2: @arrs2\n";
}
print LO @arrs1;
}
}
open(TH, ">Fstats");#print LO "Updating File stats\n";
print TH "@upd_content";
close TH;
close LO;