libjifty-plugin-chart-perl-1.01+dfsg.orig/0000755000175000017500000000000011454064767017770 5ustar gregoagregoalibjifty-plugin-chart-perl-1.01+dfsg.orig/inc/0000755000175000017500000000000011227307503020523 5ustar gregoagregoalibjifty-plugin-chart-perl-1.01+dfsg.orig/inc/Module/0000755000175000017500000000000011227307503021750 5ustar gregoagregoalibjifty-plugin-chart-perl-1.01+dfsg.orig/inc/Module/Install/0000755000175000017500000000000011227307503023356 5ustar gregoagregoalibjifty-plugin-chart-perl-1.01+dfsg.orig/inc/Module/Install/Makefile.pm0000644000175000017500000001445411227307435025445 0ustar gregoagregoa#line 1 package Module::Install::Makefile; use strict 'vars'; use Module::Install::Base; use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.76'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing, always use defaults if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } sub makemaker_args { my $self = shift; my $args = ( $self->{makemaker_args} ||= {} ); %$args = ( %$args, @_ ); return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = sShift; my $name = shift; my $args = $self->makemaker_args; $args->{name} = defined $args->{$name} ? join( ' ', $args->{name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } my %test_dir = (); sub _wanted_t { /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1; } sub tests_recursive { my $self = shift; if ( $self->tests ) { die "tests_recursive will not work if tests are already defined"; } my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } %test_dir = (); require File::Find; File::Find::find( \&_wanted_t, $dir ); $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Make sure we have a new enough require ExtUtils::MakeMaker; # MakeMaker can complain about module versions that include # an underscore, even though its own version may contain one! # Hence the funny regexp to get rid of it. See RT #35800 # for details. $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ ); # Generate the my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{VERSION} = $self->version; $args->{NAME} =~ s/-/::/g; if ( $self->tests ) { $args->{test} = { TESTS => $self->tests }; } if ($] >= 5.005) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = $self->author; } if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) { $args->{NO_META} = 1; } if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } # merge both kinds of requires into prereq_pm my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_, ($self->configure_requires, $self->build_requires, $self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # merge both kinds of requires into prereq_pm my $subdirs = ($args->{DIR} ||= []); if ($self->bundles) { foreach my $bundle (@{ $self->bundles }) { my ($file, $dir) = @$bundle; push @$subdirs, $dir if -d $dir; delete $prereq->{$file}; } } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } $args->{INSTALLDIRS} = $self->installdirs; my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if (my $preop = $self->admin->preop($user_preop)) { $args{dist} = $preop; } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; my $makefile = do { local $/; }; close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 377 libjifty-plugin-chart-perl-1.01+dfsg.orig/inc/Module/Install/Fetch.pm0000644000175000017500000000463011227307435024754 0ustar gregoagregoa#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.76'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; libjifty-plugin-chart-perl-1.01+dfsg.orig/inc/Module/Install/AutoInstall.pm0000644000175000017500000000227211227307433026160 0ustar gregoagregoa#line 1 package Module::Install::AutoInstall; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.76'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub AutoInstall { $_[0] } sub run { my $self = shift; $self->auto_install_now(@_); } sub write { my $self = shift; $self->auto_install(@_); } sub auto_install { my $self = shift; return if $self->{done}++; # Flatten array of arrays into a single array my @core = map @$_, map @$_, grep ref, $self->build_requires, $self->requires; my @config = @_; # We'll need Module::AutoInstall $self->include('Module::AutoInstall'); require Module::AutoInstall; Module::AutoInstall->import( (@config ? (-config => \@config) : ()), (@core ? (-core => \@core) : ()), $self->features, ); $self->makemaker_args( Module::AutoInstall::_make_args() ); my $class = ref($self); $self->postamble( "# --- $class section:\n" . Module::AutoInstall::postamble() ); } sub auto_install_now { my $self = shift; $self->auto_install(@_); Module::AutoInstall::do_install(); } 1; libjifty-plugin-chart-perl-1.01+dfsg.orig/inc/Module/Install/Can.pm0000644000175000017500000000337411227307435024430 0ustar gregoagregoa#line 1 package Module::Install::Can; use strict; use Module::Install::Base; use Config (); ### This adds a 5.005 Perl version dependency. ### This is a bug and will be fixed. use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.76'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { my $abs = File::Spec->catfile($dir, $_[1]); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 157 libjifty-plugin-chart-perl-1.01+dfsg.orig/inc/Module/Install/Win32.pm0000644000175000017500000000340211227307435024621 0ustar gregoagregoa#line 1 package Module::Install::Win32; use strict; use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.76'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; libjifty-plugin-chart-perl-1.01+dfsg.orig/inc/Module/Install/Include.pm0000644000175000017500000000101411227307433025275 0ustar gregoagregoa#line 1 package Module::Install::Include; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.76'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub include { shift()->admin->include(@_); } sub include_deps { shift()->admin->include_deps(@_); } sub auto_include { shift()->admin->auto_include(@_); } sub auto_include_deps { shift()->admin->auto_include_deps(@_); } sub auto_include_dependent_dists { shift()->admin->auto_include_dependent_dists(@_); } 1; libjifty-plugin-chart-perl-1.01+dfsg.orig/inc/Module/Install/Share.pm0000644000175000017500000000315411227307435024765 0ustar gregoagregoa#line 1 package Module::Install::Share; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.76'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub install_share { my $self = shift; my $dir = @_ ? pop : 'share'; my $type = @_ ? shift : 'dist'; unless ( defined $type and $type eq 'module' or $type eq 'dist' ) { die "Illegal or invalid share dir type '$type'"; } unless ( defined $dir and -d $dir ) { die "Illegal or missing directory install_share param"; } # Split by type my $S = ($^O eq 'MSWin32') ? "\\" : "\/"; if ( $type eq 'dist' ) { die "Too many parameters to install_share" if @_; # Set up the install $self->postamble(<<"END_MAKEFILE"); config :: \t\$(NOECHO) \$(MOD_INSTALL) \\ \t\t"$dir" \$(INST_LIB)${S}auto${S}share${S}dist${S}\$(DISTNAME) END_MAKEFILE } else { my $module = Module::Install::_CLASS($_[0]); unless ( defined $module ) { die "Missing or invalid module name '$_[0]'"; } $module =~ s/::/-/g; # Set up the install $self->postamble(<<"END_MAKEFILE"); config :: \t\$(NOECHO) \$(MOD_INSTALL) \\ \t\t"$dir" \$(INST_LIB)${S}auto${S}share${S}module${S}$module END_MAKEFILE } # The above appears to behave incorrectly when used with old versions # of ExtUtils::Install (known-bad on RHEL 3, with 5.8.0) # So when we need to install a share directory, make sure we add a # dependency on a moderately new version of ExtUtils::MakeMaker. $self->build_requires( 'ExtUtils::MakeMaker' => '6.11' ); # 99% of the time we don't want to index a shared dir $self->no_index( directory => $dir ); } 1; __END__ #line 125 libjifty-plugin-chart-perl-1.01+dfsg.orig/inc/Module/Install/Base.pm0000644000175000017500000000205011227307433024565 0ustar gregoagregoa#line 1 package Module::Install::Base; $VERSION = '0.76'; # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } ### This is the ONLY module that shouldn't have strict on # use strict; #line 41 sub new { my ($class, %args) = @_; foreach my $method ( qw(call load) ) { *{"$class\::$method"} = sub { shift()->_top->$method(@_); } unless defined &{"$class\::$method"}; } bless( \%args, $class ); } #line 61 sub AUTOLOAD { my $self = shift; local $@; my $autoload = eval { $self->_top->autoload } or return; goto &$autoload; } #line 76 sub _top { $_[0]->{_top} } #line 89 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 101 sub is_admin { $_[0]->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; my $Fake; sub new { $Fake ||= bless(\@_, $_[0]) } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 146 libjifty-plugin-chart-perl-1.01+dfsg.orig/inc/Module/Install/Metadata.pm0000644000175000017500000002573211227307433025447 0ustar gregoagregoa#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.76'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } my @scalar_keys = qw{ name module_name abstract author version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; sub Meta { shift } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}{$key} if defined wantarray and !@_; $self->{values}{$key} = shift; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}{resources} }; } return $self->{values}{resources}{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } sub requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{requires} }, [ $module, $version ]; } $self->{values}{requires}; } sub build_requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{build_requires} }, [ $module, $version ]; } $self->{values}{build_requires}; } sub configure_requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{configure_requires} }, [ $module, $version ]; } $self->{values}{configure_requires}; } sub recommends { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{recommends} }, [ $module, $version ]; } $self->{values}{recommends}; } sub bundles { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{bundles} }, [ $module, $version ]; } $self->{values}{bundles}; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}{resources} ||= []; push @{ $self->{values}{resources} }, [ $name, $value ]; } $self->{values}{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub sign { my $self = shift; return $self->{values}{sign} if defined wantarray and ! @_; $self->{values}{sign} = ( @_ ? $_[0] : 1 ); return $self; } sub dynamic_config { my $self = shift; unless ( @_ ) { warn "You MUST provide an explicit true/false value to dynamic_config\n"; return $self; } $self->{values}{dynamic_config} = $_[0] ? 1 : 0; return 1; } sub perl_version { my $self = shift; return $self->{values}{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); $version =~ s/_.+$//; $version = $version + 0; # Numify unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}{perl_version} = $version; return 1; } sub license { my $self = shift; return $self->{values}{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $self->{values}{license} = $license; # Automatically fill in license URLs if ( $license eq 'perl' ) { $self->resources( license => 'http://dev.perl.org/licenses/' ); } return 1; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless $self->author; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}{features} ? @{ $self->{values}{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}{no_index}{$type} }, @_ if $type; return $self->{values}{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub perl_version_from { my $self = shift; if ( Module::Install::_read($_[0]) =~ m/ ^ (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; $author =~ s{E}{<}g; $author =~ s{E}{>}g; $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } sub license_from { my $self = shift; if ( Module::Install::_read($_[0]) =~ m/ ( =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b .*? ) (=head\\d.*|=cut.*|) \z /ixms ) { my $license_text = $1; my @phrases = ( 'under the same (?:terms|license) as perl itself' => 'perl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'BSD license' => 'bsd', 1, 'Artistic license' => 'artistic', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s{\s+}{\\s+}g; if ( $license_text =~ /\b$pattern\b/i ) { if ( $osi and $license_text =~ /All rights reserved/i ) { print "WARNING: 'All rights reserved' in copyright may invalidate Open Source license.\n"; } $self->license($license); return 1; } } } warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = $content =~ m/L\<(http\:\/\/rt\.cpan\.org\/[^>]+)\>/g; unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than on rt.cpan.org link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub install_script { my $self = shift; my $args = $self->makemaker_args; my $exe = $args->{EXE_FILES} ||= []; foreach ( @_ ) { if ( -f $_ ) { push @$exe, $_; } elsif ( -d 'script' and -f "script/$_" ) { push @$exe, "script/$_"; } else { die("Cannot find script '$_'"); } } } 1; libjifty-plugin-chart-perl-1.01+dfsg.orig/inc/Module/Install/WriteAll.pm0000644000175000017500000000132111227307435025440 0ustar gregoagregoa#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.76'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->Meta->write if $args{meta}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { $self->makemaker_args( PL_FILES => {} ); } if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } } 1; libjifty-plugin-chart-perl-1.01+dfsg.orig/inc/Module/AutoInstall.pm0000644000175000017500000005077211227307433024562 0ustar gregoagregoa#line 1 package Module::AutoInstall; use strict; use Cwd (); use ExtUtils::MakeMaker (); use vars qw{$VERSION}; BEGIN { $VERSION = '1.03'; } # special map on pre-defined feature sets my %FeatureMap = ( '' => 'Core Features', # XXX: deprecated '-core' => 'Core Features', ); # various lexical flags my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS ); my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly ); my ( $PostambleActions, $PostambleUsed ); # See if it's a testing or non-interactive session _accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN ); _init(); sub _accept_default { $AcceptDefault = shift; } sub missing_modules { return @Missing; } sub do_install { __PACKAGE__->install( [ $Config ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) : () ], @Missing, ); } # initialize various flags, and/or perform install sub _init { foreach my $arg ( @ARGV, split( /[\s\t]+/, $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || '' ) ) { if ( $arg =~ /^--config=(.*)$/ ) { $Config = [ split( ',', $1 ) ]; } elsif ( $arg =~ /^--installdeps=(.*)$/ ) { __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--default(?:deps)?$/ ) { $AcceptDefault = 1; } elsif ( $arg =~ /^--check(?:deps)?$/ ) { $CheckOnly = 1; } elsif ( $arg =~ /^--skip(?:deps)?$/ ) { $SkipInstall = 1; } elsif ( $arg =~ /^--test(?:only)?$/ ) { $TestOnly = 1; } } } # overrides MakeMaker's prompt() to automatically accept the default choice sub _prompt { goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault; my ( $prompt, $default ) = @_; my $y = ( $default =~ /^[Yy]/ ); print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] '; print "$default\n"; return $default; } # the workhorse sub import { my $class = shift; my @args = @_ or return; my $core_all; print "*** $class version " . $class->VERSION . "\n"; print "*** Checking for Perl dependencies...\n"; my $cwd = Cwd::cwd(); $Config = []; my $maxlen = length( ( sort { length($b) <=> length($a) } grep { /^[^\-]/ } map { ref($_) ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} ) : '' } map { +{@args}->{$_} } grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} } )[0] ); while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) { my ( @required, @tests, @skiptests ); my $default = 1; my $conflict = 0; if ( $feature =~ m/^-(\w+)$/ ) { my $option = lc($1); # check for a newer version of myself _update_to( $modules, @_ ) and return if $option eq 'version'; # sets CPAN configuration options $Config = $modules if $option eq 'config'; # promote every features to core status $core_all = ( $modules =~ /^all$/i ) and next if $option eq 'core'; next unless $option eq 'core'; } print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n"; $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' ); unshift @$modules, -default => &{ shift(@$modules) } if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) { if ( $mod =~ m/^-(\w+)$/ ) { my $option = lc($1); $default = $arg if ( $option eq 'default' ); $conflict = $arg if ( $option eq 'conflict' ); @tests = @{$arg} if ( $option eq 'tests' ); @skiptests = @{$arg} if ( $option eq 'skiptests' ); next; } printf( "- %-${maxlen}s ...", $mod ); if ( $arg and $arg =~ /^\D/ ) { unshift @$modules, $arg; $arg = 0; } # XXX: check for conflicts and uninstalls(!) them. if ( defined( my $cur = _version_check( _load($mod), $arg ||= 0 ) ) ) { print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n"; push @Existing, $mod => $arg; $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n"; push @required, $mod => $arg; } } next unless @required; my $mandatory = ( $feature eq '-core' or $core_all ); if ( !$SkipInstall and ( $CheckOnly or _prompt( qq{==> Auto-install the } . ( @required / 2 ) . ( $mandatory ? ' mandatory' : ' optional' ) . qq{ module(s) from CPAN?}, $default ? 'y' : 'n', ) =~ /^[Yy]/ ) ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } elsif ( !$SkipInstall and $default and $mandatory and _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', ) =~ /^[Nn]/ ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { $DisabledTests{$_} = 1 for map { glob($_) } @tests; } } $UnderCPAN = _check_lock(); # check for $UnderCPAN if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) { require Config; print "*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n"; # make an educated guess of whether we'll need root permission. print " (You may need to do that as the 'root' user.)\n" if eval '$>'; } print "*** $class configuration finished.\n"; chdir $cwd; # import to main:: no strict 'refs'; *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main'; } # Check to see if we are currently running under CPAN.pm and/or CPANPLUS; # if we are, then we simply let it taking care of our dependencies sub _check_lock { return unless @Missing; if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) { print <<'END_MESSAGE'; *** Since we're running under CPANPLUS, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } _load_cpan(); # Find the CPAN lock-file my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" ); return unless -f $lock; # Check the lock local *LOCK; return unless open(LOCK, $lock); if ( ( $^O eq 'MSWin32' ? _under_cpan() : == getppid() ) and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore' ) { print <<'END_MESSAGE'; *** Since we're running under CPAN, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } close LOCK; return; } sub install { my $class = shift; my $i; # used below to strip leading '-' from config keys my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } ); my ( @modules, @installed ); while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) { # grep out those already installed if ( defined( _version_check( _load($pkg), $ver ) ) ) { push @installed, $pkg; } else { push @modules, $pkg, $ver; } } return @installed unless @modules; # nothing to do return @installed if _check_lock(); # defer to the CPAN shell print "*** Installing dependencies...\n"; return unless _connected_to('cpan.org'); my %args = @config; my %failed; local *FAILED; if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) { while () { chomp; $failed{$_}++ } close FAILED; my @newmod; while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) { push @newmod, ( $k => $v ) unless $failed{$k}; } @modules = @newmod; } if ( _has_cpanplus() ) { _install_cpanplus( \@modules, \@config ); } else { _install_cpan( \@modules, \@config ); } print "*** $class installation finished.\n"; # see if we have successfully installed them while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { if ( defined( _version_check( _load($pkg), $ver ) ) ) { push @installed, $pkg; } elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) { print FAILED "$pkg\n"; } } close FAILED if $args{do_once}; return @installed; } sub _install_cpanplus { my @modules = @{ +shift }; my @config = _cpanplus_config( @{ +shift } ); my $installed = 0; require CPANPLUS::Backend; my $cp = CPANPLUS::Backend->new; my $conf = $cp->configure_object; return unless $conf->can('conf') # 0.05x+ with "sudo" support or _can_write($conf->_get_build('base')); # 0.04x # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $conf->get_conf('makeflags') || ''; if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) { # 0.03+ uses a hashref here $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST}; } else { # 0.02 and below uses a scalar $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); } $conf->set_conf( makeflags => $makeflags ); $conf->set_conf( prereqs => 1 ); while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) { $conf->set_conf( $key, $val ); } my $modtree = $cp->module_tree; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { print "*** Installing $pkg...\n"; MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; my $success; my $obj = $modtree->{$pkg}; if ( $obj and defined( _version_check( $obj->{version}, $ver ) ) ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $cp->install( modules => [ $obj->{module} ] ); if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation cancelled.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _cpanplus_config { my @config = (); while ( @_ ) { my ($key, $value) = (shift(), shift()); if ( $key eq 'prerequisites_policy' ) { if ( $value eq 'follow' ) { $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL(); } elsif ( $value eq 'ask' ) { $value = CPANPLUS::Internals::Constants::PREREQ_ASK(); } elsif ( $value eq 'ignore' ) { $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE(); } else { die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n"; } } else { die "*** Cannot convert option $key to CPANPLUS version.\n"; } } return @config; } sub _install_cpan { my @modules = @{ +shift }; my @config = @{ +shift }; my $installed = 0; my %args; _load_cpan(); require Config; if (CPAN->VERSION < 1.80) { # no "sudo" support, probe for writableness return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) ) and _can_write( $Config::Config{sitelib} ); } # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $CPAN::Config->{make_install_arg} || ''; $CPAN::Config->{make_install_arg} = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); # don't show start-up info $CPAN::Config->{inhibit_startup_message} = 1; # set additional options while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) { ( $args{$opt} = $arg, next ) if $opt =~ /^force$/; # pseudo-option $CPAN::Config->{$opt} = $arg; } local $CPAN::Config->{prerequisites_policy} = 'follow'; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; print "*** Installing $pkg...\n"; my $obj = CPAN::Shell->expand( Module => $pkg ); my $success = 0; if ( $obj and defined( _version_check( $obj->cpan_version, $ver ) ) ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $args{force} ? CPAN::Shell->force( install => $pkg ) : CPAN::Shell->install($pkg); $rv ||= eval { $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, ) ->{install} if $CPAN::META; }; if ( $rv eq 'YES' ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation failed.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _has_cpanplus { return ( $HasCPANPLUS = ( $INC{'CPANPLUS/Config.pm'} or _load('CPANPLUS::Shell::Default') ) ); } # make guesses on whether we're under the CPAN installation directory sub _under_cpan { require Cwd; require File::Spec; my $cwd = File::Spec->canonpath( Cwd::cwd() ); my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} ); return ( index( $cwd, $cpan ) > -1 ); } sub _update_to { my $class = __PACKAGE__; my $ver = shift; return if defined( _version_check( _load($class), $ver ) ); # no need to upgrade if ( _prompt( "==> A newer version of $class ($ver) is required. Install?", 'y' ) =~ /^[Nn]/ ) { die "*** Please install $class $ver manually.\n"; } print << "."; *** Trying to fetch it from CPAN... . # install ourselves _load($class) and return $class->import(@_) if $class->install( [], $class, $ver ); print << '.'; exit 1; *** Cannot bootstrap myself. :-( Installation terminated. . } # check if we're connected to some host, using inet_aton sub _connected_to { my $site = shift; return ( ( _load('Socket') and Socket::inet_aton($site) ) or _prompt( qq( *** Your host cannot resolve the domain name '$site', which probably means the Internet connections are unavailable. ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/ ); } # check if a directory is writable; may create it on demand sub _can_write { my $path = shift; mkdir( $path, 0755 ) unless -e $path; return 1 if -w $path; print << "."; *** You are not allowed to write to the directory '$path'; the installation may fail due to insufficient permissions. . if ( eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt( qq( ==> Should we try to re-execute the autoinstall process with 'sudo'?), ((-t STDIN) ? 'y' : 'n') ) =~ /^[Yy]/ ) { # try to bootstrap ourselves from sudo print << "."; *** Trying to re-execute the autoinstall process with 'sudo'... . my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; return unless system( 'sudo', $^X, $0, "--config=$config", "--installdeps=$missing" ); print << "."; *** The 'sudo' command exited with error! Resuming... . } return _prompt( qq( ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/; } # load a module and return the version it reports sub _load { my $mod = pop; # class/instance doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; local $@; return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 ); } # Load CPAN.pm and it's configuration sub _load_cpan { return if $CPAN::VERSION; require CPAN; if ( $CPAN::HandleConfig::VERSION ) { # Newer versions of CPAN have a HandleConfig module CPAN::HandleConfig->load; } else { # Older versions had the load method in Config directly CPAN::Config->load; } } # compare two versions, either use Sort::Versions or plain comparison sub _version_check { my ( $cur, $min ) = @_; return unless defined $cur; $cur =~ s/\s+$//; # check for version numbers that are not in decimal format if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) { if ( ( $version::VERSION or defined( _load('version') )) and version->can('new') ) { # use version.pm if it is installed. return ( ( version->new($cur) >= version->new($min) ) ? $cur : undef ); } elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) ) { # use Sort::Versions as the sorting algorithm for a.b.c versions return ( ( Sort::Versions::versioncmp( $cur, $min ) != -1 ) ? $cur : undef ); } warn "Cannot reliably compare non-decimal formatted versions.\n" . "Please install version.pm or Sort::Versions.\n"; } # plain comparison local $^W = 0; # shuts off 'not numeric' bugs return ( $cur >= $min ? $cur : undef ); } # nothing; this usage is deprecated. sub main::PREREQ_PM { return {}; } sub _make_args { my %args = @_; $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing } if $UnderCPAN or $TestOnly; if ( $args{EXE_FILES} and -e 'MANIFEST' ) { require ExtUtils::Manifest; my $manifest = ExtUtils::Manifest::maniread('MANIFEST'); $args{EXE_FILES} = [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ]; } $args{test}{TESTS} ||= 't/*.t'; $args{test}{TESTS} = join( ' ', grep { !exists( $DisabledTests{$_} ) } map { glob($_) } split( /\s+/, $args{test}{TESTS} ) ); my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; $PostambleActions = ( $missing ? "\$(PERL) $0 --config=$config --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); return %args; } # a wrapper to ExtUtils::MakeMaker::WriteMakefile sub Write { require Carp; Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; if ($CheckOnly) { print << "."; *** Makefile not written in check-only mode. . return; } my %args = _make_args(@_); no strict 'refs'; $PostambleUsed = 0; local *MY::postamble = \&postamble unless defined &MY::postamble; ExtUtils::MakeMaker::WriteMakefile(%args); print << "." unless $PostambleUsed; *** WARNING: Makefile written with customized MY::postamble() without including contents from Module::AutoInstall::postamble() -- auto installation features disabled. Please contact the author. . return 1; } sub postamble { $PostambleUsed = 1; return << "."; config :: installdeps \t\$(NOECHO) \$(NOOP) checkdeps :: \t\$(PERL) $0 --checkdeps installdeps :: \t$PostambleActions . } 1; __END__ #line 1003 libjifty-plugin-chart-perl-1.01+dfsg.orig/inc/Module/Install.pm0000644000175000017500000002100711227307433023716 0ustar gregoagregoa#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } BEGIN { require 5.004; } use strict 'vars'; use vars qw{$VERSION}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '0.76'; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 and (stat($0))[9] > time ) { die <<"END_DIE" } Your installer $0 has a modification time in the future. This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); use Cwd (); use File::Find (); use File::Path (); use FindBin; sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # delegate back to parent dirs goto &$code unless $cwd eq $pwd; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; unshift @_, ( $self, $1 ); goto &{$self->can('call')} unless uc($1) eq $1; }; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; unless ( -f $self->{file} ) { require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; return 1; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { my $admin = $self->{admin}; @exts = $admin->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = delete $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } sub _read { local *FH; open FH, "< $_[0]" or die "open($_[0]): $!"; my $str = do { local $/; }; close FH or die "close($_[0]): $!"; return $str; } sub _write { local *FH; open FH, "> $_[0]" or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" } close FH or die "close($_[0]): $!"; } sub _version ($) { my $s = shift || 0; $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s ) ? $_[0] : undef; } 1; # Copyright 2008 Adam Kennedy. libjifty-plugin-chart-perl-1.01+dfsg.orig/Makefile.PL0000644000175000017500000000055211221102110021703 0ustar gregoagregoause inc::Module::Install; name('Jifty-Plugin-Chart'); all_from('lib/Jifty/Plugin/Chart.pm'); requires('Jifty' => '0.90409'); recommends('Chart::Base'); recommends('GD'); # for a testing hack recommends('GD::Graph'); recommends('XML::Simple'); recommends('Image::Info'); # for testing auto_install(); tests(qw( t/*/t/*.t )); install_share; WriteAll; libjifty-plugin-chart-perl-1.01+dfsg.orig/Changes0000644000175000017500000000033211221102212021223 0ustar gregoagregoaRevision history for Perl module Jifty::Plugin::Chart 1.00 Fri, 26 Jun 2009 10:18:45 +0200 - add dep on Jifty 0.90409 to use Jifty::Test::Dist 0.9 Wed, 10 Jun 2009 09:33:32 +0200 - original version for CPAN libjifty-plugin-chart-perl-1.01+dfsg.orig/META.yml0000644000175000017500000000113511227307435021227 0ustar gregoagregoa--- abstract: 'A charting API for Jifty' author: - 'Andrew Sterling Hanenkamp C<< >>' build_requires: ExtUtils::MakeMaker: 6.11 distribution_type: module generated_by: 'Module::Install version 0.76' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Jifty-Plugin-Chart no_index: directory: - share - share - inc - t recommends: Chart::Base: 0 GD: 0 GD::Graph: 0 Image::Info: 0 XML::Simple: 0 requires: Jifty: 0.90409 resources: license: http://dev.perl.org/licenses/ version: 1.01 libjifty-plugin-chart-perl-1.01+dfsg.orig/t/0000755000175000017500000000000011227307503020215 5ustar gregoagregoalibjifty-plugin-chart-perl-1.01+dfsg.orig/t/TestApp-Plugin-Chart/0000755000175000017500000000000011227307503024070 5ustar gregoagregoalibjifty-plugin-chart-perl-1.01+dfsg.orig/t/TestApp-Plugin-Chart/Makefile.PL0000644000175000017500000000020011155144770026037 0ustar gregoagregoause inc::Module::Install; name 'TestApp-Plugin-Chart'; version '0.01'; requires 'Jifty' => '0.70129'; WriteAll; libjifty-plugin-chart-perl-1.01+dfsg.orig/t/TestApp-Plugin-Chart/etc/0000755000175000017500000000000011227307503024643 5ustar gregoagregoalibjifty-plugin-chart-perl-1.01+dfsg.orig/t/TestApp-Plugin-Chart/etc/config.yml0000644000175000017500000000215511155144770026643 0ustar gregoagregoa--- framework: AdminMode: 1 ApplicationClass: TestApp::Plugin::Chart ApplicationName: TestApp-Plugin-Chart ApplicationUUID: D16D885C-3E10-11DC-ABE9-A583E6FF98E1 ConfigFileVersion: 2 Database: CheckSchema: 1 Database: testapp_plugin_chart Driver: SQLite Host: localhost Password: '' RecordBaseClass: Jifty::DBI::Record::Cachable RecordUUIDs: active User: '' Version: 0.0.1 DevelMode: 0 L10N: PoDir: share/po LogLevel: INFO Mailer: Sendmail MailerArgs: [] Plugins: - LetMe: {} - SkeletonApp: {} - REST: {} - Halo: {} - ErrorTemplates: {} - OnlineDocs: {} - CompressedCSSandJS: {} - AdminUI: {} - Chart: {} PubSub: Backend: Memcached Enable: ~ SkipAccessControl: 0 TemplateClass: TestApp::Plugin::Chart::View Web: BaseURL: http://localhost DataDir: var/mason Globals: [] MasonConfig: autoflush: 0 default_escape_flags: h error_format: text error_mode: fatal Port: 8888 ServeStaticFiles: 1 StaticRoot: share/web/static TemplateRoot: share/web/templates libjifty-plugin-chart-perl-1.01+dfsg.orig/t/TestApp-Plugin-Chart/t/0000755000175000017500000000000011227307503024333 5ustar gregoagregoalibjifty-plugin-chart-perl-1.01+dfsg.orig/t/TestApp-Plugin-Chart/t/chart.t0000644000175000017500000000304211222062534025615 0ustar gregoagregoa#!/usr/bin/env perl use strict; use warnings; # XXX FIXME This is here to prevent a segfault on my machine during testing. # -- sterling # typo: s/Chart::pie/Chart::Pie/ certainly fix this # -- yves (found by gregor Herrmann) use Test::More; eval "use GD; use Chart::Pie; 1"; if ($@) { plan skip_all => 'Chart is not installed.'; } else { plan tests => 9; } use Jifty::Test::Dist; use Jifty::Test::WWW::Mechanize; use Jifty::Plugin::Chart::Renderer::Chart; my $chart_plugin = (Jifty->find_plugin('Jifty::Plugin::Chart'))[0]; $chart_plugin->renderer( $chart_plugin->init_renderer('Jifty::Plugin::Chart::Renderer::Chart') ); my $server = Jifty::Test->make_server; ok($server, 'got a server'); my $url = $server->started_ok; my $mech = Jifty::Test::WWW::Mechanize->new; $mech->get_ok($url . '/graphit', 'try getting /graphit'); my $img_match = qr{content_like($img_match, 'has an img tag'); my ($chart_path) = $mech->content =~ $img_match; $mech->get_ok($url . $chart_path, 'try getting ' . $chart_path); my $response = $mech->response; is($response->header('Content-type'), 'image/png', 'content type set to png'); SKIP: { eval "use Image::Info qw/ image_info /"; skip "Image::Info is not installed", 3 if $@; my $imgdata = $mech->content; my $info = image_info(\$imgdata); diag($info->{error}) if $info->{error}; is($info->{file_ext}, 'png', 'it is a png file'); is($info->{width}, 400, 'it is 400 pixels wide'); is($info->{height}, 500, 'it is 500 pixels tall'); }; libjifty-plugin-chart-perl-1.01+dfsg.orig/t/TestApp-Plugin-Chart/t/gd_graph.t0000644000175000017500000000273211155144770026304 0ustar gregoagregoa#!/usr/bin/env perl use strict; use warnings; # XXX FIXME This is here to prevent a segfault on my machine during testing. # -- sterling use Test::More; eval "use GD; use GD::Graph::pie; 1"; if ($@) { plan skip_all => 'GD::Graph is not installed.'; } else { plan tests => 9; } use Jifty::Test::Dist; use Jifty::Test::WWW::Mechanize; use Jifty::Plugin::Chart::Renderer::GD::Graph; my $chart_plugin = (Jifty->find_plugin('Jifty::Plugin::Chart'))[0]; $chart_plugin->renderer( $chart_plugin->init_renderer('Jifty::Plugin::Chart::Renderer::GD::Graph') ); my $server = Jifty::Test->make_server; ok($server, 'got a server'); my $url = $server->started_ok; my $mech = Jifty::Test::WWW::Mechanize->new; $mech->get_ok($url . '/graphit', 'try getting /graphit'); my $img_match = qr{content_like($img_match, 'has an img tag'); my ($chart_path) = $mech->content =~ $img_match; $mech->get_ok($url . $chart_path, 'try getting ' . $chart_path); my $response = $mech->response; is($response->header('Content-type'), 'image/png', 'content type set to png'); SKIP: { eval "use Image::Info qw/ image_info /"; skip "Image::Info is not installed", 3 if $@; my $imgdata = $mech->content; my $info = image_info(\$imgdata); diag($info->{error}) if $info->{error}; is($info->{file_ext}, 'png', 'it is a png file'); is($info->{width}, 400, 'it is 400 pixels wide'); is($info->{height}, 500, 'it is 500 pixels tall'); }; libjifty-plugin-chart-perl-1.01+dfsg.orig/t/TestApp-Plugin-Chart/lib/0000755000175000017500000000000011227307503024636 5ustar gregoagregoalibjifty-plugin-chart-perl-1.01+dfsg.orig/t/TestApp-Plugin-Chart/lib/TestApp/0000755000175000017500000000000011227307503026216 5ustar gregoagregoalibjifty-plugin-chart-perl-1.01+dfsg.orig/t/TestApp-Plugin-Chart/lib/TestApp/Plugin/0000755000175000017500000000000011227307503027454 5ustar gregoagregoalibjifty-plugin-chart-perl-1.01+dfsg.orig/t/TestApp-Plugin-Chart/lib/TestApp/Plugin/Chart/0000755000175000017500000000000011227307503030515 5ustar gregoagregoalibjifty-plugin-chart-perl-1.01+dfsg.orig/t/TestApp-Plugin-Chart/lib/TestApp/Plugin/Chart/View.pm0000644000175000017500000000057611155144770032002 0ustar gregoagregoause strict; use warnings; package TestApp::Plugin::Chart::View; use Jifty::View::Declare -base; template '/graphit' => page { Jifty->web->chart( type => 'Pie', width => '100%', height => 500, data => sub { [ [ 2004, 2005, 2006, 2007 ], [ 26, 37, 12, 42 ] ]; }, ); }; 1; libjifty-plugin-chart-perl-1.01+dfsg.orig/t/TestApp-Plugin-Chart/bin/0000755000175000017500000000000011227307503024640 5ustar gregoagregoalibjifty-plugin-chart-perl-1.01+dfsg.orig/t/TestApp-Plugin-Chart/bin/jifty0000755000175000017500000000032511155144770025720 0ustar gregoagregoa#!/usr/bin/env perl use warnings; use strict; use File::Basename qw(dirname); use UNIVERSAL::require; use Jifty; use Jifty::Script; local $SIG{INT} = sub { warn "Stopped\n"; exit; }; Jifty::Script->dispatch(); libjifty-plugin-chart-perl-1.01+dfsg.orig/lib/0000755000175000017500000000000011227307503020520 5ustar gregoagregoalibjifty-plugin-chart-perl-1.01+dfsg.orig/lib/Jifty/0000755000175000017500000000000011227307503021605 5ustar gregoagregoalibjifty-plugin-chart-perl-1.01+dfsg.orig/lib/Jifty/Plugin/0000755000175000017500000000000011227307503023043 5ustar gregoagregoalibjifty-plugin-chart-perl-1.01+dfsg.orig/lib/Jifty/Plugin/Chart/0000755000175000017500000000000011227307503024104 5ustar gregoagregoalibjifty-plugin-chart-perl-1.01+dfsg.orig/lib/Jifty/Plugin/Chart/Renderer.pm0000644000175000017500000000375511155144770026227 0ustar gregoagregoause strict; use warnings; package Jifty::Plugin::Chart::Renderer; use base qw/Jifty::Object/; =head1 NAME Jifty::Plugin::Chart::Renderer - Base class for chart rendering classes =head1 SYNOPSIS In your F: Plugins: - Chart: DefaultRenderer: MyApp::Renderer In F: package MyApp::Renderer; use base qw/ Jifty::Plugin::Chart::Renderer /; sub init { my $self = shift; # Handle any required initialization, like required CSS, JS, etc. } sub render { my $self = shift; my %args = @_; # Output your chart Jifty->web->out( #{ Output your chart here... } ); # You could also return it as a string... return; } =head1 METHODS Your renderer implementation must subclass this package and implement the following methods: =head2 new This is the constructor. Don't override this directly. Instead implement L. =cut sub new { my $class = shift; my $self = bless {}, $class; $self->init( @_ ); return $self; } =head2 init $renderer->init(); This is called by C immediately after constructing the object. It is passed a param hash from the config file. Subclasses should implement this method to do any required initialization such as letting Jifty know about required CSS files, JS files, etc. =cut sub init {} =head2 render Jifty->web->out($renderer->render(%args)); See L for the arguments. It must (at least) accept the arguments given to the L method. The C method may either return it's output or print it out using L. =cut sub render {} =head1 SEE ALSO L, L =head1 AUTHOR Andrew Sterling Hanenkamp C<< >> =head1 COPYRIGHT AND LICENSE Copyright 2007 Boomer Consulting, Inc. This is free software and may be modified and distributed under the same terms as Perl itself. =cut 1; libjifty-plugin-chart-perl-1.01+dfsg.orig/lib/Jifty/Plugin/Chart/Dispatcher.pm0000644000175000017500000000444411155144770026543 0ustar gregoagregoause strict; use warnings; package Jifty::Plugin::Chart::Dispatcher; use Jifty::Dispatcher -base; use Jifty::YAML; =head1 NAME Jifty::Plugin::Chart::Dispatcher - Dispatcher for the chart API plugin =cut my %classes = ( chart => 'Chart::$TYPE', gd_graph => 'GD::Graph::$TYPE', xmlswf => 'XML::Simple', ); =head1 RULES =head2 chart/*/* Grabs the chart configuration stored in the key indicated in C<$1> and unpacks it using L. It then passes it to the correct L template. =cut on 'chart/*/*' => run { my $renderer = $1; # No renderer? Act like a 404. last_rule if not defined $classes{$renderer}; # Create a session ID to lookup the chart configuration my $session_id = 'chart_' . $2; # Unpack the data and then clear it from the session my $args = Jifty::YAML::Load( Jifty->web->session->get( $session_id ) ); # XXX if there are a lot of charts, this could asplode #Jifty->web->session->remove( $session_id ); # No data? Act like a 404 last_rule unless defined $args; # Request might override width/height: $args->{width} = get 'width' if get 'width'; $args->{height} = get 'height' if get 'height'; # XXX TODO Is there a better way to guess the pixel heights when using CSS # heights initially? # Remove 'px' from width/height and set to 400/300 if not in pixels ($args->{width} =~ s/px$//) or ($args->{width} = 400); ($args->{height} =~ s/px$//) or ($args->{height} = 300); # No zeroes! Ba Ba Blacksheep. $args->{width} ||= 400; $args->{height} ||= 300; if (my $class = $classes{$renderer}) { # Use the "type" to determine which class to use $class =~ s/\$TYPE/$args->{type}/g; # Load that class or die if it does not exist $class->require; # Remember the class name for the view $args->{class} = $class; } # Send them on to chart the chart set 'args' => $args; show "chart/$renderer"; }; =head1 SEE ALSO L =head1 AUTHOR Andrew Sterling Hanenkamp C<< >> =head1 COPYRIGHT AND LICENSE Copyright 2007 Boomer Consulting, Inc. This is free software and may be modified and redistributed under the same terms as Perl itself. =cut 1; libjifty-plugin-chart-perl-1.01+dfsg.orig/lib/Jifty/Plugin/Chart/Web.pm0000644000175000017500000001277211155144770025175 0ustar gregoagregoause strict; use warnings; package Jifty::Plugin::Chart::Web; use Scalar::Util qw/ looks_like_number /; =head1 NAME Jifty::Plugin::Chart::Web - Base class to add to Jifty::Web's ISA =head1 DESCRIPTION When the L is loaded, this class is added as a base class for L to add the L method to that class. =head1 METHODS =head2 chart Jifty->web->out(Jifty->web->chart(%args)); The arguments passed in C<%args> may include: =over =item type This will be one of the following scalar values indicating the kind of chart. A given renderer may not support every type listed here. A renderer might support others in addition to these, but if it supports these it should use these names. =over =item points This is the default value. A scatter plot with each dataset represented using differnet dot styles. =item lines A line plot with each dataset presented as separate line. =item bars A bar chart with each dataset set side-by-side. =item stackedbars A bar chart with each dataset stacked on top of each other. =item pie A pie chart with a single dataset representing the values for different pieces of the pie. =item horizontalbars A bar chart turned sideways. =item area An area chart uses lines to represent each dataset, but the lines are stacked on top of each other with filled areas underneath. =back =item width This is the width the chart should take when rendered. This may be a number, indicating the width in pixels. It may also be any value that would be appropriate for the C CSS property. Defaults to C, which indicates that the chart will take on whatever size the box it is in will be. See L. =item height This is the height the chart should take when rendered. This may be a number, indicating the height in pixels. It may also be any value that would be appropriate for the C CSS property. Defaults to C, which indicates that the chart will take on whatever size the box it is in will be. See L. =item data An array of arrays containing the data. The first array in the parent array is a list of labels. Each following array is the set of data points matching each label in the first array. Defaults to no data (i.e., it must be given if anything useful is to happen). =item class This allows you to associated an additional class or classes to the element containing the chart. This can be a string containing on or more class names separated by spaces or an array of class names. =item renderer This allows you to use a different renderer than the one configured in F. Give the renderer as a class name, which will be initialized for you. =item options This is a hash containing additional options to pass to the renderer and are renderer specific. This may include anything that is not otherwise set by one of the other options above. =back Here's an example: <% Jifty->web->chart( type => 'Pie', width => '100%', height => '300px', data => sub { [ [ 2004, 2005, 2006, 2007 ], [ 26, 37, 12, 42 ] ]; }, class => 'visualizeronimicon', ) %> Be sure to output anything returned by the method (unless it returns undef). =cut sub chart { my $self = shift; my ($plugin) = Jifty->find_plugin('Jifty::Plugin::Chart'); # TODO It might be a good idea to make this config.yml-able # Setup the defaults my %args = ( renderer => $plugin->renderer, type => 'points', width => undef, height => undef, data => [], class => [], @_, ); # load the renderer $args{renderer} = $plugin->init_renderer($args{renderer}); # canonicalize the width/height $args{width} .= 'px' if looks_like_number($args{width}); $args{height} .= 'px' if looks_like_number($args{height}); # canonicalize the type argument (always lowercase) $args{type} = lc $args{type}; # canonicalize the class argument if (not ref $args{class}) { $args{class} = defined $args{class} ? [ $args{class} ] : []; } # Add the chart class, which is always present push @{ $args{class} }, 'chart'; # Turn any subs into values returned for my $key (keys %args) { $args{$key} = $args{$key}->(\%args) if ref $args{$key} eq 'CODE'; } # Call the rendering class' render method return $args{renderer}->render(%args); } =head1 CSS FOR CHARTS The chart API allows you to build the charts without explicit pixel widths and heights. In fact, you can not specify C and C and perform the styling in your regular CSS stylesheets by using the "chart" class associated with every chart or by using custom classes with the C argument. See your renderer class documentation for further details. =head1 JAVASCRIPT FOR CHARTS Charts typically require JavaScript to render properly. If the client does not have JavaScript available, the chart may not work or could look very bad. If you are using one of the image based renderers like L, it is recommended that you stick with pixel widths if you expect clients with limited or no JavaScript support. =head1 SEE ALSO L, L =head1 AUTHOR Andrew Sterling Hanenkamp C<< >> =head1 COPYRIGHT AND LICENSE Copyright 2007 Boomer Consulting, Inc. This is free software and may be modified and distributed under the same terms as Perl itself. =cut 1; libjifty-plugin-chart-perl-1.01+dfsg.orig/lib/Jifty/Plugin/Chart/View.pm0000644000175000017500000001013711227307332025356 0ustar gregoagregoause strict; use warnings; package Jifty::Plugin::Chart::View; use Jifty::View::Declare -base; =head1 NAME Jifty::Plugin::Chart::View - Views for the renderers built into the Chart plugin =head1 TEMPLATES =head2 chart/chart This shows a chart using L. It expects to find the arguments in the C parameter, which is setup for it in L. This will output a PNG file unless there is an error building the chart. =cut template 'chart/chart' => sub { # Load the arguments my $args = get 'args'; # Set the output type to the PNG file type Jifty->handler->apache->content_type('image/png'); # Render the chart and output the PNG file generated eval { my $chart = $args->{class}->new( $args->{width}, $args->{height} ); $chart->set(%{ $args->{options} }) if $args->{options}; # XXX scalar_png() is undocumented!!! Might bad to rely upon. outs_raw($chart->scalar_png($args->{data})); }; # Should have thrown an error if bad stuff happened, handle that if ($@) { Jifty->log->error("Failed to render chart: $@"); die $@; } }; =head2 chart/gd_graph This shows a chart using L. It expects to find the arguments in the C parameter, which is setup for it in L. This will output a PNG file unless there is an error building the chart. =cut template 'chart/gd_graph' => sub { # Load the arguments my $args = get 'args'; # Set the output type to the PNG file type Jifty->handler->apache->content_type('image/png'); # Render the chart and output the PNG file generated eval { my $graph = $args->{class}->new( $args->{width}, $args->{height} ); $graph->set(%{ $args->{options} }) if $args->{options}; $graph->set_legend(@{ $args->{legend} } ) if $args->{legend}; my $gd = $graph->plot($args->{data}) or die $graph->error; outs_raw($gd->png); }; # Should have thrown an error if bad stuff happened, handle that if ($@) { Jifty->log->error("Failed to render chart: $@"); die $@; } }; =head2 chart/xmlswf This shows a chart using XML SWF. It expects to find the arguments in the C parameter, which is setup for it in L. This will output an XML source file unless there is an error building the chart. =cut template 'chart/xmlswf' => sub { # Load the arguments my $args = get 'args'; # Set the output type to the XML file type Jifty->handler->apache->content_type('application/xml'); # The KeyAttr thing is a bloody hack to get ordering right my $xml = $args->{class}->new( RootName => 'chart', KeyAttr => { row => '+string' } ); my $labels = shift @{ $args->{data} }; # Base chart options my %chart = ( chart_type => { content => $args->{type} }, axis_category => { size => '11', color => '808080' }, axis_value => { size => '11', color => '808080' }, axis_ticks => { major_color => '808080' }, legend_label => { size => '11' }, chart_value => { position => 'cursor', size => '11', color => '666666' }, %{ $args->{options} || {} }, chart_data => { row => [ { string => [ {}, @$labels ], }, ], }, ); if ($args->{type} eq 'composite') { $chart{chart_type} = { string => $args->{types} }; } for my $i ( 0 .. $#{ $args->{data} } ) { my $label = $args->{legend}[$i]; push @{$chart{'chart_data'}{'row'}}, { string => [ defined $label ? $label : {} ], number => $args->{data}[$i], }; } outs_raw( $xml->XMLout( \%chart ) ); }; =head1 SEE ALSO L =head1 AUTHOR Andrew Sterling Hanenkamp C<< >> =head1 COPYRIGHT AND LICENSE Copyright 2007 Boomer Consulting, Inc. This is free software and may be modified and distributed under the same terms as Perl itself. =cut 1; libjifty-plugin-chart-perl-1.01+dfsg.orig/lib/Jifty/Plugin/Chart/Renderer/0000755000175000017500000000000011454064767025670 5ustar gregoagregoalibjifty-plugin-chart-perl-1.01+dfsg.orig/lib/Jifty/Plugin/Chart/Renderer/GD/0000755000175000017500000000000011227307503026144 5ustar gregoagregoalibjifty-plugin-chart-perl-1.01+dfsg.orig/lib/Jifty/Plugin/Chart/Renderer/GD/Graph.pm0000644000175000017500000000433711155144770027557 0ustar gregoagregoause strict; use warnings; package Jifty::Plugin::Chart::Renderer::GD::Graph; use base qw/ Jifty::Plugin::Chart::Renderer /; =head1 NAME Jifty::Plugin::Chart::Renderer::GD::Graph - A chart renderer using GD::Graph =head1 SYNOPSIS In F: Plugins: - Chart: DefaultRenderer: Jifty::Plugin::Chart::Renderer::GD::Graph =head1 DESCRIPTION This is a chart renderer that uses L to build charts. =head1 METHODS =head2 init Adds the F script to those loaded. =cut sub init { Jifty->web->add_javascript('chart_img_behaviour.js'); } =head2 render Renders an IMG tag referring to the L image view. =cut sub render { my $self = shift; my %args = @_; # GD::Graph types from generic types my %types = ( lines => 'lines', bars => 'bars', horizontalbars => 'hbars', points => 'points', linespoints => 'linespoints', # non-standart area => 'area', pie => 'pie', mixed => 'mixed', # non-standard ); # Convert the generic type to a GD::Graph type $args{type} = $types{ $args{type} } || undef; # Save the data for retrieval from the session later my $chart_id = Jifty->web->serial; my $session_id = 'chart_' . $chart_id; Jifty->web->session->set( $session_id => Jifty::YAML::Dump(\%args) ); # Build up the chart tag my $img; $img = qq{}; # Output the tag and include the chart's configuration key Jifty->web->out($img); # Make sure we don't return anything that will get output return; } =head1 AUTHOR Andrew Sterling Hanenkamp C<< >> =head1 COPYRIGHT AND LICENSE Copyright 2007 Boomer Consulting, Inc. This is free software and may be modified and distributed under the same terms as Perl itself. =cut 1; libjifty-plugin-chart-perl-1.01+dfsg.orig/lib/Jifty/Plugin/Chart/Renderer/Google.pm0000644000175000017500000003351311155144770027436 0ustar gregoagregoause strict; use warnings; package Jifty::Plugin::Chart::Renderer::Google; use base qw/ Jifty::Plugin::Chart::Renderer /; use URI::Escape qw(uri_escape); use List::Util qw(max min sum); use List::MoreUtils qw(mesh); use Scalar::Util qw(looks_like_number); =head1 NAME Jifty::Plugin::Chart::Renderer::Google - A chart renderer using Google Charts =head1 DESCRIPTION This is an alternate chart renderer used by the L plugin. It works by rendering an tag in the HTML output. =head1 METHODS =head2 render Implemented the L method interface. =cut sub render { my $self = shift; my %args = ( width => 200, height => 100, labels => [], geoarea => 'world', min_minus => 0, max_plus => 0, format => '%0.2f', markers => [], axis_styles => [], @_ ); # Translations from generic type to Google charts types (incomplete) my %types = ( trend => 'lc', lines => 'lxy', line => 'lxy', sparkline => 'ls', horizontalbars => 'bhg', bars => 'bvg', bar => 'bvg', stackedhorizontalbars => 'bhs', stackedbars => 'bvs', pie => 'p', pie3d => 'p3', venn => 'v', scatter => 's', points => 's', point => 's', map => 't', geo => 't', ); # Make sure the type is ready to be used my $type = $types{ lc $args{type} } || undef; # Not a supported type if ( not defined $type ) { $self->log->warn("Unsupported chart type: $args{'type'}!"); return; } # Kill the "px" unit $args{'width'} =~ s/px$//; $args{'height'} =~ s/px$//; # a bit of dwim $args{'min_value'} ||= delete $args{'min_values'}; $args{'max_value'} ||= delete $args{'max_values'}; # Check size and die if wrong for ( qw(width height) ) { if ( $type eq 't' ) { my $max = $_ eq 'width' ? 440 : 220; die "$_ over ${max}px" if $args{$_} > $max; } else { die "$_ over 1000px" if $args{$_} > 1000; } } # Check chart area die "Chart area over maximum allowed (300,000 for charts, 96,800 for maps)" if $args{'width'} * $args{'height'} > ( $type eq 't' ? 96800 : 300000 ); if ( $type eq 't' ) { $args{'codes'} = shift @{ $args{'data'} }; # Light blue for water $args{'bgcolor'} = "EAF7FE" if not defined $args{'bgcolor'}; } # Set max/min value if we don't have one if ( not defined $args{'max_value'} or not defined $args{'min_value'} ) { my $max = 0; my $min = 0; if ( $args{'type'} =~ /stacked/i ) { # Stacked bar charts are additive, so max / min take a little # more work to calculate my $size = @{ $args{'data'}->[0] } - 1; for my $index ( 0 .. $size ) { my @stack = grep { defined } map { $_->[$index] } @{ $args{'data'} }; if ( not defined $args{'max_value'} ) { # Add all of the positive numbers my $lmax = sum grep { $_ > 0 } @stack; $max = $lmax if defined $lmax and $lmax > $max; } if ( not defined $args{'min_value'} ) { # Add all of the negative numbers my $lmin = sum grep { $_ < 0 } @stack; $min = $lmin if defined $lmin and $lmin < $min; } } } else { # Everything else, simply find the largest and smallest value in # any of the datasets for my $dataset ( @{ $args{'data'} } ) { if ( not defined $args{'max_value'} ) { my $lmax = max grep { defined } @$dataset; $max = $lmax if $lmax > $max; } if ( not defined $args{'min_value'} ) { my $lmin = min grep { defined } @$dataset; $min = $lmin if $lmin < $min; } } } $args{'max_value'} = $max if not defined $args{'max_value'}; $args{'min_value'} = $min if not defined $args{'min_value'}; } # Build the base chart URL my $url = 'http://chart.apis.google.com/chart?'; # Add the type $url .= "cht=$type"; # Add the width $url .= "&chs=$args{'width'}x$args{'height'}"; # Format the data unless ( not defined $args{'format'} ) { for my $set ( @{$args{'data'}} ) { @$set = map { looks_like_number($_) ? sprintf $args{'format'}, $_ : $_ } @$set; } } # Add the data (encoding it first) if ( $type eq 't' ) { # Map! $url .= "&chtm=$args{'geoarea'}"; $url .= "&chld=" . join '', @{ $args{'codes'} }; # We need to do simple encoding $url .= "&chd=s:" . $self->_simple_encode_data( $args{'max_value'}, @{$args{'data'}} ); } else { # Deal with out of range horizontal markers here by fixing our range if ( @{ $args{'markers'} } ) { for my $marker ( grep { $_->{'type'} eq 'h' } @{$args{'markers'}} ) { $args{'max_value'} = $marker->{'position'} if $marker->{'position'} > $args{'max_value'}; $args{'min_value'} = $marker->{'position'} if $marker->{'position'} < $args{'min_value'}; } } # If we want to add/subtract a percentage of the max/min, then # calculate it now for my $limit (qw( min max )) { my $key = $limit . "_" . ($limit eq 'min' ? 'minus' : 'plus'); if ( $args{$key} =~ s/\%$// ) { $args{$key} = ($args{$key} / 100) * abs($args{ $limit."_value" }); } } for ('min_value', 'max_value') { $args{$_} = [ $args{$_} ] if !ref($args{$_}); } my @min = map { $_ - $args{'min_minus'} } @{ $args{'min_value'} }; my @max = map { $_ - $args{'max_plus'} } @{ $args{'max_value'} }; # repeat if necessary push @min, ($min[-1]) x (@{ $args{'data'} } - @min); push @max, ($max[-1]) x (@{ $args{'data'} } - @max); $args{'calculated_min'} = \@min; $args{'calculated_max'} = \@max; # Format the min and max for use a few lines down unless ( not defined $args{'format'} ) { @min = map { sprintf $args{'format'}, $_ } @min; @max = map { sprintf $args{'format'}, $_ } @max; } # If it's a number, pass it through, otherwise replace it with a # number out of range to mark it as undefined my @data; for my $data_idx ( 0 .. @{$args{'data'}}-1 ) { push @data, [ map { looks_like_number($_) ? $_ : $min[$data_idx] - 42 } @{ $args{'data'}[$data_idx] } ]; } # Let's do text encoding with data scaling $url .= "&chd=t:" . join '|', map { join ',', @$_ } @data; $url .= "&chds=" . join(',', mesh @min, @max); } # Add a title if ( defined $args{'title'} ) { $args{'title'} =~ tr/\n/|/; $url .= "&chtt=" . uri_escape( $args{'title'} ); } # Add the legend if ( $args{'legend'} ) { my $key = $args{'type'} =~ /pie/i ? 'chl' : 'chdl'; $url .= "&$key=" . join '|', map { uri_escape($_) } @{ $args{'legend'} }; $url .= "&chdlp=" . substr $args{'legend_position'}, 0, 1 if $args{'legend_position'}; } # Add any axes if ( $args{'axes'} ) { $url .= "&chxt=" . $args{'axes'}; if ( defined $args{'labels'} ) { my @labels; my @ranges; my $index = 0; for my $labelset ( @{ $args{'labels'} } ) { if ( ref $labelset eq 'ARRAY' and @$labelset ) { push @labels, "$index:|" . join '|', map { uri_escape($_) } @$labelset; } elsif ( not ref $labelset and $labelset eq 'RANGE' ) { push @ranges, sprintf "%d,$args{'format'},$args{'format'}", $index, $args{'calculated_min'}[$index], $args{'calculated_max'}[$index]; } $index++; } my @styles; $index = 0; for my $style ( @{ $args{'axis_styles'} } ) { if ( ref $style eq 'ARRAY' and @$style ) { push @styles, join ',', $index, @$style; } $index++; } $url .= "&chxl=" . join '|', @labels if @labels; $url .= "&chxr=" . join '|', @ranges if @ranges; $url .= "&chxs=" . join '|', @styles if @styles; # label positions $url .= "&chxp=" . join ',', @{ $args{'positions'} } if defined $args{'positions'}; } } # Add colors if ( defined $args{'colors'} ) { $url .= "&chco=" . join ',', @{ $args{'colors'} }; } if ( defined $args{'bgcolor'} ) { $url .= "&chf=bg,s,$args{'bgcolor'}"; } # Add bar widths and zero line for bar charts if ( $args{'type'} =~ /bar/i ) { @{ $args{'bar_width'} } = $self->_calculate_bar_width(\%args) if @{ $args{'bar_width'} || [] } == 0; $url .= "&chbh=" . join ',', @{ $args{'bar_width'} }; $url .= "&chp=" . $args{'zero_line'} if defined $args{'zero_line'}; } # Add shape/range markers if ( @{ $args{'markers'} } ) { my @markers; my $index = 0; for my $data ( @{$args{'markers'}} ) { my %marker = ( type => 'x', color => '000000', dataset => 0, position => 0, size => 5, priority => 0, %$data, ); # Calculate where the position should be for horizontal lines if ( $marker{'type'} eq 'h' ) { $marker{'position'} = $self->_position_in_range( $marker{'position'}, $args{'calculated_min'}[$index], $args{'calculated_max'}[$index] ); } # Calculate where the position should be for ranges elsif ( lc($marker{'type'}) eq 'r' ) { for (qw( start end )) { $marker{$_} = $args{'calculated_min'}[$index] if $marker{$_} eq 'MIN'; $marker{$_} = $args{'calculated_max'}[$index] if $marker{$_} eq 'MAX'; $marker{$_} = $self->_position_in_range( $marker{$_}, $args{'calculated_min'}[$index], $args{'calculated_max'}[$index] ); } } # Fix text type elsif ( $marker{'type'} eq 't' ) { $marker{'type'} .= uri_escape( $marker{'text'} ); } if ( lc($marker{'type'}) eq 'r' ) { $marker{'position'} = sprintf $args{'format'}, $marker{'start'}; $marker{'size'} = sprintf $args{'format'}, $marker{'end'}; } else { # Format the position $marker{'position'} = sprintf $args{'format'}, $marker{'position'}; } push @markers, join(',', @marker{qw( type color dataset position size priority )}); } $url .= "&chm=" . join '|', @markers if @markers; ++$index; } return $url if $args{'want_url'}; Jifty->web->_redirect($url) if $args{'redirect'}; Jifty->web->out( qq{} ); # Make sure we don't return anything that will get output return; } sub _position_in_range { my ( $self, $point, $min, $max ) = @_; return 0 if not defined $point or not defined $min or not defined $max; return $min if $max == $min; return ($point - $min) / ($max - $min); } # Borrowed with slight modifications from Google::Chart::Data::SimpleEncoding sub _simple_encode_data { my $self = shift; my $maxes = shift; my $data = shift; $maxes = [ ($maxes) x @$data ] if !ref($maxes); my $i = 0; my $result = ''; my @map = ('A'..'Z', 'a'..'z', 0..9); for my $value ( @$data ) { if ( looks_like_number($value) ) { my $index = int($value / $maxes->[$i] * (@map - 1)); $index = 0 if $index < 0; $index = @map if $index > @map; $result .= $map[$index]; } else { $result .= '_'; } ++$i; } return $result; } sub _calculate_bar_width { my $self = shift; my $args = shift; my $bars = @{ $args->{data}[0] }; my $bar_width = $args->{width}; $bar_width -= 10; # chart margins $bar_width -= 3 * $bars; # bar margins $bar_width /= $bars; # each bar's width return int($bar_width), 3; } =head1 SEE ALSO L, L =head1 AUTHOR Thomas Sibley =head1 COPYRIGHT AND LICENSE Copyright 2008 Best Practical Solutions, LLC This is free software and may be modified and distributed under the same terms as Perl itself. =cut 1; libjifty-plugin-chart-perl-1.01+dfsg.orig/lib/Jifty/Plugin/Chart/Renderer/GoogleViz.pm0000644000175000017500000001121411227307332030114 0ustar gregoagregoapackage Jifty::Plugin::Chart::Renderer::GoogleViz; use strict; use warnings; use base 'Jifty::Plugin::Chart::Renderer'; use Jifty::JSON 'objToJson'; =head1 NAME Jifty::Plugin::Chart::Renderer::GoogleViz - chart renderer using Google Charts JS =head2 init We need to load Google's JS. =cut sub init { my $self = shift; Jifty->web->add_external_javascript("http://www.google.com/jsapi"); } =head2 render =cut sub render { my $self = shift; my %args = @_; my $chart_id = 'chart_' . Jifty->web->serial; my $chart_class = $self->chart_class; my $load_params = objToJson($self->load_params); my $draw_params = objToJson($self->draw_params($args{options})); my $callback_name = 'callback_' . Jifty->web->serial; Jifty->web->out(<< "JS_HEADER"); JS_FOOTER Jifty->web->out(qq{
}); #" return; } =head2 load_params Load the "packages" required for the visualization; define a C method which returns a list of them. =cut sub load_params { my $self = shift; return { packages => [ $self->packages_to_load ], }; } =head2 render_data Renders the columns and the data. =cut sub render_data { my $self = shift; my %args = @_; my $cols = $self->add_columns(%args); $self->add_data(%args, columns => $cols); } =head2 add_columns Adds the columns to the visualization. Each column is a key-value pair; the key is the column's C and the value is either a string (the C) or a hashref. The hashref may specify C and C