src/Configuration/BootStrapProject.pm

=head1 NAME

Configuration::BootStrapProject - File parsing utilities for boot files.

=head1 SYNOPSIS

        my $obj = Configuration::BootStrapProject->new([$area]);

=head1 DESCRIPTION

Package containing functions for parsing bootstrap files (project initialisation documents).
These documents are written in XML.

=head1 METHODS

=over

=cut

=item C<new($cache,$installbase)>

A new bootstrapper.

=item C<boot(url[,$devareaname])>

Boot up a new project and return the Configuration::ConfigArea.

=back

=head1 AUTHOR

Originally written by Christopher Williams.

=head1 MAINTAINER

Shaun ASHBY

=cut

package Configuration::BootStrapProject;
use ActiveDoc::SimpleURLDoc;
use URL::URLhandler;
use Utilities::Verbose;
require 5.004;

@ISA=qw(Utilities::Verbose);
$Configuration::BootStrapProject::self;

sub new()
   {
   my $class=shift;
   # Initialise the global package variable:
   no strict 'refs';
   $self = defined $self ? $self
      : (bless {}, $class );
   $self->{havesourcedir}=0;
   $self->{cache}=shift;   
   $self->{baselocation}=shift;
   
   if ( @_ )
      {
      $self->{area}=shift;
      }
   
   $self->{mydoctype}="Configuration::BootStrapProject";
   $self->{mydocversion}="1.0";   
   $self->{scramdoc} = ActiveDoc::SimpleURLDoc->new($self->{cache});
   $self->{scramdoc}->newparse("bootstrap",$self->{mydoctype},'Subs');
   $self->{Arch}=1;
   push @{$self->{ARCHBLOCK}}, $self->{Arch};
   return $self;
   }

sub boot()
   {
   my $self=shift;
   my $url=shift;       
   my $filemode = 0644;
   # Check that the boot file is XML (simplistic check: make sure file
   # suffix is xml!):
   if ($url !~ /xml$/) {
       die __PACKAGE__.": Wrong boot file type (MUST be XML!)\n";
   }
   
   # -- override directory name
   if ( @_ )
      {
      $self->{devareaname}=shift;
      }
   else
      {
      $self->{devareaname}="";
      }
   
   my ($fullurl,$filename)=$self->{scramdoc}->urldownload($url);
   chmod $filemode,$filename;
   $self->{scramdoc}->filetoparse($filename);
   $self->{scramdoc}->parse("bootstrap");
   return $self->{area};
   }

# --- Tag Routines
sub project()
   {
   my ($xmlparser,$name,%attributes)=@_;
   my $name = $attributes{'name'};
   my $version = $attributes{'version'};
   
   print "Creating New Project ".$name.
      " Version ".$version."\n";
   print "\n";
   
   use Configuration::ConfigArea;
   $self->{area}=Configuration::ConfigArea->new();
   
   $self->{area}->name($name);
   $self->{area}->version($version);
   $self->{area}->setup($self->{baselocation});
   
   # new urlhandler based on area cache
   $self->{scramdoc}->cache($self->{area}->cache());
   }

sub project_()
   {
   my ($xmlparser,$name,%attributes)=@_;
   $self->{area}->sourcedir('src');
   $ENV{SCRAM_SOURCEDIR} = $self->{area}->sourcedir();
   $self->{area}->save();
   }

sub config()
   {
   my ($xmlparser,$name,%attributes)=@_;
   # Set the project config dir variable here so that
   # "projconfigdir" value can be used while bootstrapping:
   $ENV{SCRAM_CONFIGDIR} = $attributes{'dir'};
   $self->{area}->configurationdir($attributes{'dir'});
   }

sub download()
   {
   my ($xmlparser,$name,%attributes)=@_;
   # -- download into top directory
   my ($fullurl,$filename)=$self->{scramdoc}->urlget($attributes{'url'},
                                                     $self->{area}->location()."/".$attributes{'name'});   
   }

