Learn how easy it is to sync an existing GitHub or Google Code repo to a SourceForge project! See Demo

Close

Gccg_package

Developers
2010-05-20
2013-05-29
  • gccg_package
    gccg_package
    2010-05-20

    gccg_package may use perl core modules instead of external command :

    --- gccg_package.old
    +++ gccg_package.new
    @@ -2,4 +2,14 @@
    
     #
    +# Modules
    +#
    +use Archive::Extract;
    +use Archive::Tar;
    +use File::Copy;
    +use File::Fetch;
    +use File::Find;
    +use File::Path qw/mkpath rmtree/;
    +
    +#
     # Globals
     #
    @@ -11,9 +21,8 @@
     $store="";         # Where to store modules built.
     %url=();           # $url{mode}{module name} - url of newest module
    -$mode;             # Section to handle "build", "installed" or "available".
    -$current_module;   # Current module during xml-read.
    -$module_list_already_fetched;  # Set to "yes" if module list is already fetched.
    +$mode="";          # Section to handle "build", "installed" or "available".
    +$current_module="";        # Current module during xml-read.
    +$module_list_already_fetched="";# Set to "yes" if module list is already fetched.
     $build_list="xml/packages.xml"; # File describing packagelists.
    -$winsystem=($^O eq "MSWin32");  # True if we are running on Windows
     @file_cache=();     # A file name cache.
    
    @@ -66,5 +75,5 @@
        $files{$mode}=();
    
    -   open(F,$file) or die "cannot open $file";
    +   open F,'<',$file or die "cannot open $file";
        while(<F>)
        {
    @@ -97,17 +106,11 @@
                {
                    print "Reading files...\n";
    -               open(DIR,"find .. -follow 2>/dev/null |");
    -               while(<DIR>)
    -               {
    -               chomp;
    -               s|^\.\./[a-zA-Z]+/||;
    -               next if m |/\.svn|;
    -               next if m |^\.svn|;
    -               next if m |~$|;
    -               next if $_ eq ".";
    -
    -               push @file_cache,$_;
    -               }
    -               close(DIR);
    +               find({
    +                   wanted=>sub{
    +                       s|^\.\./[a-zA-Z]+/||;
    +                       return if m|/\.svn| || m|^\.svn| || m|~$| || $_ eq ".";
    +                       push @file_cache,$_},
    +                   follow=>1
    +                   },"..")
                }
    
    @@ -146,31 +149,26 @@
                    for $b (branches())
                    {
    -               if(-d "../$b/$dir")
    -               {
    -                   open(DIR,"find ../$b/$dir -follow 2>/dev/null |");
    -                   while(<DIR>)
    -                   {
    -                   chomp;
    -                   next if m|/\.svn|;
    -                   s|^../$b/||;
    -                   $files{$mode}{$current_module}{$_}=1;
    -                   }
    +                   if(-d "../$b/$dir")
    +                   {
    +                       find({
    +                           wanted=>sub{
    +                               return if m|/\.svn|;
    +                               s|^../$b/||;
    +                               $files{$mode}{$current_module}{$_}=1},
    +                           follow=>1
    +                           },"../$b/$dir")
    +                   }
                    }
    -               }
                }       
                else
                {
    -               open(DIR,"find $dir -follow 2>/dev/null |");
    -               while(<DIR>)
    -               {
    -               chomp;
    -               if (not m/(\bCVS\b|.svn|\.cvsignore|~$)/)
    -                   {
    -                   $files{$mode}{$current_module}{$_}=1;
    -                   }
    -               }
    -               close(DIR);
    +               find({
    +                   wanted=>sub{
    +                       return if m/(\bCVS\b|.svn|\.cvsignore|~$)/;
    +                       $files{$mode}{$current_module}{$_}=1},
    +                   follow=>1
    +                   },"$dir")
                }
    -           }
    +       }
            elsif(m/<source url="(.+?)"\/>/)
            {
    @@ -189,5 +187,5 @@
        my $type=shift;
    
    -   open(F,">$file") or die "$0: cannot write '$file'";
    +   open F,'>',$file or die "$0: cannot write '$file'";
        print F "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n";
        print F "<!DOCTYPE modules SYSTEM \"modules.dtd\">\n";
    @@ -273,5 +271,5 @@
        my $path=shift;
    
    -   open(F,">$path") or die "cannot write $path";
    +   open F,'>',$path or die "cannot write $path";
        print F "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>
     <!DOCTYPE modules SYSTEM \"modules.dtd\">
    @@ -310,5 +308,5 @@
        }
    
    -   system("rm -rf build");
    +   rmtree "build";
        mkdir("build",0755);
    
    @@ -336,9 +334,9 @@
                    {
                        print "Module $name: using alternative: module_$name/$dir$f\n";
    -                   system("cp \"module_$name/$dir$f\" \"build/$dir$f\"");
    +                   copy "module_$name/$dir$f","build/$dir$f"
                    }
                    else
                    {
    -                   system("cp \"$orig\" \"build/$dir$f\"");
    +                   copy "$orig","build/$dir$f"
                    }
                }
    @@ -356,5 +354,5 @@
                        {
                            print "Module $name: from branch ../$b/$orig\n";
    -                       system("cp \"../$b/$orig\" \"build/$dir$f\"");
    +                       copy "../$b/$orig","build/$dir$f";
                            $ok=1;
                            last;
    @@ -366,5 +364,5 @@
                    $f="$dir$f";
                    print "WARNING: suspicious directory name $f\n" if $f=~m/\.[a-z]+$/;
    -               system("mkdir -p build/$f")
    +               mkpath "build/$f"
                    }
                }
    @@ -384,10 +382,12 @@
    
        print "Module $name: creating package $modulename\n";
    -   system("cd build && tar czf ../$modulename .");
    -   system("rm -rf build");
    +   my $tar=Archive::Tar->new;
    +   find(sub{$tar->add_files($_)unless/\./},"build");
    +   $tar->write("$modulename",COMPRESS_GZIP);
    +   rmtree "build";
        print "Removing old modules $store/$old\n";
    -   system("rm -f $store/$old");
    +   rmtree "$store/$old";
        print "Moving module to $store/$modulename\n";
    -   system("mv $modulename $store");
    +   move "$modulename","$store";
        print "Writing $store/available.xml\n";
        $module{"available"}{$name}=$module{"build"}{$name};
    @@ -406,31 +406,9 @@
    
        unlink($file);
    -   if ( $use_LWP )
    -   {
    -       if ( system("lwp-request $url >$file 2>/dev/null") == 0 )
    -       {
    -           return $file if -s $file;
    -       }
    -   }
    
    -   if($use_curl)
    -   {
    -       if ( system("curl $url >$file 2>/dev/null") == 0 )
    -       {
    -           return $file if -s $file;
    -       }
    -   }
    -   
    -   if ( $use_wget )
    -   {
    -       if($winsystem)
    -       {
    -       system("wget -t 0 $url");
    -       }
    -       else
    -       {
    -       system("wget -t 0 $url >/dev/null 2>&1");
    -       }
    -   }
    +   my $ff = File::Fetch->new(uri=>$url);
    +
    +   $ff->fetch;
    +
        return (-s $file)? $file : "";
     }
    @@ -618,19 +596,6 @@
     sub uncompress
     {
    -    my $file=shift;
    -    my $r;
    -
    -    if($winsystem)
    -    {
    -       $r=system("gunzip -f $file");
    -       $file=~s/(.*)\.tgz$/$1.tar/;
    -       $r=system("tar xpf $file");
    -    }
    -    else
    -    {
    -       $r=system("gunzip -c $file | tar xpf -");
    -    }
    -
    -    return $r==0;
    +   my $ae=Archive::Extract->new(archive=>shift);
    +   return $ae->extract
     }
    
    @@ -675,32 +640,9 @@
                    $module{"installed"}{$name}=$module{"updated"}{$name};
                    %{$files{"installed"}{$name}}=();
    -               if($winsystem)
    -               {
    -                   $file=~s/(.*)\.tgz$/$1.tar/;                
    -                   system("tar tf $file > log");
    -                   open(FILES,"log");
    -               }
    -               else
    -               {
    -                   open(FILES,"gunzip -c $file | tar tf - |");
    -               }
    -               while(<FILES>)
    -               {
    -                   chomp;
    -                   $files{"installed"}{$name}{$_}=1;
    -               }
    -               close(FILES);
    +               my $tar=Archive::Tar->new($file);
    +               $files{"installed"}{$name}{$_}=1 foreach($tar->list_files);
                    write_xml_document("xml/installed.xml","installed");
                    unlink($file);
    -
    -               if($winsystem)
    -               {
    -                   unlink("log");
    -               }
    -
    -               if($name eq "windows32")
    -               {
    -                   system("chmod +x ccg_client.exe");
    -               }
    +               chmod 0755,"ccg_client.exe" if ($name eq "windows32")
                }
                else
    @@ -771,5 +713,5 @@
    
        @st=stat($filename);
    -   open(F,$filename);
    +   open F,'<',$filename;
        read(F,$ret,$st[7]);
        close(F);
    @@ -785,5 +727,6 @@
        my $file=shift;
        my $modulename=shift;
    -   my $f1,$f2;
    +   my $f1;
    +   my $f2;
        my $ok=1;
        mkdir("build",0755);
    @@ -791,31 +734,27 @@
        $file="../$file" if(substr($file,0,2) eq "..");
        die "$0: uncompress failed" if !uncompress("$file");
    -   open(DIR,"find .|");
    -   while(<DIR>)
    -   {
    -       chomp;
    -       if(-f $_)
    +   find(
    +       sub
            {
    -           $f1=read_file($_);
    -           
    -           if(-f "../module_$modulename/$_")
    -           {
    -               $f2=read_file("../module_$modulename/$_");
    -           }
    -           else
    +           if(-f $_)
                {
    -               $f2=read_file("../$_");
    -           }
    -           
    -           if($f1 ne $f2 and $_ ne "./xml/installed.xml")
    -           {
    -               $ok=0;
    -               print "$modulename ".$module{"build"}{$modulename}.": $_\n";
    +               $f1=read_file $_;
    +               if(-f "../module_$modulename/$_")
    +               {
    +                   $f2=read_file "../module_$modulename/$_"
    +               }
    +               else
    +               {
    +                   $f2=read_file "../$_"
    +               }
    +               if($f1 ne $f2 and $_ ne "./xml/installed.xml")
    +               {
    +                   $ok=0;
    +                   print "$modulename ".$module{"build"}{$modulename}.": $_\n"
    +               }
                }
    -       }
    -   }
    -   close(DIR);
    +       },".");
        chdir("..");
    -   system("rm -rf build");
    +   rmtree "build";
    
        return $ok;
    @@ -922,34 +861,4 @@
     # Main
     #
    -
    -#
    -# See if we can use lwp-request instead of wget
    -#
    -if($winsystem)
    -{
    -    $use_wget = 1;
    -}
    -else
    -{
    -    if(($_ = `lwp-request -v 2>&1`)  &&  /version/)
    -    {
    -   $use_LWP = 1;
    -    }
    -    elsif(($_ = `curl --version 2>&1`)  &&  /curl/)
    -    {
    -   $use_curl = 1;
    -    }
    -    elsif ( system("wget --help >/dev/null 2>&1") == 0 )
    -    {
    -   $use_wget = 1;
    -    }
    -    else
    -    {
    -   die "$0: gccg_package requires wget, curl or lwp-request";
    -    }
    -    system("tar --help >/dev/null 2>&1")==0 or die "$0: gccg_package requires tar";
    -    system("gunzip --help > /dev/null 2>&1")==0 or die "$0: gccg_package requires gunzip";
    -}
    -
     if( $ARGV[0] eq "status" or $ARGV[0] eq "s" )
     {
    @@ -1015,7 +924,7 @@
        }
        print "-----------------------------------------------------------------\n";
    -   open(FILE,$build_list);
    +   open FILE,'<',$build_list;
        @f=<FILE>;
    -   open(PACKAGES,">$build_list");
    +   open PACKAGES,'>',$build_list;
        for(@f)
        {
    @@ -1149,10 +1058,10 @@
            {
            print("Remaking $store/../mirrors/$mirror\n");
    -       system("rm -rf $store/../mirrors/$mirror");
    +       rmtree "$store/../mirrors/$mirror";
            mkdir("$store/../mirrors/$mirror");
            for(@updates)
            {
                print "Copying $store/".module_file($_,$module{"build"}{$_})." "."$store/../mirrors/$mirror/\n";
    -           system("cp $store/".module_file($_,$module{"build"}{$_})." "."$store/../mirrors/$mirror/");
    +           copy "$store/".module_file($_,$module{"build"}{$_}),"$store/../mirrors/$mirror"
            }
            if($mirror=~m/gccg\.sourceforge\.net/)