[Rt-commit] r2288 - in rt.cpan.org: . import-tools import-tools/pause

jesse at bestpractical.com jesse at bestpractical.com
Sat Mar 5 20:12:16 EST 2005


Author: jesse
Date: Sat Mar  5 20:12:15 2005
New Revision: 2288

Added:
   rt.cpan.org/import-tools/
   rt.cpan.org/import-tools/pause/
   rt.cpan.org/import-tools/pause/import-cpan
   rt.cpan.org/import-tools/pause/import-pause.sh
Modified:
   rt.cpan.org/   (props changed)
Log:
 r6367 at hualien:  jesse | 2005-03-05 19:19:27 -0500
 snapshot import tool


Added: rt.cpan.org/import-tools/pause/import-cpan
==============================================================================
--- (empty file)
+++ rt.cpan.org/import-tools/pause/import-cpan	Sat Mar  5 20:12:15 2005
@@ -0,0 +1,316 @@
+#F
+#!/usr/bin/perl -w
+
+# $Header: /raid/cvsroot/rt-addons/import/rt.cpan.org-rt2,v 1.2 2001/10/27 05:00:42 jesse Exp $
+
+#  RT is (c) 1996-2001 Jesse Vincent <jesse at fsck.com>
+
+my $Debug = 0;
+
+use vars qw($modules_root %modules %people);
+use strict;
+use Carp;
+use CPAN::DistnameInfo;
+
+
+
+
+exit(0);
+
+
+# {{{ Subroutines and helpers
+
+
+# data structure of :
+#
+# 	all modules
+# 		authors
+# 		versions
+# 		:q
+#
+
+sub ParseFindDashLs {
+
+    while ( my $line = <STDIN> ) {
+        next unless ( $line =~ / authors/ );
+        next if ( $line =~ /readme|checksums$/i );
+        if ( $line =~ ' authors/(\S*) id/(.*)$' ) {
+
+            $people{$2} = $1;
+            next;
+        }
+
+
+        $line =~ s/^(.*?) authors/authors/g;
+        my $d = CPAN::DistnameInfo->new($line);
+
+        my $owner  = $d->cpanid;
+        my $module = $d->dist;
+        my $rev    = $d->version;
+        next unless ($module);
+
+        if ( $module =~ /^(perl|parrot)$/i ) {
+            #print "Skipping $1 $rev from $owner\n";
+            next;
+        }
+
+        if ( $module =~ /tar.gz/i ) {
+            #print "We have a tarball somehow $rev --  $module\n";
+        }
+
+        #print "Owner we found was $owner";
+	# If the most recent recorded rev has a different owner than the current one
+        if (   $owner
+            && ( $modules{$module}{'owner'} )
+            && ( $modules{$module}{'owner'} ne $owner )) {
+
+
+            if ( $modules{$module}{'versions'}[-1] < $rev ) {
+        #    print "$module $rev: $owner isn't $modules{$module}{'owner'}. Handed off?\n";
+
+            # If this is more recent, let's get up to date
+            $modules{$module}{'owner'} = $owner;
+        }
+        else {
+            #print "$rev is less than " . $modules{$module}{versions}[-1] . "\n";
+        }
+	}
+	else {
+            $modules{$module}{'owner'} = $owner;
+
+	#	print "$owner is the same as ".$modules{$module}{'owner'}."\n";
+
+	}
+        push @{ $modules{$module}{'versions'} }, $rev;
+
+    #        print "$owner -- $module -- $rev\n";
+}
+    foreach my $module ( keys %modules ) {
+
+#        print "Gonna deal with $module\n";
+       ImportModule( $module, $modules{$module}{'owner'}, @{ $modules{$module}{'versions'} });
+
+    }
+
+}
+
+# {{{ sub ImportModule
+
+sub ImportModule {
+    my $name = shift;
+    my $owner = shift;
+    my @versions =( @_);
+    my $queue = RT::Queue->new($RT::SystemUser);
+    
+    
+    # Try to load up the current queue by name. avoids duplication.
+    $queue->Load($name);
+   	if ($queue->Id) {
+		#print "Found module ".$queue->Name ." (".$queue->id.")\n";
+	}
+    #if the queue isn't there, create one.
+    unless ($queue->id) {
+	print "Adding module ".$name."...";
+	my ($val, $msg) = 
+	  $queue->Create(Name => $name,
+			 Description => 'Bugs in '.$name,
+			 CorrespondAddress => "bug-$name\@rt.cpan.org",
+			 CommentAddress =>"comment-$name\@rt.cpan.org",
+			);
+	
+	if ($val == 0) {
+	    warn "failed: $msg\n";
+	}
+	else {
+	    #print "...added\n";
+	    CreateKeywordSelects($queue);
+	}
+    }
+    
+    
+    #Lets get the areas for this queue
+    ImportVersions($queue, at versions);
+    
+    my $ownerobj = CreateUser($owner);
+    
+    MakeOwnerAdminCc($queue, $ownerobj);
+#    print "\n";
+}
+    
+# }}}
+
+
+sub MakeOwnerAdminCc {
+    my $queue = shift;
+    my $user = shift;
+   
+
+	print "Looking at ".$user->Name;
+
+    unless ($queue->IsAdminCc($user)) {
+    	 print "...adding as AdminCc.";
+    	$queue->AddAdminCc(Owner => $user->id);
+    }
+
+	print "\n";
+}
+# {{{ sub GrantOwnerRights
+
+sub GrantOwnerRights {
+    my $queue = shift;
+    my $user = shift;
+    
+
+    
+    my @displayrights = ( "SeeQueue", "ShowTemplate", "ShowScrips", 
+			  "ShowTicket", "ShowTicketComments");
+    my @manipulaterights = ( "CreateTicket", "ReplyToTicket", 
+			     "CommentOnTicket", "OwnTicket", 
+			     "ModifyTicket", "DeleteTicket",
+			     "ModifyQueueWatchers");
+    my @adminrights = ( "ModifyACL", "ModifyQueueWatchers", 
+			"AdminKeywordSelects", "ModifyTemplate",
+			    "ModifyScrips");
+    
+    print "Granting queue rights.\n";
+	my @rights;
+	
+	print " Granting rights for: ".$user." ";
+	
+	@rights = (@manipulaterights, @displayrights);
+	
+    my $group = RT::Group->new($RT::SystemUser);
+    $group->Load('AdminCc');
+    
+	
+    foreach my $right (@rights) {
+	print "$right...";
+	$group->GrantQueueRight( RightName => $right,
+				 RightAppliesTo => $queue->id);
+    }
+    
+    
+    print ".\n";
+}
+
+
+
+# }}}
+
+
+# {{{ sub CreateKeywordSelects 
+
+
+sub CreateKeywordSelects {
+    my $queue = shift;	
+    
+    #Create /Modules/$queuename
+    my $queue_keyword = RT::Keyword->new($RT::SystemUser);
+    my ($val, $msg) = 
+      $queue_keyword->Create( Name => $queue->Name,
+			      Description => 'Keywords for module '.$queue->Name,
+			      Parent => $modules_root->id );
+    
+    
+	
+    #Create /Modules/<module>/Version/
+    my $area_keyword = RT::Keyword->new($RT::SystemUser);
+    my ($area, $areamsg) = 
+      $area_keyword->Create( Name => 'Version',
+			     Description => '',
+			     Parent => $val );
+    
+    
+    #Create the 'Broken in' keyword select
+    #print "Creating 'Broken in' KeywordSelect...\n"; 
+    my $ks = new RT::KeywordSelect($RT::SystemUser);
+    $ks->Create(Name => 'Broken in',
+		Keyword => $area_keyword->Id,
+		ObjectType => 'Ticket',
+		ObjectField => 'Queue',
+		ObjectValue => $queue->id,
+		Single => 0,
+		Depth => 1);
+    
+    # print "Creating 'Fixed in' KeywordSelect...\n"; 
+    my $fixed_ks = new RT::KeywordSelect($RT::SystemUser);
+    $fixed_ks->Create(Name => 'Fixed in',
+		      Keyword => $area_keyword->Id,
+		      ObjectType => 'Ticket',
+		      ObjectField => 'Queue',
+		      ObjectValue => $queue->id,
+		      Single => 0,
+		      Depth => 1);
+}
+# }}}
+    
+# {{{ sub ImportVersions
+
+sub ImportVersions {
+    my $queue    = shift;
+    my @versions = (@_);
+
+    my $area_keyword = RT::Keyword->new($RT::SystemUser);
+    $area_keyword->LoadByPath( "/Modules/" . $queue->Name . "/Version" );
+    unless ( $area_keyword->Id ) {
+    	CreateKeywordSelects($queue);
+    	$area_keyword->LoadByPath( "/Modules/" . $queue->Name . "/Version" );
+    }
+    unless ( $area_keyword->Id ) {
+	die "Cant' find version root for ImportVersions";
+	}
+    #print "Adding module versions for ". $queue->Name ."\n\t";
+    foreach my $ver (@versions) {
+        my $this_area = RT::Keyword->new($RT::SystemUser);
+        $this_area->LoadByNameAndParentId( $ver, $area_keyword->Id );
+        unless ( $this_area->Id ) {
+            print $queue->Name . " has new version $ver\n";
+            $this_area->Create(
+                Name   => $ver,
+                Parent => $area_keyword->Id
+            );
+        }
+    }
+}
+
+# }}}
+
+# {{{ sub CreateUser
+
+sub CreateUser {
+    my $username = shift;
+
+    
+
+    my $user = RT::User->new($RT::SystemUser);
+
+    $user->Load($username);
+    if ($user->Id) {
+	return($user);
+    }
+
+    print "Importing user $username - ".$people{$username}."\n";
+    #clean up bogus email addresses
+    my ($return, $msg) =  $user->Create( Name => $username,
+					 RealName => $people{$username},
+					 EmailAddress =>$username.'@cpan.org',
+					 Privileged => 1);
+    if ($return == 0) {
+	warn "failed: $msg\n";
+    }
+    
+    #print "...added\n";
+    
+    return ($user);
+    
+}
+
+# }}}
+
+# }}}
+
+
+sub debug {
+    return 1;
+    return undef;
+}

Added: rt.cpan.org/import-tools/pause/import-pause.sh
==============================================================================
--- (empty file)
+++ rt.cpan.org/import-tools/pause/import-pause.sh	Sat Mar  5 20:12:15 2005
@@ -0,0 +1,6 @@
+#!/bin/sh
+mkdir /var/cache/pause/
+rsync pause.perl.org::pausedata/moddump.current /var/cache/pause/
+mysqladmin --force drop pause_mirror
+mysqladmin create pause_mirror
+mysql pause_mirror < /var/cache/pause/moddump.current


More information about the Rt-commit mailing list