sub requirementsdoc() {
    my ($xmlparser,$name,%attributes)=@_;
    my ($filename,$fullurl);
    
    if ( exists $attributes{'url'} ) {
        # -- download into our cache
        ($fullurl,$filename)=$self->{scramdoc}->urlget($attributes{'url'});
    } else {
        $filename=$attributes{'name'};
    }
    
    # Check that the requirements file is XML (simplistic check: make sure file
    # suffix is xml!):
    if ($filename !~ /xml$/) {  
        # We have to use exit here because die() doesn't respond...I guess
        # that SIG{__DIE__} has been trapped somewhere:
        print __PACKAGE__.": Wrong requirements file type (MUST be XML!)\n";
        exit(1);
    }
    
    $self->{area}->requirementsdoc($filename);   
}

sub doc()
   {
   my ($xmlparser,$name,%attributes)=@_;
   my $doctype = $attributes{'type'};

   if ($doctype ne $self->{mydoctype})
      {
      warn "Configuration::BootStrapProject::boot: Unable to handle doc of type $doctype";
      }
   }

sub AUTOLOAD()
   {
   my ($xmlparser,$name,%attributes)=@_;
   return if $AUTOLOAD =~ /::DESTROY$/;
   my $name=$AUTOLOAD;
   $name =~ s/.*://;
   if ($name eq 'base' || $name eq 'base_')
      {
      $self->{scramdoc}->$name(%attributes);
      }
   }

