Make valid perl unit tests for function list
This commit is contained in:
Don HO
parent
0488e92e9f
commit
95a924f4f3
@ -1,89 +1,300 @@
|
|||||||
<?php
|
#!/usr/bin/env perl
|
||||||
/*
|
|
||||||
************************************************************************
|
# pltags - create a tags file for Perl code, for use by vi(m)
|
||||||
Copyright [2014] [PagSeguro Internet Ltda.]
|
#
|
||||||
Licensed under the Apache License, Version 2.0 (the "License");
|
# Distributed with Vim <http://www.vim.org/>, latest version always available
|
||||||
you may not use this file except in compliance with the License.
|
# at <http://www.mscha.com/mscha.html?pltags#tools>
|
||||||
You may obtain a copy of the License at
|
#
|
||||||
http://www.apache.org/licenses/LICENSE-2.0
|
# Version 2.3, 28 February 2002
|
||||||
Unless required by applicable law or agreed to in writing, software
|
#
|
||||||
distributed under the License is distributed on an "AS IS" BASIS,
|
# Written by Michael Schaap <pltags@mscha.com>. Suggestions for improvement
|
||||||
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
# are very welcome!
|
||||||
See the License for the specific language governing permissions and
|
#
|
||||||
limitations under the License.
|
# This script will not work with Perl 4 or below!
|
||||||
************************************************************************
|
#
|
||||||
*/
|
# Revision history:
|
||||||
require_once "../PagSeguroLibrary/PagSeguroLibrary.php";
|
# 1.0 1997? Original version, quickly hacked together
|
||||||
class NotificationListener
|
# 2.0 1999? Completely rewritten, better structured and documented,
|
||||||
|
# support for variables, packages, Exuberant Ctags extensions
|
||||||
|
# 2.1 Jun 2000 Fixed critical bug (typo in comment) ;-)
|
||||||
|
# Support multiple level packages (e.g. Archive::Zip::Member)
|
||||||
|
# 2.2 Jul 2001 'Glob' wildcards - especially useful under Windows
|
||||||
|
# (thanks to Serge Sivkov and Jason King)
|
||||||
|
# Bug fix: reset package name for each file
|
||||||
|
# 2.21 Jul 2001 Oops... bug in variable detection (/local../ -> /^local.../)
|
||||||
|
# 2.3 Feb 2002 Support variables declared with "our"
|
||||||
|
# (thanks to Lutz Mende)
|
||||||
|
|
||||||
|
# Complain about undeclared variables
|
||||||
|
use strict;
|
||||||
|
|
||||||
|
# Used modules
|
||||||
|
use Getopt::Long;
|
||||||
|
|
||||||
|
# Options with their defaults
|
||||||
|
my $do_subs = 1; # --subs, --nosubs include subs in tags file?
|
||||||
|
my $do_vars = 1; # --vars, --novars include variables in tags file?
|
||||||
|
my $do_pkgs = 1; # --pkgs, --nopkgs include packages in tags file?
|
||||||
|
my $do_exts = 1; # --extensions, --noextensions
|
||||||
|
# include Exuberant Ctags extensions
|
||||||
|
|
||||||
|
# Global variables
|
||||||
|
my $VERSION = "2.21"; # pltags version
|
||||||
|
my $status = 0; # GetOptions return value
|
||||||
|
my $file = ""; # File being processed
|
||||||
|
my @tags = (); # List of produced tags
|
||||||
|
my $is_pkg = 0; # Are we tagging a package?
|
||||||
|
my $has_subs = 0; # Has this file any subs yet?
|
||||||
|
my $package_name = ""; # Name of current package
|
||||||
|
my $var_continues = 0; # Variable declaration continues on last line
|
||||||
|
my $line = ""; # Current line in file
|
||||||
|
my $stmt = ""; # Current Perl statement
|
||||||
|
my @vars = (); # List of variables in declaration
|
||||||
|
my $var = ""; # Variable in declaration
|
||||||
|
my $tagline = ""; # Tag file line
|
||||||
|
|
||||||
|
# Create a tag file line and push it on the list of found tags
|
||||||
|
sub MakeTag($$$$$)
|
||||||
{
|
{
|
||||||
public static function main()
|
my ($tag, # Tag name
|
||||||
|
$type, # Type of tag
|
||||||
|
$is_static, # Is this a static tag?
|
||||||
|
$file, # File in which tag appears
|
||||||
|
$line) = @_; # Line in which tag appears
|
||||||
|
|
||||||
|
my $tagline = ""; # Created tag line
|
||||||
|
|
||||||
|
# Only process tag if not empty
|
||||||
|
if ($tag)
|
||||||
{
|
{
|
||||||
$code = (isset($_POST['notificationCode']) && trim($_POST['notificationCode']) !== "" ?
|
# Get rid of \n, and escape / and \ in line
|
||||||
trim($_POST['notificationCode']) : null);
|
chomp $line;
|
||||||
$type = (isset($_POST['notificationType']) && trim($_POST['notificationType']) !== "" ?
|
$line =~ s/\\/\\\\/g;
|
||||||
trim($_POST['notificationType']) : null);
|
$line =~ s/\//\\\//g;
|
||||||
if ($code && $type) {
|
|
||||||
$notificationType = new PagSeguroNotificationType($type);
|
# Create a tag line
|
||||||
$strType = $notificationType->getTypeFromValue();
|
$tagline = "$tag\t$file\t/^$line\$/";
|
||||||
switch ($strType) {
|
|
||||||
case 'TRANSACTION':
|
# If we're told to do so, add extensions
|
||||||
self::transactionNotification($code);
|
if ($do_exts)
|
||||||
break;
|
{
|
||||||
case 'APPLICATION_AUTHORIZATION':
|
$tagline .= ";\"\t$type"
|
||||||
self::authorizationNotification($code);
|
. ($is_static ? "\tfile:" : "")
|
||||||
break;
|
. ($package_name ? "\tclass:$package_name" : "");
|
||||||
case 'PRE_APPROVAL':
|
}
|
||||||
self::preApprovalNotification($code);
|
|
||||||
break;
|
# Push it on the stack
|
||||||
default:
|
push (@tags, $tagline);
|
||||||
LogPagSeguro::error("Unknown notification type [" . $notificationType->getValue() . "]");
|
|
||||||
}
|
|
||||||
self::printLog($strType);
|
|
||||||
} else {
|
|
||||||
LogPagSeguro::error("Invalid notification parameters.");
|
|
||||||
self::printLog();
|
|
||||||
}
|
|
||||||
}
|
|
||||||
private static function transactionNotification($notificationCode)
|
|
||||||
{
|
|
||||||
$credentials = PagSeguroConfig::getAccountCredentials();
|
|
||||||
try {
|
|
||||||
$transaction = PagSeguroNotificationService::checkTransaction($credentials, $notificationCode);
|
|
||||||
// Do something with $transaction
|
|
||||||
} catch (PagSeguroServiceException $e) {
|
|
||||||
die($e->getMessage());
|
|
||||||
}
|
|
||||||
}
|
|
||||||
private static function authorizationNotification($notificationCode)
|
|
||||||
{
|
|
||||||
$credentials = PagSeguroConfig::getApplicationCredentials();
|
|
||||||
try {
|
|
||||||
$authorization = PagSeguroNotificationService::checkAuthorization($credentials, $notificationCode);
|
|
||||||
// Do something with $authorization
|
|
||||||
} catch (PagSeguroServiceException $e) {
|
|
||||||
die($e->getMessage());
|
|
||||||
}
|
|
||||||
}
|
|
||||||
private static function preApprovalNotification($preApprovalCode)
|
|
||||||
{
|
|
||||||
$credentials = PagSeguroConfig::getAccountCredentials();
|
|
||||||
try {
|
|
||||||
$preApproval = PagSeguroNotificationService::checkPreApproval($credentials, $preApprovalCode);
|
|
||||||
// Do something with $preApproval
|
|
||||||
|
|
||||||
} catch (PagSeguroServiceException $e) {
|
|
||||||
die($e->getMessage());
|
|
||||||
}
|
|
||||||
}
|
|
||||||
private static function printLog($strType = null)
|
|
||||||
{
|
|
||||||
$count = 4;
|
|
||||||
echo "<h2>Receive notifications</h2>";
|
|
||||||
if ($strType) {
|
|
||||||
echo "<h4>notifcationType: $strType</h4>";
|
|
||||||
}
|
|
||||||
echo "<p>Last <strong>$count</strong> items in <strong>log file:</strong></p><hr>";
|
|
||||||
echo LogPagSeguro::getHtml($count);
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
NotificationListener::main();
|
|
||||||
|
# Parse package name from statement
|
||||||
|
sub PackageName($)
|
||||||
|
{
|
||||||
|
my ($stmt) = @_; # Statement
|
||||||
|
|
||||||
|
# Look for the argument to "package". Return it if found, else return ""
|
||||||
|
if ($stmt =~ /^package\s+([\w:]+)/)
|
||||||
|
{
|
||||||
|
my $pkgname = $1;
|
||||||
|
|
||||||
|
# Remove any parent package name(s)
|
||||||
|
$pkgname =~ s/.*://;
|
||||||
|
return $pkgname;
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
return "";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# Parse sub name from statement
|
||||||
|
sub SubName($)
|
||||||
|
{
|
||||||
|
my ($stmt) = @_; # Statement
|
||||||
|
|
||||||
|
# Look for the argument to "sub". Return it if found, else return ""
|
||||||
|
if ($stmt =~ /^sub\s+([\w:]+)/)
|
||||||
|
{
|
||||||
|
my $subname = $1;
|
||||||
|
|
||||||
|
# Remove any parent package name(s)
|
||||||
|
$subname =~ s/.*://;
|
||||||
|
return $subname;
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
return "";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# Parse all variable names from statement
|
||||||
|
sub VarNames($)
|
||||||
|
{
|
||||||
|
my ($stmt) = @_;
|
||||||
|
|
||||||
|
# Remove my or local from statement, if present
|
||||||
|
$stmt =~ s/^(my|our|local)\s+//;
|
||||||
|
|
||||||
|
# Remove any assignment piece
|
||||||
|
$stmt =~ s/\s*=.*//;
|
||||||
|
|
||||||
|
# Now find all variable names, i.e. "words" preceded by $, @ or %
|
||||||
|
@vars = ($stmt =~ /[\$\@\%]([\w:]+)\b/g);
|
||||||
|
|
||||||
|
# Remove any parent package name(s)
|
||||||
|
map(s/.*://, @vars);
|
||||||
|
|
||||||
|
return (@vars);
|
||||||
|
}
|
||||||
|
|
||||||
|
############### Start ###############
|
||||||
|
|
||||||
|
print "\npltags $VERSION by Michael Schaap <mscha\@mscha.com>\n\n";
|
||||||
|
|
||||||
|
# Get options
|
||||||
|
$status = GetOptions("subs!" => \$do_subs,
|
||||||
|
"vars!" => \$do_vars,
|
||||||
|
"pkgs!" => \$do_pkgs,
|
||||||
|
"extensions!" => \$do_exts);
|
||||||
|
|
||||||
|
# Usage if error in options or no arguments given
|
||||||
|
unless ($status && @ARGV)
|
||||||
|
{
|
||||||
|
print "\n" unless ($status);
|
||||||
|
print " Usage: $0 [options] filename ...\n\n";
|
||||||
|
print " Where options can be:\n";
|
||||||
|
print " --subs (--nosubs) (don't) include sub declarations in tag file\n";
|
||||||
|
print " --vars (--novars) (don't) include variable declarations in tag file\n";
|
||||||
|
print " --pkgs (--nopkgs) (don't) include package declarations in tag file\n";
|
||||||
|
print " --extensions (--noextensions)\n";
|
||||||
|
print " (don't) include Exuberant Ctags / Vim style\n";
|
||||||
|
print " extensions in tag file\n\n";
|
||||||
|
print " Default options: ";
|
||||||
|
print ($do_subs ? "--subs " : "--nosubs ");
|
||||||
|
print ($do_vars ? "--vars " : "--novars ");
|
||||||
|
print ($do_pkgs ? "--pkgs " : "--nopkgs ");
|
||||||
|
print ($do_exts ? "--extensions\n\n" : "--noextensions\n\n");
|
||||||
|
print " Example: $0 *.pl *.pm ../shared/*.pm\n\n";
|
||||||
|
exit;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Loop through files on command line - 'glob' any wildcards, since Windows
|
||||||
|
# doesn't do this for us
|
||||||
|
foreach $file (map { glob } @ARGV)
|
||||||
|
{
|
||||||
|
# Skip if this is not a file we can open. Also skip tags files and backup
|
||||||
|
# files
|
||||||
|
next unless ((-f $file) && (-r $file) && ($file !~ /tags$/)
|
||||||
|
&& ($file !~ /~$/));
|
||||||
|
|
||||||
|
print "Tagging file $file...\n";
|
||||||
|
|
||||||
|
$is_pkg = 0;
|
||||||
|
$package_name = "";
|
||||||
|
$has_subs = 0;
|
||||||
|
$var_continues = 0;
|
||||||
|
|
||||||
|
open (IN, $file) or die "Can't open file '$file': $!";
|
||||||
|
|
||||||
|
# Loop through file
|
||||||
|
foreach $line (<IN>)
|
||||||
|
{
|
||||||
|
# Statement is line with comments and whitespace trimmed
|
||||||
|
($stmt = $line) =~ s/#.*//;
|
||||||
|
$stmt =~ s/^\s*//;
|
||||||
|
$stmt =~ s/\s*$//;
|
||||||
|
|
||||||
|
# Nothing left? Never mind.
|
||||||
|
next unless ($stmt);
|
||||||
|
|
||||||
|
# This is a variable declaration if one was started on the previous
|
||||||
|
# line, or if this line starts with my or local
|
||||||
|
if ($var_continues or ($stmt =~/^my\b/)
|
||||||
|
or ($stmt =~/^our\b/) or ($stmt =~/^local\b/))
|
||||||
|
{
|
||||||
|
# The declaration continues if the line does not end with ;
|
||||||
|
$var_continues = ($stmt !~ /;$/);
|
||||||
|
|
||||||
|
# Loop through all variable names in the declaration
|
||||||
|
foreach $var (VarNames($stmt))
|
||||||
|
{
|
||||||
|
# Make a tag for this variable unless we're told not to. We
|
||||||
|
# assume that a variable is always static, unless it appears
|
||||||
|
# in a package before any sub. (Not necessarily true, but
|
||||||
|
# it's ok for most purposes and Vim works fine even if it is
|
||||||
|
# incorrect)
|
||||||
|
if ($do_vars)
|
||||||
|
{
|
||||||
|
MakeTag($var, "v", (!$is_pkg or $has_subs), $file, $line);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# This is a package declaration if the line starts with package
|
||||||
|
elsif ($stmt =~/^package\b/)
|
||||||
|
{
|
||||||
|
# Get name of the package
|
||||||
|
$package_name = PackageName($stmt);
|
||||||
|
|
||||||
|
if ($package_name)
|
||||||
|
{
|
||||||
|
# Remember that we're doing a package
|
||||||
|
$is_pkg = 1;
|
||||||
|
|
||||||
|
# Make a tag for this package unless we're told not to. A
|
||||||
|
# package is never static.
|
||||||
|
if ($do_pkgs)
|
||||||
|
{
|
||||||
|
MakeTag($package_name, "p", 0, $file, $line);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# This is a sub declaration if the line starts with sub
|
||||||
|
elsif ($stmt =~/^sub\b/)
|
||||||
|
{
|
||||||
|
# Remember that this file has subs
|
||||||
|
$has_subs = 1;
|
||||||
|
|
||||||
|
# Make a tag for this sub unless we're told not to. We assume
|
||||||
|
# that a sub is static, unless it appears in a package. (Not
|
||||||
|
# necessarily true, but it's ok for most purposes and Vim works
|
||||||
|
# fine even if it is incorrect)
|
||||||
|
if ($do_subs)
|
||||||
|
{
|
||||||
|
MakeTag(SubName($stmt), "s", (!$is_pkg), $file, $line);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
close (IN);
|
||||||
|
}
|
||||||
|
|
||||||
|
# Do we have any tags? If so, write them to the tags file
|
||||||
|
if (@tags)
|
||||||
|
{
|
||||||
|
# Add some tag file extensions if we're told to
|
||||||
|
if ($do_exts)
|
||||||
|
{
|
||||||
|
push (@tags, "!_TAG_FILE_FORMAT\t2\t/extended format/");
|
||||||
|
push (@tags, "!_TAG_FILE_SORTED\t1\t/0=unsorted, 1=sorted/");
|
||||||
|
push (@tags, "!_TAG_PROGRAM_AUTHOR\tMichael Schaap\t/mscha\@mscha.com/");
|
||||||
|
push (@tags, "!_TAG_PROGRAM_NAME\tpltags\t//");
|
||||||
|
push (@tags, "!_TAG_PROGRAM_VERSION\t$VERSION\t/supports multiple tags and extended format/");
|
||||||
|
}
|
||||||
|
|
||||||
|
print "\nWriting tags file.\n";
|
||||||
|
|
||||||
|
open (OUT, ">tags") or die "Can't open tags file: $!";
|
||||||
|
|
||||||
|
foreach $tagline (sort @tags)
|
||||||
|
{
|
||||||
|
print OUT "$tagline\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
close (OUT);
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
print "\nNo tags found.\n";
|
||||||
|
}
|
||||||
|
|||||||
@ -1 +1 @@
|
|||||||
{"root":"unitTest"}
|
{"leaves":["MakeTag","PackageName","SubName","VarNames"],"root":"unitTest"}
|
||||||
Loading…
Reference in New Issue
Block a user