coe_info.in from LinuxCOE at Krugle

Show coe_info.in syntax highlighted

#!/usr/bin/perl
#############################################################################################
# File:         coe_info
# Description:  script to send SysDes info to other processes
# Author:       Lee Mayes   ( email leem@hp.com )
# Created:      9 Sep 2006 
# Language:     perl
# Package:      LinuxCOE
##############################################################################################
# Â© Copyright 2000-2007 Hewlett-Packard Development Company, L.P
#
# This program is free software; you can redistribute it and/or modify it under the terms of 
# the GNU General Public License as published by the Free Software Foundation; either version 
# 2 of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; 
# without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 
# See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along with this program; 
# if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
##############################################################################################
use strict;
my $debug = 0;
my $nonav = 0;
use CGI;
my $q = new CGI qw();
print $q->header;
use lib qw (@prefix@/lib);
use LinuxCOE;
my $db = new LinuxCOE;
$db->debug($debug);

my $COE_VER=$db->def('COE_VER');
my @vars = qw(defs);
my $bootimageurl = "/@PACKAGE_NAME@-cgi-bin/coe_bootimage";
my $profileurl = "/@PACKAGE_NAME@-cgi-bin/coe_profiles";

# Override defaults if requested 

my $defs = $q->param('defs');
if ( $defs ) {
  $db->LoadDefs($defs);
  $bootimageurl .= "?defs=$defs";
  $profileurl .= "?defs=$defs";
}
$db->InitDB;

# Check to see if we're beaming a profile... (WARN: not fully implemented!)
my $path_info = $q->path_info;
if ( $path_info ) { &Beam_Profiles($path_info) }

# If in a multi-sysdes instance config, beam profiles back and forth

sub Beam_Profiles {

  my $path_info = shift;
  print STDERR "Entering Beam_Profiles with \$path_info = $path_info\n" if $debug;
  my ($null,$cmd,$dist,$ver,$arch,$profile) = split('\/',$path_info);
  print STDERR "In Beam_Profiles with \$cmd = $cmd $dist,$ver,$arch,$profile\n" if $debug;
  &Beam_Header;
  if ( $cmd eq 'list' ) {  
    my @profiles = $db->show_profiles($dist,$ver,$arch);
    my $count = @profiles;
    print STDERR "show_profiles return $count profiles for $dist $ver $arch\n" if $debug;
    foreach my $profile (@profiles) {  print "$profile\n"; }
  } elsif ( $cmd eq 'beam' ) {
    my $file = $db->get_filename($dist,$ver,$arch,$profile);
    $file = $db->profbase . "/$file";
    open(IN,$file) || exit;
    while(<IN>) { print }
  } elsif ( $cmd eq 'osvend' ) {
    print STDERR "Bean_Profiles: requesting OSVEND list\n" if $debug;
    my @choices = $db->show_os;
    foreach my $choice (@choices) { $choice =~ s/- //; print "$choice\n" }
  } elsif ( $cmd eq 'backend' ) {
    my $mapfile = $db->find_file("data/image_gen.map");
    unless (-r $mapfile) {
      print "ERR\n";
      &Beam_Trailer;
      exit;
    }
    my %urlbase;
    open(MAP,$mapfile) || &end_it_now("Cannot open $mapfile : $!\n");
    while(<MAP>) {
      chomp;
      next if /^#/;
      next unless $_;
      my ($key,$val) = split;
      $urlbase{$key} = $val;
    }
    close(MAP);
    my $gen_url = $urlbase{$dist} || 'NONE';
    print "$gen_url\n";
  } else {
    print "$cmd - Unimplemented Command!\n";
  }
  &Beam_Trailer;
  exit;
}

sub Beam_Header {

  print "<pre>\nSTART_OF_LINUXCOE_BEAM_DATA\n";

}

sub Beam_Trailer {

  print "END_OF_LINUXCOE_BEAM_DATA\n</pre>\n";
  exit;

}
See more files for this project here