1;
Revision:	1.11
Committed:	Tue Feb 27 12:46:01 2007 UTC (18 years, 2 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V1_1_0, v110p1, V110p6, V110p5, V110p4, V110p3
Branch point for:	v200branch
Changes since 1.10:	+2 -1 lines
Log Message:	changes for XML. Remove obsoletes.
#	User	Rev	Content
1	sashby	1.7	=head1 NAME
2
3			Configuration::BootStrapProject - File parsing utilities for boot files.
4
5			=head1 SYNOPSIS
6
7			my $obj = Configuration::BootStrapProject->new([$area]);
8
9			=head1 DESCRIPTION
10
11			Package containing functions for parsing bootstrap files (project initialisation documents).
12	sashby	1.11	These documents are written in XML.
13
14	sashby	1.7	=head1 METHODS
15
16			=over
17
18			=cut
19
20			=item C<new($cache,$installbase)>
21
22			A new bootstrapper.
23
24			=item C<boot(url[,$devareaname])>
25
26			Boot up a new project and return the Configuration::ConfigArea.
27
28			=back
29
30			=head1 AUTHOR
31
32			Originally written by Christopher Williams.
33
34			=head1 MAINTAINER
35
36			Shaun ASHBY
37
38			=cut
39	williamc	1.2
40			package Configuration::BootStrapProject;
41			use ActiveDoc::SimpleURLDoc;
42			use URL::URLhandler;
43			use Utilities::Verbose;
44			require 5.004;
45
46			@ISA=qw(Utilities::Verbose);
47	sashby	1.10	$Configuration::BootStrapProject::self;
48	williamc	1.2
49	sashby	1.10	sub new()
50	sashby	1.5	{
51	sashby	1.10	my $class=shift;
52			# Initialise the global package variable:
53			no strict 'refs';
54			$self = defined $self ? $self
55			: (bless {}, $class );
56			$self->{havesourcedir}=0;
57			$self->{cache}=shift;
58			$self->{baselocation}=shift;
59
60			if ( @_ )
61			{
62			$self->{area}=shift;
63			}
64
65			$self->{mydoctype}="Configuration::BootStrapProject";
66			$self->{mydocversion}="1.0";
67			$self->{scramdoc} = ActiveDoc::SimpleURLDoc->new($self->{cache});
68			$self->{scramdoc}->newparse("bootstrap",$self->{mydoctype},'Subs');
69			$self->{Arch}=1;
70			push @{$self->{ARCHBLOCK}}, $self->{Arch};
71			return $self;
72	sashby	1.5	}
73
74	sashby	1.10	sub boot()
75	sashby	1.5	{
76			my $self=shift;
77			my $url=shift;
78	sashby	1.10	my $filemode = 0644;
79			# Check that the boot file is XML (simplistic check: make sure file
80			# suffix is xml!):
81			if ($url !~ /xml$/) {
82			die __PACKAGE__.": Wrong boot file type (MUST be XML!)\n";
83			}
84
85			# -- override directory name
86			if ( @_ )
87			{
88			$self->{devareaname}=shift;
89			}
90			else
91			{
92			$self->{devareaname}="";
93			}
94
95			my ($fullurl,$filename)=$self->{scramdoc}->urldownload($url);
96	sashby	1.6	chmod $filemode,$filename;
97	sashby	1.10	$self->{scramdoc}->filetoparse($filename);
98			$self->{scramdoc}->parse("bootstrap");
99	sashby	1.5	return $self->{area};
100			}
101
102	williamc	1.2	# --- Tag Routines
103	sashby	1.10	sub project()
104			{
105			my ($xmlparser,$name,%attributes)=@_;
106			my $name = $attributes{'name'};
107			my $version = $attributes{'version'};
108
109			print "Creating New Project ".$name.
110			" Version ".$version."\n";
111			print "\n";
112
113			use Configuration::ConfigArea;
114			$self->{area}=Configuration::ConfigArea->new();
115
116			$self->{area}->name($name);
117			$self->{area}->version($version);
118			$self->{area}->setup($self->{baselocation});
119
120			# new urlhandler based on area cache
121			$self->{scramdoc}->cache($self->{area}->cache());
122			}
123	williamc	1.2
124	sashby	1.10	sub project_()
125			{
126			my ($xmlparser,$name,%attributes)=@_;
127			$self->{area}->sourcedir('src');
128			$ENV{SCRAM_SOURCEDIR} = $self->{area}->sourcedir();
129			$self->{area}->save();
130			}
131	williamc	1.2
132	sashby	1.10	sub config()
133	sashby	1.4	{
134	sashby	1.10	my ($xmlparser,$name,%attributes)=@_;
135	sashby	1.4	# Set the project config dir variable here so that
136			# "projconfigdir" value can be used while bootstrapping:
137	sashby	1.10	$ENV{SCRAM_CONFIGDIR} = $attributes{'dir'};
138			$self->{area}->configurationdir($attributes{'dir'});
139	sashby	1.4	}
140	williamc	1.2
141	sashby	1.10	sub download()
142			{
143			my ($xmlparser,$name,%attributes)=@_;
144			# -- download into top directory
145			my ($fullurl,$filename)=$self->{scramdoc}->urlget($attributes{'url'},
146			$self->{area}->location()."/".$attributes{'name'});
147			}
148	williamc	1.2
149	sashby	1.10	sub requirementsdoc() {
150			my ($xmlparser,$name,%attributes)=@_;
151			my ($filename,$fullurl);
152
153			if ( exists $attributes{'url'} ) {
154	sashby	1.9	# -- download into our cache
155	sashby	1.10	($fullurl,$filename)=$self->{scramdoc}->urlget($attributes{'url'});
156			} else {
157			$filename=$attributes{'name'};
158			}
159
160			# Check that the requirements file is XML (simplistic check: make sure file
161			# suffix is xml!):
162			if ($filename !~ /xml$/) {
163			# We have to use exit here because die() doesn't respond...I guess
164			# that SIG{__DIE__} has been trapped somewhere:
165			print __PACKAGE__.": Wrong requirements file type (MUST be XML!)\n";
166			exit(1);
167			}
168
169			$self->{area}->requirementsdoc($filename);
170	williamc	1.2	}
171
172	sashby	1.10	sub doc()
173			{
174			my ($xmlparser,$name,%attributes)=@_;
175			my $doctype = $attributes{'type'};
176	sashby	1.5
177	sashby	1.10	if ($doctype ne $self->{mydoctype})
178			{
179			warn "Configuration::BootStrapProject::boot: Unable to handle doc of type $doctype";
180			}
181			}
182	sashby	1.5
183	sashby	1.10	sub AUTOLOAD()
184			{
185			my ($xmlparser,$name,%attributes)=@_;
186			return if $AUTOLOAD =~ /::DESTROY$/;
187			my $name=$AUTOLOAD;
188			$name =~ s/.*://;
189			if ($name eq 'base' \|\| $name eq 'base_')
190			{
191			$self->{scramdoc}->$name(%attributes);
192			}
193	sashby	1.5	}
194
195	sashby	1.10	1;