#!/usr/pkg/bin/perl # # $Header: /e/u/j/local-repository/htdocs/www/software/NetBSD/time-make/index.cgi,v 1.1.1.1 2008/03/12 10:53:05 makoto Exp $ $rcsid = q$Id: index.cgi,v 1.1.1.1 2008/03/12 10:53:05 makoto Exp $; $rcsid =~ s/Id://; #------------ my_name for appropriate help message ---- # my name, strip all before '/' inclusively # /home/fujiwara/perl/my_name -> my_name $my_name = $0; $my_name =~ s#(.*)/##; #------------ my_path for getting right @INC path ----- # my location, strip rightmost '/' and right of it. # /home/fujiwara/perl/my_path -> /home/fujiwara/perl $my_path = $0; $my_path =~ s|/[^/]+$||; #--------------------- push(@INC,"$my_path"); require 'getopts.pl'; require 'cgi-lib.pl'; require 'stat.pl'; require 'index.pl'; ReadParse(); $FILE = $in{'file'}; $WIDTH = $in{'width'}; $FRAME = $in{'frame'}; $FORMAT = $in{'format'}; $HELP = $in{'help'}; $FONTSIZE = $in{'fontsize'}; if ( $WIDTH ) { $width = 'WIDTH='.$WIDTH ; } if ( $FONTSIZE ){ $fontsize = ''; } else { $fontsize = ''; } $URI = $ENV{'REQUEST_URI'}; $PATH = $URI; $URI =~ s/\?([^?*]+)$//; $ARGUMENT = $1; $PATH =~ s|/[^/]+$||; $DK = '#b0b0b0'; $GRDK = '#90c090'; $ORDK = '#d0b080'; $BLDK = '#a0a0f0'; $LI = '#d0d0d0'; $GRLI = '#b0e0b0'; $ORLI = '#e0c090'; $BLLI = '#c0c0ff'; &Getopts('dh'); # ----------------- help ------------- if ( $opt_h ) { &usage ; } # ----------------------------------- chdir $my_path; if ( $HELP ) { usage(); exit } $FILE = '.data'; open(STDOUT,"|/usr/local/bin/nkf -j"); if ( $FILE eq '' ) { header('Database list'); show_list (); } else { header("Database($my_name) for $FILE"); print '

time make (NetBSD)\n"; } else { pointer();} open(FILE) || print "problem opening $FILE: $!\n" ; if ( $FORMAT eq '' ) { if ( $FRAME =~ /yes/i ) { print "\n" ;} else { print "
\n" ;}} $counter = 0; # -------- R E P E A T F O R E A C H L I N E ------ my $line; my $offset = 2; while () { if ( /^\s*$/ ) { next; } @iii = split(',',$_); # まず , 区切で分けて、 @time = split(' ',$iii[$offset]); # 三つ目を更に空白で分けて splice(@iii,$offset,1,@time); # 分けたものを元のものと交換する。 # push(@ptr,[$iii[0],$iii[1],$iii[2]]); push(@ptr,[$#iii, @iii]); # 一つ目には数を入れておく # __END__ 以下のように push される。 } list_all_entries(); print "
"; } exit; # # 呼出し方法例 # sub test { $tmp = $ptr[0]; $count = $tmp -> [0]; # get how many info's are there. # print "$count\n"; foreach $i ( 1.. $count ) { # skip the first one, which was count. print $tmp -> [$i], "\n";} } sub list_all_entries { my ($p,$line,$tmp,$count,$i,$name,$prev_name); $BG = $DK; foreach $p ( sort by_name @ptr ) { $count = $p -> [0]; # get how many info's are there. $count++; $prev_name = $name ; $name = $p -> [1]; # get name if ( $prev_name ne $name ) { if ( $BG eq $LI ) { $BG = $DK ;} else { $BG = $LI ;}} print ""; foreach $i ( 1.. $count ) { # skip the first one, which was count. if ($i == 10) { # column for model $model = $p ->[$i]; if ( $model =~ /iBook/ ) { if ($BG eq $DK) { $CL = $GRDK } else { $CL = $GRLI }} elsif ( $model =~ /SS-2/ ) { if ($BG eq $DK) { $CL = $ORDK } else { $CL = $ORLI }} elsif ( $model =~ /4000/ ) { if ($BG eq $DK) { $CL = $BLDK } else { $CL = $BLLI }} } elsif ($i == 14) { # column for version $kernel = $p ->[$i]; if ( $kernel =~ /2\./ ){ if ($BG eq $DK) { $CL = $ORDK } else { $CL = $ORLI }} } else { # other column $CL = ''} if ( $CL ne '') { $COLOR = "BGCOLOR=\"$CL\"";} else { $COLOR = ''} print "", $fontsize, $p -> [$i], "";} print "\n";} } sub by_name { $aaa = $a -> [1] ; $bbb = $b -> [1] ; $ccc = $a -> [2] ; $ddd = $b -> [2] ; $eee = $a -> [3] ; $eee =~ s/u//; $fff = $b -> [3] ; $fff =~ s/u//; if ( $aaa ne $bbb ) { $aaa =~ y/A-Z/a-z/; $bbb =~ y/A-Z/a-z/; return $aaa cmp $bbb } elsif ( $eee ne $fff ) { return $fff <=> $eee ;} else { # if ( $ccc ne $ddd ) { return $ccc cmp $ddd } } sub table_output { my @lines = @_; print ""; while ( $_ = shift @lines ) { print "$_"; } print "\n"; } __END__ 次のように push される 1 Perl 2 5.6.0 3 432.585u 4 99.081s 5 11:43.84 6 75.5% 7 0+0k 8 17359+8152io 9 771pf+0w 10 StarMax 4000/160 11 604ev 160MHz 12 32M 13 IDE Quantum FIREBALLlct10 15G 14 1.5_ALPHA $BG = '#d0d0d0'; while () { $line = ''; if ( /^$/ ) { next ;} if ( /^#/ ) { next ;} @iii = split(',',$_); $prev_name = $name; $name = shift @iii; if ( $prev_name ne $name ) { if ( $BG eq '#d0d0d0' ) { $BG = '#b0b0b0'} else { $BG = '#d0d0d0'}} $line = ""; $line .= "".$fontsize. $counter++.""; $line .= ''.$fontsize. $name . ""; my $count = 0; while ( $_ = shift @iii ) { if ( $count++ == 1 ) { # 第二桁だけは さらに分ける s#\s+#$fontsize#g ; } elsif ( /iBook/ ) { $mach = "BGCOLOR=\"#90c090\""; if ( $BG eq '#d0d0d0' ) { $mach = "BGCOLOR=\"#b0e0b0\"" }} elsif ( /SS-2/ ) { $mach = "BGCOLOR=\"#d0b080\""; if ( $BG eq '#d0d0d0' ) { $mach = "BGCOLOR=\"#e0c090\"" }} else { $mach = ''} $line .= "$fontsize$_\n";} $line .= $_ . "\n"; print $line; } print "\n" ;} # --------------------------------------------------------- print < TRAILER # $Log: index.cgi,v $ # Revision 1.1.1.1 2008/03/12 10:53:05 makoto # initial # # Revision 1.2 2000/09/08 13:30:51 makoto # title # # Revision 1.1 2000/09/08 13:23:18 makoto # Initial revision # # Revision 1.3 1999/11/04 06:23:17 makoto # add frame +/- # l # # Revision 1.2 1999/11/04 06:14:46 makoto # fujiwara/frame, fix font bug # # Revision 1.1 1999/10/26 05:24:03 makoto # Initial revision #