AnnoCPAN::Perldoc::SyncDB - Download the AnnoCPAN database

AnnoCPAN-Perldoc-SyncDB documentation Contained in the AnnoCPAN-Perldoc-SyncDB distribution.

Index

Code Index:

NAME

Top

AnnoCPAN::Perldoc::SyncDB - Download the AnnoCPAN database

LICENSE

Top

Copyright Clotho Advanced Media Inc.

This software is released by Clotho Advanced Media, Inc. under the same terms as Perl itself. That means that it is dual-licensed under the Artistic license and the GPL, and that you can redistribute it and/or modify it under the terms of either or both of those licenses. See the "LICENSE" file, or visit http://www.clotho.com/code/Perl

The definitive source of Clotho Advanced Media software is http://www.clotho.com/code/

All of our software is also available under commercial license. If the Artisic license or the GPL does not meet the needs of your project, please contact us at info@clotho.com or visit the above URL.

We release open source software to help the world. We hope that you will enjoy this software, and we also hope and that you will hire us. As authors of this software, we are best able to help you integrate it into your project and to assist you with any problems.

SYNOPSIS

Top

    use AnnoCPAN::Perldoc::SyncDB;
    AnnoCPAN::Perldoc::SyncDB->run(
       dest => "$ENV{HOME}/.annopod.db",
       verbose => 1,
    );

DESCRIPTION

Top

This module provides a simple interface to mirror the http://annocpan.org/ content to a local machine. In conjunction with the AnnoCPAN::Perldoc module, this allows one to get all the benefits of the AnnoCPAN website in one's local perldoc command.

Recommended usage: 1) Install this module and AnnoCPAN::Perldoc, 2) set up a weekly process to run the syncannopod command included in this distribution, 3) Put the following in your shell configuration: alias perldoc annopod.

FUNCTIONS

Top

$pkg->baseurl()
$pkg->baseurl($newurl)

Returns the default URL for the annopod.db file. If there is an argument, it sets the default URL to that value before returning.

$pkg->run([OPTS])

Mirrors the annopod.db file from the net. The behavior can be altered via hash-like options:

dest => filename

Specifies the filename where the downloaded file should be stored.

Defaults to the same location used by AnnoCPAN::Perldoc, or if that fails $HOME/.annopod.db ($HOME\annopod.db on Windows).

src => url

Specifies the net resource that should be mirrored.

Defaults to the baseurl property of this module.

timeout => seconds

Specifies the LWP::UserAgent timeout. Defaults to 30 seconds.

compress => flag

Specifies which version of the database to download. The options are bz2, gz, the empty string (i.e. no compression) or undef, which means autodetection. The autodetect mode checks if you have Compress::Bzip2 or Compress::Zlib installed before picking the best of the other flag values.

Defaults to undef (that is, autodetect mode).

verbose => boolean

Defaults to a false value. If set to true, this method prints status messages to the output filehandle.

SEE ALSO

Top

AnnoCPAN::Perldoc

AUTHOR

Top

Clotho Advanced Media Inc., cpan@clotho.com

Primary developer: Chris Dolan

AnnoCPAN-Perldoc-SyncDB documentation Contained in the AnnoCPAN-Perldoc-SyncDB distribution. 
package AnnoCPAN::Perldoc::SyncDB;

use warnings;
use strict;
use LWP::UserAgent;
use File::Spec;
use Carp;

our $VERSION = '0.11';

# Default URL, can be overridden via package method
my $baseurl = 'http://annocpan.org/annopod.db';


sub baseurl
{
   my $pkg = shift;
   if (@_ > 0)
   {
      $baseurl = shift;
   }
   return $baseurl;
}


sub run
{
   my $pkg = shift;
   if (@_ % 2)
   {
      croak("Error: odd number of arguments");
   }
   my %opts = @_;
   $opts{src} ||= $baseurl;
   $opts{timeout} ||= 30;

   if (!$opts{dest})
   {
      # This algorithm is duplicated from AnnoCPAN::Perldoc
      # Future versions should access that module's algorithm directly
      DIR: foreach my $dir (@ENV{qw(HOME USERPROFILE ALLUSERSPROFILE)},
                            '/var/annocpan')
      {
         if ($dir && -d $dir)
         {
            foreach my $file ('annopod.db', '.annopod.db')
            {
               my $path = File::Spec->catfile($dir, $file);
               if (-w $path)
               {
                  $opts{dest} = $path;
                  last DIR;
               }
            }
         }
      }
   }

   if (!$opts{dest} && $ENV{HOME})
   {
      $opts{dest} = File::Spec->catfile($ENV{HOME}, 
                                  ($^O eq 'MSWin32' ? '' : '.') .
                                  'annopod.db');
   }
   
   if (!$opts{dest})
   {
      croak('No destination file specified');
   }

   if (!defined $opts{compress})
   {
      $opts{compress} = '';
      local $SIG{__WARN__} = 'DEFAULT';
      local $SIG{__DIE__} = 'DEFAULT';
      eval 'use Compress::Bzip2';
      if (!$@)
      {
         $opts{compress} = 'bz2';
      }
      else
      {
         eval 'use Compress::Zlib';
         if (!$@)
         {
            $opts{compress} = 'gz';
         }
      }
   }

   my $ext = $opts{compress} ? ".$opts{compress}" : '';
   my $url = $opts{src}.$ext;
   my $dest = $opts{dest};

   print "Downloading $url --> $dest$ext\n" if ($opts{verbose});

   my $ua = LWP::UserAgent->new();
   $ua->timeout($opts{timeout});
   $ua->env_proxy;
   $ua->mirror($url, $dest.$ext)
       || croak("Failed to mirror $url");

   if ($opts{compress})
   {
      print "Uncompressing $dest$ext --> $dest\n" if ($opts{verbose});
      open(my $out, "> $dest")
          || croak("Failed to write to $dest");
      my $buf;
      if ($opts{compress} eq 'bz2')
      {
         my $bz = Compress::Bzip2->new();
         $bz->bzopen($dest.$ext, "r");
         while ($bz->bzread($buf) > 0)
         {
            print $out $buf;
         }
         $bz->bzclose();
      }
      elsif ($opts{compress} eq 'gz')
      {
         my $gz = Compress::Zlib::gzopen($dest.$ext, "r");
         while ($gz->gzread($buf) > 0)
         {
            print $out $buf;
         }
         $gz->gzclose();
      }
      else
      {
         carp('Compression option not understood.  Skipping uncompress step.');
      }
      close $out;
   }
   print "Done\n" if ($opts{verbose});
}

1;
__END__