Module-Dependency
1 match

 view release on metacpan or  search on metacpan

examples/pmd_cgidepend.plx  view on Meta::CPAN 

#!/usr/bin/perl
# $Id: pmd_cgidepend.plx 6570 2006-06-27 15:01:04Z timbo $

### YOU MAY NEED TO EDIT THE SHEBANG LINE!

use strict;

### EDIT THIS LINE - You may need to point this at some special lib directory
use lib qw(/home/piers/src/dependency/lib);

### EDIT THIS LINE - New versions of GD do not support GIF
### Set this to 'GIF' or 'PNG' depending on what your GD can handle
### This program will try to override this if the CGI parameter 'format' is given: this
### value is used when no guess can be made
use constant DEFAULT_FORMAT => 'PNG';

### EDIT THIS - set it to the URL of the stylesheet you want to use
use constant STYLESHEET_LOC => '/depend.css';

### EDIT THIS OPTIONALLY - this value will be prepended to the incoming 'datafile' parameter, allowing you to restrict it to a single directory
use constant DATADIR => '';

### EDIT THIS OPTIONALLY - if true then we'll print a clientside imagemap/make SVGs clickable. if false, no imagemap
use constant DOES_IMAGEMAP => 1;

### EDIT THIS OPTIONALLY - set to 'object' or 'embed'. the default way of embedding an SVG image into the page. Apparently we _should_ use object but many browsers can't handle that
use constant HOW_EMBED => 'object';

use CGI;
use Module::Dependency::Info;
use Module::Dependency::Grapher;

use vars qw/$VERSION $cgi %MIMELUT/;

($VERSION) = ('$Revision: 6570 $' =~ /([\d\.]+)/ );
$cgi = new CGI;
%MIMELUT = (
	'GIF' => 'image/gif',
	'PNG' => 'image/png',
	'JPG' => 'image/jpeg',
	'SVG' => 'image/svg+xml',
);

eval {
	# no parameters... print the usage
	unless ( $cgi->param('go') ) {
		print CGI::header('text/plain');
		require Pod::Text;
		Pod::Text::pod2text($0);
		die("NORMALEXIT");
	}
	
	my $datafile = $cgi->param('datafile');
	my $allscripts = $cgi->param('allscripts');
	my $re = $cgi->param('re');
	my $xre = $cgi->param('xre');
	my $seed;
	unless ( $allscripts) {
		$seed = $cgi->param('seed') || die("There must be a 'seed' specified");
	}
	my $kind = $cgi->param('kind') || 'both';
	my $embed = $cgi->param('embed');
	my $format = $cgi->param('format') || DEFAULT_FORMAT;
	$format =~ s/\W//g;
	$format = uc($format);
	my $howembed = lc($cgi->param('howembed')) || HOW_EMBED;
	
	if ($datafile) {
		die("Unlikely characters in filename") if ($datafile =~ m/[^\w\/\:\.-]/);
		die("Unlikely looking filename") if ($datafile =~ m/\.\./);
		Module::Dependency::Grapher::setIndex( DATADIR . $datafile );
	}

	# what modules/scripts will be included
	my @objlist;
	my $objliststr;
	my $plural = '';
	
	if ( $allscripts ) {
		@objlist = @{ Module::Dependency::Info::allScripts() };
		$plural = 's';
		$objliststr = 'All Scripts';
	} else {
		if (index($seed, ',') > -1) {
			@objlist = split(/,\s*/, $seed);
			$plural = 's';
			$objliststr = join(', ', @objlist);
		} else {
			@objlist = $objliststr = $seed;
		}
	}
	
	my $title;
	if ($kind == 'both') {
		$title = "Parent + child dependencies for package$plural $objliststr";
	} elsif ($kind == 'parent') {
		$title = "Parent dependencies for package$plural $objliststr";
	} else {
		$title = "Dependencies for package$plural $objliststr";
	}

	my $scripturl = $ENV{SCRIPT_URL} || $ENV{SCRIPT_NAME};
	my $cgi_this_time = "$scripturl?go=1&kind=$kind&format=$format&datafile=$datafile&allscripts=$allscripts&re=$re&xre=$xre&howembed=$howembed";

	if ( $embed == 1 ) {
		print CGI::header( $MIMELUT{$format} );
		
		my @imopts;
		if (DOES_IMAGEMAP) { @imopts = ('HrefFormat', "$cgi_this_time&seed=%s"); }
		my @args = ( $kind, \@objlist, '-', {Title => $title, Format => $format, IncludeRegex => $re, ExcludeRegex => $xre, @imopts} );

		if ($format eq 'SVG') {
			Module::Dependency::Grapher::makeSvg( @args );
		} else {
			Module::Dependency::Grapher::makeImage( @args );
		}
	} else {
		print CGI::header('text/html');
		if ( $embed == 0 ) {
			my $title = $seed || 'all scripts';
			print qq(<html>\n<head><title>Dependencies for $title</title>\n<link rel="stylesheet" href=") . STYLESHEET_LOC . qq(" type="text/css">\n</head>\n<body>\n);
		}
		
		print qq(<h1>Dependency Information for $seed</h1><hr />\n<h2>Plot of relationships</h2>\n);

		if ($format eq 'SVG') {



( run in 1.210 second using v1.01-cache-2.11-cpan-71847e10f99 )