view release on metacpan or  search on metacpan

lib/Pod/Simple/Wiki/Twiki/Upload.pm  view on Meta::CPAN

			print "already up-to-date.\n";
		} elsif ($old_content =~ /$newcontent/ or $old_content =~ /\Q$header\E/) {
			# my $res = $twiki->save_topic($header."\n\n".$newtext);
			$twiki->save_new_stuff($new_content);
			print "uploaded\n";
		} else {
			print "skipping: content doesn't match starting cookie\n";
		}
	}
}


sub contains_pod {
	my ($file) = @_;
	return '' unless -T $file;  # Only look at text files

	my $fh = IO::File->new( $file ) or die "Can't open $file: $!";
	while (my $line = <$fh>) {
		return 1 if $line =~ /^\=(?:head|pod|item)/;
	}

	return '';
}


sub find_bin_pods {
	my %files;
	for my $spec ("blib/script") {
		my $dir = localize_dir_path($spec);
		next unless -e $dir;
		for my $file ( @{ rscan_dir( $dir ) } ) {
			next if $file =~ /\.bat$/;
			if ( contains_pod( $file ) ) {
				$files{$file} = $file;
			}
			elsif (my $pm_file = find_client_lib( $file ) ) {
				$files{$file} = $pm_file;
			}
		}
	}
	return %files;
}


sub find_client_lib {
	my ($file) = @_;
	return '' unless -T $file;      # Only look at text files

	my $fh = IO::File->new( $file ) or die "Can't open $file: $!";
	while (my $line = <$fh>) {
		next if $line !~ /^use\s+(?:aliased\s+(['"]))((?:[\w:]+)?Client::\w+)\1;$/;
		# We have a client class.
		return join( '/', 'lib', split /::/, $2 ) . '.pm'
	}
	return;
}


sub localize_dir_path {
	my ($path) = @_;
	return File::Spec->catdir( split m{/}, $path );
}


sub rscan_dir {
	my ($dir, $pattern) = @_;
	my @result;
	local $_; # find() can overwrite $_, so protect ourselves
	my $subr = !$pattern ? sub {push @result, $File::Find::name} :
		!ref($pattern) || (ref $pattern eq 'Regexp') ? sub {push @result, $File::Find::name if /$pattern/} :
		ref($pattern) eq 'CODE' ? sub {push @result, $File::Find::name if $pattern->()} : die "Unknown pattern type";
  
	File::Find::find({wanted => $subr, no_chdir => 1}, $dir);
	return \@result;
}


# NOTE this is a blocking operation if(-t STDIN)
sub _is_interactive {
	return -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ;   # Pipe?
}

sub _is_unattended {
	return $ENV{PERL_MM_USE_DEFAULT} || ( ! _is_interactive() && eof STDIN );
}

sub _readline {
	return undef if _is_unattended();

	my $answer = <STDIN>;
	chomp $answer if defined $answer;
	return $answer;
}


sub prompt {
	my ($mess) = @_;
	if (not defined $mess) {
		die "prompt() called without a prompt message";
	}

	# use a list to distinguish a default of undef() from no default
	my @def;
	@def = (shift) if @_;
	# use dispdef for output
	my @dispdef = scalar(@def) ?  ('[', (defined($def[0]) ? $def[0] . ' ' : ''), ']') : (' ', '');

	local $|=1;
	print "$mess ", @dispdef;

	if ( _is_unattended() && !@def ) {
		die "ERROR: This runseems to be unattended, but there is no default value for this question.  Aborting.";
	}

	my $ans = _readline();

	     # Ctrl-D or unattendeda           User hit return
	if ( !defined($ans)                    or !length($ans) ) {
		print "$dispdef[1]\n";
		$ans = scalar(@def) ? $def[0] : '';
	}