1 # Copyright (c) 2000-2009 Nokia Corporation and/or its subsidiary(-ies).

     2 # All rights reserved.

     3 # This component and the accompanying materials are made available

     4 # under the terms of the License "Eclipse Public License v1.0"

     5 # which accompanies this distribution, and is available

     6 # at the URL "http://www.eclipse.org/legal/epl-v10.html".

     7 # 

     8 # Initial Contributors:

     9 # Nokia Corporation - initial contribution.

    10 # 

    11 # Contributors:

    12 # 

    13 # Description:

    14 # 

    15 #

    16 # Description:

    17 # PathData/ProjectBased.pm

    18 #

    19 

    20 package PathData::ProjectBased;

    21 use Utils;

    22 use Carp;

    23 use File::Spec;

    24 use strict;

    25 

    26 BEGIN {

    27   @PathData::ProjectBased::ISA=('PathData');

    28 };

    29 

    30 #

    31 # Public

    32 #

    33 #

    34 

    35 sub ProcessLine {

    36   my $self = shift;

    37   my $keywordref = shift;

    38   my $lineref = shift;

    39 

    40   die "Unknown keyword $$keywordref for project-based path data" unless ($$keywordref =~ m/archive_path/i);

    41   $$lineref =~ m/(\S+)\s+(\S+)(?:\s+(\S*))?/ or die "Error: Couldn't cope with archive path arguments \"$$lineref\": possibly the wrong number of arguments?\n";

    42   my $entry = {

    43     'name' => lc $1,

    44     'local' => $2,

    45     'remote' => $3

    46   };

    47  

    48 

    49   $self->{project_paths} ||= []; # I know this line is redundant, but I prefer explicitness :-)

    50   die "You cannot have multiple archive_path lines with the same project name (".$entry->{name}.")" if (grep { $_->{name} eq $entry->{'name'} } @{$self->{project_paths}});

    51   # You are allowed to have multiple lines with the same local and/or remote path lines,

    52   # but it ain't necessarily a good plan.

    53   push @{$self->{project_paths}}, $entry;

    54 }

    55 

    56 sub LocalArchivePath {

    57   my $self = shift;

    58   my $project = shift;

    59   my $result;

    60   $self->BasicChecks();

    61 

    62   if(defined $project){

    63     $self->CheckProject($project);

    64     $result = $self->FindEntry("name", $project);

    65   }

    66   else{

    67     $result = $self->FindEntryWithSub(sub { -d ($_->{'local'})});

    68   }

    69   

    70   return undef unless $result;

    71   print "Existing component stored at $result\n" if ($self->{verbose});

    72   return $result->{'local'};

    73 }

    74 

    75 sub LocalArchivePathForNewComponent {

    76   my $self = shift;

    77   my $comp = shift || confess "No component provided";

    78   my $ver = shift || confess "No version provided";

    79   my $project = shift;

    80   $self->BasicChecks();

    81 

    82   my $result;

    83   if (defined $project) {

    84     $self->CheckProject($project);

    85     $result = $self->FindEntry("name", $project);

    86   } else {

    87     $result = $self->{project_paths}->[0];

    88   }

    89   die "Error: No archive paths found\n" unless $result; # should never happen due to BasicChecks

    90   $self->CreateLocalDirectory($result);

    91   $result = $result->{'local'};

    92   print "New component being stored at $result\n" if ($self->{verbose});

    93   return $result . "\\$comp\\$ver";

    94 }

    95 

    96 sub LocalArchivePathForExistingComponent {

    97   my $self = shift;

    98   my $comp = shift;

    99   my $ver = shift;

   100   my $project = shift;

   101   

   102   my $result;

   103   

   104   $self->BasicChecks();

   105   confess "Component name undefined" unless defined $comp;

   106   confess "Version number undefined" unless defined $ver;

   107 

   108   if(defined $project){

   109     $self->CheckProject($project);

   110     $result = $self->FindEntry("name", $project);

   111   }

   112   else{

   113     $result = $self->FindEntryWithSub(sub { -d ($_->{'local'}.'\\'.$comp.'\\'.$ver)});

   114   }

   115   

   116   return undef unless $result;

   117   print "Existing component stored at $result\n" if ($self->{verbose});

   118   return $result->{'local'} . "\\$comp\\$ver";

   119 }

   120 

   121 sub LocalArchivePathForImportingComponent {

   122   my $self = shift;

   123   my $comp = shift;

   124   my $ver = shift;

   125   my $remotepath = shift; 

   126   $self->BasicChecks();

   127   confess "Component name undefined" unless defined $comp;

   128   confess "Version number undefined" unless defined $ver;

   129   $remotepath =~ s/(.*)\/.*/$1/;

   130   my $result = $self->FindEntry("remote", $remotepath);

   131   $self->CreateLocalDirectory($result);

   132   die "Couldn't find the remote project directory $remotepath where component $comp is being imported from." unless defined $result;

   133   return $result->{'local'} . "\\$comp\\$ver";

   134 }

   135 

   136 sub RemoteArchivePathForExistingComponent {

   137   my $self = shift;

   138   my $comp = shift;

   139   my $ver = shift;

   140   my $remotesite = shift; # we must get passed a remote site object

   141 

   142   $self->CheckRemoteSites();

   143 

   144   $self->BasicChecks();

   145   confess "Component name undefined" unless defined $comp;

   146   confess "Version number undefined" unless defined $ver;

   147   confess "No remote site object was provided" unless (ref $remotesite);

   148   die "Component name undefined" unless defined $comp;

   149   my %checked;

   150   my $result = $self->FindEntryWithSub(sub {

   151      return undef unless $_->{'remote'}; # skip those with no remote path

   152      return undef if $checked{$_->{'remote'}}; # already checked this remote path

   153      $checked{$_->{'remote'}} = 1;

   154      $remotesite->FileExists($_->{'remote'}."/$comp/$comp$ver.zip"

   155    )});

   156   return undef unless defined $result;

   157   $result = $result->{remote};

   158   return $result . "/$comp";

   159 }

   160 

   161 sub RemoteArchivePathForExportingComponent {

   162   my $self = shift;

   163   my $comp = shift;

   164   my $ver = shift;

   165   my $localpath = shift;

   166 

   167   $self->CheckRemoteSites();

   168 

   169   $localpath =~ s/(.*)[\/\\].*?[\/\\].*?$/$1/; # remove last two path segments

   170   $self->BasicChecks();

   171   confess "Component name undefined" unless defined $comp;

   172   my $result = $self->FindEntry("local", $localpath);

   173   die "Couldn't find the local project directory $localpath where component $comp is being exported from." unless (defined $result);

   174   die "Error: The archive ".$result->{name}." does not have a remote path listed in reltools.ini" unless (defined $result->{remote});

   175   return $result->{remote} . "/$comp";

   176 }

   177 

   178 sub ListComponents {

   179   my $self = shift;

   180   my $remote = shift || 0;

   181   my $continue = shift || 0;

   182   # This returns a list of the components we have locally or remotely.

   183   

   184   my $archiveExists;

   185   

   186   $self->BasicChecks();

   187   my @list;

   188   if ($remote) { # list remote archive

   189     $self->CheckRemoteSites();

   190     die "Need a remote site object" unless (ref $remote);

   191     foreach (map { $_->{'remote'} } @{$self->{project_paths}}) {

   192       next unless $remote->DirExists($_);

   193       $archiveExists = 1;

   194       my $rawlist = $remote->DirList($_);

   195       if ($rawlist) {

   196         push @list, grep { !m/^\./ } map { s/.*[\\\/]//; $_ } @$rawlist;

   197       }

   198     }

   199   } else { # list local archive

   200     foreach (map { $_->{'local'} } @{$self->{project_paths}}) {

   201       if (!-d $_) {

   202         if ($continue) {

   203           next;

   204         }		

   205         die "Project path $_ does not correspond to a real directory" ;

   206       }

   207       

   208       $archiveExists = 1;

   209       

   210       opendir LISTHANDLE, $_;

   211       push @list, grep { !/^\./ } readdir LISTHANDLE;

   212       closedir LISTHANDLE;

   213     }

   214   }

   215   

   216   if (!$archiveExists) {

   217     warn "Warning: The archive path locations specified in your reltools.ini do not exist\n";

   218   }

   219     

   220   # Now unique-ify list as per Perl Cookbook recipe

   221   my %seen;

   222   @list = grep { ! $seen{$_} ++ } @list;

   223 

   224   return @list if wantarray;

   225   return \@list;

   226 }

   227 

   228 sub ListProjects {

   229   my $self = shift;

   230   $self->BasicChecks();

   231   my @results = map { $_->{name} } @{$self->{project_paths}};

   232   return @results if wantarray;

   233   return \@results;

   234 }

   235 

   236 sub ListVersions {

   237   my $self = shift;

   238   my $comp = shift;

   239   my $remote = shift || 0;

   240   my $filter = shift;

   241   my $latestverFilter = shift;

   242   $self->BasicChecks();

   243 

   244   my $archiveExists;

   245 

   246   confess "Component name undefined" unless defined $comp;

   247   my @found;

   248   if ($remote) {

   249     $self->CheckRemoteSites();

   250     die "Need a remote site object" unless (ref $remote);

   251     foreach (map { $_->{'remote'} } @{$self->{project_paths}}) {

   252       my $dir = "$_/$comp";

   253       next unless $remote->DirExists($dir);

   254       $archiveExists = 1;

   255       my $files = $remote->DirList($dir);

   256       push @found, grep { $_ } map { m/.*(?:^|\\|\/)\Q$comp\E[\\\/]\Q$comp\E(.*?)\.zip$/i; $1 } @$files;

   257     }

   258   } else {

   259     foreach (map { $_->{'local'} } @{$self->{project_paths}}) {

   260       if (-e $_) {

   261         $archiveExists = 1;

   262       }

   263       

   264       my $dir = "$_\\$comp";

   265       if (-d $dir) {

   266         foreach my $entry (@{Utils::ReadDir($dir)}) {

   267           if (-d File::Spec->catdir($dir, $entry)) {

   268             push @found, $entry;

   269           }

   270         }

   271       }

   272     }

   273   }

   274   

   275   if (!$archiveExists) {

   276     warn "Warning: The archive path locations specified in your reltools.ini do not exist\n";

   277   }

   278   

   279   # Now unique-ify list as per Perl Cookbook recipe

   280   my %seen;

   281   @found = grep { ! $seen{$_} ++ } @found;

   282 

   283   # The filter regexes may have been compiled, here we uncompile them

   284   $latestverFilter =~ s/^\(\?[-imsx]*:(.*)\)$/$1/i if ($latestverFilter);

   285   $filter =~ s/^\(\?[-imsx]*:(.*)\)$/$1/i if ($filter);

   286            

   287   # Now apply a filter to the list

   288   @found = grep { ! m/$latestverFilter/i } @found if ($latestverFilter);

   289   @found = grep { m/$filter/i } @found if ($filter);

   290   return @found if wantarray;

   291   return \@found;

   292 }

   293 

   294 sub ComponentProjects {

   295   my $self = shift;

   296   my $comp = shift;

   297   my $ver = shift;

   298 

   299   confess "Component name undefined" unless defined $comp;

   300   confess "Version number undefined" unless defined $ver;

   301   $self->BasicChecks();

   302   my @results = $self->FindEntriesWithSub(sub {

   303     -d ($_->{local}."\\$comp\\$ver")

   304   });

   305   return map {$_->{name}} @results; 

   306 }

   307 

   308 sub ComponentProject {

   309   my $self = shift;

   310   my $comp = shift;

   311   my $ver = shift;

   312 

   313   confess "Component name undefined" unless defined $comp;

   314   confess "Version number undefined" unless defined $ver;

   315   $self->BasicChecks();

   316   my $archive = $self->FindEntryWithSub(sub {

   317     -d ($_->{local}."\\$comp\\$ver")

   318   });

   319 

   320   if (defined $archive) {

   321     return $archive->{name};

   322   } else {

   323     return "<none>";

   324   }

   325 }

   326 

   327 #

   328 # Private

   329 #

   330 

   331 sub BasicChecks {

   332   my $self = shift;

   333   die "No project paths are defined" unless ($self->{project_paths});

   334 }

   335 

   336 sub CheckProject {

   337   my $self = shift;

   338   my $project = shift;

   339 

   340   die "Project \"$project\" unknown" unless $self->FindEntry("name", $project);

   341 }

   342 

   343 sub FindEntry {

   344   my $self = shift;

   345   my $type = shift;

   346   my $what = shift;

   347 

   348   return ($self->FindEntries($type, $what))[0];

   349 }

   350 

   351 sub FindEntries {

   352   my $self = shift;

   353   my $type = shift;

   354   my $what = shift;

   355 

   356   return $self->FindEntriesWithSub(sub { lc $_->{$type} eq lc $what });

   357 }

   358 

   359 sub CreateLocalDirectory {

   360   my $self = shift;

   361   my $entry = shift;

   362   if (-e $entry->{'local'}) {

   363     die "Error: Local archive path ".$entry->{'local'}." is not a directory\n" unless (-d _);

   364   } else {

   365     print "Warning: creating local archive path ".$entry->{local}."\n";

   366     Utils::MakeDir($entry->{'local'});

   367   }

   368 }

   369 

   370 sub FindEntryWithSub {

   371   my $self = shift;

   372   my $checksub = shift;

   373   my $projectPath;

   374   

   375   foreach (@{$self->{project_paths}}) {

   376     if (&$checksub) {

   377       $projectPath = $_;

   378       last;

   379     }

   380   }

   381 

   382   return $projectPath;

   383 } 

   384 

   385 sub FindEntriesWithSub {

   386   my $self = shift;

   387   my $checksub = shift;

   388 

   389   return grep { &$checksub } @{$self->{project_paths}};

   390 }

   391 

   392 sub CheckRemoteSites {

   393   my $self = shift;

   394   my $hasRemoteSite = 0;

   395   

   396   foreach my $project (@{$self->{project_paths}}) {

   397     $hasRemoteSite = 1 if ($project->{remote}); 

   398   }

   399   

   400   die "Error: No remote sites are defined in your reltools.ini\n" if (!$hasRemoteSite);

   401 }

   402 

   403 1;

   404 

   405 __END__

   406 

   407 =head1 NAME

   408 

   409 PathData/ProjectBased.pm - Provides the location of archived releases with a new-style archive structure.

   410 

   411 =head1 DESCRIPTION

   412 

   413 A subclass of C<PathData>, provides the understanding of the new-style archive path structure and returns information on where to store releases, and where existing releases are stored.

   414 

   415 =head1 INTERFACE

   416 

   417 The abstract methods of C<PathData> are implemented.

   418 

   419 =head2 LocalArchivePathForNewComponent

   420 

   421 This takes a component and a version and (optionally) the name of the project to store the component in.

   422 

   423 =head2 LocalArchivePathForExistingComponent

   424 

   425 This takes a component, version and optionally a project. 

   426 

   427 =head2 LocalArchivePathForImportingComponent

   428 

   429 This takes a component, a version, and the remote path where the component was found.

   430 

   431 =head2 RemoteArchivePathForExistingComponent

   432 

   433 This takes a component, a version and a C<RemoteSite> object.

   434 

   435 =head2 RemoteArchivePathForExportingComponent

   436 

   437 This takes a component, a version, and the local path where the component was found.

   438 

   439 =head2 ListComponents

   440 

   441 This takes a remote and continue flag. The remote flag when set as "1" is used to indicate that it should list the components stored remotely, not locally. The continue flag when set as "1" is used to indicate that the script should continue regardless of any problems found with regards to the paths set.

   442 

   443 =head2 ListVersions

   444 

   445 This takes a component. It may optionally take a "1" to indicate that it should list the versions stored remotely, not locally. The third parameter is also optional; it's a Perl-syntax pattern match for the versions.

   446 

   447 =head2 ListProjects

   448 

   449 =head2 ComponentProjects

   450 

   451 This takes a component and a version and returns the project name of all archives where the release is found.

   452 

   453 =head2 ComponentProject

   454 

   455 This takes a component name and a version and returns the project name of the first archive where the release is found.  It gives the corresponding project name to the path that LocalArchivePathForExistingComponent gives for the same arguments.

   456 =head2 ProcessLine

   457 

   458 This processes a line from the F<reltools.ini>.

   459 

   460 =head1 IMPLEMENTATION

   461 

   462 This object has a data member, C<project_paths>, which is an array of the project descriptions found in the F<reltools.ini>. Each line is stored as a hash struct, with keys "name", "local" and "remote". It's filled in by C<ProcessLine>, and used by all the other methods via a variety of subroutines which check the contents of this array.

   463 

   464 =head1 KNOWN BUGS

   465 

   466 None.

   467 

   468 =head1 COPYRIGHT

   469 

   470  Copyright (c) 2000-2009 Nokia Corporation and/or its subsidiary(-ies).

   471  All rights reserved.

   472  This component and the accompanying materials are made available

   473  under the terms of the License "Eclipse Public License v1.0"

   474  which accompanies this distribution, and is available

   475  at the URL "http://www.eclipse.org/legal/epl-v10.html".

   476  

   477  Initial Contributors:

   478  Nokia Corporation - initial contribution.

   479  

   480  Contributors:

   481  

   482  Description:

   483  

   484 

   485 =cut