silentbob/plugins/plugin_perl.cxx

   1 /*
   2  * (c) Oleg Puchinin 2006.
   3  * graycardinalster@gmail.com
   4  *
   5  * 25/06/06 - Perl plugin for SilentBob.
   6  *
   7  */
   8
   9 #include <stdio.h>
  10 #include <stdlib.h>
  11 #include <unistd.h>
  12 #include <ctype.h>
  13 #include <gclib/gclib.h>
  14 #include <mod.h>
  15 #include <head.h>
  16 #include <dbg.h>
  17 #include <the_tt.h>
  18 #include <the_fly.hpp>
  19
  20 extern "C" DArray * plugin_init (struct env_t *env);
  21 void __perl_files (char * f_name);
  22 int perl_make_ctags (char * f_name, FILE * of);
  23 char t_op2 (char ** d_in, char ** d_prev);
  24
  25 struct env_t *ENV;
  26 FILE * ofile;
  27
  28 void pl_sub (struct tt_state_t *tt, int line, char * d_out, char ch)
  29 {
  30         char *S;
  31         char *part1, *part2;
  32
  33         S = strchr (d_out, '(');
  34         if (S)
  35                 *S = '\0';
  36
  37         part1 = strchr (d_out, ' ');
  38         ++part1;
  39         part2 = strchr (part1, ':');
  40
  41         if (part2) {
  42                 *part2 = '\0';
  43                 ++part2;
  44                 part2 = strip (part2);
  45                 strip2 (part2);
  46         }
  47
  48         strip2 (part1);
  49         if (part2)
  50                 fprintf (ofile, "%s:%s\t%s\t%i\n", part1, part2, tt->fileName, line);
  51         else
  52                 fprintf (ofile, "%s\t%s\t%i\n", part1, tt->fileName, line);
  53 }
  54
  55 void pl_package (struct tt_state_t *tt, int line, char * d_out, char ch)
  56 {
  57         char * S;
  58         char * ptr;
  59
  60         S = strchr (d_out, ' ');
  61         if (! S)
  62                 return;
  63
  64         ++S;
  65         strip2 (S);
  66
  67         ptr = rindex (S, ':');
  68         if (ptr) {
  69                 ++ptr;
  70                 fprintf (ofile, "%s\t%s\t%i\n", ptr, tt->fileName, line);
  71         }
  72         fprintf (ofile, "%s\t%s\t%i\n", S, tt->fileName, line);
  73 }
  74
  75 void perl_make_tag (struct tt_state_t *tt, char * d_out, char ch)
  76 {
  77         int line;
  78
  79         line = tt->attachment[ENV->t_op_no].pair_line+1;
  80         if (*d_out == ' ')
  81                 ++d_out;
  82
  83         if ((ch == '{') && (! strncmp (d_out, "sub ", 4))) {
  84                 pl_sub (tt, line, d_out, ch);
  85                 return;
  86         }
  87
  88         if ((ch == ';') && (! strncmp (d_out, "package ", 8))) {
  89                 pl_package (tt, line, d_out, ch);
  90                 return;
  91         }
  92 }
  93
  94 void pl_lookup ()
  95 {
  96         int i;
  97         DArray * d_array;
  98
  99         __perl_files (ENV->tmp_files);
 100         d_array = new DArray (32);
 101         d_array->from_file (ENV->tmp_files);
 102         d_array->foreach ((Dfunc_t)chomp);
 103
 104         for (i = 0; i < d_array->get_size (); ++i) {
 105                 if (! d_array->get (i))
 106                         continue;
 107
 108                 perl_make_ctags (d_array->get (i), ofile);
 109         }
 110
 111         unlink (ENV->tmp_files);
 112         d_array->foreach (free);
 113         delete d_array;
 114 }
 115
 116 int perl_make_ctags (char * f_name, FILE * of)
 117 {
 118         char ch;
 119         char *d_ptr,*d_out; // for t_op2
 120         int block_depth = 0;
 121         struct tt_state_t *tt;
 122
 123         ofile = of;
 124         if (f_name == NULL) {
 125                 pl_lookup ();
 126                 return 0;
 127         }
 128
 129         ENV->t_op_no = 0;
 130         tt = CNEW (tt_state_t, 1);
 131         memset (tt, 0, sizeof (struct tt_state_t));
 132         tt->fileName = strdup (f_name);
 133         THE_FLY::fly_for_file (tt);
 134
 135         d_out = tt->result;
 136         d_ptr = d_out;
 137         while (true) {
 138                 ch = t_op2 (&d_ptr, &d_out);
 139                 ENV->t_op_no++;
 140
 141                 if (ch == '\0')
 142                         break;
 143
 144                 if (! block_depth)
 145                         perl_make_tag (tt, d_out, ch);
 146
 147                 if (ch == '{')
 148                         ++block_depth;
 149
 150                 if (ch == '}')
 151                         --block_depth;
 152
 153                 if (block_depth < 0)
 154                         block_depth = 0;
 155         }
 156
 157         fflush (ofile);
 158         free_tt_state (tt);
 159         return 0;
 160 }
 161
 162 int perl_call_tags (char * f_name)
 163 {
 164         printf ("Under construction.\n");
 165         return 0;
 166 }
 167
 168 char perl_opt (DArray * d_opts, int * i)
 169 {
 170         if (! d_opts || ! i)
 171                 return 0;
 172
 173         if (EQ (d_opts->get (*i), "--perl")) {
 174                 ENV->language =  (char *) "Perl";
 175                 return 1;
 176         }
 177         return 0;
 178 }
 179
 180 void __perl_files (char * f_name)
 181 {
 182         unlink (f_name);
 183         sblib_find ("./", "*.pm", f_name);
 184         sblib_find ("./", "*.pl", f_name);
 185         sblib_find ("./", "*.ph", f_name);
 186 }
 187
 188 char perl_files_opt (DArray * d_opts, int * i)
 189 {
 190         if (! d_opts || ! i)
 191                 return 0;
 192
 193         if (EQ (d_opts->get (*i), "--files") && EQ (ENV->language, "Perl")) {
 194                 __perl_files ((char *) "./perl_files");
 195                 return 1;
 196         }
 197
 198         return 0;
 199 }
 200
 201 void perl_plugin_short_info ()
 202 {
 203         printf ("Perl language support.");
 204 }
 205
 206
 207 void perl_plugin_long_info ()
 208 {
 209         printf ("Perl language support.\n");
 210         printf ("Version: 1.0-rc1\n");
 211         printf ("options: --perl --make-ctags\n");
 212 }
 213
 214 void perl_files_short_info ()
 215 {
 216         printf ("Perl files.");
 217 }
 218
 219 void perl_files_long_info ()
 220 {
 221         printf ("Perl files.\n");
 222         printf ("Version: 1.0\n");
 223         printf ("options: --perl --files\n");
 224 }
 225
 226 DArray * perl_init ()
 227 {
 228         DArray * Ret;
 229         struct mod_t * pm;
 230         struct mod_t * mod_perlfiles;
 231         struct mod_t * pm_lang;
 232
 233         Ret = new DArray (2);
 234         pm = CNEW (mod_t, 1);
 235         pm_lang = CNEW (mod_t, 1);
 236         mod_perlfiles = CNEW (mod_t, 1);
 237
 238         memset (pm, 0, sizeof (mod_t));
 239         memset (pm_lang, 0, sizeof (mod_t));
 240         memset (mod_perlfiles, 0, sizeof (mod_t));
 241
 242         pm->Version = strdup ("0.1");
 243         pm->opt = perl_opt;
 244
 245         mod_perlfiles->Version = strdup ("1.0");
 246         mod_perlfiles->short_info = perl_files_short_info;
 247         mod_perlfiles->long_info = perl_files_long_info;
 248         mod_perlfiles->opt = perl_files_opt;
 249
 250         pm_lang->Version = strdup ("1.0-rc1");
 251         pm_lang->short_info = perl_plugin_short_info;
 252         pm_lang->long_info = perl_plugin_long_info;
 253         pm_lang->language = strdup ("Perl");
 254         pm_lang->the = THE_FLY::fly_for_file;
 255         pm_lang->make_ctags = perl_make_ctags;
 256
 257         ENV->listOptions->add ("--perl");
 258         ENV->listOptions->add ("--files");
 259
 260         Ret->add (LPCHAR (pm));
 261         Ret->add (LPCHAR (pm_lang));
 262         Ret->add (LPCHAR (mod_perlfiles));
 263
 264         return Ret;
 265 }
 266
 267 DArray * plugin_init (struct env_t *env)
 268 {
 269 #if 1
 270         return perl_init ();
 271 #else
 272 //      printf ("Perl module under construction.\n");
 273         return NULL;
 274 #endif
 275 }
 276